5
9
10
11:- module(writef,
12 [ prconj/1, 13 prexpr/1, 14 prlist/1, 15 ttyprint/1, 16 fwritef/2,
17 fwritef/3, 18 writef/1,
19 writef/2 20 ]). 21
51
52
53 54 55
56ttyprint(X) :- 57 telling(Old),
58 tell(user),
59 print(X),
60 tell(Old).
61
62
63
64 65
66prlist([]) :- !.
67prlist([Head|Tail]) :-
68 tab(4), print(Head), nl,
69 prlist(Tail).
70
71
72
73 74
75prconj(true) :- !.
76prconj(&(A,B)) :-
77 prconj(A), !,
78 prconj(B).
79prconj((A,B)) :-
80 prconj(A), !,
81 prconj(B).
82prconj(A) :-
83 tab(4), print(A), nl.
84
85
86
87 88 89 90 91 92
93prexpr(Expr) :-
94 prexpr(Expr, 1, _, Elements, []),
95 nl, write(' where :'), nl,
96 prexpr(Elements, 1).
97
98
99prexpr(Term, Nin, Nout, Elements, Z) :-
100 prexpr(Term, Conn, A, B), !,
101 put("("), prexpr(A, Nin, Nmid, Elements, Rest),
102 put(" "), put(Conn),
103 put(" "), prexpr(B, Nmid, Nout, Rest, Z),
104 put(")").
105prexpr(Term, Nin, Nout, [Term|Z], Z) :-
106 Nout is Nin+1,
107 put("X"), write(Nin).
108
109
110 prexpr(&(A,B), 38, A, B). 111 prexpr(#(A,B), 35, A, B). 112 prexpr((A,B), 38, A, B). 113 prexpr((A;B), 124, A, B). 114
115
116prexpr([Head|Tail], M) :-
117 write(' X'), write(M), write(' = '),
118 print(Head), nl,
119 N is M+1, !,
120 prexpr(Tail, N).
121prexpr([], _).
122
123
124 125 126 127 128
129fwritef(File, Format) :-
130 fwritef(File, Format, []).
131
132fwritef(File, Format, List) :-
133 telling(Old),
134 tell(File),
135 writef(Format, List),
136 tell(Old).
137
138writef(Format) :-
139 writef(Format, []).
140
141
142writef(Format, Item) :-
143 writef_nonlist(Item, List), !,
144 writef(Format, List).
145writef([F|String], List) :-
146 writefs([F|String], List),
147 fail.
148writef(Format, List) :-
149 atom(Format),
150 name(Format, Fstring),
151 writefs(Fstring, List),
152 fail.
153writef(_, _).
154
155
156writef_nonlist([], _) :- !, fail.
157writef_nonlist([_|_], _) :- !, fail.
158writef_nonlist(Item, [Item]).
159
160
161
162 163 164
165writefs([], _List).
166
167writefs([37,A|Rest], List) :- 168 wf_act(A, List, More), !,
169 writefs(Rest, More).
170
171writefs([37,D|Rest], [Head|Tail]) :- 172 "0" =< D, D =< "9",
173 getpad(Size, Just, [D|Rest], More),
174 padout(Head, Size, Just), !,
175 writefs(More, Tail).
176
177writefs([92,C|Rest], List) :- 178 wf_char(C, [Char|CharL]),
179 putL([Char|CharL]), !,
180 writefs(Rest, List).
181writefs([92,C|Rest], List) :- 182 wf_char(C, Char),
183 put(Char), !,
184 writefs(Rest, List).
185
186writefs([92|Rest], List) :- 187 getcode(Char, Rest, More),
188 put(Char), !,
189 writefs(More, List).
190
191writefs([Char|Rest], List) :- 192 put(Char), !,
193 writefs(Rest, List).
194
195putL([]).
196putL([C|Cs]):-
197 put(C),
198 putL(Cs).
199
200
201wf_act( 99, [Head|Tail], Tail) :- 202 nl, !, prconj(Head).
203
204wf_act(100, [Head|Tail], Tail) :- 205 display(Head).
206
207wf_act(101, [Head|Tail], Tail) :- 208 nl, !, prexpr(Head).
209
210wf_act(102, List, List) :- 211 ttyflush.
212
213wf_act(103, [Head|Tail], Tail) :- 214 cfunctor(Head, F, N),
215 praggl(1, N, F, Head).
216
217wf_act(105, [Format,List|Tail], Tail):- 218 writef(Format, List).
219
220wf_act(106, [1,S,_|Tail], Tail) :- !, 221 write(S).
222wf_act(106, [_,_,P|Tail], Tail) :-
223 write(P).
224
225wf_act(108, [Head|Tail], Tail) :- 226 nl, !, prlist(Head).
227
228wf_act(110, [Char|Tail], Tail) :- 229 put(Char).
230
231wf_act(112, [Head|Tail], Tail) :- 232 print(Head).
233
234wf_act(113, [Head|Tail], Tail) :- 235 writeq(Head).
236
237wf_act(114, [Thing,Times|Tail],Tail) :- 238 writelots(Times, Thing).
239
240wf_act(115, [Head|Tail], Tail) :- 241 padout(Head).
242
243wf_act(116, [Head|Tail], Tail) :- 244 print(Head).
245
246wf_act(118, List, List) :- 247 numbervars(List, 0, _).
248
249wf_act(119, [Head|Tail], Tail) :- 250 write(Head).
251
252wf_act(120, [_|Tail], Tail). 253
254
255
256
257wf_char( 37, 37). 258wf_char( 92, 92). 259wf_char( 98, 8). 260wf_char(101, 27). 261wf_char(102, 12). 262wf_char(108, 10). 263wf_char(110, [13, 10]). 264wf_char(114, 13). 265wf_char(116, 9). 266
267
268
269getcode(Char) -->
270 getdigits(3, Digits), !,
271 { Digits \== [], name(Char, Digits), Char < 128 }.
272
273getdigits(Limit, [Digit|Digits]) -->
274 { Limit > 0 },
275 [Digit], { "0" =< Digit, Digit =< "9" },
276 { Fewer is Limit-1 }, !,
277 getdigits(Fewer, Digits).
278getdigits(_, []) --> [].
279
280
281writelots(N, T) :-
282 N > 0,
283 write(T),
284 M is N-1, !,
285 writelots(M, T).
286writelots(_, _).
287
288
293
294praggl(N, N, _, Term) :- !,
295 arg(N, Term, Arg),
296 print(Arg).
297praggl(L, N, F, Term) :-
298 arg(L, Term, Arg),
299 print(Arg),
300 put(32), write(F), put(32),
301 M is L+1, !,
302 praggl(M, N, F, Term).
303
304
310
311getpad(Size, Just) -->
312 getdigits(3, Digits), { name(Size, Digits) },
313 [Char], { getpad(Char, Just) }.
314
315 getpad(114, r). 316 getpad(108, l). 317 getpad(106, j). 318 getpad( 99, c). 319 getpad( 82, r). 320 getpad( 76, l). 321 getpad( 74, j). 322 getpad( 67, c). 323
324
325
326 327 328
329padout(Number, Style, j) :-
330 wf_suffix(Style, Number, Suffix),
331 !,
332 write(Suffix).
333padout(Atom, Size, Just) :-
334 atomic(Atom),
335 name(Atom, Name), !,
336 padout(Name, Size, Just).
337padout(String, Size, Just) :-
338 length(String, Length),
339 padout(Just, Size, Length, Left, Right),
340 tab(Left),
341 padout(String),
342 tab(Right).
343
344 345 346 347 348
349padout(l, Size, Length, 0, Right) :-
350 Excess is Size-Length, !,
351 getpad(Excess, 1, Right).
352padout(r, Size, Length, Left, 0) :-
353 Excess is Size-Length, !,
354 getpad(Excess, 1, Left).
355padout(c, Size, Length, Left, Right) :-
356 Prefix is (Size-Length)//2,
357 getpad(Prefix, 1, Left),
358 Remainder is (Size-Length)-Left, !,
359 getpad(Remainder, 1, Right).
360
361
362 363
364getpad(A, B, A) :- A >= B, !.
365getpad(_, B, B).
366
367
368 369
370padout([Head|Tail]) :-
371 put(Head), !,
372 padout(Tail).
373padout([]).
374
375
376wf_suffix(1, 1, ''). 377wf_suffix(1, _, s).
378wf_suffix(2, 1, ''). 379wf_suffix(2, _, es).
380wf_suffix(3, 1, y). 381wf_suffix(3, _, ies).
382wf_suffix(4, 1, fe). 383wf_suffix(4, _, ves).
384wf_suffix(5, 1, s). 385wf_suffix(5, _, '').
386wf_suffix(6, 1, es). 387wf_suffix(6, _, '').
388wf_suffix(7, 1, ies). 389wf_suffix(7, _, y).
390wf_suffix(8, 1, ''). 391wf_suffix(8, _, j)