/* --- Copyright University of Sussex 1990. All rights reserved. ----------
 > File:            $poplocal/local/plog/lib/examine.pl
 > Purpose:         Simple term examiner
 > Author:          Chris Mellish, Feb 85 (see revisions)
 > Documentation:	HELP * EXAMINE
 */

:- library(popsetq).

:- library(modules).
:- module(examiner).
:- export examine/1.

:- prolog_eval(popval(quote([vars,varcounter,';']))).

examine(Term) :-
   write('examining...'), nl,
   prolog_setq(varcounter,1),
   examine(Term,[],1,[]),
   fail.
examine(Term) :-
   write('...examined'), nl.

   getchar(C) :-
      prolog_eval(sysflush(popval(quote([pop_charout_device])))),
      C is apply(valof(rawcharin)), put(C), nl.

   examine([],[],_,_) :- !.
   examine(Term,Stack,N,Env) :-
      writetop(Term), write(' ?'),
      getchar(C),
      obey(C,Term,Stack,N,Env,Newterm,Newstack,NewN,NewEnv), !,
      examine(Newterm,Newstack,NewN,NewEnv).

;;; write the current term without all detail

   writetop(X) :- var(X), !, newvar(X).
   writetop(X) :- X = '$VAR'(N), !, write(X).
   writetop(X) :- atomic(X), !, write(X).
   writetop(X) :- X = [_|_], !, writetoplist(X).
   writetop(X) :-
      functor(X,F,N),
      write(F), write('('),
      writetopargs(1,N,X),
      write(')').

   newvar(X) :-
      X1 is valof(varcounter),
      X = '$VAR'(X1),
      X2 is X1+1,
      prolog_setq(varcounter,X2).

   writetoplist(List) :-
      write('['),
      writetoplelts(List),
      write(']').

   writetoplelts([X|Y]) :-
      var(Y), !, newvar(Y),
      writetoplelts([X|Y]).
   writetoplelts([X,Y|Z]) :- !,
      writeabb(X), write(', '),
      writetoplelts([Y|Z]).
   writetoplelts([X]) :- !,
      writeabb(X).
   writetoplelts([X|Y]) :-
      writeabb(X),
      write('| '),
      writeabb(Y).

   writetopargs(N,N,X) :- !,
      arg(N,X,A),
      writeabb(A).
   writetopargs(N1,N,X) :-
      N2 is N1 + 1,
      arg(N1,X,A),
      writeabb(A),
      write(','),
      writetopargs(N2,N,X).

   writeabb(X) :- var(X), !, newvar(X), write(X).
   writeabb(X) :- X = '$VAR'(N), !, write(X).
   writeabb(X) :- atomic(X), !, write(X).
   writeabb(X) :- write('&').

;;; examiner commands

;;; e - exit from examiner
obey(101,T,S,N,Env,[],[],N,Env).
;;; h - list options
obey(104,T,S,N,Env,T,S,N,Env) :-
   write('b        - go Back to last argument of term'), nl,
   write('e        - Exit from examiner'), nl,
   write('g        - Go to named term'), nl,
   write('h        - Help on examiner commands'), nl,
   write('l        - Label current term with name'), nl,
   write('<digit>  - go to nth argument of term'), nl,
   write('n        - go to Next argument of term'), nl,
   write('o        - go back Out of this term'), nl,
   write('w        - Write out whole of term'), nl.
;;; b - go back to last term at this level
obey(98,_,state(T,S,SNu),N,Env,NT,state(T,S,SNu),N1,Env) :-
   N1 is N - 1,
   functor(T,_,Ar),
   gen_arg(N1,T,NT).
;;; <digit> - go to nth argument
obey(C,T,S,N1,Env,NT,state(T,S,N1),A,Env) :-
   C =< 57, C >= 49, A is C - 48,
   not(atomic(T)),
   not(T='$VAR'(_)),
   functor(T,_,N),
   gen_arg(A,T,NT).
;;; n - go to next term at this level
obey(110,_,state(T,S,SNu),N,Env,NT,state(T,S,SNu),N1,Env) :-
   N1 is N + 1,
   functor(T,_,Ar),
   gen_arg(N1,T,NT).
;;; o - go out to next enclosing term
obey(111,T,state(T1,S,N),_,Env,T1,S,N,Env).
;;; l - label term by name
obey(108,T,S,N,Env,T,S,N,[assoc(Na,state(T,S,N))|Env]) :-
   [Na] is getline('please type in word to label this term').
;;; g - go to term with given label
obey(103,_,_,_,Env,T,S,N,Env) :-
   [Na] is getline('please type in label of term'),
   findassoc(Na,Env,T,S,N).
;;; w - write whole term
obey(119,T,S,N,Env,T,S,N,Env) :-
   X is valof(varcounter),
   numbervars(T,X,X1),
   prolog_setq(varcounter,X1),
   write(T), nl.
;;; default - error, do nothing
obey(X,T,S,N,Env,T,S,N,Env) :- write('?'), nl.

   findassoc(Na,[assoc(Na,XX)|_],T,S,N) :- !, XX = state(T,S,N).
   findassoc(Na,[_|L],T,S,N) :- findassoc(Na,L,T,S,N).

   gen_arg(N,T,Arg) :-
      T = [_|_], !,
      N > 0,
      nmember(N,T,Arg).
   gen_arg(N,T,Arg) :-
      functor(T,F,Ar),
      N > 0,
      N =< Ar,
      arg(N,T,Arg).

   nmember(1,[X|Y],X) :- !.
   nmember(N,[X|Y],Z) :- !,
      N1 is N - 1,
      nmember(N1,Y,Z).
   nmember(1,X,X).

:- endmodule.


/* --- Revision History ---------------------------------------------------
--- Simon Nichols, Nov  6 1990
		Changed -popdevX- to -pop_charX_device-.
 */
