Prolog library: pp.
pereira at sri-unix.UUCP
pereira at sri-unix.UUCP
Mon Aug 15 15:57:18 AEST 1983
%% PP : Pretty-printing functions.
%
% Copyright H. G. Barrow, February 1983.
% Fairchild Laboratory for Artificial Intelligence Research.
%
% Declare the size of page to be printed.
% pagewidth(60).
% Declare maximum nesting depth for pretty-printing.
% ppdepth(10).
% Top level test function to produce all possible formats of output.
:- public pptest/1.
pptest(Term) :-
ppdepth(D),
nl,
ppplan(vert,Term,PPList,[],1,W,D),
ppdo(PPList),
nl,nl,fail.
% The top-level function to pretty-print a term.
% The single argument version begins printing on the next line at the left.
% The two argument version begins at the current location on the page:
% it takes current column (starting at 1) as an input
% and it returns the column following the end of its print-out.
%
% Note that for each term printed (so long as it is not a variable) a
% call is made to the user-defined function ppform(X,Y). ppform is
% intended to convert the input term, X, to a new form to be printed, Y.
% If ppform is not defined for X, it will be pretty-printed in the usual way.
:- public pp/1.
:- mode pp(+).
pp(Term) :-
nl,
pp(Term,1,NextPos).
:- public pp/3.
:- mode pp(+,+,-).
pp(Term,Pos,NextPos) :-
ppdepth(D),
ppplan(vert,Term,PPList,[],Pos,NextPos,D),% plan how to print term
ppdo(PPList), !. % carry out the plan
pp(Term,Pos,NextPos) :-
write(Term). % plan failed!
% Execute the plan for printing.
% The plan is simply a list of terms to be printed,
% new lines are specially represented by "$nl" and tabs by "$tab(N)".
ppdo([]).
ppdo([X|L]) :- var(X), !, write(X), ppdo(L).
ppdo(['$tab'(N)|L]) :- !, tab(N), ppdo(L).
ppdo(['$nl'|L]) :- !, nl, ppdo(L).
ppdo([X|L]) :- !, write(X), ppdo(L).
% Routines for planning how to print.
% The last five arguments of all of these are L0,L1,P0,P1,D, where:
% L0 is the output list fragment, which ends with a variable as a tail,
% L1 is the tail variable, for linking fragments together easily,
% P0 is the input current column,
% P1 is the output next column.
% D is the currently permitted nesting depth.
%
% Thus routines can be chained together:
% ppplan(vert,TermA,L0,L1,P0,P1,D), ppplan(vert,TermB,L1,L2,P1,P2,D).
%
% The first argument to these routines is usually a mode -- "line" or "vert".
% line means print this term on one line
% vert means print the subterms of this term vertically above each other.
%
% Generate a new line.
ppnl(['$nl'|L],L,P0,1).
% Generate N spaces.
pptab(N,['$tab'(N)|L],L,P0,P1) :-
P1 is P0+N,
pagewidth(W), P1 =< W.
% Generate new line and indent N spaces.
ppnltab(N,['$nl','$tab'(N1)|L],L,P0,N) :-
N1 is N-1,
pagewidth(W), N =< W.
% The main planning function, ppplan
% It tries first to print a term in one line,
% and on failure, tries to print it vertically.
% ppplan fails if it exceeds the page width.
ppplan(Mode,X,[X|L],L,P0,P1,D) :- var(X), !, % variable
P1 is P0+4, % assume 4 characters
pagewidth(W), P1 =< W.
ppplan(Mode,X,L0,L1,P0,P1,D) :-
ppform(X,Y), !, % user-defined pp form?
ppplan(Mode,Y,L0,L1,P0,P1,D).
ppplan(Mode,X,[X|L],L,P0,P1,D) :- atomic(X), !, % atomic
name(X,Name), length(Name,N), P1 is P0+N,
pagewidth(W), P1 =< W.
ppplan(Mode,X,['...'|L],L,P0,P1,0) :- !, % depth limit
P1 is P0+3.
ppplan(line,X,L0,L3,P0,P3,D) :- functor(X,'.',2), !, % list--in line mode
D1 is D-1,
ppplan(line,'[',L0,L1,P0,P1,D1),
ppseq(line,X,L1,L2,P1,P2,D1),
ppplan(line,']',L2,L3,P2,P3,D1).
ppplan(vert,X,L0,L3,P0,P3,D) :- functor(X,'.',2), % list--vert mode
ppplan(line,X,L0,L3,P0,P3,D). % (try line mode first)
ppplan(vert,X,L0,L3,P0,P3,D) :- functor(X,'.',2), !, % list--true vert mode
D1 is D-1,
ppplan(vert,'[',L0,L1,P0,P1,D1),
ppseq(vert,X,L1,L2,P1,P2,D1),
ppplan(vert,']',L2,L3,P2,P3,D1).
ppplan(line,X,L0,L1,P0,P1,D) :-
opdata(X,Fn,Type,Prec), !, % operator--line mode
D1 is D-1,
ppop(line,Type,Prec,Fn,X,L0,L1,P0,P1,D1).
ppplan(vert,X,L0,L1,P0,P1,D) :-
opdata(X,Fn,Type,Prec), % operator--vert mode
ppplan(line,X,L0,L1,P0,P1,D). % (try line mode first)
ppplan(vert,X,L0,L1,P0,P1,D) :-
opdata(X,Fn,Type,Prec), !, % operator-- vert mode
D1 is D-1,
ppop(vert,Type,Prec,Fn,X,L0,L1,P0,P1,D1).
ppplan(line,X,L0,L4,P0,P4,D) :- X=..[Fn|Args], !, % function--line mode
D1 is D-1,
ppplan(line,Fn,L0,L1,P0,P1,D1),
ppplan(line,'(',L1,L2,P1,P2,D1),
ppseq(line,Args,L2,L3,P2,P3,D1),
ppplan(line,')',L3,L4,P3,P4,D1).
ppplan(vert,X,L0,L4,P0,P4,D) :- X=..[Fn|Args], % function--vert mode
ppplan(line,X,L0,L4,P0,P4,D). % (try line mode first)
ppplan(vert,X,L0,L4,P0,P4,D) :- X=..[Fn|Args], !, % function--vert mode
D1 is D-1,
ppplan(vert,Fn,L0,L1,P0,P1,D1),
ppplan(vert,'(',L1,L2,P1,P2,D1),
ppseq(vert,Args,L2,L3,P2,P3,D1),
ppplan(vert,')',L3,L4,P3,P4,D1).
% Routine to print a sequence of things, e.g. elements of list,
% or args of a function, with commas between items.
% Prints either in line, or vertically.
ppseq(Mode,[],L0,L0,P0,P0,D) :- !. % []--exit
ppseq(line,[X|Rest],L0,L3,P0,P3,D) :- var(Rest), !, % tail var--line mode
ppplan(line,X,L0,L1,P0,P1,D),
ppplan(line,'|',L1,L2,P1,P2,D),
ppplan(line,Rest,L2,L3,P2,P3,D).
ppseq(vert,[X|Rest],L0,L3,P0,P3,D) :- var(Rest), !, % tail var--vert mode
ppline(vert,X,L0,L1,P0,P1),
ppnltab(P0,L1,L12,P1,P12), !,
ppplan(vert,'|',L12,L2,P12,P2,D),
ppplan(vert,Rest,L2,L3,P2,P3,D).
ppseq(Mode,[X],L0,L1,P0,P1,D) :- !, % last item--no comma
ppplan(Mode,X,L0,L1,P0,P1,D).
ppseq(line,[X|Rest],L0,L3,P0,P3,D) :- % item--line mode
ppplan(line,X,L0,L1,P0,P1,D),
ppplan(line,',',L1,L2,P1,P2,D),
ppseq(line,Rest,L2,L3,P2,P3,D).
ppseq(vert,[X|Rest],L0,L3,P0,P3,D) :- % item--vert mode
ppplan(vert,X,L0,L1,P0,P1,D),
ppplan(vert,',',L1,L2,P1,P2,D),
ppnltab(P0,L2,L22,P2,P22), !,
ppseq(vert,Rest,L22,L3,P22,P3,D).
% Routine to print term involving an operator in standard format.
% Behavior depends on printing mode and operator type, e.g. xfy, or xf, etc.
% Single argument terms are always printed on one line,
% double argument terms may be stacked in vert mode.
ppop(Mode,fx,Prec,Fn,Term,L0,L2,P0,P2,D) :-
arg(1,Term,Arg),
ppplan(Mode,Fn,L0,L1,P0,P1,D),
pparg(Mode,fx,Fn,Arg,Prec,L1,L2,P1,P2,D).
ppop(Mode,fy,Prec,Fn,Term,L0,L2,P0,P2,D) :-
arg(1,Term,Arg),
ppplan(Mode,Fn,L0,L1,P0,P1,D),
pparg(Mode,fy,Fn,Arg,Prec,L1,L2,P1,P2,D).
ppop(Mode,xf,Prec,Fn,Term,L0,L2,P0,P2,D) :-
arg(1,Term,Arg),
pparg(Mode,xf,Fn,Arg,Prec,L0,L1,P0,P1,D),
ppplan(Mode,Fn,L1,L2,P1,P2,D).
ppop(Mode,yf,Prec,Fn,Term,L0,L2,P0,P2,D) :-
arg(1,Term,Arg),
pparg(Mode,yf,Fn,Arg,Prec,L0,L1,P0,P1,D),
ppplan(Mode,Fn,L1,L2,P1,P2,D).
ppop(line,xfx,Prec,Fn,Term,L0,L3,P0,P3,D) :- !,
arg(1,Term,Arg1),arg(2,Term,Arg2),
pparg(line,xf,Fn,Arg1,Prec,L0,L1,P0,P1,D),
ppplan(line,Fn,L1,L2,P1,P2,D),
pparg(line,fx,Fn,Arg2,Prec,L2,L3,P2,P3,D).
ppop(line,yfx,Prec,Fn,Term,L0,L3,P0,P3,D) :- !,
arg(1,Term,Arg1),arg(2,Term,Arg2),
pparg(line,yf,Fn,Arg1,Prec,L0,L1,P0,P1,D),
ppplan(line,Fn,L1,L2,P1,P2,D),
pparg(line,fx,Fn,Arg2,Prec,L2,L3,P2,P3,D).
ppop(line,xfy,Prec,Fn,Term,L0,L3,P0,P3,D) :- !,
arg(1,Term,Arg1),arg(2,Term,Arg2),
pparg(line,xf,Fn,Arg1,Prec,L0,L1,P0,P1,D),
ppplan(line,Fn,L1,L2,P1,P2,D),
pparg(line,fy,Fn,Arg2,Prec,L2,L3,P2,P3,D).
ppop(vert,xfx,Prec,Fn,Term,L0,L3,P0,P3,D) :- !,
arg(1,Term,Arg1),arg(2,Term,Arg2),
pparg(vert,xf,Fn,Arg1,Prec,L0,L1,P0,P1,D),
ppnltab(P0,L1,L11,P1,P11), !,
ppplan(vert,Fn,L11,L2,P11,P2,D),
ppnltab(P0,L2,L21,P2,P21), !,
pparg(vert,fx,Fn,Arg2,Prec,L21,L3,P21,P3,D).
ppop(vert,yfx,Prec,Fn,Term,L0,L3,P0,P3,D) :- !,
arg(1,Term,Arg1),arg(2,Term,Arg2),
pparg(vert,yf,Fn,Arg1,Prec,L0,L1,P0,P1,D),
ppnltab(P0,L1,L11,P1,P11), !,
ppplan(vert,Fn,L11,L2,P11,P2,D),
ppnltab(P0,L2,L21,P2,P21), !,
pparg(vert,fx,Fn,Arg2,Prec,L21,L3,P21,P3,D).
ppop(vert,xfy,Prec,Fn,Term,L0,L3,P0,P3,D) :- !,
arg(1,Term,Arg1),arg(2,Term,Arg2),
pparg(vert,xf,Fn,Arg1,Prec,L0,L1,P0,P1,D),
ppnltab(P0,L1,L11,P1,P11), !,
ppplan(vert,Fn,L11,L2,P11,P2,D),
ppnltab(P0,L2,L21,P2,P21), !,
pparg(vert,fy,Fn,Arg2,Prec,L21,L3,P21,P3,D).
% Print a space between operator and argument, if it is needed.
ppfntab(vert,Fn,L0,L0,P0,P0) :- !. % vert mode--no space
ppfntab(line,Fn,L0,L0,P0,P0) :- symbol(Fn), !. % op is symbol--no
ppfntab(line,Fn,L0,L1,P0,P1) :- pptab(1,L0,L1,P0,P1). % otherwise--space
% Print an argument of the operator.
% This routine checks on the nature of the arguments to determine
% whether parentheses are necessary.
pparg(Mode,fx,Fn,Term,Prec,L0,L3,P0,P3,D) :-
opdata(Term,TFn,TType,TPrec),
TPrec >= Prec, !, % need parens
ppplan(Mode,'(',L0,L1,P0,P1,D),
ppplan(Mode,Term,L1,L2,P1,P2,D),
ppplan(Mode,')',L2,L3,P2,P3,D).
pparg(Mode,fx,Fn,Term,Prec,L0,L2,P0,P2,D) :- % no parens
ppfntab(Mode,Fn,L0,L1,P0,P1),
ppplan(Mode,Term,L1,L2,P1,P2,D).
pparg(Mode,fy,Fn,Term,Prec,L0,L3,P0,P3,D) :-
opdata(Term,TFn,TType,TPrec),
TPrec > Prec, !, % need parens
ppplan(Mode,'(',L0,L1,P0,P1,D),
ppplan(Mode,Term,L1,L2,P1,P2,D),
ppplan(Mode,')',L2,L3,P2,P3,D).
pparg(Mode,fy,Fn,Term,Prec,L0,L2,P0,P2,D) :- % no parens
ppfntab(Mode,Fn,L0,L1,P0,P1),
ppplan(Mode,Term,L1,L2,P1,P2,D).
pparg(Mode,xf,Fn,Term,Prec,L0,L3,P0,P3,D) :-
opdata(Term,TFn,TType,TPrec),
TPrec >= Prec, !, % need parens
ppplan(Mode,'(',L0,L1,P0,P1,D),
ppplan(Mode,Term,L1,L2,P1,P2,D),
ppplan(Mode,')',L2,L3,P2,P3,D).
pparg(Mode,xf,Fn,Term,Prec,L0,L2,P0,P2,D) :- % no parens
ppplan(Mode,Term,L0,L1,P0,P1,D),
ppfntab(Mode,Fn,L1,L2,P1,P2).
pparg(Mode,yf,Fn,Term,Prec,L0,L3,P0,P3,D) :-
opdata(Term,TFn,TType,TPrec),
TPrec > Prec, !, % need parens
ppplan(Mode,'(',L0,L1,P0,P1,D),
ppplan(Mode,Term,L1,L2,P1,P2,D),
ppplan(Mode,')',L2,L3,P2,P3,D).
pparg(Mode,yf,Fn,Term,Prec,L0,L2,P0,P2,D) :- % no parens
ppplan(Mode,Term,L0,L1,P0,P1,D),
ppfntab(Mode,Fn,L1,L2,P1,P2).
% Miscellaneous functions.
% Return the function, its type and precedence for a term.
% Fail if the function is not an operator.
opdata(Term,Fn,Type,Prec) :-
nonvar(Term), % fail if a variable
functor(Term,Fn,Arity),
current_op(Prec,Type,Fn),
aritytype(Arity,Type), % return type consistent with arity.
!.
% Associate possible function types and arities.
aritytype(1,fx).
aritytype(1,fy).
aritytype(1,xf).
aritytype(1,yf).
aritytype(2,xfx).
aritytype(2,yfx).
aritytype(2,xfy).
% Is an atom a symbol?
% It is a symbol if its name begins with a certain sort of character.
symbol(X) :-
name(X,[C|_]),
symMember(C,"+-*/\^<>=~:.?@#$&"),
!.
symMember(C,[C|L]) :- !.
symMember(C,[X|L]) :- symMember(C,L).
More information about the Comp.sources.unix
mailing list