rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
a622ffddfe529a172d2c9a7eb3cf7166fbeccd00
scryer-prolog/src/lib/format.pl
Markus Triska dcc4b91b35 ENHANCED: flush output for impure I/O (format/[2,3], portray_clause/1 etc.) 
Without this, we do not get a (timely) prompt in cases like:

    ?- format("press a key: ", []), get_single_char(C).

whereas for example write/1 already works in such cases:

    ?- write('press a key: '), get_single_char(C).
    press a key:
2020-07-25 09:49:02 +02:00

581 lines
19 KiB
Prolog
Raw Blame History

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written March 2020 by Markus Triska (triska@metalevel.at)
Part of Scryer Prolog.
This library provides the nonterminal format_//2 to describe
formatted strings. format/[2,3] are provided for impure output.
Usage:
======
phrase(format_(FormatString, Arguments), Ls)
format_//2 describes a list of characters Ls that are formatted
according to FormatString. FormatString is a string (i.e.,
a list of characters) that specifies the layout of Ls.
The characters in FormatString are used literally, except
for the following tokens with special meaning:
~w use the next available argument from Arguments here
~q use the next argument here, formatted as by writeq/1
~a use the next argument here, which must be an atom
~s use the next argument here, which must be a string
~d use the next argument here, which must be an integer
~f use the next argument here, a floating point number
~Nf where N is an integer: format the float argument
using N digits after the decimal point
~Nd like ~d, placing the last N digits after a decimal point;
if N is 0 or omitted, no decimal point is used.
~ND like ~Nd, separating digits to the left of the decimal point
in groups of three, using the character "," (comma)
~Nr where N is an integer between 2 and 36: format the
next argument, which must be an integer, in radix N.
The characters "a" to "z" are used for radices 10 to 36.
~NR like ~Nr, except that "A" to "Z" are used for radices > 9
~| place a tab stop at this position
~N| where N is an integer: place a tab stop at text column N
~N+ where N is an integer: place a tab stop N characters
after the previous tab stop (or start of line)
~t distribute spaces evenly between the two closest tab stops
~`Ct like ~t, use character C instead of spaces to fill the space
~n newline
~Nn N newlines
~i ignore the next argument
~~ the literal ~
Instead of ~N, you can write ~* to use the next argument from Arguments
as the numeric argument.
The predicate format/2 is like format_//2, except that it outputs
the text on the terminal instead of describing it declaratively.
format/3, used as format(Stream, FormatString, Arguments), outputs
the described string to the given Stream. If Stream is a binary
stream, then the code of each emitted character must be in 0..255.
If at all possible, format_//2 should be used, to stress pure parts
that enable easy testing etc. If necessary, you can emit the list Ls
with maplist(write, Ls).
The entire library only works if the Prolog flag double_quotes
is set to chars, the default value in Scryer Prolog. This should
also stay that way, to encourage a sensible environment.
Example:
?- phrase(format_("~s~n~`.t~w!~12|", ["hello",there]), Cs).
%@ Cs = "hello\n......there!"
%@ ; false.
I place this code in the public domain. Use it in any way you want.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
:- module(format, [format_//2,
format/2,
format/3,
portray_clause/1,
portray_clause/2,
listing/1
]).
:- use_module(library(dcgs)).
:- use_module(library(lists)).
:- use_module(library(error)).
:- use_module(library(charsio)).
:- use_module(library(between)).
format_(Fs, Args) -->
{ must_be(list, Fs),
must_be(list, Args),
phrase(cells(Fs,Args,0,[]), Cells) },
format_cells(Cells).
format_cells([]) --> [].
format_cells([Cell|Cells]) -->
format_cell(Cell),
format_cells(Cells).
format_cell(newline) --> "\n".
format_cell(cell(From,To,Es)) -->
% distribute the space between the glue elements
{ phrase(elements_gluevars(Es, 0, Length), Vs),
( Vs = [] -> true
; Space is To - From - Length,
( Space =< 0 -> maplist(=(0), Vs)
; length(Vs, NumGlue),
Distr is Space // NumGlue,
Delta is Space - Distr*NumGlue,
( Delta =:= 0 ->
maplist(=(Distr), Vs)
; BigGlue is Distr + Delta,
reverse(Vs, [BigGlue|Rest]),
maplist(=(Distr), Rest)
)
)
) },
format_elements(Es).
format_elements([]) --> [].
format_elements([E|Es]) -->
format_element(E),
format_elements(Es).
format_element(chars(Cs)) --> list(Cs).
format_element(glue(Fill,Num)) -->
{ length(Ls, Num),
maplist(=(Fill), Ls) },
list(Ls).
list([]) --> [].
list([L|Ls]) --> [L], list(Ls).
elements_gluevars([], N, N) --> [].
elements_gluevars([E|Es], N0, N) -->
element_gluevar(E, N0, N1),
elements_gluevars(Es, N1, N).
element_gluevar(chars(Cs), N0, N) -->
{ length(Cs, L),
N is N0 + L }.
element_gluevar(glue(_,V), N, N) --> [V].
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Our key datastructure is a list of cells and newlines.
A cell has the shape from_to(From,To,Elements), where
From and To denote the positions of surrounding tab stops.
Elements is a list of elements that occur in a cell,
namely terms of the form chars(Cs) and glue(Char, Var).
"glue" elements (TeX terminology) are evenly stretched
to fill the remaining whitespace in the cell. For each
glue element, the character Char is used for filling,
and Var is a free variable that is used when the
available space is distributed.
newline is used if ~n occurs in a format string.
It is is used because a newline character does not
consume whitespace in the sense of format strings.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
cells([], Args, Tab, Es) -->
( { Args == [] } -> cell(Tab, Tab, Es)
; { domain_error(empty_list, Args, format_//2) }
).
cells([~,~|Fs], Args, Tab, Es) --> !,
cells(Fs, Args, Tab, [chars("~")|Es]).
cells([~,w|Fs], [Arg|Args], Tab, Es) --> !,
{ write_term_to_chars(Arg, [], Chars) },
cells(Fs, Args, Tab, [chars(Chars)|Es]).
cells([~,q|Fs], [Arg|Args], Tab, Es) --> !,
{ write_term_to_chars(Arg, [quoted(true)], Chars) },
cells(Fs, Args, Tab, [chars(Chars)|Es]).
cells([~,a|Fs], [Arg|Args], Tab, Es) --> !,
{ atom_chars(Arg, Chars) },
cells(Fs, Args, Tab, [chars(Chars)|Es]).
cells([~|Fs0], Args0, Tab, Es) -->
{ numeric_argument(Fs0, Num, [d|Fs], Args0, [Arg0|Args]) },
!,
{ Arg is Arg0, % evaluate compound expression
must_be(integer, Arg),
number_chars(Arg, Cs0) },
( { Num =:= 0 } -> { Cs = Cs0 }
; { length(Cs0, L),
( L =< Num ->
Delta is Num - L,
length(Zs, Delta),
maplist(=('0'), Zs),
phrase(("0.",list(Zs),list(Cs0)), Cs)
; BeforeComma is L - Num,
length(Bs, BeforeComma),
append(Bs, Ds, Cs0),
phrase((list(Bs),".",list(Ds)), Cs)
) }
),
cells(Fs, Args, Tab, [chars(Cs)|Es]).
cells([~|Fs0], Args0, Tab, Es) -->
{ numeric_argument(Fs0, Num, ['D'|Fs], Args0, [Arg|Args]) },
!,
{ number_chars(Num, NCs),
phrase(("~",list(NCs),"d"), FStr),
phrase(format_(FStr, [Arg]), Cs0),
phrase(upto_what(Bs0, .), Cs0, Ds),
reverse(Bs0, Bs1),
phrase(groups_of_three(Bs1), Bs2),
reverse(Bs2, Bs),
append(Bs, Ds, Cs) },
cells(Fs, Args, Tab, [chars(Cs)|Es]).
cells([~,i|Fs], [_|Args], Tab, Es) --> !,
cells(Fs, Args, Tab, Es).
cells([~,n|Fs], Args, Tab, Es) --> !,
cell(Tab, Tab, Es),
n_newlines(1),
cells(Fs, Args, 0, []).
cells([~|Fs0], Args0, Tab, Es) -->
{ numeric_argument(Fs0, Num, [n|Fs], Args0, Args) },
!,
cell(Tab, Tab, Es),
n_newlines(Num),
cells(Fs, Args, 0, []).
cells([~,s|Fs], [Arg|Args], Tab, Es) --> !,
cells(Fs, Args, Tab, [chars(Arg)|Es]).
cells([~,f|Fs], [Arg|Args], Tab, Es) --> !,
{ format_number_chars(Arg, Chars) },
cells(Fs, Args, Tab, [chars(Chars)|Es]).
cells([~|Fs0], Args0, Tab, Es) -->
{ numeric_argument(Fs0, Num, [f|Fs], Args0, [Arg|Args]) },
!,
{ format_number_chars(Arg, Cs0),
phrase(upto_what(Bs, .), Cs0, Cs),
( Num =:= 0 -> Chars = Bs
; ( Cs = ['.'|Rest] ->
length(Rest, L),
( Num < L ->
length(Ds, Num),
append(Ds, _, Rest)
; Num =:= L ->
Ds = Rest
; Num > L,
Delta is Num - L,
% we should look into the float with
% greater accuracy here, and use the
% actual digits instead of 0.
length(Zs, Delta),
maplist(=('0'), Zs),
append(Rest, Zs, Ds)
)
; length(Ds, Num),
maplist(=('0'), Ds)
),
append(Bs, ['.'|Ds], Chars)
) },
cells(Fs, Args, Tab, [chars(Chars)|Es]).
cells([~|Fs0], Args0, Tab, Es) -->
{ numeric_argument(Fs0, Num, [r|Fs], Args0, [Arg|Args]) },
!,
{ integer_to_radix(Arg, Num, lowercase, Cs) },
cells(Fs, Args, Tab, [chars(Cs)|Es]).
cells([~|Fs0], Args0, Tab, Es) -->
{ numeric_argument(Fs0, Num, ['R'|Fs], Args0, [Arg|Args]) },
!,
{ integer_to_radix(Arg, Num, uppercase, Cs) },
cells(Fs, Args, Tab, [chars(Cs)|Es]).
cells([~,'`',Char,t|Fs], Args, Tab, Es) --> !,
cells(Fs, Args, Tab, [glue(Char,_)|Es]).
cells([~,t|Fs], Args, Tab, Es) --> !,
cells(Fs, Args, Tab, [glue(' ',_)|Es]).
cells([~|Fs0], Args0, Tab, Es) -->
{ numeric_argument(Fs0, Num, ['|'|Fs], Args0, Args) },
!,
cell(Tab, Num, Es),
cells(Fs, Args, Num, []).
cells([~|Fs0], Args0, Tab0, Es) -->
{ numeric_argument(Fs0, Num, [+|Fs], Args0, Args) },
!,
{ Tab is Tab0 + Num },
cell(Tab0, Tab, Es),
cells(Fs, Args, Tab, []).
cells([~,C|_], _, _, _) -->
{ atom_chars(A, [~,C]),
domain_error(format_string, A, format_//2) }.
cells(Fs0, Args, Tab, Es) -->
{ phrase(upto_what(Fs1, ~), Fs0, Fs),
Fs1 = [_|_] },
cells(Fs, Args, Tab, [chars(Fs1)|Es]).
format_number_chars(N0, Chars) :-
N is N0, % evaluate compound expression
number_chars(N, Chars).
n_newlines(0) --> !.
n_newlines(N0) --> { N0 > 0, N is N0 - 1 }, [newline], n_newlines(N).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
?- phrase(upto_what(Cs, ~), "abc~test", Rest).
Cs = [a,b,c], Rest = [~,t,e,s,t].
?- phrase(upto_what(Cs, ~), "abc", Rest).
Cs = [a,b,c], Rest = [].
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
upto_what([], W), [W] --> [W], !.
upto_what([C|Cs], W) --> [C], !, upto_what(Cs, W).
upto_what([], _) --> [].
groups_of_three([A,B,C,D|Rs]) --> !, [A,B,C], ",", groups_of_three([D|Rs]).
groups_of_three(Ls) --> list(Ls).
cell(From, To, Es0) -->
( { Es0 == [] } -> []
; { reverse(Es0, Es) },
[cell(From,To,Es)]
).
%?- numeric_argument("2f", Num, ['f'|Fs], Args0, Args).
%?- numeric_argument("100b", Num, Rs, Args0, Args).
numeric_argument(Ds, Num, Rest, Args0, Args) :-
( Ds = [*|Rest] ->
Args0 = [Num|Args]
; numeric_argument_(Ds, [], Ns, Rest),
foldl(pow10, Ns, 0-0, Num-_),
Args0 = Args
).
numeric_argument_([D|Ds], Ns0, Ns, Rest) :-
( member(D, "0123456789") ->
number_chars(N, [D]),
numeric_argument_(Ds, [N|Ns0], Ns, Rest)
; Ns = Ns0,
Rest = [D|Ds]
).
pow10(D, N0-Pow0, N-Pow) :-
N is N0 + D*10^Pow0,
Pow is Pow0 + 1.
integer_to_radix(I0, R, Which, Cs) :-
I is I0, % evaluate compound expression
must_be(integer, I),
must_be(integer, R),
( \+ between(2, 36, R) ->
domain_error(radix, R, format_//2)
; true
),
digits(Which, Ds),
( I < 0 ->
Pos is abs(I),
phrase(integer_to_radix_(Pos, R, Ds), Cs0, "-")
; I =:= 0 -> Cs0 = "0"
; phrase(integer_to_radix_(I, R, Ds), Cs0)
),
reverse(Cs0, Cs).
integer_to_radix_(0, _, _) --> !.
integer_to_radix_(I0, R, Ds) -->
{ M is I0 mod R,
nth0(M, Ds, D),
I is I0 // R
},
[D],
integer_to_radix_(I, R, Ds).
digits(lowercase, "0123456789abcdefghijklmnopqrstuvwxyz").
digits(uppercase, "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ").
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Impure I/O, implemented as a small wrapper over format_//2.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
format(Fs, Args) :-
current_output(Stream),
format(Stream, Fs, Args).
format(Stream, Fs, Args) :-
phrase(format_(Fs, Args), Cs),
% we use a specialised internal predicate that uses only a
% single "write" operation for efficiency. It is equivalent to
% maplist(put_char(Stream), Cs). It also works for binary streams.
'$put_chars'(Stream, Cs),
flush_output(Stream).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
?- phrase(cells("hello", [], 0, []), Cs).
?- phrase(cells("hello~10|", [], 0, []), Cs).
?- phrase(cells("~ta~t~10|", [], 0, []), Cs).
?- phrase(format_("~`at~50|", []), Ls).
?- phrase(cells("~`at~50|", [], 0, []), Cs),
phrase(format_cells(Cs), Ls).
?- phrase(cells("~ta~t~tb~tc~21|", [], 0, []), Cs).
Cs = [cell(0,21,[glue(' ',_38),chars([a]),glue(' ',_62),glue(' ',_67),chars([b]),glue(' ',_91),chars([c])])].
?- phrase(cells("~ta~t~4|", [], 0, []), Cs).
Cs = [cell(0,4,[glue(' ',_38),chars([a]),glue(' ',_62)])].
?- phrase(format_cell(cell(0,1,[glue(a,_94)])), Ls).
?- phrase(format_cell(cell(0,50,[chars("hello")])), Ls).
?- phrase(format_("~`at~50|~n", []), Ls).
?- phrase(format_("hello~n~tthere~6|", []), Ls).
?- format("~ta~t~4|", []).
a true
; false.
?- format("~ta~tb~tc~10|", []).
a b c true
; false.
?- format("~tabc~3|", []).
?- format("~ta~t~4|", []).
?- format("~ta~t~tb~tc~20|", []).
a b c true
; false.
?- format("~2f~n", [3]).
3.00
true
?- format("~20f", [0.1]).
0.10000000000000000000 true % this should use higher accuracy!
; false.
?- X is atan(2), format("~7f~n", [X]).
1.1071487
X = 1.1071487177940906
?- format("~`at~50|~n", []).
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
true
?- format("~t~N", []).
?- format("~q", [.]).
'.' true
?- format("~12r", [300]).
210 true
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
We also provide rudimentary versions of portray_clause/1 and listing/1.
In the eventual library organization, portray_clause/1 and
related predicates may be placed in their own dedicated library.
portray_clause/1 is useful for printing solutions in such a way
that they can be read back with read/1.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
portray_clause(Term) :-
current_output(Out),
portray_clause(Out, Term).
portray_clause(Stream, Term) :-
phrase(portray_clause_(Term), Ls),
format(Stream, "~s", [Ls]).
portray_clause_(Term) -->
{ term_variables(Term, Vs),
foldl(var_name, Vs, VNs, 0, _) },
portray_(Term, VNs), ".\n".
var_name(V, Name=V, Num0, Num) :-
charsio:fabricate_var_name(numbervars, Name, Num0),
Num is Num0 + 1.
literal(Lit, VNs) -->
{ write_term_to_chars(Lit, [quoted(true),variable_names(VNs)], Ls) },
list(Ls).
portray_(Var, VNs) --> { var(Var) }, !, literal(Var, VNs).
portray_((Head :- Body), VNs) --> !,
literal(Head, VNs), " :-\n",
body_(Body, 0, 3, VNs).
portray_((Head --> Body), VNs) --> !,
literal(Head, VNs), " -->\n",
body_(Body, 0, 3, VNs).
portray_(Any, VNs) --> literal(Any, VNs).
body_(Var, C, I, VNs) --> { var(Var) }, !,
indent_to(C, I),
literal(Var, VNs).
body_((A,B), C, I, VNs) --> !,
body_(A, C, I, VNs), ",\n",
body_(B, 0, I, VNs).
body_((A ; Else), C, I, VNs) --> % ( If -> Then ; Else )
{ nonvar(A), A = (If -> Then) },
!,
indent_to(C, I),
"( ",
{ C1 is I + 3 },
body_(If, C1, C1, VNs), " ->\n",
body_(Then, 0, C1, VNs), "\n",
else_branch(Else, C1, I, VNs).
body_((A;B), C, I, VNs) --> !,
indent_to(C, I),
"( ",
{ C1 is I + 3 },
body_(A, C1, C1, VNs), "\n",
else_branch(B, C1, I, VNs).
body_(Goal, C, I, VNs) -->
indent_to(C, I), literal(Goal, VNs).
else_branch(Else, C, I, VNs) -->
indent_to(0, I),
"; ",
body_(Else, C, C, VNs), "\n",
indent_to(0, I),
")".
indent_to(CurrentColumn, Indent) -->
{ Delta is Indent - CurrentColumn },
format_("~t~*|", [Delta]).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
?- portray_clause(a).
a.
?- portray_clause((a :- b)).
a :-
b.
?- portray_clause((a :- b, c, d)).
a :-
b,
c,
d.
true
?- portray_clause([a,b,c,d]).
"abcd".
?- portray_clause(X).
?- portray_clause((f(X) :- X)).
?- portray_clause((h :- ( a -> b; c))).
?- portray_clause((h :- ( (a -> x ; y) -> b; c))).
?- portray_clause((h(X) :- ( (a(X) ; y(A,B)) -> b; c))).
?- portray_clause((h :- (a,d;b,c) ; (b,e;d))).
?- portray_clause((a :- b ; c ; d)).
?- portray_clause((h :- L = '.')).
?- portray_clause(-->(a, (b, {t}, d))).
?- portray_clause((A :- B)).
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
listing(PI) :-
nonvar(PI),
( PI = Name/Arity0 ->
Arity = Arity0
; PI = Name//Arity0 ->
Arity is Arity0 + 2
; type_error(predicate_indicator, PI, listing/1)
),
functor(Head, Name, Arity),
\+ \+ clause(Head, _), % only true if there is at least one clause
( clause(Head, Body),
( Body == true ->
portray_clause(Head)
; portray_clause((Head :- Body))
),
false
; true
).
Reference in New Issue View Git Blame Copy Permalink