root/tags/lgt2305/library/listing.lgt

Revision 3340, 3.8 KB (checked in by pmoura, 2 years ago)

Added a new library category, "listing", defining listing/0 and listing/1 methods for helping in debugging tasks.
  • Property svn:eol-style set to native
Line 
1
2:- category(listing).
3
4    :- info([
5        version is 1.0,
6        author is 'Paulo Moura',
7        date is 2007/2/8,
8        comment is 'Listing predicates.']).
9
10    :- public(listing/0).
11    :- mode(listing, one).
12    :- info(listing/0, [
13        comment is 'Lists all clauses of all dynamic predicates to the current output stream.']).
14
15    :- public(listing/1).
16    :- mode(listing(+predicate_indicator), one).
17    :- info(listing/1, [
18        comment is 'Lists all clauses of a dynamic predicate to the current output stream.',
19        argnames is ['Predicate']]).
20
21    :- public(portray_clause/1).
22    :- mode(portray_clause(+clause), one).
23    :- info(portray_clause/1, [
24        comment is 'Pretty prints a clause to the current output stream.',
25        argnames is ['Clause']]).
26
27    :- protected(portray_body/1).
28    :- mode(portray_body(+callable), one).
29    :- info(portray_body/1, [
30        comment is 'Pretty prints a clause body to the current output stream.',
31        argnames is ['Body']]).
32
33    :- protected(spaces/1).
34    :- mode(spaces(+integer), one).
35    :- info(spaces/1, [
36        comment is 'Prints N spaces to the current output stream.',
37        argnames is ['N']]).
38
39    listing :-
40        ::current_predicate(Functor/Arity),
41        functor(Head, Functor, Arity),
42        ::predicate_property(Head, (dynamic)),
43        nl,
44        listing_properties(Head, Functor, Arity),
45        listing_clauses(Head, Functor, Arity),
46        fail.
47    listing.
48
49    listing(Functor/Arity) :-
50        atom(Functor),
51        integer(Arity),
52        ::current_predicate(Functor/Arity),
53        functor(Head, Functor, Arity),
54        ::predicate_property(Head, (dynamic)), !,
55        listing_properties(Head, Functor, Arity),
56        listing_clauses(Head, Functor, Arity).
57
58    listing_properties(Head, Functor, Arity) :-
59        ::predicate_property(Head, public),
60        write(':- public('), writeq(Functor/Arity), write(').'),
61        fail.
62    listing_properties(Head, Functor, Arity) :-
63        ::predicate_property(Head, protected),
64        write(':- protected('), writeq(Functor/Arity), write(').'),
65        fail.
66    listing_properties(Head, Functor, Arity) :-
67        ::predicate_property(Head, private),
68        write(':- private('), writeq(Functor/Arity), write(').'),
69        fail.
70    listing_properties(Head, _, _) :-
71        ::predicate_property(Head, declared_in(DclEntity)),
72        write('    % '), writeq(declared_in(DclEntity)), nl,
73        fail.
74    listing_properties(Head, Functor, Arity) :-
75        ::predicate_property(Head, (dynamic)),
76        write(':- dynamic('), writeq(Functor/Arity), write(').'),
77        fail.
78    listing_properties(Head, _, _) :-
79        (   ::clause(Head, _) ->
80            nl
81        ;   write('   % no local clauses found'), nl
82        ),
83        fail.
84    listing_properties(Head, _, _) :-
85        ::predicate_property(Head, meta_predicate(Mode)),
86        write(':- meta_predicate('), writeq(Mode), write(').'), nl,
87        fail.
88    listing_properties(Head, Functor, Arity) :-
89        ::predicate_property(Head, synchronized),
90        write(':- synchronized('), writeq(Functor/Arity), write(').'), nl,
91        fail.
92    listing_properties(Head, Functor, Arity) :-
93        ::predicate_property(Head, alias(OFunctor/OArity)),
94        write(':- alias('), writeq(OFunctor/OArity), write(', '), writeq(Functor/Arity), write(').'), nl,
95        fail.
96    listing_properties(Head, _, _) :-
97        ::predicate_property(Head, non_terminal(NonTerminal//NTArity)) ->
98        write('% clauses resulting from the expansion of the non-terminal '), writeq(NonTerminal//NTArity), nl,
99        fail.
100    listing_properties(_, _, _).
101
102    listing_clauses(Head, _, _) :-
103        ::clause(Head, Body),
104        ::portray_clause((Head :- Body)),
105        fail.
106    listing_clauses(_).
107
108    portray_clause((Head :- true)) :-
109        !,
110        numbervars(Head, 0, _),
111        write_term(Head, [numbervars(true), quoted(true)]), write('.'), nl.
112    portray_clause((Head :- Body)) :-
113        numbervars((Head:-Body), 0, _),
114        write_term(Head, [numbervars(true), quoted(true)]), write(' :-'), nl,
115        ::portray_body(Body),
116        write('.'), nl.
117
118    portray_body(Body) :-
119        spaces(4), write_term(Body, [numbervars(true), quoted(true)]).
120
121    spaces(0) :-
122        !.
123    spaces(N) :-
124        put_char(' '),
125        N2 is N - 1,
126        spaces(N2).
127
128:- end_category.
Note: See TracBrowser for help on using the browser.