diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

portray_clause should not bind variables.

Browse Source 
fix to look more like SICStus.
use standard streams and format.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@611 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-10-01 20:28:47 +00:00
parent 08342b2905
commit ef57cc40ce
1 changed files with 92 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

182
pl/listing.yap
View File

@ -20,129 +20,131 @@
*/ */
listing :- listing :-
current_output(Stream),
'$current_module'(Mod), '$current_module'(Mod),
'$current_predicate_no_modules'(Mod,_,Pred), '$current_predicate_no_modules'(Mod,_,Pred),
'$list_clauses'(Mod,Pred). '$list_clauses'(Stream,Mod,Pred).
listing. listing.
listing(V) :- listing(V) :-
current_output(Stream),
'$current_module'(M), '$current_module'(M),
'$listing'(V,M). '$listing'(V,M,Stream).
'$listing'(V,_) :- var(V), !. % ignore variables '$listing'(V,Mod,Stream) :- var(V), !,
'$listing'(M:V,_) :- !, '$current_predicate_no_modules'(Mod,_,Pred),
'$list_clauses'(Stream,Mod,Pred).
'$listing'(M:V,_,_) :- !,
'$listing'(V,M). '$listing'(V,M).
'$listing'([],_) :- !. '$listing'([],_,_) :- !.
'$listing'([X|Rest], M) :- '$listing'([X|Rest], M, Stream) :-
!, !,
'$listing'(X, M), '$listing'(X, M, Stream),
'$listing'(Rest, M). '$listing'(Rest, M, Stream).
'$listing'(X, M) :- '$listing'(X, M, Stream) :-
'$funcspec'(X,Name,Arity), '$funcspec'(X,Name,Arity),
'$current_predicate_no_modules'(M,Name,Pred), '$current_predicate_no_modules'(M,Name,Pred),
functor(Pred,Name,Arity), functor(Pred,Name,Arity),
'$list_clauses'(M,Pred). '$list_clauses'(Stream,M,Pred).
'$listing'(_,_). '$listing'(_,_,_).
'$funcspec'(Name/Arity,Name,Arity) :- !, atom(Name). '$funcspec'(Name/Arity,Name,Arity) :- !, atom(Name).
'$funcspec'(Name,Name,_) :- atom(Name), !. '$funcspec'(Name,Name,_) :- atom(Name), !.
'$funcspec'(Name,_,_) :- write('! Invalid procedure specification : '), '$funcspec'(Name,_,_) :-
write(Name), nl. '$do_error'(domain_error(predicate_spec,Name),listing(Name)).
'$list_clauses'(M,Pred) :- '$list_clauses'(Stream, M, Pred) :-
( '$recordedp'(M:Pred,_,_) -> nl ), ( '$recordedp'(M:Pred,_,_) -> nl(Stream) ),
fail. fail.
'$list_clauses'(M,Pred) :- '$list_clauses'(Stream, M, Pred) :-
'$recordedp'(M:Pred,(Pred:-Body),_), '$recordedp'(M:Pred,(Pred:-Body),_),
'$beautify_vars'((Pred:-Body)), '$portray_clause'(Stream,(Pred:-Body)),
'$write_clause'(Pred,Body),
fail. fail.
portray_clause(Stream, Clause) :- portray_clause(Stream, Clause) :-
current_output(OldStream), '$portray_clause'(Stream, Clause),
set_output(Stream), fail.
portray_clause(Clause), portray_clause(_, _).
set_output(OldStream).
portray_clause((Pred:-Body)) :- !, portray_clause(Clause) :-
current_output(Stream),
'$portray_clause'(Stream, Clause),
fail.
portray_clause(_).
'$portray_clause'(Stream, (Pred :- true)) :- !,
'$beautify_vars'(Pred),
'$format'(Stream, "~q.~n", [Pred]).
'$portray_clause'(Stream, (Pred:-Body)) :-
'$beautify_vars'((Pred:-Body)), '$beautify_vars'((Pred:-Body)),
'$write_clause'(Pred,Body). '$format'(Stream, "~q :-", [Pred]),
portray_clause(Pred) :- '$write_body'(Body, 3, ',', Stream),
'$beautify_vars'((Pred:-true)), '$format'(Stream, ".~n", []).
'$write_clause'(Pred,true).
'$write_clause'(Head,Body) :- '$write_body'(X,I,T,Stream) :- var(X), !,
writeq(Head), '$beforelit'(T,I,Stream),
( Body = true ; writeq(Stream, '_').
'$tab'(1), write((:-)), '$write_body'((P,Q), I, T, Stream) :-
'$write_body'(Body,3,',')
),
put("."), nl,
!.
'$write_body'(X,I,T) :- var(X), !, '$beforelit'(T,I), writeq('_').
'$write_body'((P,Q), IO, T) :-
!, !,
'$write_body'(P,IO,T), '$write_body'(P,I,T, Stream),
put(","), put(Stream, ","),
'$aftercomma'(T,IO,I), '$write_body'(Q,I,',',Stream).
'$write_body'(Q,I,','). '$write_body'((P->Q;S),I,_, Stream) :-
'$write_body'((P->Q;S),I,_) :-
!, !,
nl, '$tab'(I-2), put("("), '$format'(Stream, "~n~*c(",[I,0' ]),
'$write_body'(P,I,'('), I1 is I+2,
put("-"), put(">"), '$write_body'(P,I1,'(',Stream),
'$write_body'(Q,I,'->'), '$format'(Stream, " ->",[]),
put(";"), '$write_disj'((Q;S),I,I1,'->',Stream),
'$write_body'(S,I,';'), '$format'(Stream, "~n~*c)",[I,0' ]).
'$tab'(1), put(")"). '$write_body'((P->Q|S),I,_,Stream) :-
'$write_body'((P->Q|S),I,_) :-
!, !,
nl, '$tab'(I-2), put("("), '$format'(Stream, "~n~*c(",[I,0' ]),
'$write_body'(P,I,'('), I1 is I+2,
put("-"), put(">"), '$write_body'(P,I,'(',Stream),
'$write_body'(Q,I,'->'), '$format'(Stream, " ->",[]),
put("|"), '$write_disj'((Q|S),I,I1,'->',Stream),
'$write_body'(S,I,'|'), '$format'(Stream, "~n~*c)",[I,0' ]).
'$tab'(1), put(")"). '$write_body'((P->Q),I,_,Stream) :-
'$write_body'((P->Q),I,_) :-
!, !,
nl, '$tab'(I-2), put("("), '$format'(Stream, "~n~*c(",[I,0' ]),
'$write_body'(P,I,'('), I1 is I+2,
put("-"), put(">"), '$write_body'(P,I1,'(',Stream),
'$write_body'(Q,I,'->'), '$format'(Stream, " ->",[]),
'$tab'(1), put(")"). '$write_body'(Q,I1,'->',Stream),
'$write_body'((P;Q),I,_) :- '$format'(Stream, "~n~*c)",[I,0' ]).
'$write_body'((P;Q),I,_,Stream) :-
!, !,
nl, '$tab'(I-2), put("("), '$format'(Stream, "~n~*c(",[I,0' ]),
'$write_body'(P,I,'('), I1 is I+2,
put(";"), '$write_disj'((P;Q),I,I1,'->',Stream),
'$write_body'(Q,I,';'), '$format'(Stream, "~n~*c)",[I,0' ]).
'$tab'(1), put(")"). '$write_body'((P|Q),I,_,Stream) :-
'$write_body'((P|Q),I,_) :-
!, !,
nl, '$tab'(I-2), put("("), '$format'(Stream, "~n~*c(",[I,0' ]),
'$write_body'(P,I,'('), I1 is I+2,
put("|"), '$write_disj'((P|Q),I,I1,'->',Stream),
'$write_body'(Q,I,'|'), '$format'(Stream, "~n~*c)",[I,0' ]).
'$tab'(1), put(")"). '$write_body'(X,I,T,Stream) :-
'$write_body'((P|Q),I,_) :- '$beforelit'(T,I,Stream),
!, '$format'(Stream,"~q",[X]).
nl, '$tab'(I-2), put("("),
'$write_body'(P,I,'('),
put("|"),
'$write_body'(Q,I,'|'),
'$tab'(1), put(")").
'$write_body'(X,I,T) :-
'$beforelit'(T,I),
writeq(X).
'$aftercomma'(',',I,I) :- !.
'$aftercomma'(_,I0,I) :- I is I0+3.
'$beforelit'('(',_) :- !, '$tab'(1). '$write_disj'((Q;S),I0,I,C,Stream) :- !,
'$beforelit'(_,I) :- nl, '$tab'(I). '$write_body'(Q,I,C,Stream),
'$format'(Stream, "~n~*c;",[I0,0' ]),
'$write_disj'(S,I0,I,';',Stream).
'$write_disj'((Q|S),I0,I,C,Stream) :- !,
'$write_body'(Q,I,C,Stream),
'$format'(Stream, "~n~*c|",[I0,0' ]),
'$write_disj'(S,I0,I,'|',Stream).
'$write_disj'(S,I0,I,C,Stream) :-
'$write_body'(S,I,C,Stream).
'$beforelit'('(',_,Stream) :- !, '$format'(Stream," ",[]).
'$beforelit'(_,I,Stream) :- '$format'(Stream,"~n~*c",[I,0' ]).
'$beautify_vars'(T) :- '$beautify_vars'(T) :-
'$list_get_vars'(T,[],L), '$list_get_vars'(T,[],L),