/* XRF.PL :  Prolog Cross-Reference Program
 
                        Dave Bowen
                        Updated: 1 June 1983
    This is the main module of XREF.
 
*/
 
% Compiler declarations %
 
/*
 :- public go/0.            % User entry.
 :- public xrf/1, indirect/1.       % These are public for internal Call.
*/
 
 :- op(125,fy,@).
 
/*
 :- mode caller(+,+,+,+).
 :- mode crecord(+,+).
 :- mode definition(+,+).
 :- mode do_file(+,+).
 :- mode exhaust(+).
 :- mode getfrom(+).
 :- mode goal(?,-). 
 :- mode goal0(+,-).
 :- mode has_ext(+,+).
 :- mode head(+,+,-,-).  
 :- mode indirect(+).    
 :- mode mark_interpreted(+).
 :- mode process(+,+).   
 :- mode reply(+).  
 :- mode widen(?,-).
 :- mode xrf(+).
*/
 
/******************************************************************************
 
Data
 
   $caller(Called_Predicate, Calling_Functor, Calling_Arity, Where_Defined)
              Held on key: Called_Predicate.
              $caller(P,F,N,I) means P is called by F/N in file I.
   $defn(File, Predicate)
              Held on key: Predicate.
              $defn(I,P) means P is defined in I.
   $file(File)
              Held on key: $file(_).
              $file(F) means F is a file.
   Predicate
              Held on key: $pred
              pred(G,M) means G/M was defined OR used.
 
******************************************************************************/
 
                /* Top level */
go :-
    repeat,
        ttynl, write('Next file: '), ttyflush,
        readtonl(String),
        reply(String), !.
 
                /* Check for termination of input: just
                   <newline> typed? */
reply([]) :- !,
    (collect ; true).   % Yes: go and start output phase
reply(String) :-
    getfrom(String), !, % Something input: what is it?
    fail.           % Go back to repeat
 
                /* Prolog, indirect or definition file? */
getfrom([64|S]) :- !,
    do_file(indirect,S).        % Indirect file introduced by '@'
getfrom([42|S]) :- !,
    do_file(load_file,S).       % Definition file introduced by '*'
getfrom(S) :-
    has_ext(S,".CCL"), !,       % Indirect file indicated by ".CCL"?
    do_file(indirect,S).
getfrom(S) :- 
    has_ext(S,".DEF"), !,       % Definition file indicated by ".DEF"?
    do_file(load_file,S).
getfrom(S) :-               % Must be Prolog file for cross ref
    do_file(xrf,S).
 
                /* Takes two character lists as arguments, and
                   tests whether the 1st ends with the 2nd */
has_ext(Ext,Ext) :- !.
has_ext([_|L],Ext) :- has_ext(L,Ext).
 
 
                /* Open up the file, call processing procedure,
                   and close file again. Calls indirect(File)
                   load_file(File) or xrf(File). */
do_file(Predicate,String) :-
    name(File,String),      % Convert char list to atom (File)
    seeing(Old_file),       % Save currently open file
    see_chek(File),         % Open required file (may fail)
    P =.. [Predicate,File],     % Construct call to reqd procedure
    call(P),            % Call it
    seen,               % Close file
    see(Old_file).          % Re-open original file
do_file(_,_).               % Always succeed
 
                /* Get file names from indirect file */
indirect(F) :- 
    readtonl(S),            % Read a line, fail at end_of_file(^Z)
    ( (S="")            % Ignore blank lines
    ;   write('File: '),      % (S is char list)
        writes(S), ttynl,       % Echo on terminal
        getfrom(S)          % Process (may be indirect or def)
    ), !,
    indirect(F).            % Loop to get next line
indirect(F) :-
    ttynl,              % Tell user when indirect file finished
    write('Indirect file '),
    write(F),
    write(' processed'), ttynl.
 
                /* Cross reference processing for a particular
                   file F */
xrf(F) :-
    recordz('$file'(_),'$file'(F),_),   % record F under $file
    exhaust(F).             % go through F term by term
 
                /* Process each clause, T, in file F */
exhaust(F) :-
    repeat,             % Iterate till end_of_file
        read(T),            % Read a clause
        ( expand_term(T,T1) -> true ; T1 = T ),
                            % Pre-translation of grammar rules
        process(T1,F),      % Cross-ref processing
    T=(end_of_file), !.
 
                /* Process clause (1st arg). 2nd arg is file */
 
process((P:-Q),I) :- !,         % Non-unit clause
    head(P,I,F,N), !,
    goal(Q,G),          % Process successive goals by 
    caller(G,F,N,I).        %   backtracking.
process((:-G),_) :- !, call(G).     % goal clause, call it.
process((?-G),_) :- !, call(G).     % question, ditto
process(end_of_file,_) :- !.        % eof so succeed and exit repeat loop
process(P,I) :- head(P,I,_,_).      % unit clause
 
                /* Record the fact that P is a predicate & that
                   it is defined in file I. Return principal
                   functor of P (F) & its arity (N). */
head(P,I,F,N) :-
    functor(P,F,N),         % P has name F and arity N
    functor(G,F,N),         % G is most general term F/N
    definition(G,I).        % Record F/N is pred & defined in I
 
                /* Fail if goal is a variable. */
goal(G,_) :- var(G), !, fail.
goal(G,G1) :- goal0(G,G1).
 
                /* Returns most general term having the
                   principal functor & arity of each goal in 
                   the clause (successively on backtracking).
                   Ignores system predicates. */
goal0((G,_),G1) :-
   goal(G,G1).
goal0((_,G),G1) :- !,
   goal(G,G1).
goal0((G;_),G1) :-
   goal(G,G1).
goal0((_;G),G1) :- !,
   goal(G,G1).
goal0(G1,G2) :- 
   recorded(G1,'$applies'(G1,P),_),
   widen(P,P1),
   goal(P1,G2),
   mark_interpreted(G2).
goal0(G,_) :- 
   recorded(G,'$system',_), !,
   fail.
goal0(G,G).
 
                /* Record that P is a predicate and that it is
                   defined in file I */
definition(P,I) :-
    recorded(P,'$system',_), !, % But not if P is a system predicate
    warn(P,'already defined as a system predicate'), fail.
definition(P,I) :-
    crecord('$pred',P),
    crecord(P,'$defn'(I,P)).
 
                /* Record that P is a predicate called by
                   F/N in file I */
caller(P,F,N,I) :- 
    functor(P,Pf,Pn),
    functor(P1,Pf,Pn),
    crecord('$pred',P1),
    crecord(P1,'$caller'(P1,F,N,I)).
 
                /* Record that P is called by the user or
                   outside its file of definition, and hence
                   must be public. */
mark_interpreted(P) :- 
    caller(P,'<user>',0,undefined).
 
                /* Record term Q on key P unless already
                   recorded. */
crecord(P,Q) :- recorded(P,Q,_), !.
crecord(P,Q) :- recordz(P,Q,_), !.
 
 
                /* Increase arity of predicate by specified
                   amount */
widen(A+_,_) :-
    var(A), !, fail.    % NB also covers variable as first arg
widen(A+Offset,A1) :- !,
    functor(A,F,N1),
    N2 is N1+Offset,
    functor(A1,F,N2).
widen(A,A).
