[net.sources] Prolog library: pp.

pereira@sri-unix.UUCP (08/15/83)

%% 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).