From 1db6bff8905b825f60b767c0586d50c242127861 Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Mon, 18 Mar 2024 21:34:13 +0100 Subject: [PATCH 1/5] ENHANCED: Partial evaluation of format_//2. This moves analysis of the format string to compilation time when possible, so that parsing it at run time is no longer necessary. --- src/lib/format.pl | 192 ++++++++++++++++++++++++++-------------------- 1 file changed, 108 insertions(+), 84 deletions(-) diff --git a/src/lib/format.pl b/src/lib/format.pl index 3b3d1dc4..82d96701 100644 --- a/src/lib/format.pl +++ b/src/lib/format.pl @@ -84,12 +84,38 @@ % ``` format_(Fs, Args) --> - { must_be(list, Fs), - must_be(list, Args), - unique_variable_names(Args, VNs), - phrase(cells(Fs,Args,0,[],VNs), Cells) }, + { format_args_cells(Fs, Args, Cells) }, format_cells(Cells). +format_args_cells(Fs, Args, Cells) :- + must_be(list, 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) + )). + format_cells([]) --> []. format_cells([Cell|Cells]) --> format_cell(Cell), @@ -125,6 +151,7 @@ format_element(glue(Fill,Num)) --> { length(Ls, Num), maplist(=(Fill), Ls) }, seq(Ls). +format_element(goal(_)) --> []. elements_gluevars([], N, N) --> []. elements_gluevars([E|Es], N0, N) --> @@ -135,6 +162,7 @@ element_gluevar(chars(Cs), N0, N) --> { length(Cs, L), N is N0 + L }. element_gluevar(glue(_,V), N, N) --> [V]. +element_gluevar(goal(G), N, N) --> { G }. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Our key datastructure is a list of cells and newlines. @@ -142,12 +170,16 @@ element_gluevar(glue(_,V), N, N) --> [V]. 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). + namely terms of the form chars(Cs), glue(Char, Var) + and goal(G). + "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. + 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. It is used because a newline character does not @@ -161,54 +193,54 @@ cells([], Args, Tab, Es, _) --> !, cells([~,~|Fs], Args, Tab, Es, VNs) --> !, cells(Fs, Args, Tab, [chars("~")|Es], VNs). cells([~,w|Fs], [Arg|Args], Tab, Es, VNs) --> !, - { write_term_to_chars(Arg, [numbervars(true),variable_names(VNs)], Chars) }, - cells(Fs, Args, Tab, [chars(Chars)|Es], VNs). + { G = write_term_to_chars(Arg, [numbervars(true),variable_names(VNs)], Chars) }, + cells(Fs, Args, Tab, [chars(Chars),goal(G)|Es], VNs). cells([~,q|Fs], [Arg|Args], Tab, Es, VNs) --> !, - { write_term_to_chars(Arg, [quoted(true),numbervars(true),variable_names(VNs)], Chars) }, - cells(Fs, Args, Tab, [chars(Chars)|Es], VNs). + { G = write_term_to_chars(Arg, [quoted(true),numbervars(true),variable_names(VNs)], Chars) }, + cells(Fs, Args, Tab, [chars(Chars),goal(G)|Es], VNs). cells([~,a|Fs], [Arg|Args], Tab, Es, VNs) --> !, - { atom_chars(Arg, Chars) }, - cells(Fs, Args, Tab, [chars(Chars)|Es], VNs). + { G = atom_chars(Arg, Chars) }, + cells(Fs, Args, Tab, [chars(Chars),goal(G)|Es], VNs). cells([~|Fs0], Args0, Tab, Es, VNs) --> { 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.",seq(Zs),seq(Cs0)), Cs) - ; BeforeComma is L - Num, - length(Bs, BeforeComma), - append(Bs, Ds, Cs0), - phrase((seq(Bs),".",seq(Ds)), Cs) - ) } - ), - cells(Fs, Args, Tab, [chars(Cs)|Es], VNs). + { G = ( 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.",seq(Zs),seq(Cs0)), Cs) + ; BeforeComma is L - Num, + length(Bs, BeforeComma), + append(Bs, Ds, Cs0), + phrase((seq(Bs),".",seq(Ds)), Cs) + ) + )) }, + cells(Fs, Args, Tab, [chars(Cs),goal(G)|Es], VNs). cells([~|Fs0], Args0, Tab, Es, VNs) --> { numeric_argument(Fs0, Num, ['D'|Fs], Args0, [Arg|Args]) }, !, - { separate_digits_fractional(Arg, ',', Num, Cs) }, - cells(Fs, Args, Tab, [chars(Cs)|Es], VNs). + { G = separate_digits_fractional(Arg, ',', Num, Cs) }, + cells(Fs, Args, Tab, [chars(Cs),goal(G)|Es], VNs). cells([~|Fs0], Args0, Tab, Es, VNs) --> { numeric_argument(Fs0, Num, ['U'|Fs], Args0, [Arg|Args]) }, !, - { separate_digits_fractional(Arg, '_', Num, Cs) }, - cells(Fs, Args, Tab, [chars(Cs)|Es], VNs). + { G = separate_digits_fractional(Arg, '_', Num, Cs) }, + cells(Fs, Args, Tab, [chars(Cs),goal(G)|Es], VNs). cells([~|Fs0], Args0, Tab, Es, VNs) --> { numeric_argument(Fs0, Num0, ['L'|Fs], Args0, [Arg|Args]) }, !, - { ( Num0 =:= 0 -> - Num = 72 - ; Num = Num0 - ), - phrase(format_("~d", [Arg]), Cs0), - phrase(split_lines_width(Cs0, Num), Cs) }, - cells(Fs, Args, Tab, [chars(Cs)|Es], VNs). + { G = (( Num0 =:= 0 -> + Num = 72 + ; Num = Num0 + ), + phrase(format_("~d", [Arg]), Cs0), + phrase(split_lines_width(Cs0, Num), Cs) ) }, + cells(Fs, Args, Tab, [chars(Cs),goal(G)|Es], VNs). cells([~,i|Fs], [_|Args], Tab, Es, VNs) --> !, cells(Fs, Args, Tab, Es, VNs). cells([~,n|Fs], Args, Tab, Es, VNs) --> !, @@ -224,58 +256,58 @@ cells([~|Fs0], Args0, Tab, Es, VNs) --> cells([~,s|Fs], [Arg|Args], Tab, Es, VNs) --> !, cells(Fs, Args, Tab, [chars(Arg)|Es], VNs). cells([~,f|Fs], [Arg|Args], Tab, Es, VNs) --> !, - { format_number_chars(Arg, Chars) }, - cells(Fs, Args, Tab, [chars(Chars)|Es], VNs). + { G = format_number_chars(Arg, Chars) }, + cells(Fs, Args, Tab, [chars(Chars),goal(G)|Es], VNs). cells([~|Fs0], Args0, Tab, Es, VNs) --> { 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], VNs). + { G = (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),goal(G)|Es], VNs). cells([~,r|Fs], Args, Tab, Es, VNs) --> !, cells([~,'8',r|Fs], Args, Tab, Es, VNs). cells([~|Fs0], Args0, Tab, Es, VNs) --> { numeric_argument(Fs0, Num, [r|Fs], Args0, [Arg|Args]) }, !, - { integer_to_radix(Arg, Num, lowercase, Cs) }, - cells(Fs, Args, Tab, [chars(Cs)|Es], VNs). + { G = integer_to_radix(Arg, Num, lowercase, Cs) }, + cells(Fs, Args, Tab, [chars(Cs),goal(G)|Es], VNs). cells([~,'R'|Fs], Args, Tab, Es, VNs) --> !, cells([~,'8','R'|Fs], Args, Tab, Es, VNs). cells([~|Fs0], Args0, Tab, Es, VNs) --> { numeric_argument(Fs0, Num, ['R'|Fs], Args0, [Arg|Args]) }, !, - { integer_to_radix(Arg, Num, uppercase, Cs) }, - cells(Fs, Args, Tab, [chars(Cs)|Es], VNs). + { G = integer_to_radix(Arg, Num, uppercase, Cs) }, + cells(Fs, Args, Tab, [chars(Cs),goal(G)|Es], VNs). cells([~,'`',Char,t|Fs], Args, Tab, Es, VNs) --> !, cells(Fs, Args, Tab, [glue(Char,_)|Es], VNs). cells([~,t|Fs], Args, Tab, Es, VNs) --> !, cells(Fs, Args, Tab, [glue(' ',_)|Es], VNs). cells([~,'|'|Fs], Args, Tab0, Es, VNs) --> !, - { phrase(elements_gluevars(Es, 0, Width), _), - 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([~|Fs0], Args0, Tab, Es, VNs) --> { numeric_argument(Fs0, Num, ['|'|Fs], Args0, Args) }, @@ -285,8 +317,8 @@ cells([~|Fs0], Args0, Tab, Es, VNs) --> cells([~|Fs0], Args0, Tab0, Es, VNs) --> { numeric_argument(Fs0, Num, [+|Fs], Args0, Args) }, !, - { 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([~|Cs], Args, _, _, _) --> ( { Args == [] } -> @@ -517,14 +549,6 @@ portray_clause_(Term) --> { unique_variable_names(Term, VNs) }, 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) --> { write_term_to_chars(Lit, [quoted(true),variable_names(VNs),double_quotes(true)], Ls) }, seq(Ls). From 8af29c200d504ea977692c1c269915d32f0162b2 Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Mon, 18 Mar 2024 21:35:12 +0100 Subject: [PATCH 2/5] strengthen type check --- src/lib/format.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/format.pl b/src/lib/format.pl index 82d96701..2478e371 100644 --- a/src/lib/format.pl +++ b/src/lib/format.pl @@ -88,7 +88,7 @@ format_(Fs, Args) --> format_cells(Cells). format_args_cells(Fs, Args, Cells) :- - must_be(list, Fs), + must_be(chars, Fs), must_be(list, Args), unique_variable_names(Args, VNs), phrase(cells(Fs,Args,0,[],VNs), Cells). From 58f7c94e7489d9cbb3d9ed8faed7c89c3e7413b4 Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Mon, 18 Mar 2024 21:43:30 +0100 Subject: [PATCH 3/5] goal expansion for format/2 and format/3 In this way, we benefit from partial evaluation of format strings. --- src/lib/format.pl | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/lib/format.pl b/src/lib/format.pl index 2478e371..35d4fea2 100644 --- a/src/lib/format.pl +++ b/src/lib/format.pl @@ -451,9 +451,11 @@ digits(uppercase, "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"). % advantage of this is that an ideal implementation writes the % characters as they become known, without manifesting the list. -format(Fs, Args) :- - current_output(Stream), - format(Stream, Fs, Args). +format(_, _) :- not_used. + +user:goal_expansion(format(Fs, Args), + ( current_output(Stream), + format(Stream, Fs, Args))). %% format(Stream, FormatString, Arguments) % @@ -461,9 +463,11 @@ format(Fs, Args) :- % binary stream, then the code of each emitted character must be in % 0..255. -format(Stream, Fs, Args) :- - phrase_to_stream(format_(Fs, Args), Stream), - flush_output(Stream). +format(_, _, _) :- not_used. + +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). From bc04790fd51639741afd0f9f722523560317e16a Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Wed, 20 Mar 2024 19:48:33 +0100 Subject: [PATCH 4/5] extend partial evaluation to computing lengths when statically possible --- src/lib/format.pl | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/src/lib/format.pl b/src/lib/format.pl index 35d4fea2..6b756c15 100644 --- a/src/lib/format.pl +++ b/src/lib/format.pl @@ -305,9 +305,14 @@ cells([~,'`',Char,t|Fs], Args, Tab, Es, VNs) --> !, cells([~,t|Fs], Args, Tab, Es, VNs) --> !, cells(Fs, Args, Tab, [glue(' ',_)|Es], VNs). cells([~,'|'|Fs], Args, Tab0, Es, VNs) --> !, - { G = (phrase(elements_gluevars(Es, 0, Width), _), - Tab is Tab0 + Width) }, - cell(Tab0, Tab, [goal(G)|Es]), + ( { ground(Tab0), Es = [chars(Cs)], ground(Cs) } -> + { length(Cs, Width), + 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([~|Fs0], Args0, Tab, Es, VNs) --> { numeric_argument(Fs0, Num, ['|'|Fs], Args0, Args) }, @@ -317,8 +322,12 @@ cells([~|Fs0], Args0, Tab, Es, VNs) --> cells([~|Fs0], Args0, Tab0, Es, VNs) --> { numeric_argument(Fs0, Num, [+|Fs], Args0, Args) }, !, - { G = (Tab is Tab0 + Num) }, - cell(Tab0, Tab, [goal(G)|Es]), + ( { ground(Tab0+Num) } -> + { 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([~|Cs], Args, _, _, _) --> ( { Args == [] } -> From 767d90d5e7c8682e6b0801af1d1386ba9dca0551 Mon Sep 17 00:00:00 2001 From: Markus Triska Date: Wed, 20 Mar 2024 20:26:01 +0100 Subject: [PATCH 5/5] ENHANCED: further partial evaluation for the common control sequence ~d --- src/lib/format.pl | 61 ++++++++++++++++++++++++++++++++++------------- 1 file changed, 45 insertions(+), 16 deletions(-) diff --git a/src/lib/format.pl b/src/lib/format.pl index 6b756c15..d1fe1f61 100644 --- a/src/lib/format.pl +++ b/src/lib/format.pl @@ -116,6 +116,34 @@ user:goal_expansion(format_(Fs,Args,Cs0,Cs), ; 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([Cell|Cells]) --> format_cell(Cell), @@ -204,22 +232,23 @@ cells([~,a|Fs], [Arg|Args], Tab, Es, VNs) --> !, cells([~|Fs0], Args0, Tab, Es, VNs) --> { numeric_argument(Fs0, Num, [d|Fs], Args0, [Arg0|Args]) }, !, - { G = ( 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.",seq(Zs),seq(Cs0)), Cs) - ; BeforeComma is L - Num, - length(Bs, BeforeComma), - append(Bs, Ds, Cs0), - phrase((seq(Bs),".",seq(Ds)), Cs) - ) - )) }, + { G0 = ( 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.",seq(Zs),seq(Cs0)), Cs) + ; BeforeComma is L - Num, + length(Bs, BeforeComma), + append(Bs, Ds, Cs0), + phrase((seq(Bs),".",seq(Ds)), Cs) + ) + )), + goal_pe(G0, G) }, cells(Fs, Args, Tab, [chars(Cs),goal(G)|Es], VNs). cells([~|Fs0], Args0, Tab, Es, VNs) --> { numeric_argument(Fs0, Num, ['D'|Fs], Args0, [Arg|Args]) },