Merge pull request #284 from triska/master
ADDED: library(format), describing strings with format_//2
This commit is contained in:
Mark Thom
317
src/prolog/lib/format.pl
Normal file
317
src/prolog/lib/format.pl
Normal file
@@ -0,0 +1,317 @@
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
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 is 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,
|
||||
which must be atomic (a current limitation)
|
||||
~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
|
||||
~s use the next argument here, which must be a string
|
||||
~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
|
||||
~~ the literal ~
|
||||
|
||||
The predicate format/2 is like format_//2, except that it outputs
|
||||
the text on the terminal instead of describing it declaratively.
|
||||
|
||||
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 = [h,e,l,l,o,'\n','.','.','.','.','.','.',t,h,e,r,e,!] ;
|
||||
%@ false.
|
||||
|
||||
I place this code in the public domain. Use it in any way you want.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
:- module(format, [format_//2,
|
||||
format/2
|
||||
]).
|
||||
|
||||
:- use_module(library(dcgs)).
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(error)).
|
||||
|
||||
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([], _, Tab, Es) --> cell(Tab, Tab, Es).
|
||||
cells([~,~|Fs], Args, Tab, Es) --> !,
|
||||
cells(Fs, Args, Tab, [chars("~")|Es]).
|
||||
cells([~,w|Fs], [Arg|Args], Tab, Es) --> !,
|
||||
{ arg_chars(Arg, Chars) },
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es]).
|
||||
cells([~,n|Fs], Args, Tab, Es) --> !,
|
||||
cell(Tab, Tab, Es),
|
||||
[newline],
|
||||
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) --> !,
|
||||
{ number_chars(Arg, Chars) },
|
||||
cells(Fs, Args, Tab, [chars(Chars)|Es]).
|
||||
cells([~|Fs0], [Arg|Args], Tab, Es) -->
|
||||
{ numeric_argument(Fs0, Num, [f|Fs]) },
|
||||
!,
|
||||
{ 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([~,'`',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], Args, Tab, Es) -->
|
||||
{ numeric_argument(Fs0, Num, ['|'|Fs]) },
|
||||
!,
|
||||
cell(Tab, Num, Es),
|
||||
cells(Fs, Args, Num, []).
|
||||
cells([~|Fs0], Args, Tab0, Es) -->
|
||||
{ numeric_argument(Fs0, Num, ['+'|Fs]) },
|
||||
!,
|
||||
{ Tab is Tab0 + Num },
|
||||
cell(Tab0, Tab, Es),
|
||||
cells(Fs, Args, Tab, []).
|
||||
cells([~,C|_], _, _, _) -->
|
||||
{ atom_chars(A, [~,C]),
|
||||
domain_error(format_string, A) }.
|
||||
cells([F|Fs0], Args, Tab, Es) -->
|
||||
{ phrase(upto_what(Fs1, ~), [F|Fs0], Fs),
|
||||
Fs1 = [_|_] },
|
||||
cells(Fs, Args, Tab, [chars(Fs1)|Es]).
|
||||
|
||||
domain_error(Type, Term) :-
|
||||
throw(error(domain_error(Type, Term), _)).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
?- 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([], _) --> [].
|
||||
|
||||
|
||||
cell(From, To, Es0) -->
|
||||
( { Es0 == [] } -> []
|
||||
; { reverse(Es0, Es) },
|
||||
[cell(From,To,Es)]
|
||||
).
|
||||
|
||||
%?- numeric_argument("2f", Num, ['f'|Fs]).
|
||||
|
||||
%?- numeric_argument("100b", Num, Rs).
|
||||
|
||||
numeric_argument(Ds, Num, Rest) :-
|
||||
numeric_argument_(Ds, [], Ns, Rest),
|
||||
foldl(pow10, Ns, 0-0, Num-_).
|
||||
|
||||
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.
|
||||
|
||||
|
||||
arg_chars(Arg, Chars) :-
|
||||
( ( integer(Arg)
|
||||
; float(Arg)
|
||||
) ->
|
||||
number_chars(Arg, Chars)
|
||||
; must_be(atom, Arg),
|
||||
atom_chars(Arg, Chars)
|
||||
).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Impure I/O, implemented as a small wrapper over format_//2.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
format(Fs, Args) :-
|
||||
phrase(format_(Fs, Args), Cs),
|
||||
maplist(write, Cs).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
?- 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 ctrue ;
|
||||
false.
|
||||
|
||||
?- format("~tabc~3|", []).
|
||||
|
||||
?- format("~ta~t~4|", []).
|
||||
|
||||
?- format("~ta~t~tb~tc~20|", []).
|
||||
a b c
|
||||
a b ctrue ;
|
||||
false.
|
||||
|
||||
?- format("~2f~n", [3]).
|
||||
3.00
|
||||
true ...
|
||||
|
||||
?- format("~20f", [0.1]).
|
||||
0.10000000000000000000true ; % 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", []).
|
||||
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
Reference in New Issue
Block a user