home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / X_PROLOG.LZH / X_PROLOG / _BOOT next >
Text File  |  1990-08-13  |  6KB  |  223 lines
  1. /*
  2.  *        X PROLOG  Vers. 2.0
  3.  *
  4.  *
  5.  *    Written by :     Andreas Toenne
  6.  *            CS Dept. , IRB
  7.  *            University of Dortmund, W-Germany
  8.  *            <atoenne@unido.uucp>
  9.  *            <....!seismo!unido!atoenne>
  10.  *            <atoenne@unido.bitnet>
  11.  *
  12.  *    Copyright :    This software is copyrighted by Andreas Toenne.
  13.  *            Permission is granted hereby to copy the entire
  14.  *            package including this copyright notice without fee.
  15.  *
  16.  */
  17.  
  18. %    X Prolog Boot File
  19.  
  20. % hack to create an intermediate goal for call
  21. % this make the cut local to call
  22.  
  23. call(A) :- $call(A).
  24.  
  25. % definitions for conjunction and disjunction
  26. % both procedures are made transparent to the cut
  27.  
  28. (A ; B) :- $call(A).
  29. (A ; B) :- $call(B).
  30.  
  31. (A , B) :- $call(A), $call(B).
  32.  
  33. % further predicates
  34.  
  35. not(Predicate) :- call(Predicate), !, fail.
  36. not(Predicate).
  37.  
  38. clause(Head, Body) :- $clause(Head, Body, Help).  % see the documentation
  39.  
  40. A = A.                    % equality predicate :-)
  41. A \= A :- !, fail.
  42. _ \= _.
  43.  
  44. print(Term) :- var(Term), !, write(Term).
  45. print(Term) :- portray(Term).        % portray should be user defined
  46.  
  47. append([],L,L).                % common append procedure
  48. append([X|L1],L2,[X|L3]) :- append(L1,L2,L3).
  49.  
  50. member(X, [X|_]).            % common member procedure
  51. member(X, [_|Y]) :- member(X, Y).
  52.  
  53. % toplevel interpreter loop
  54. % the main goal should not be changed
  55.  
  56. main :- $loop(toplevel).        % start things
  57. main.                    % just to make Xprolog happy
  58.  
  59. % this is a failure driven loop
  60.  
  61. $loop(toplevel) :-
  62.     prompt(Old, '|    '),        % change the default prompt
  63.     repeat,                % loop forever
  64.         $prompt('?- '),        % give a prompt
  65.         read(Term),        % wait for response
  66.         $solve(Term, toplevel),    % solve the query
  67.     prompt(_, Old),            % restore the prompt
  68.     !.
  69. $loop(Where) :-                % loop not at top level
  70.     prompt(Old, '| '),        % different default prompt
  71.     repeat,                % round and round again
  72.         prompt_if_user,        % no prompt for files
  73.         read(Term),        % read something
  74.         $solve(Term, Where),    % solve it
  75.     prompt(_, Old),            % restore the prompt
  76.     !.
  77.     
  78. prompt_if_user :- seeing(user), $prompt('| '), !.
  79. prompt_if_user.
  80.  
  81. $solve(end_of_file, _) :- !.        % the only way to stop the repeat
  82. $solve(Term, _) :- var(Term), !, fail.    % don't accept strange goals
  83. $solve(Term, Where) :-            % try to solve it as a goal
  84.     $query(Term, Where, Goal, What), % check for sort of question
  85.     !,
  86.     prompt(Old, '|: '),
  87.     $solve_goal(Goal, What),    % try to solve a goal
  88.     prompt(_, Old),
  89.     fail.
  90. $solve(Term, Where) :-            % try to assert it
  91.     $process(Term, Result),        % hook for preprocessors
  92.     assertz(Result),        % assert it
  93.     !,
  94.     fail.
  95. $solve(Term, _) :-            % assert or $process failed
  96.     write('! clause: '),
  97.     write(Term),
  98.     fail.
  99.     
  100. % this is a hook to add preprocessors like the grammar rule translator
  101. % to this top level interpreter.
  102. % simply add via 'asserta' another clause for the preprocessor
  103.  
  104. $process(T,T).
  105.  
  106. % check the current term for a question or a command
  107.  
  108. $query(:-(X), _, X, command) :- !.    % this is a command
  109. $query(?-(X), _, X, question) :- !.    % this is a question
  110. $query(X, toplevel, X, question).    % always questions on top level
  111.  
  112. % this procedure solves goals
  113. % note the use of $more and $goalvars
  114.  
  115. $solve_goal(Term, command) :-        % no answer, no alternatives
  116.     call(Term),            % try it once
  117.     !.                % and no further alternatives
  118. $solve_goal(_, command)    :-        % above clause failed
  119.     !,
  120.     nl, write('?'), nl.        % notify the user
  121. $solve_goal(Term, question) :-
  122.     $goalvars(List),        % save the reader's symbol table
  123.     call(Term),            % try the question
  124.     $more(Ok),            % call(Term) had a alternative ?
  125.     $reply(List, Ok),        % say 'yes' to the user
  126.     nl,
  127.     !.
  128. $solve_goal(_, question) :-        % above clause failed !
  129.     nl,
  130.     write(no),            % sorry but ...
  131.     nl,
  132.     !.
  133.     
  134. $reply(List, Ok) :-            % say yes and show variables
  135.     $show_variables(List),
  136.     write(yes),            % horray
  137.     Ok = yes,            % an alternative ?
  138.     $askformore,            % check if the user wants it
  139.     !.
  140. $reply(_, Ok) :-            % no more alternative
  141.     Ok = no,
  142.     !.
  143.     
  144. $askformore :- get(X), skip(10), X \== 59. % 59 is ';'
  145.     
  146. $show_variables([]) :- !.
  147. $show_variables([(Name, Variable)|L]) :-
  148.     write(Name),
  149.     write(' = '),
  150.     write(Variable),
  151.     nl,
  152.     !,
  153.     $show_variables(L).
  154.     
  155.  
  156.  
  157. % consult and friends
  158. % we simply use the top level interpreter for the asserts and queries
  159.  
  160. [X|Y] :- $process_files([X|Y]).
  161.  
  162. $process_files([]) :- !.
  163. $process_files([-File|Rest]) :- !, reconsult(File), $process_files(Rest).
  164. $process_files([File|Rest]) :- !, consult(File), $process_files(Rest).
  165.  
  166. consult(File) :- !, $read_file(File, 0).
  167.  
  168. reconsult(File) :- !, $read_file(File, 1).
  169.  
  170. $read_file(File, R) :-
  171.     Heap is heapused,
  172.     Time is cputime,
  173.     $reconsulting(R),
  174.     $test_filename(File),        % check the file
  175.     seeing(OldIn),
  176.     telling(OldOut),
  177.     see(File),            % open the file
  178.     $do_loop,
  179.     seen,                % close the file
  180.     see(OldIn),
  181.     tell(OldOut),
  182.     $reconsulting(0),
  183.     DiffTime is cputime - Time,
  184.     DiffHeap is heapused - Heap,
  185.     write(File),
  186.     ( R == 0 , write('  consulted ') ;
  187.       R == 1 , write('  reconsulted ')),
  188.     write(DiffHeap), write(' bytes '),
  189.     write(DiffTime), write(' msec.'),
  190.     nl, !.
  191.  
  192. $do_loop :- $loop(filelevel).        % loop at filelevel
  193. $do_loop.
  194.  
  195. $test_filename(user) :- !.        % this stream is always ok
  196. $test_filename(File) :-
  197.     not atom(File),            % invalid name
  198.     nl,
  199.     write('Invalid filename: '),
  200.     write(File),
  201.     nl,
  202.     !, fail.
  203. $test_filename(File) :-
  204.     not exists(File),        % file not found
  205.     nl,
  206.     write('The file '),
  207.     write(File),
  208.     write(' does not exist.'),
  209.     nl,
  210.     !, fail.
  211. $test_filename(_).            % is ok
  212.  
  213. %
  214. % debugging hooks
  215. %
  216.  
  217. leash(off) :- $leash(0).
  218. leash(loose) :- $leash(1).
  219. leash(half) :- $leash(5).
  220. leash(tight) :- $leash(7).
  221. leash(full) :- $leash(15).
  222.  
  223.