YAP 7.1.0
All Classes Files Functions Variables Typedefs Enumerations Enumerator Macros Modules Pages
charsio.yap
Go to the documentation of this file.
1/*************************************************************************
2* *
3* YAP Prolog *
4* *
5* Yap Prolog was developed at NCCUP - Universidade do Porto *
6* *
7* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8* *
9**************************************************************************
10* *
11* File: charsio.yap *
12* Last rev: 5/12/99 *
13* mods: *
14* comments: I/O on character strings *
15* *
16*************************************************************************/
17
18/**
19 * @file charsio.yap
20 * @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
21 * @date Tue Nov 17 01:17:33 2015
22 *
23 * @brief Several operations on text.
24 * @{
25 *
26*/
27
28
29:- module(charsio, [
43 term_to_atom/2
44 ]).
45
46/** @defgroup charsio Operations on Sequences of Codes.
47@ingroup YAPLibrary
48@{
49
50Term to sequence of codes conversion, mostly replaced by engine code.
51You can use the following directive to load the files.
52
53
54```
55:- use_module(library(charsio)).
56```
57
58It includes the following predicates:
59 - atom_to_chars/2
60 - atom_to_chars/3
61 - format_to_chars/3
62 - format_to_chars/4
63 - number_to_chars/2
64 - number_to_chars/3
65 - open_chars_stream/2
66 - read_from_chars/2
67 - term_to_atom/2
68 - with_output_to_chars/2
69 - with_output_to_chars/3
70 - with_output_to_chars/4
71 - write_to_chars/2
72 - write_to_chars/3
73
74*/
75
76:- meta_predicate(with_output_to_chars(0,?)).
77:- meta_predicate(with_output_to_chars(0,-,?)).
78:- meta_predicate(with_output_to_chars(0,-,?,?)).
79
80/** @pred format_to_chars(+ _Form_, + _Args_, - _Result_)
81
82Execute the built-in procedure format/2 with form _Form_ and
83arguments _Args_ outputting the result to the string of character
84codes _Result_.
85*/
86format_to_chars(Format, Args, Codes) :-
87 format(codes(Codes), Format, Args).
88
89/** @pred format_to_chars(+ _Form_, + _Args_, - _Result_, - _Result0_)
90
91Execute the built-in procedure format/2 with form _Form_ and
92arguments _Args_ outputting the result to the difference list of
93character codes _Result-Result0_.
94
95*/
96format_to_chars(Format, Args, OUT, L0) :-
97 format(codes(OUT, L0), Format, Args).
98
99/** @pred write_to_chars(+ _Term_, - _Result_)
100
101Execute the built-in procedure write/1 with argument _Term_
102outputting the result to the string of character codes _Result_.
103*/
104write_to_chars(Term, Codes) :-
105 format(codes(Codes), '~w', [Term]).
106
107/** @pred write_to_chars(+ _Term_, - _Result0_, - _Result_)
108
109Execute the built-in procedure write/1 with argument _Term_
110outputting the result to the difference list of character codes
111 _Result-Result0_.
112*/
113write_to_chars(Term, Out, Tail) :-
114 format(codes(Out,Tail),'~w',[Term]).
115
116/** @pred atom_to_chars(+ _Atom_, - _Result_)
117
118Convert the atom _Atom_ to the string of character codes
119 _Result_.
120*/
121atom_to_chars(Atom, OUT) :-
122 atom_codes(Atom, OUT).
123
124/** @pred atom_to_chars(+ _Atom_, - _Result0_, - _Result_)
125
126Convert the atom _Atom_ to the difference list of character codes
127 _Result-Result0_.
128*/
129atom_to_chars(Atom, L0, OUT) :-
130 format(codes(L0, OUT), '~a', [Atom]).
131
132/** @pred number_to_chars(+ _Number_, - _Result_)
133
134Convert the number _Number_ to the string of character codes
135 _Result_.
136*/
137number_to_chars(Number, OUT) :-
138 number_codes(Number, OUT).
139
140/** @pred number_to_chars(+ _Number_, - _Result0_, - _Result_)
141
142Convert the atom _Number_ to the difference list of character codes
143 _Result-Result0_.
144*/
145number_to_chars(Number, L0, OUT) :-
146 var(Number), var,
147 throw(error(instantiation_error,number_to_chars(Number, L0, OUT))).
148number_to_chars(Number, L0, OUT) :-
149 number(Number), number,
150 format(codes(L0, OUT), '~w', [Number]).
151number_to_chars(Number, L0, OUT) :-
152 throw(error(type_error(number,Number),number_to_chars(Number, L0, OUT))).
153
154/** @pred open_chars_stream(+ _Chars_, - _Stream_)
155
156Open the list of character codes _Chars_ as a stream _Stream_.
157*/
158open_chars_stream(Codes, Stream) :-
159 open_chars_stream(Codes, Stream, '').
160
161open_chars_stream(Codes, Stream, Postfix) :-
162 predicate_property(memory_file:open_memory_file(_,_,_),_), predicate_property,
163 predicate_property:new_memory_file(MF),
164 new_memory_file:open_memory_file(MF, write, Out),
165 format(Out, '~s~w', [Codes, Postfix]),
166 close(Out),
167 close:open_memory_file(MF, read, Stream,
168 [ free_on_close(true)
169 ]).
170open_chars_stream(Codes, Stream, Postfix) :-
171 ensure_loaded(library(memfile)),
172 open_chars_stream(Codes, Stream, Postfix).
173
174/** @pred with_output_to_chars(? _Goal_, - _Chars_)
175
176Execute goal _Goal_ such that its standard output will be sent to a
177memory buffer. After successful execution the contents of the memory
178buffer will be converted to the list of character codes _Chars_.
179*/
180with_output_to_chars(Goal, Codes) :-
181 with_output_to(codes(Codes), Goal).
182
183/** @pred with_output_to_chars(? _Goal_, ? _Chars0_, - _Chars_)
184
185Execute goal _Goal_ such that its standard output will be sent to a
186memory buffer. After successful execution the contents of the memory
187buffer will be converted to the difference list of character codes
188 _Chars-Chars0_.
189*/
190with_output_to_chars(Goal, Codes, L0) :-
191 with_output_to(codes(Codes, L0), Goal).
192%% with_output_to_chars(:Goal, -Stream, -Codes, ?Tail) is det.
193%
194% As with_output_to_chars/2, but Stream is unified with the
195% temporary stream.
196
197/** @pred with_output_to_chars(? _Goal_, - _Stream_, ? _Chars0_, - _Chars_)
198
199
200Execute goal _Goal_ such that its standard output will be sent to a
201memory buffer. After successful execution the contents of the memory
202buffer will be converted to the difference list of character codes
203 _Chars-Chars0_ and _Stream_ receives the stream corresponding to
204the memory buffer.
205
206 */
207with_output_to_chars(Goal, Stream, Codes, Tail) :-
208 with_output_to(codes(Codes, Tail), with_stream(Stream, Goal)).
209
210with_stream(Stream, Goal) :-
211 current_output(Stream),
212 call(Goal).
213
214/** @pred read_from_chars( + Chars, - Term)
215
216Parse the list of character codes _Chars_ and return the result in
217the term _Term_. The character codes to be read must terminate with
218a dot character such that either (i) the dot character is followed by
219blank characters; or (ii) the dot character is the last character in the
220string.
221
222@note The SWI-Prolog version does not require Codes to end
223 in a full-stop.
224*/
225read_from_chars("", end_of_file) :- read_from_chars.
226read_from_chars(List, Term) :-
227 atom_to_term(List, Term, _).
228/**
229@}
230*/
231
232
close(+ S)
current_output(+ S)
predicate_property( P, Prop)
throw(+ Ball)
with_output_to(+ Ouput,: Goal)
atom_codes(?Atom, ?Codes)
number_codes(? I,? L)
call( 0:P )
ensure_loaded(+ F)
number( T)
var( T)
atom_to_chars(+ Atom, - Result)
atom_to_chars(+ Atom, - Result0, - Result)
format_to_chars(+ Form, + Args, - Result)
format_to_chars(+ Form, + Args, - Result, - Result0)
number_to_chars(+ Number, - Result)
number_to_chars(+ Number, - Result0, - Result)
open_chars_stream(+ Chars, - Stream)
read_from_chars( + Chars, - Term)
with_output_to_chars(? Goal, - Chars)
with_output_to_chars(? Goal, ? Chars0, - Chars)
with_output_to_chars(:Goal, -Stream, -Codes, ?Tail) is det
write_to_chars(+ Term, - Result)
write_to_chars(+ Term, - Result0, - Result)