/* INIT : Initial boot file for building the Prolog system

                                                 Lawrence
                                                 Updated: 22 January 82
*/

%   System portable version,   Richard Marshall 1984

%   Current host system lines are preceded by /*host*/
%   Other hosts are preceded by %host%

%   Comment flags: VAX EMAS APM

%   Simple ECCE macro to change between them.


                         % Atoms that the code requires
[].
','.
'{}'.
end_of_file.
true.
user.
$live.
$break.
                         % Functors that the code requires
call(_).
','(_,_).
'{}'(_).
'.'(_,_).
':-'(_,_).
':-'(_).


                         % And now we start properly

         % Predicates are attached to evaluable predicates defined in the
         % code by one of two methods:
         %
         %       1) pred(....) :- N.
         %       2)  :- $sysp(pred(....),N).
         %
         %               where N is an integer specifying the evaluable 
         % predicate - N is the value of the switch label in the PL2900 code.
         % The difference between these is that with the first method a (local)
         % frame will be built which will contain the arguments to the
         % procedure; whereas in the second case no frame is built.

                         % Set up the Operators

 :-(op(P,T,A),76).

 :-(op(1200,fx,[ :- , ?- ])).

 :-op(1200,xfx,[ (:-) , --> ]).
 :-op(1100,xfy,';').
 :-op(1050,xfy,'->').
 :-op(1000,xfy,',').
 :-op(900,fy,[ \+ , not , spy , nospy ]).
 :-op(700,xfx,[ =, is, =.. , ==, \==, @<, @>, @=<, @>=, =:=, =\=, <, > , =<, >= ]).
 :-op(500,yfx,[+,-,/\,\/]).
 :-op(500,fx,[(+),(-)]).
 :-op(400,yfx,[*,/,<<,>>]).
 :-op(300,xfx,[mod]).
 :-op(200,xfy,'^').


                         % And now all the evaluable predicates

 $sysp(F,N) :- 100.
 $sysflgs(F,N) :- 101.
 :-$sysp((A,B),6).
 :-$sysp(call(_),1).
 :-$sysp(!,2).
true.
 repeat :- 3.
 :-$sysp(abort,4).
 :-$sysp($call(_),5).

not(X) :- X, !, fail.
not(X).

\+(X) :- X, !, fail.
\+(X).

(A -> B ; C) :- !, $cond(A,B,C).

         $cond(A,B,C) :- A, !, B.
         $cond(A,B,C) :- C.

(A;B) :- $call(A).
(A;B) :- $call(B).
(A -> B) :- A, !, B.

 see(F) :- 10.
 seeing(F) :- 11.
 seen :- 12.
 tell(F) :- 13.
 telling(F) :- 14.
 told :- 15.
 close(F) :- 16.
 read(T) :- 17.
 write(T) :- 18.       display(T) :- 18.
 nl :- 19.             ttynl :- 19.
 get0(C) :- 20.
 get(C) :- 21.
 skip(C) :- 22.
 put(C) :- 23.
 tab(C) :- 24.         ttytab(C) :- 24.
 fileerrors :- 25.
 nofileerrors :- 26.
 rename(F,F1) :- 27.
 writeq(T) :- 28.

%VAX% set_default(F) :- 117.
%VAX% current_default(F) :- 118.

/*APM*/ set_terminal_mode(Bits) :- 117.
/*APM*/ test_symbol(Character) :- 118.

call_edwin(F) :- 119.
call_edwin(F, P1) :- 119.
call_edwin(F, P1, P2) :- 119.
call_edwin(F, P1, P2, P3) :- 119.
call_edwin(F, P1, P2, P3, P4) :- 119.
call_edwin(F, P1, P2, P3, P4, P5) :- 119.

implode(String, Atom) :- 120.
explode(Atom, String) :- 121.

print(V) :- var(V), !, write(V).

print(X) :- portray(X), !.

print(X) :- write(X).

                         % define arithmetic operators

  :-$sysflgs(cputime,1).
  :-$sysflgs(heapused,2).
  :-$sysflgs([A|B],1).
  :-$sysflgs(+(A),1).
  :-$sysflgs(-(A),2).
  :-$sysflgs(A+B,3).
  :-$sysflgs(A-B,4).
  :-$sysflgs(A*B,5).
  :-$sysflgs(A/B,6).
  :-$sysflgs(A mod B,7).
  :-$sysflgs(A /\ B,8).
  :-$sysflgs(A\/B,9).
  :-$sysflgs('!'(A),10).
  :-$sysflgs(A<<B,11).
  :-$sysflgs(A>>B,12).

