This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/pl/listing.yap

350 lines
8.6 KiB
Plaintext
Raw Normal View History

2019-01-09 09:32:09 +00:00
/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: listing.pl *
* Last rev: *
* mods: *
* comments: listing a prolog program *
* *
*************************************************************************/
2017-10-27 13:50:40 +01:00
/**
2018-05-01 23:25:58 +01:00
* @file pl/listing.yap
2017-10-27 13:50:40 +01:00
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP-2.lan>
* @date Thu Oct 19 12:05:19 2017
2018-05-30 21:54:12 +01:00
*
2017-10-27 13:50:40 +01:00
* @brief list predicates in a module
*
2018-05-30 21:54:12 +01:00
*/
2017-10-27 13:50:40 +01:00
2018-06-05 11:20:39 +01:00
/*:- system_module( '$_listing', [listing/0,
2014-04-09 12:39:29 +01:00
listing/1,
portray_clause/1,
portray_clause/2], []).
2018-06-05 11:20:39 +01:00
*/
2014-04-09 12:39:29 +01:00
2018-05-30 21:54:12 +01:00
/**
2018-06-05 11:20:39 +01:00
* @defgroup listingGroup List predicates in a module
2018-11-04 10:55:58 +00:00
*
2018-05-30 21:54:12 +01:00
* @ingroup builtins
*
2018-11-04 10:55:58 +00:00
* @{
2018-05-30 21:54:12 +01:00
*/
2014-04-09 12:39:29 +01:00
2018-06-05 11:20:39 +01:00
/** @brief listing : Listing clauses in the database
*
*/
2016-08-05 22:37:02 +01:00
/** @pred listing
2014-09-11 20:06:57 +01:00
2018-05-30 21:54:12 +01:00
Lists in the current output stream all the clauses for which source code
2014-09-11 20:06:57 +01:00
is available (these include all clauses for dynamic predicates and
clauses for static predicates compiled when source mode was `on`).
- listing/0 lists in the current module
2016-08-05 22:37:02 +01:00
- listing/1 receives a generalization of the predicate indicator:
+ `listing(_)` will list the whole sources.
+ `listing(lists:_)` will list the module lists.
+ `listing(lists:append)` will list all `append` predicates in the module lists.
+ `listing(lists:append/_)` will do the same.
+ listing(lists:append/3)` will list the popular `append/3` predicate in the module lists.
- listing/2 is similar to listing/1, but t he first argument is a stream reference.
The `listing` family of built-ins does not enumerate predicates whose
name starts with a `$` character.
2014-09-11 20:06:57 +01:00
*/
listing :-
current_output(Stream),
'$current_module'(Mod),
2016-01-03 02:06:09 +00:00
\+ system_module(Mod),
Mod \= prolog,
Mod \= system,
2016-01-03 02:06:09 +00:00
\+ '$hidden_atom'( Mod ),
2016-08-05 22:37:02 +01:00
current_predicate( Name, Mod:Pred ),
\+ '$undefined'(Pred, Mod), % skip predicates exported from prolog.
functor(Pred,Name,Arity),
'$listing'(Name,Arity,Mod,Stream),
fail.
listing.
2014-09-11 20:06:57 +01:00
/** @pred listing(+ _P_)
Lists predicate _P_ if its source code is available.
2016-08-05 22:37:02 +01:00
2014-09-11 20:06:57 +01:00
*/
listing(MV) :-
current_output(Stream),
listing(Stream, MV).
listing(Stream, MV) :-
2019-01-09 09:32:09 +00:00
'$yap_strip_module'( MV, M, I),
listing_(Stream, I, M),
!.
listing_(Stream, V, M) :-
var(V),
!,
'$mlisting'(Stream, V, M).
listing_(_Stream, [], _) :-
!.
listing_(Stream, [MV|MVs], M) :-
!,
'$mlisting'(Stream, MV, M),
listing_(Stream, MVs, M).
listing_(Stream, MV, M) :-
'$mlisting'(Stream, MV, M).
'$mlisting'(Stream, MV, M) :-
2016-08-05 22:37:02 +01:00
( var(MV) ->
2019-01-09 09:32:09 +00:00
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(Ar) ) -> '$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, Name/Arity) :-
2016-08-05 22:37:02 +01:00
( current_predicate(Name, M:Pred),
2017-06-16 11:53:21 +01:00
\+ '$is_opaque_predicate'(Pred,M),
2016-08-05 22:37:02 +01:00
functor( Pred, Name, Arity),
\+ '$undefined'(Pred, M),
'$listing'(Name,Arity,M,Stream),
fail
2019-01-09 09:32:09 +00:00
;
true
).
%
2015-06-19 01:11:30 +01:00
% at this point we are ground and we know who we want to list.
%
'$listing'(Name, Arity, M, Stream) :-
2019-01-09 09:32:09 +00:00
% skip by default predicates starting with $
functor(Pred,Name,Arity),
'$list_clauses'(Stream,M,Pred).
'$listing'(_,_,_,_).
'$funcspec'(Name/Arity,Name,Arity) :- !, atom(Name).
2018-11-04 10:55:58 +00:00
'$funcspec'(Name,Name,0) :- atom(Name), !.
'$funcspec'(Name,_,_) :-
2019-01-09 09:32:09 +00:00
'$do_error'(domain_error(predicate_spec,Name),listing(Name)).
2014-07-16 18:59:03 +01:00
'$list_clauses'(Stream, M, Pred) :-
2019-01-09 09:32:09 +00:00
'$predicate_flags'(Pred,M,Flags,Flags),
(Flags /\ 0x48602000 =\= 0
->
nl(Stream),
fail
;
!
).
'$list_clauses'(Stream, M, Pred) :-
2016-08-05 22:37:02 +01:00
( '$is_dynamic'(Pred, M) -> true ; '$is_log_updatable'(Pred, M) ),
2014-07-16 18:59:03 +01:00
functor( Pred, N, Ar ),
'$current_module'(Mod),
2016-08-05 22:37:02 +01:00
(
M == Mod
->
2019-01-09 09:32:09 +00:00
format( Stream, ':- dynamic ~q/~d.~n', [N,Ar])
;
2019-01-09 09:32:09 +00:00
format( Stream, ':- dynamic ~q:~q/~d.~n', [M,N,Ar])
),
fail.
'$list_clauses'(Stream, M, Pred) :-
2016-08-05 22:37:02 +01:00
'$is_thread_local'(Pred, M),
2014-07-16 18:59:03 +01:00
functor( Pred, N, Ar ),
'$current_module'(Mod),
2016-08-05 22:37:02 +01:00
(
M == Mod
->
2019-01-09 09:32:09 +00:00
format( Stream, ':- thread_local ~q/~d.~n', [N,Ar])
;
2019-01-09 09:32:09 +00:00
format( Stream, ':- thread_local ~q:~q/~d.~n', [M,N,Ar])
),
fail.
'$list_clauses'(Stream, M, Pred) :-
2016-08-05 22:37:02 +01:00
'$is_multifile'(Pred, M),
2014-07-16 18:59:03 +01:00
functor( Pred, N, Ar ),
'$current_module'(Mod),
2016-08-05 22:37:02 +01:00
(
M == Mod
->
2019-01-09 09:32:09 +00:00
format( Stream, ':- multifile ~q/~d.~n', [N,Ar])
;
2019-01-09 09:32:09 +00:00
format( Stream, ':- multifile ~q:~q/~d.~n', [M,N,Ar])
),
fail.
'$list_clauses'(Stream, M, Pred) :-
2019-01-09 09:32:09 +00:00
'$is_metapredicate'(Pred, M),
functor( Pred, Name, Arity ),
prolog:'$meta_predicate'(Name,M,Arity,PredDef),
'$current_module'(Mod),
2016-08-05 22:37:02 +01:00
(
M == Mod
->
2019-01-09 09:32:09 +00:00
format( Stream, ':- ~q.~n', [PredDef])
;
2019-01-09 09:32:09 +00:00
format( Stream, ':- ~q:~q.~n', [M,PredDef])
),
fail.
'$list_clauses'(Stream, _M, _Pred) :-
2019-01-09 09:32:09 +00:00
nl( Stream ),
fail.
'$list_clauses'(Stream, M, Pred) :-
2015-06-19 01:11:30 +01:00
'$predicate_flags'(Pred,M,Flags,Flags),
2019-01-09 09:32:09 +00:00
% has to be dynamic, source, or log update.
Flags /\ 0x08402000 =\= 0,
clause(M:Pred, Body, _),
'$current_module'(Mod),
( M \= Mod -> H = M:Pred ; H = Pred ),
portray_clause(Stream,(H:-Body)),
fail.
2014-09-11 20:06:57 +01:00
/** @pred portray_clause(+ _S_,+ _C_)
Write clause _C_ on stream _S_ as if written by listing/0.
*/
portray_clause(Stream, Clause) :-
2018-09-18 19:26:31 +01:00
copy_term_nat(Clause, CopiedClause),
2019-01-09 09:32:09 +00:00
'$beautify_vs'(CopiedClause),
'$portray_clause'(Stream, CopiedClause),
fail.
portray_clause(_, _).
2016-08-05 22:37:02 +01:00
/** @pred portray_clause(+ _C_)
2014-09-11 20:06:57 +01:00
Write clause _C_ as if written by listing/0.
2016-08-05 22:37:02 +01:00
2014-09-11 20:06:57 +01:00
*/
portray_clause(Clause) :-
2019-01-09 09:32:09 +00:00
current_output(Stream),
portray_clause(Stream, Clause).
'$portray_clause'(Stream, (Pred :- true)) :- !,
2019-01-09 09:32:09 +00:00
format(Stream, '~q.~n', [Pred]).
'$portray_clause'(Stream, (Pred:-Body)) :- !,
2019-01-09 09:32:09 +00:00
format(Stream, '~q :-', [Pred]),
'$write_body'(Body, 3, ',', Stream),
format(Stream, '.~n', []).
2014-10-06 00:00:42 +01:00
'$portray_clause'(Stream, Pred) :-
2019-01-09 09:32:09 +00:00
format(Stream, '~q.~n', [Pred]).
2019-01-09 09:32:09 +00:00
'$write_body'(X,I,T,Stream) :-
var(X), !,
'$beforelit'(T,I,Stream),
writeq(Stream, '_').
'$write_body'((P,Q), I, T, Stream) :-
2019-01-09 09:32:09 +00:00
!,
'$write_body'(P,I,T, Stream),
put(Stream, 0',), %
'$write_body'(Q,I,',',Stream).
'$write_body'((P->Q;S),I,_, Stream) :-
2019-01-09 09:32:09 +00:00
!,
format(Stream, '~n~*c(',[I,0' ]),
I1 is I+2,
'$write_body'(P,I1,'(',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) :-
2019-01-09 09:32:09 +00:00
!,
format(Stream, '~n~*c(',[I,0' ]),
I1 is I+2,
'$write_body'(P,I,'(',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) :-
2019-01-09 09:32:09 +00:00
!,
format(Stream, '~n~*c(',[I,0' ]),
I1 is I+2,
'$write_body'(P,I1,'(',Stream),
format(Stream, '~n~*c->',[I,0' ]),
'$write_body'(Q,I1,'->',Stream),
format(Stream, '~n~*c)',[I,0' ]).
'$write_body'((P;Q),I,_,Stream) :-
2019-01-09 09:32:09 +00:00
!,
format(Stream, '~n~*c(',[I,0' ]),
I1 is I+2,
'$write_disj'((P;Q),I,I1,'->',Stream),
format(Stream, '~n~*c)',[I,0' ]).
'$write_body'((P|Q),I,_,Stream) :-
2019-01-09 09:32:09 +00:00
!,
format(Stream, '~n~*c(',[I,0' ]),
I1 is I+2,
'$write_disj'((P|Q),I,I1,'->',Stream),
format(Stream, '~n~*c)',[I,0' ]).
'$write_body'(X,I,T,Stream) :-
2019-01-09 09:32:09 +00:00
'$beforelit'(T,I,Stream),
writeq(Stream,X).
2014-10-06 00:00:42 +01:00
'$write_disj'((Q;S),I0,I,C,Stream) :- !,
2019-01-09 09:32:09 +00:00
'$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) :- !,
2019-01-09 09:32:09 +00:00
'$write_body'(Q,I,C,Stream),
format(Stream, '~n~*c|',[I0,0' ]),
'$write_disj'(S,I0,I,'|',Stream).
'$write_disj'(S,_,I,C,Stream) :-
2019-01-09 09:32:09 +00:00
'$write_body'(S,I,C,Stream).
2016-08-05 22:37:02 +01:00
'$beforelit'('(',_,Stream) :-
2014-10-06 00:00:42 +01:00
!,
format(Stream,' ',[]).
2018-08-09 02:07:25 +01:00
'$beforelit'(_,I,Stream) :- format(Stream,'~n~*c',[I,0' ]). %'
2018-09-18 19:26:31 +01:00
'$beautify_vs'(T) :-
'$non_singletons_in_term'(T,[],Fs),
'$vv_transform'(Fs,1),
term_variables(T, NFs),
'$v_transform'(NFs).
'$v_transform'([]).
'$v_transform'(['$VAR'(-1)|L]) :-
2019-01-09 09:32:09 +00:00
'$v_transform'(L).
2018-09-18 19:26:31 +01:00
'$vv_transform'([],_) :- !.
'$vv_transform'(['$VAR'(M)|L],M) :-
2019-01-09 09:32:09 +00:00
N is M+1,
'$vv_transform'(L,N).
2018-06-05 11:20:39 +01:00
%% @}