From f37806d7ccc0aa93cc971223a67ea4354d11cf2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Wed, 16 Jul 2014 11:55:16 -0500 Subject: [PATCH] improve listing, make it more generous and SWi-like. --- C/cdmgr.c | 16 +++++++ pl/listing.yap | 113 +++++++++++++++++++++++++++++++++++++++---------- 2 files changed, 106 insertions(+), 23 deletions(-) diff --git a/C/cdmgr.c b/C/cdmgr.c index f37df2a4d..af8433511 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -3174,6 +3174,21 @@ p_is_discontiguous( USES_REGS1 ) return(out); } +static Int +p_is_thread_local( USES_REGS1 ) +{ /* '$is_dynamic'(+P) */ + PredEntry *pe; + Int out; + + pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_log_updatable"); + if (EndOfPAEntr(pe)) + return FALSE; + PELOCK(27,pe); + out = (pe->PredFlags & ThreadLocalPredFlag); + UNLOCKPE(45,pe); + return(out); +} + static Int p_is_log_updatable( USES_REGS1 ) { /* '$is_dynamic'(+P) */ @@ -6617,6 +6632,7 @@ Yap_InitCdMgr(void) Yap_InitCPred("$is_metapredicate", 2, p_is_metapredicate, TestPredFlag | SafePredFlag); Yap_InitCPred("$is_expand_goal_or_meta_predicate", 2, p_is_expandgoalormetapredicate, TestPredFlag | SafePredFlag); Yap_InitCPred("$is_log_updatable", 2, p_is_log_updatable, TestPredFlag | SafePredFlag); + Yap_InitCPred("$is_thread_local", 2, p_is_thread_local, TestPredFlag | SafePredFlag); Yap_InitCPred("$is_source", 2, p_is_source, TestPredFlag | SafePredFlag); Yap_InitCPred("$is_exo", 2, p_is_exo, TestPredFlag | SafePredFlag); Yap_InitCPred("$owner_file", 3, p_owner_file, SafePredFlag); diff --git a/pl/listing.yap b/pl/listing.yap index 5edcc6d72..45df6e152 100644 --- a/pl/listing.yap +++ b/pl/listing.yap @@ -37,25 +37,41 @@ listing :- '$list_clauses'(Stream,Mod,Pred). listing. +listing(MV) :- + current_output(Stream), + listing(Stream, MV). -listing(V) :- - current_output(Stream), - '$current_module'(M), - '$listing'(V,M,Stream). +listing(Stream, MV) :- + '$mlisting'(Stream, MV, _). +listing(Stream, []) :- !. +listing(Stream, [MV|MVs]) :- !, + listing(Stream, MV), + listing(Stream, MVs). + +'$mlisting'(Stream, MV, M) :- + ( var(MV) -> MV = NA, '$do_listing'(Stream, M, NA) + ; + atom(MV) -> MV/_ = NA, '$do_listing'(Stream, M, NA) + ; + MV = N//Ar -> ( integer(Ar) -> Ar2 is Ar+2, NA is N/Ar2 ; '$do_listing'(Stream, Na/Ar2, M), Ar2 >= 2, Ar is Ar2-2 ) + ; + MV = N/Ar, ( atom(N) -> true ; var(N) ), ( integer(Ar) -> true ; var(A) ) -> '$do_listing'(Stream, M, MV) + ; + MV = M1:PP -> '$mlisting'(Stream, PP, M1) + ; + '$do_error'(type_error(predicate_indicator,MV),listing(Stream, MV) ) + ). + +'$do_listing'(Stream, M, NA) :- + ( '$$current_predicate'(NA, M), + '$listing'(NA,M,Stream), + fail + ; + true + ). -'$listing'(V,Mod,Stream) :- var(V), !, - '$current_predicate_no_modules'(Mod,_,Pred), - ( '$list_clauses'(Stream,Mod,Pred) ; true ). -'$listing'(M:V,_,Stream) :- !, - '$listing'(V,M,Stream). -'$listing'([],_,_) :- !. -'$listing'([X|Rest], M, Stream) :- - !, - '$listing'(X, M, Stream), - '$listing'(Rest, M, Stream). '$listing'(X, M, Stream) :- '$funcspec'(X,Name,Arity), - '$current_predicate_no_modules'(M,Name,Pred), functor(Pred,Name,Arity), '$list_clauses'(Stream,M,Pred). '$listing'(_,_,_). @@ -65,12 +81,66 @@ listing(V) :- '$funcspec'(Name,_,_) :- '$do_error'(domain_error(predicate_spec,Name),listing(Name)). +'$list_clauses'(Stream, M, Pred) :- + ( '$is_dynamic'(Pred, M) -> true ; '$is_log_updatable'(Pred, M) ), + functor( Pred, M, Ar ), + '$current_module'(Mod), + ( + M == Mod + -> + format( Stream, '~n:- dynamic ~q/~d.~n', [N,Ar]) + ; + format( Stream, '~n:- dynamic ~q:~q/~d.~n', [M,N,Ar]) + ), + fail. +'$list_clauses'(Stream, M, Pred) :- + '$is_thread_local'(Pred, M), + functor( Pred, M, Ar ), + '$current_module'(Mod), + ( + M == Mod + -> + format( Stream, '~n:- thread_local ~q/~d.~n', [N,Ar]) + ; + format( Stream, '~n:- thread_local ~q:~q/~d.~n', [M,N,Ar]) + ), + fail. +'$list_clauses'(Stream, M, Pred) :- + '$is_multifile'(Pred, M), + functor( Pred, M, Ar ), + '$current_module'(Mod), + ( + M == Mod + -> + format( Stream, '~n:- multifile ~q/~d.~n', [N,Ar]) + ; + format( Stream, '~n:- multifile ~q:~q/~d.~n', [M,N,Ar]) + ), + fail. +'$list_clauses'(Stream, M, Pred) :- + '$is_metapredicate'(Pred, M), + functor( Pred, Name, Arity ), + prolog:'$meta_predicate'(Name,M,Arity,PredDef), + '$current_module'(Mod), + ( + M == Mod + -> + format( Stream, '~n:- ~q.~n', [PredDef]) + ; + format( Stream, '~n:- ~q:~q.~n', [M,PredDef]) + ), + fail. +'$list_clauses'(Stream, M, Pred) :- + nl( Stream ), + fail. '$list_clauses'(Stream, M, Pred) :- '$flags'(Pred,M,Flags,Flags), % has to be dynamic, source, or log update. Flags /\ 0x08402000 =\= 0, '$clause'(Pred, M, Body, _), - '$portray_clause'(Stream,(Pred:-Body)), + '$current_module'(Mod), + ( M \= Mod -> H = M:Pred ; H = Pred ), + '$portray_clause'(Stream,(H:-Body)), fail. portray_clause(Stream, Clause) :- @@ -81,10 +151,7 @@ portray_clause(_, _). portray_clause(Clause) :- current_output(Stream), - copy_term_nat(Clause, CopiedClause), - '$portray_clause'(Stream, CopiedClause), - fail. -portray_clause(_). + portray_clause(Stream, Clause). '$portray_clause'(Stream, (Pred :- true)) :- !, '$beautify_vars'(Pred), @@ -114,7 +181,7 @@ portray_clause(_). format(Stream, '~n~*c(',[I,0' ]), I1 is I+2, '$write_body'(P,I1,'(',Stream), - format(Stream, ' ->',[]), + format(Stream, '~n~*c->',[I,0' ]), '$write_disj'((Q;S),I,I1,'->',Stream), format(Stream, '~n~*c)',[I,0' ]). '$write_body'((P->Q|S),I,_,Stream) :- @@ -122,7 +189,7 @@ portray_clause(_). format(Stream, '~n~*c(',[I,0' ]), I1 is I+2, '$write_body'(P,I,'(',Stream), - format(Stream, ' ->',[]), + format(Stream, '~n~*c->',[I,0' ]), '$write_disj'((Q|S),I,I1,'->',Stream), format(Stream, '~n~*c)',[I,0' ]). '$write_body'((P->Q),I,_,Stream) :- @@ -130,7 +197,7 @@ portray_clause(_). format(Stream, '~n~*c(',[I,0' ]), I1 is I+2, '$write_body'(P,I1,'(',Stream), - format(Stream, ' ->',[]), + format(Stream, '~n~*c->',[I,0' ]), '$write_body'(Q,I1,'->',Stream), format(Stream, '~n~*c)',[I,0' ]). '$write_body'((P;Q),I,_,Stream) :-