X is Y :- 40.
X =:= Y :- 41.
X =\= Y :- 42.
X < Y :- 43.
X > Y :- 44.
X =< Y :- 45.
X >= Y :- 46.

var(X) :- 50.
nonvar(X) :- 51.
integer(X) :- 52.
atomic(X) :- 53.
atom(X) :- 59.

%EMAS% emas(_) :- 29.
%EMAS% emas(_,_) :- 30.


prompt(_,_) :- 31.
exists(user) :- !.
exists(_) :- 32.
save(_) :- 33.

X=X.
functor(T,F,N) :- 56.
arg(N,T,A) :- 57.
X=..L :- 58.
name(X,L) :- 75.

A == B :- A \== B, !, fail.
A == B.

A \== B :- $equal(A,B), !, fail.
A \== B.

         $equal(V1,V2) :- var(V1), !, var(V2), $eqvars(V1,V2).
         $equal(A1,A2) :- atomic(A1), !, atomic(A2), A1=A2.
         $equal(Term1,Term2) :-
                 functor(Term1,Fn,Arity),
                 functor(Term2,Fn,Arity),
                 $eqargs(Arity,Term1,Term2).

         $eqargs(0,_,_) :- !.
         $eqargs(N,Term1,Term2) :-
                 arg(N,Term1,Arg1),
                 arg(N,Term2,Arg2),
                 $equal(Arg1,Arg2),
                 N1 is N-1,
                 $eqargs(N1,Term1,Term2).

         $eqvars(29,V) :- var(V), !, fail.
         $eqvars(_,_).


clause(P,Q) :- var(P), !,
        display('! Error, 1st arg to clause cannot be a variable: '),
        display(clause(P,Q)), ttynl,
        fail.
clause(P,Q) :-  !, $clause((P:-Q),R,P).
clause(P,Q,R) :- var(R), !, $clause((P:-Q),R,P).
clause(P,Q,R) :- instance(R,(P:-Q)).
assert(C) :- 61.     assertz(C) :- 61.
asserta(C) :- 62.
assert(C,R) :- 63.     assertz(C,R) :- 63.
asserta(C,R) :- 64.
$clause(_,_,_) :- 65.     $clause(_,_,_):-66.

retract(V) :- var(V), !, fail.
retract( (Head :- Body) ) :-
        !,
        clause(Head,Body,ID),
        erase(ID),
        !.
retract( UnitClause ) :-
        clause(UnitClause,true,ID),
        erase(ID),
        !.

retractall(UnitClause) :-
        repeat,
           not(retract(UnitClause)).

abolish(Pred,Arity) :-
        functor(Head,Pred,Arity),
        clause(Head,_,ID),
        erase(ID),
        fail.
abolish(_,_).

$recorded(_,_,_) :- 67.    $recorded(_,_,_):-68.
recorded(K,T,R) :- $checkkey(K), $recorded(T,R,K).
$checkkey(K) :- (var(K);integer(K)),!,
      ttynl,display('! invalid key to data base'),ttynl,trace,fail.
$checkkey(_).
recorda(K,T,R) :- $checkkey(K), $recorda(K,T,R).
recordz(K,T,R) :- $checkkey(K), $recordz(K,T,R).
$recorda(_,_,_) :- 73.
$recordz(_,_,_) :- 74.
instance(R,T) :- 69.
erase(R) :- 60.

$leash(P,N) :- 78.
$debug(P,N) :- 79.
current_atom(A) :- 80.
current_atom(A) :- 81.
$current_functor(A,N,K,M) :- 82.
$current_functor(A,N,K,M) :- 83.
current_functor(A,P) :- nonvar(P),!, functor(P,A,_).
current_functor(A,P) :-
        current_atom(A),
        $current_functor(A,N,0,0),
        functor(P,A,N).
