rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #2363 from triska/compile_format

Browse Source 
ENHANCED: Partial evaluation of format_//2 and related constructs
This commit is contained in:
Mark Thom
2024-03-20 18:52:08 -06:00
committed by GitHub
parent 0292cb73d3 767d90d5e7
commit 2fdbb94c79
1 changed files with 156 additions and 90 deletions
Download Patch File Download Diff File Expand all files Collapse all files

246
src/lib/format.pl
View File

@@ -84,12 +84,66 @@
% ``` % ```
format_(Fs, Args) --> format_(Fs, Args) -->
{ must_be(list, Fs), { format_args_cells(Fs, Args, Cells) },
must_be(list, Args),
unique_variable_names(Args, VNs),
phrase(cells(Fs,Args,0,[],VNs), Cells) },
format_cells(Cells). format_cells(Cells).
format_args_cells(Fs, Args, Cells) :-
must_be(chars, Fs),
must_be(list, Args),
unique_variable_names(Args, VNs),
phrase(cells(Fs,Args,0,[],VNs), Cells).
unique_variable_names(Term, VNs) :-
term_variables(Term, Vs),
foldl(var_name, Vs, VNs, 0, _).
var_name(V, Name=V, Num0, Num) :-
charsio:fabricate_var_name(numbervars, Name, Num0),
Num is Num0 + 1.
user:goal_expansion(format_(Fs,Args,Cs0,Cs),
format:format_cells(Cells, Cs0, Cs)) :-
catch(format_args_cells(Fs,Args,Cells),
E,
% no partial evaluation for uses of format_//2 that
% cannot be compiled statically, for example those where
% the argument list is a variable, or where ~*n occurs
% in the format string, or a domain error occurs
( ( E = error(instantiation_error,_)
; E = error(domain_error(_,_), _)
) ->
false
; throw(E)
)).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Partial evaluation of goals involving conditions that can be
checked at compilation time. This is especially useful for the
common case of conditions that test a numeric argument against 0.
It is currently used for the goals of ~d.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
goal_pe(G0, G) :- var(G0), !, G = G0.
goal_pe((A0,B0), (A,B)) :- !, goal_pe(A0, A), goal_pe(B0, B).
goal_pe((Body0 ; Else0), Body) :-
nonvar(Body0),
Body0 = ( If -> Then0 ),
!,
( ground(If) ->
( If ->
goal_pe(Then0, Body)
; goal_pe(Else0, Body)
)
; goal_pe(Then0, Then),
goal_pe(Else0, Else),
Body = ( If -> Then ; Else )
).
goal_pe(Goal, Goal).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
format_cells//1 is an interpreter for cells, describing a string.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
format_cells([]) --> []. format_cells([]) --> [].
format_cells([Cell|Cells]) --> format_cells([Cell|Cells]) -->
format_cell(Cell), format_cell(Cell),
@@ -125,6 +179,7 @@ format_element(glue(Fill,Num)) -->
{ length(Ls, Num), { length(Ls, Num),
maplist(=(Fill), Ls) }, maplist(=(Fill), Ls) },
seq(Ls). seq(Ls).
format_element(goal(_)) --> [].
elements_gluevars([], N, N) --> []. elements_gluevars([], N, N) --> [].
elements_gluevars([E|Es], N0, N) --> elements_gluevars([E|Es], N0, N) -->
@@ -135,6 +190,7 @@ element_gluevar(chars(Cs), N0, N) -->
{ length(Cs, L), { length(Cs, L),
N is N0 + L }. N is N0 + L }.
element_gluevar(glue(_,V), N, N) --> [V]. element_gluevar(glue(_,V), N, N) --> [V].
element_gluevar(goal(G), N, N) --> { G }.
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Our key datastructure is a list of cells and newlines. Our key datastructure is a list of cells and newlines.
@@ -142,12 +198,16 @@ element_gluevar(glue(_,V), N, N) --> [V].
From and To denote the positions of surrounding tab stops. From and To denote the positions of surrounding tab stops.
Elements is a list of elements that occur in a cell, Elements is a list of elements that occur in a cell,
namely terms of the form chars(Cs) and glue(Char, Var). namely terms of the form chars(Cs), glue(Char, Var)
and goal(G).
"glue" elements (TeX terminology) are evenly stretched "glue" elements (TeX terminology) are evenly stretched
to fill the remaining whitespace in the cell. For each to fill the remaining whitespace in the cell. For each
glue element, the character Char is used for filling, glue element, the character Char is used for filling,
and Var is a free variable that is used when the and Var is a free variable that is used when the
available space is distributed. available space is distributed. Goals are dynamically
executed to obtain characters. In this way, format strings
can be parsed and compiled statically when possible.
newline is used if ~n occurs in a format string. newline is used if ~n occurs in a format string.
It is used because a newline character does not It is used because a newline character does not
@@ -161,54 +221,55 @@ cells([], Args, Tab, Es, _) --> !,
cells([~,~|Fs], Args, Tab, Es, VNs) --> !, cells([~,~|Fs], Args, Tab, Es, VNs) --> !,
cells(Fs, Args, Tab, [chars("~")|Es], VNs). cells(Fs, Args, Tab, [chars("~")|Es], VNs).
cells([~,w|Fs], [Arg|Args], Tab, Es, VNs) --> !, cells([~,w|Fs], [Arg|Args], Tab, Es, VNs) --> !,
{ write_term_to_chars(Arg, [numbervars(true),variable_names(VNs)], Chars) }, { G = write_term_to_chars(Arg, [numbervars(true),variable_names(VNs)], Chars) },
cells(Fs, Args, Tab, [chars(Chars)|Es], VNs). cells(Fs, Args, Tab, [chars(Chars),goal(G)|Es], VNs).
cells([~,q|Fs], [Arg|Args], Tab, Es, VNs) --> !, cells([~,q|Fs], [Arg|Args], Tab, Es, VNs) --> !,
{ write_term_to_chars(Arg, [quoted(true),numbervars(true),variable_names(VNs)], Chars) }, { G = write_term_to_chars(Arg, [quoted(true),numbervars(true),variable_names(VNs)], Chars) },
cells(Fs, Args, Tab, [chars(Chars)|Es], VNs). cells(Fs, Args, Tab, [chars(Chars),goal(G)|Es], VNs).
cells([~,a|Fs], [Arg|Args], Tab, Es, VNs) --> !, cells([~,a|Fs], [Arg|Args], Tab, Es, VNs) --> !,
{ atom_chars(Arg, Chars) }, { G = atom_chars(Arg, Chars) },
cells(Fs, Args, Tab, [chars(Chars)|Es], VNs). cells(Fs, Args, Tab, [chars(Chars),goal(G)|Es], VNs).
cells([~|Fs0], Args0, Tab, Es, VNs) --> cells([~|Fs0], Args0, Tab, Es, VNs) -->
{ numeric_argument(Fs0, Num, [d|Fs], Args0, [Arg0|Args]) }, { numeric_argument(Fs0, Num, [d|Fs], Args0, [Arg0|Args]) },
!, !,
{ Arg is Arg0, % evaluate compound expression { G0 = ( Arg is Arg0, % evaluate compound expression
must_be(integer, Arg), must_be(integer, Arg),
number_chars(Arg, Cs0) }, number_chars(Arg, Cs0),
( { Num =:= 0 } -> { Cs = Cs0 } ( Num =:= 0 -> Cs = Cs0
; { length(Cs0, L), ; length(Cs0, L),
( L =< Num -> ( L =< Num ->
Delta is Num - L, Delta is Num - L,
length(Zs, Delta), length(Zs, Delta),
maplist(=('0'), Zs), maplist(=('0'), Zs),
phrase(("0.",seq(Zs),seq(Cs0)), Cs) phrase(("0.",seq(Zs),seq(Cs0)), Cs)
; BeforeComma is L - Num, ; BeforeComma is L - Num,
length(Bs, BeforeComma), length(Bs, BeforeComma),
append(Bs, Ds, Cs0), append(Bs, Ds, Cs0),
phrase((seq(Bs),".",seq(Ds)), Cs) phrase((seq(Bs),".",seq(Ds)), Cs)
) } )
), )),
cells(Fs, Args, Tab, [chars(Cs)|Es], VNs). goal_pe(G0, G) },
cells(Fs, Args, Tab, [chars(Cs),goal(G)|Es], VNs).
cells([~|Fs0], Args0, Tab, Es, VNs) --> cells([~|Fs0], Args0, Tab, Es, VNs) -->
{ numeric_argument(Fs0, Num, ['D'|Fs], Args0, [Arg|Args]) }, { numeric_argument(Fs0, Num, ['D'|Fs], Args0, [Arg|Args]) },
!, !,
{ separate_digits_fractional(Arg, ',', Num, Cs) }, { G = separate_digits_fractional(Arg, ',', Num, Cs) },
cells(Fs, Args, Tab, [chars(Cs)|Es], VNs). cells(Fs, Args, Tab, [chars(Cs),goal(G)|Es], VNs).
cells([~|Fs0], Args0, Tab, Es, VNs) --> cells([~|Fs0], Args0, Tab, Es, VNs) -->
{ numeric_argument(Fs0, Num, ['U'|Fs], Args0, [Arg|Args]) }, { numeric_argument(Fs0, Num, ['U'|Fs], Args0, [Arg|Args]) },
!, !,
{ separate_digits_fractional(Arg, '_', Num, Cs) }, { G = separate_digits_fractional(Arg, '_', Num, Cs) },
cells(Fs, Args, Tab, [chars(Cs)|Es], VNs). cells(Fs, Args, Tab, [chars(Cs),goal(G)|Es], VNs).
cells([~|Fs0], Args0, Tab, Es, VNs) --> cells([~|Fs0], Args0, Tab, Es, VNs) -->
{ numeric_argument(Fs0, Num0, ['L'|Fs], Args0, [Arg|Args]) }, { numeric_argument(Fs0, Num0, ['L'|Fs], Args0, [Arg|Args]) },
!, !,
{ ( Num0 =:= 0 -> { G = (( Num0 =:= 0 ->
Num = 72 Num = 72
; Num = Num0 ; Num = Num0
), ),
phrase(format_("~d", [Arg]), Cs0), phrase(format_("~d", [Arg]), Cs0),
phrase(split_lines_width(Cs0, Num), Cs) }, phrase(split_lines_width(Cs0, Num), Cs) ) },
cells(Fs, Args, Tab, [chars(Cs)|Es], VNs). cells(Fs, Args, Tab, [chars(Cs),goal(G)|Es], VNs).
cells([~,i|Fs], [_|Args], Tab, Es, VNs) --> !, cells([~,i|Fs], [_|Args], Tab, Es, VNs) --> !,
cells(Fs, Args, Tab, Es, VNs). cells(Fs, Args, Tab, Es, VNs).
cells([~,n|Fs], Args, Tab, Es, VNs) --> !, cells([~,n|Fs], Args, Tab, Es, VNs) --> !,
@@ -224,58 +285,63 @@ cells([~|Fs0], Args0, Tab, Es, VNs) -->
cells([~,s|Fs], [Arg|Args], Tab, Es, VNs) --> !, cells([~,s|Fs], [Arg|Args], Tab, Es, VNs) --> !,
cells(Fs, Args, Tab, [chars(Arg)|Es], VNs). cells(Fs, Args, Tab, [chars(Arg)|Es], VNs).
cells([~,f|Fs], [Arg|Args], Tab, Es, VNs) --> !, cells([~,f|Fs], [Arg|Args], Tab, Es, VNs) --> !,
{ format_number_chars(Arg, Chars) }, { G = format_number_chars(Arg, Chars) },
cells(Fs, Args, Tab, [chars(Chars)|Es], VNs). cells(Fs, Args, Tab, [chars(Chars),goal(G)|Es], VNs).
cells([~|Fs0], Args0, Tab, Es, VNs) --> cells([~|Fs0], Args0, Tab, Es, VNs) -->
{ numeric_argument(Fs0, Num, [f|Fs], Args0, [Arg|Args]) }, { numeric_argument(Fs0, Num, [f|Fs], Args0, [Arg|Args]) },
!, !,
{ format_number_chars(Arg, Cs0), { G = (format_number_chars(Arg, Cs0),
phrase(upto_what(Bs, .), Cs0, Cs), phrase(upto_what(Bs, .), Cs0, Cs),
( Num =:= 0 -> Chars = Bs ( Num =:= 0 -> Chars = Bs
; ( Cs = ['.'|Rest] -> ; ( Cs = ['.'|Rest] ->
length(Rest, L), length(Rest, L),
( Num < L -> ( Num < L ->
length(Ds, Num), length(Ds, Num),
append(Ds, _, Rest) append(Ds, _, Rest)
; Num =:= L -> ; Num =:= L ->
Ds = Rest Ds = Rest
; Num > L, ; Num > L,
Delta is Num - L, Delta is Num - L,
% we should look into the float with % we should look into the float with
% greater accuracy here, and use the % greater accuracy here, and use the
% actual digits instead of 0. % actual digits instead of 0.
length(Zs, Delta), length(Zs, Delta),
maplist(=('0'), Zs), maplist(=('0'), Zs),
append(Rest, Zs, Ds) append(Rest, Zs, Ds)
) )
; length(Ds, Num), ; length(Ds, Num),
maplist(=('0'), Ds) maplist(=('0'), Ds)
), ),
append(Bs, ['.'|Ds], Chars) append(Bs, ['.'|Ds], Chars)
) }, )) },
cells(Fs, Args, Tab, [chars(Chars)|Es], VNs). cells(Fs, Args, Tab, [chars(Chars),goal(G)|Es], VNs).
cells([~,r|Fs], Args, Tab, Es, VNs) --> !, cells([~,r|Fs], Args, Tab, Es, VNs) --> !,
cells([~,'8',r|Fs], Args, Tab, Es, VNs). cells([~,'8',r|Fs], Args, Tab, Es, VNs).
cells([~|Fs0], Args0, Tab, Es, VNs) --> cells([~|Fs0], Args0, Tab, Es, VNs) -->
{ numeric_argument(Fs0, Num, [r|Fs], Args0, [Arg|Args]) }, { numeric_argument(Fs0, Num, [r|Fs], Args0, [Arg|Args]) },
!, !,
{ integer_to_radix(Arg, Num, lowercase, Cs) }, { G = integer_to_radix(Arg, Num, lowercase, Cs) },
cells(Fs, Args, Tab, [chars(Cs)|Es], VNs). cells(Fs, Args, Tab, [chars(Cs),goal(G)|Es], VNs).
cells([~,'R'|Fs], Args, Tab, Es, VNs) --> !, cells([~,'R'|Fs], Args, Tab, Es, VNs) --> !,
cells([~,'8','R'|Fs], Args, Tab, Es, VNs). cells([~,'8','R'|Fs], Args, Tab, Es, VNs).
cells([~|Fs0], Args0, Tab, Es, VNs) --> cells([~|Fs0], Args0, Tab, Es, VNs) -->
{ numeric_argument(Fs0, Num, ['R'|Fs], Args0, [Arg|Args]) }, { numeric_argument(Fs0, Num, ['R'|Fs], Args0, [Arg|Args]) },
!, !,
{ integer_to_radix(Arg, Num, uppercase, Cs) }, { G = integer_to_radix(Arg, Num, uppercase, Cs) },
cells(Fs, Args, Tab, [chars(Cs)|Es], VNs). cells(Fs, Args, Tab, [chars(Cs),goal(G)|Es], VNs).
cells([~,'`',Char,t|Fs], Args, Tab, Es, VNs) --> !, cells([~,'`',Char,t|Fs], Args, Tab, Es, VNs) --> !,
cells(Fs, Args, Tab, [glue(Char,_)|Es], VNs). cells(Fs, Args, Tab, [glue(Char,_)|Es], VNs).
cells([~,t|Fs], Args, Tab, Es, VNs) --> !, cells([~,t|Fs], Args, Tab, Es, VNs) --> !,
cells(Fs, Args, Tab, [glue(' ',_)|Es], VNs). cells(Fs, Args, Tab, [glue(' ',_)|Es], VNs).
cells([~,'|'|Fs], Args, Tab0, Es, VNs) --> !, cells([~,'|'|Fs], Args, Tab0, Es, VNs) --> !,
{ phrase(elements_gluevars(Es, 0, Width), _), ( { ground(Tab0), Es = [chars(Cs)], ground(Cs) } ->
Tab is Tab0 + Width }, { length(Cs, Width),
cell(Tab0, Tab, Es), Tab is Tab0 + Width },
cell(Tab0, Tab, Es)
; { G = (phrase(elements_gluevars(Es, 0, Width), _),
Tab is Tab0 + Width) },
cell(Tab0, Tab, [goal(G)|Es])
),
cells(Fs, Args, Tab, [], VNs). cells(Fs, Args, Tab, [], VNs).
cells([~|Fs0], Args0, Tab, Es, VNs) --> cells([~|Fs0], Args0, Tab, Es, VNs) -->
{ numeric_argument(Fs0, Num, ['|'|Fs], Args0, Args) }, { numeric_argument(Fs0, Num, ['|'|Fs], Args0, Args) },
@@ -285,8 +351,12 @@ cells([~|Fs0], Args0, Tab, Es, VNs) -->
cells([~|Fs0], Args0, Tab0, Es, VNs) --> cells([~|Fs0], Args0, Tab0, Es, VNs) -->
{ numeric_argument(Fs0, Num, [+|Fs], Args0, Args) }, { numeric_argument(Fs0, Num, [+|Fs], Args0, Args) },
!, !,
{ Tab is Tab0 + Num }, ( { ground(Tab0+Num) } ->
cell(Tab0, Tab, Es), { Tab is Tab0 + Num },
cell(Tab0, Tab, Es)
; { G = (Tab is Tab0 + Num) },
cell(Tab0, Tab, [goal(G)|Es])
),
cells(Fs, Args, Tab, [], VNs). cells(Fs, Args, Tab, [], VNs).
cells([~|Cs], Args, _, _, _) --> cells([~|Cs], Args, _, _, _) -->
( { Args == [] } -> ( { Args == [] } ->
@@ -419,9 +489,11 @@ digits(uppercase, "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ").
% advantage of this is that an ideal implementation writes the % advantage of this is that an ideal implementation writes the
% characters as they become known, without manifesting the list. % characters as they become known, without manifesting the list.
format(Fs, Args) :- format(_, _) :- not_used.
current_output(Stream),
format(Stream, Fs, Args). user:goal_expansion(format(Fs, Args),
( current_output(Stream),
format(Stream, Fs, Args))).
%% format(Stream, FormatString, Arguments) %% format(Stream, FormatString, Arguments)
% %
@@ -429,9 +501,11 @@ format(Fs, Args) :-
% binary stream, then the code of each emitted character must be in % binary stream, then the code of each emitted character must be in
% 0..255. % 0..255.
format(Stream, Fs, Args) :- format(_, _, _) :- not_used.
phrase_to_stream(format_(Fs, Args), Stream),
flush_output(Stream). user:goal_expansion(format(Stream, Fs, Args),
( pio:phrase_to_stream(format:format_(Fs, Args), Stream),
flush_output(Stream))).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
?- phrase(format:cells("hello", [], 0, [], []), Cs). ?- phrase(format:cells("hello", [], 0, [], []), Cs).
@@ -517,14 +591,6 @@ portray_clause_(Term) -->
{ unique_variable_names(Term, VNs) }, { unique_variable_names(Term, VNs) },
portray_(Term, VNs), ".\n". portray_(Term, VNs), ".\n".
unique_variable_names(Term, VNs) :-
term_variables(Term, Vs),
foldl(var_name, Vs, VNs, 0, _).
var_name(V, Name=V, Num0, Num) :-
charsio:fabricate_var_name(numbervars, Name, Num0),
Num is Num0 + 1.
literal(Lit, VNs) --> literal(Lit, VNs) -->
{ write_term_to_chars(Lit, [quoted(true),variable_names(VNs),double_quotes(true)], Ls) }, { write_term_to_chars(Lit, [quoted(true),variable_names(VNs),double_quotes(true)], Ls) },
seq(Ls). seq(Ls).