home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / X_PROLOG.LZH / X_PROLOG / LISTING < prev    next >
Text File  |  1990-08-13  |  3KB  |  136 lines
  1. %
  2. %    listing predicate
  3. %
  4. %    for Xprolog 2.0
  5. %    by Andreas Toenne
  6.  
  7. % listing :-
  8. %    all known and not hidden procedures are written to the output
  9. %    stream. The output of listing can be reread.
  10. % listing(name) :-
  11. %    all known and not hidden procedures with the named head are
  12. %    written as in listing.
  13. % listing(ListOfNames) :-
  14. %    applies listing(name) to all members of the list.
  15.  
  16. :- op(255, xfx, '<-').
  17.  
  18. listing :-
  19.     assert(lastlisted(foo, foo)),
  20.     next_functor(Name, Arity),
  21.     functor(Head, Name, Arity),        % construct clause head
  22.     clause(Head, Body),            % find matching clause
  23.     nl,
  24.     check_for_new_procedure(Name, Arity),    % nl if new procedure
  25.     write_clause(Head, Body),        % output the clause
  26.     fail.                    % search for next solution
  27. listing :- nl, abolish(lastlisted, 2).
  28.  
  29. listing(X) :- var(X), !.            % don't list variables
  30. listing([]) :- !.                % stop at empty list
  31. listing([Name|Names]) :-
  32.     !,
  33.     listing(Name),
  34.     listing(Names).
  35. listing(Name) :-
  36.     assert(lastlisted(foo, foo)),
  37.     next_functor(Name, Arity),
  38.     functor(Head, Name, Arity),
  39.     clause(Head, Body),
  40.     nl,
  41.     check_for_new_procedure(Name, Arity),
  42.     write_clause(Head, Body),
  43.     fail.
  44. listing(_) :- nl, abolish(lastlisted, 2).
  45.  
  46. next_functor(Name, Arity) :- 
  47.     $functor(Name, Arity, Help),
  48.     isNotCommentClause(Name, Arity).
  49.  
  50. isNotCommentClause((<-), 2) :- !,fail.
  51. isNotCommentClause(_,_).
  52.  
  53. check_for_new_procedure(Name, Arity) :-        % no changes
  54.     lastlisted(Name, Arity),
  55.     !.
  56. check_for_new_procedure(Name, Arity) :-        % new procedure
  57.     retract(lastlisted(_,_)),
  58.     assert(lastlisted(Name, Arity)),
  59.     nl,
  60.     output_comment(Name, Arity),        % show it's purpose
  61.     nl.
  62.  
  63. output_comment(Name, Arity) :-
  64.     functor(Head, Name, Arity),
  65.     clause((Head <- Comment), X),        % look for comment
  66.     writeq(Head),
  67.     write(' <- '),
  68.     write_body(Comment, 8, notstart),
  69.     put(['.']),
  70.     fail.                    % show all comments
  71. output_comment(_,_).                % always succeed
  72.  
  73. write_clause(Head, true) :-
  74.     writeq(Head),
  75.     put(['.']),
  76.     !.
  77. write_clause(Head, Body) :-
  78.     writeq(Head),
  79.     write(' :- '),
  80.     write_body(Body, 8, start),
  81.     put(['.']),
  82.     !.
  83.     
  84. write_body(X, _, _) :-                % Xprolog has no variable terms
  85.     var(X),
  86.     nl,
  87.     !,
  88.     write('***** variable goal is bad *****').
  89. write_body((A,B), Tab, _) :-
  90.     !,
  91.     write_body(A, Tab, comma),
  92.     put([',']),
  93.     write_body(B, Tab, comma).
  94. write_body((A;B), Tab, FromWhere) :-
  95.     (
  96.         FromWhere = start
  97.         ;
  98.         FromWhere = semicolon
  99.     ),
  100.     !,
  101.     write_body(A, Tab, semicolon),
  102.     nl,
  103.     tab(Tab),
  104.     put([';']),
  105.     write_body(B, Tab, semicolon).
  106. write_body((A;B), Tab, _) :-
  107.     !,
  108.     nl,
  109.     tab(Tab),
  110.     put(['(']),
  111.     NewTab is Tab + 8,
  112.     write_body(A, NewTab, semicolon),
  113.     nl,
  114.     tab(NewTab),
  115.     put([';']),
  116.     write_body(B, NewTab, semicolon),
  117.     nl,
  118.     tab(Tab),
  119.     put([')']).
  120. write_body(X, _, start) :-            % simple body
  121.     !,
  122.     writeq(X).
  123. write_body(X, Tab, _) :-
  124.     !,
  125.     nl,
  126.     tab(Tab),
  127.     writeq(X).
  128.  
  129. lastlisted(foo, foo).                % for output formatting
  130.  
  131. % hide all new procedures
  132.  
  133. :- hide([listing, listing(_), next_functor(_,_), check_for_new_procedure(_,_),
  134.      write_clause(_,_), write_body(_,_,_), lastlisted(_,_),
  135.      output_comment(_,_), isNotCommentClause(_,_)]).
  136.