current_predicate(A,P) :-
        current_atom(A),
        $current_functor(A,N,256,2'11100000),
        functor(P,A,N).

$flags(F,P,N) :- 84.
trace :- 72.

'NOLC'  :-  70.
'LC'  :-  71.

                         % Various hacky system predicates

 :-$sysp($break(_),102).
 :-$sysp($exit_break,103).
 $prompt(_) :- 104.
 $user_exec(_) :- 105.
 :-$sysp($save_read_vars,106).
 :-$sysp($reset_read_vars,107).
 :-$sysp($repply,108).
 $recons(_) :- 109.
 :-$sysp($break_start,110).
 :-$sysp($break_end,111).
 $assertr(_) :- 112.
 :-$sysp($rest_in_peace,113).
 $patch(_) :- 114.
 $repeat :- 3.
 $read(X) :- 17.

                          % How to get out (various mnemonics)

  :- $sysp(halt,113).
  :- $sysp(quit,113).
  :- $sysp(stop,113).

%-----------------------------------------------------------------------

%    Interpreter control

$live:- $cycle(0), $rest_in_peace.     % this is the Prolog session goal

$cycle(0):-
      prompt(Old,'|    '),
      $repeat,
        $prompt('| ?- '), $read(C),
        $interpret(C,0),
      prompt(_,Old),
      !.

$cycle(Status):-
      prompt(Old,'| '),
      $repeat,
        $read(C),
        $interpret(C,Status),
      prompt(_,Old),
      !.

$interpret(C,Status) :-
      var(C),
      !,
      display('! Statement is a variable'), 
      ttynl,
      fail.

$interpret(C,Status) :-
      integer(C),
      !,
      display('! Statement is an integer'), 
      ttynl,
      fail.
$interpret(end_of_file,_):-!.

$interpret(C,Status):-
      $directive(C,Status,D,T),
      !,
      prompt(Old,'|: '),
      $dogoal(T,D),
      prompt(_,Old),
      fail.

$interpret(C,Status):-
      expand_term(C,C1),
      $assert(C1),
      !,
      fail.

$assert(C):-$assertr(C),!.
$assert(C):-
      seeing(user),
      !.
$assert(C):-
      display('! clause: '),
      display(C).

$directive(:-(X),_,X,command) :- !.
$directive(?-(X),_,X,question) :- !.
$directive(X,0,X,question).

$dogoal(command,C) :-
      $user_exec(C),
      !.

$dogoal(command,_) :-
      !,
      ttynl, display('?'),
      ttynl.

$dogoal(question,Q) :-
      $save_read_vars,
      $user_exec(Q),
      $repply,
      ttynl, display('yes.'),
      $reset_read_vars,
      ttynl,
      !.

$dogoal(question,_) :-
      ttynl, display(no),
      $reset_read_vars,
      ttynl,
      !.


/*  consult and reconsult  */

consult(X):-!, $break($csult(0,X)).

reconsult(X) :- $break($csult(1,X)).

[X|Rest] :- $conlist([X|Rest]).

         $conlist([]) :- !.
         $conlist([-X|Rest]) :- !, reconsult(X), $conlist(Rest).
         $conlist([X|Rest]) :- !, consult(X), $conlist(Rest).


$csult(R,F) :-
      S0 is heapused,
      T0 is cputime,
      $recons(R),
      $checkfile(F),
      $read_file(F,consult),
      Tt is cputime-T0,
      Ts is heapused-S0,
      display(F), $dpr(R), display(Ts), display(' bytes '),
      display(Tt), display(' mscs.'), ttynl,
      fail.


$csult(R,F) :- $exit_break.

$dpr(0) :- !, display(' consulted ').
$dpr(1) :- display(' reconsulted ').

$read_file(F,S) :-
      seeing(I),
      telling(O),
      see(F),
      $cycle(S),
      close(F),
      see(I),
      tell(O),
      fail.
$read_file(_,_).

$checkfile(F) :-
      (atom(F);
        ttynl, display('! Invalid file name: '),
        display(F), ttynl, fail
      ),
      !,
      (exists(F);
        ttynl, display('! The file '), display(F),
        display(' does not exist.'), ttynl, fail
      ),
      !.

/* break      */

break :- $break($break).

$break :-
      $break_start,
      $read_file(user,0),
      $break_end,
      $exit_break.
$break :- $exit_break.    % just to make sure

                         % Expand term - bottom case, other routine should
                         %  asserta their additions into place (with cuts).

 expand_term(T,T).

end_of_file.                     % needed here for a special reason...