home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / X_PROLOG.LZH / X_PROLOG / SOURCES / _BOOT next >
Text File  |  1990-08-13  |  5KB  |  211 lines
  1. /*
  2.  *        ST PROLOG  Vers. 2.0
  3.  *
  4.  *
  5.  *    Written by :     Andreas Toenne
  6.  *            CS Dept. , IRB
  7.  *            University of Dortmund, W-Germany
  8.  *            <at@unido.uucp>
  9.  *            <....!seismo!unido!at>
  10.  *            <at@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.  
  19. /*    ST Prolog Startup File        */
  20.  
  21. /*    Structuring clauses */
  22.  
  23. call(A) :- $call(A).            /* make cut local to call */
  24.  
  25. (A ; B) :- $call(A).            /* ; is transparent to CUT */
  26. (A ; B) :- $call(B).
  27.  
  28. (A , B) :- $call(A), $call(B).
  29.  
  30. /*    Error handling  */
  31.  
  32. error(Number, Where) :-
  33.             write('Error ! '),
  34.             describe_error(Number), nl, !,
  35.             write(Where), nl, fail.
  36.  
  37. describe_error(1) :- write('Clause not found').        /* ENOCLAUSE */
  38. describe_error(2) :- write('IO Failure').        /* EIO */
  39. describe_error(3) :- write('Read past EOF').        /* EEOF */
  40. describe_error(4) :- write('Bad syntax').        /* ESYNTAX */
  41. describe_error(5) :- write('Too many args/vars').    /* ETOOMANY */
  42. describe_error(6) :- write('Bad arguments').        /* EBAD */
  43. describe_error(7) :- write('No valid expression').    /* EEVAL */
  44. describe_error(8).                    /* EINTER */
  45. describe_error(_) :- write('Hehe. This is a funny one'). /* catch all */
  46.  
  47. /*    Metalogical stuff */
  48.  
  49. not(Predicate) :- call(Predicate), !, fail.
  50. not(Predicate).
  51.  
  52. clause(Head, Body) :- '$clause'(Head, Body, Help).
  53.  
  54. A = A.                /* Simple equality */
  55.  
  56. print(Term) :- var(Term), !, write(Term).
  57. print(Term) :- portray(Term).    /* User defined */
  58.  
  59. append([],L,L).            % common append rule
  60. append([X|L1],L2,[X|L3]) :- append(L1,L2,L3).
  61.                 
  62. /*    Toplevel interpreter (with a lot of help from c-prolog) */
  63.  
  64. main :- write('Welcome to X Prolog'), nl, $loop(0).
  65. main.
  66.  
  67. $loop(0) :-                    /* toplevel loop */
  68.     prompt(Old, '|    '),
  69.     repeat,
  70.         $prompt('?- '),
  71.         read(Term),
  72.         $interpret(Term, 0),
  73.     prompt(_, Old),
  74.     !.
  75.     
  76. $loop(Status) :-
  77.     prompt(Old, '| '),
  78.     repeat,
  79.         prompt_if_user,
  80.         read(Term),
  81.         $interpret(Term, Status),
  82.     prompt(_, Old),
  83.     !.
  84.     
  85. prompt_if_user :- seeing(user), $prompt('| ').
  86. prompt_if_user.
  87.  
  88. $interpret(end_of_file, _) :- !.
  89.  
  90. $interpret(Term, Status) :-
  91.     $query(Term, Status, D, T),
  92.     !,
  93.     prompt(Old, '|: '),
  94.     $dogoal(T, D),
  95.     prompt(_, Old),
  96.     fail.
  97.     
  98. $interpret(Term, Status) :-
  99.     $process(Term, Result),
  100.     assertz(Result),
  101.     !,
  102.     fail.
  103.  
  104. $interpret(Term, _) :-
  105.     write('! clause: '),
  106.     write(Term),
  107.     fail.
  108.     
  109. $process(T,T).
  110.  
  111. $query(:-(X), _, X, command) :- !.
  112. $query(?-(X), _, X, question) :- !.
  113. $query(X, 0, X, question).
  114.  
  115. $dogoal(command, Term) :-
  116.     call(Term),
  117.     !.
  118.     
  119. $dogoal(command, _) :-
  120.     !,
  121.     nl, write('?'),
  122.     nl.
  123.     
  124. $dogoal(question, Term) :-
  125.     $goalvars(List),
  126.     call(Term),
  127.     $more(Ok),
  128.     reply(List, Ok),
  129.     nl,
  130.     !.
  131.     
  132. $dogoal(question, _) :-
  133.     nl,
  134.     write(no),
  135.     nl,
  136.     !.
  137.     
  138. reply(List,Ok) :-
  139.         $reply(List),
  140.         write(yes),
  141.         Ok = yes,
  142.         $askformore,
  143.         !.
  144. reply(_,Ok)    :-
  145.         Ok = no,
  146.         !.
  147.  
  148. $askformore :- get(X), skip(10), X \== 59.
  149.  
  150. $reply([]) :- !.
  151. $reply([(Name,Term)|L]) :-
  152.                 write(Name),
  153.                 write(' = '),
  154.                 write(Term),
  155.                 nl,
  156.                 !,
  157.                 $reply(L).
  158.  
  159.  
  160. /*    Consult and friends */
  161.  
  162. [File|MoreToCome] :- digfilelist([File|MoreToCome]).
  163.  
  164. digfilelist([]) :- !.
  165. digfilelist([-File|MoreToCome]) :- !, reconsult(File), digfilelist(MoreToCome).
  166. digfilelist([File|MoreToCome]) :- !, consult(File), digfilelist(MoreToCome).
  167.  
  168. consult(File) :- !, '$consult'(consult, File).
  169.  
  170. reconsult(File) :- '$consult'(reconsult, File).
  171.  
  172. $consult(R, File) :-
  173.     S0 is heapused,
  174.     T0 is cputime,
  175.     ( R == consult, X = 0, ! ; X = 1),
  176.     $reconsulting(X),        % set lastconsult
  177.     $checkfile(File), 
  178.     $read_file(File, R),
  179.     Tt is cputime - T0,
  180.     Ts is heapused - S0,
  181.     write(File), tab(2),
  182.     write(R), write('ed '),
  183.     write(Ts), write(' bytes '),
  184.     Sec is Tt / 1000,
  185.     Frac is Tt mod 1000,
  186.     write(Sec), display('.'), write(Frac), write(' sec.'), nl, !.
  187. $consult(_,_).
  188.  
  189. $read_file(File, R) :-
  190.     seeing(I),
  191.     telling(O),
  192.     see(File),
  193.     $loop(R),
  194.     close(File),
  195.     see(I),
  196.     tell(O),
  197.     fail.
  198. $read_file(_, _).
  199.  
  200. $checkfile(user) :- !.
  201. $checkfile(File) :-
  202.     (atom(File);
  203.      nl, write('! Invalid file name: '), write(File), nl, fail
  204.     ),
  205.     !,
  206.     (exists(File) ;
  207.      nl, write('! The file '), write(File),
  208.      write(' does not exist.'), nl, fail
  209.     ),
  210.     !.
  211.