home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / OSK / EFFO / pd3.lzh / SBPROLOG2.2 / MODLIB / MODLIB_SRC / $read.P.unix < prev    next >
Text File  |  1991-08-10  |  35KB  |  986 lines
  1. %   File   : READ.PL
  2. %   Author : D.H.D.Warren + Richard O'Keefe
  3. %   Updated: 5 July 1984
  4. %   Purpose: Read Prolog terms in Dec-10 syntax.
  5. /*
  6.     Modified by Alan Mycroft to regularise the functor modes.
  7.     This is both easier to understand (there are no more '?'s),
  8.     and also fixes bugs concerning the curious interaction of cut with
  9.     the state of parameter instantiation.
  10.  
  11.     Since this file doesn't provide "metaread", it is considerably
  12.     simplified.  The token list format has been changed somewhat, see
  13.     the comments in the RDTOK file.
  14.  
  15.     I have added the rule X(...) -> apply(X,[...]) for Alan Mycroft.
  16. */
  17.  
  18. /*
  19.     Modified by Saumya Debray, SUNY @ Stony Brook, to cut away DEC-10 syntax
  20.     that isn't used by C-Prolog 1.5 : "public" and "mode" declarations have
  21.     been deleted, and the builtins ttynl/0 and ttyput/1 replaced by nl/0
  22.     and put/1.    (April 2, 1985)
  23. */
  24.  
  25. $read_export([$read/1,$read/2]).
  26.  
  27. /* $read_use($bmeta,[$atom/1,$atomic/1,$integer/1,$number/1,$structure/1,
  28.     $functor0/2,$bldstr/3,$arg/3,$arity/2,$real/1,$floor/2]).
  29.    $read_use($meta,[$functor/3,$univ/2,$length/2]).
  30.    $read_use($bio,[$writename/1,$writeqname/1,$put/1,$nl/0,$tab/1,
  31.     $tell/1,_,$telling/1,$told/0,$get/1,$get0/1,$see/1,$seeing/1,
  32.     $seen/0]).
  33.    $read_use($io,[$write/1,$writeq/1,$display/1,$print/1]).
  34.    $read_use($blist,[$append/3,$member/2,$memberchk/2]).
  35.    $read_use($retr,[$retract/1,_,_]).
  36.    $read_use($name,[$name/2,$name0/2]).
  37. */
  38.  
  39. %   $read(?Answer).
  40.  
  41. $read(Answer) :- $read(Answer,_).
  42.  
  43. %   $read(?Answer, ?Variables)
  44. %   reads a term from the current input stream and unifies it with
  45. %   Answer.  Variables is bound to a list of [Atom=Variable] pairs.
  46.  
  47. $read(Answer, Variables) :-
  48.         repeat,
  49.             $read_tokens(Tokens, Variables),
  50.             (   $read(Tokens, 1200, Term, LeftOver), $read_all(LeftOver) ;
  51.             $read_syntax_error(Tokens)
  52.             ),
  53.         !,
  54.         Answer = Term.
  55.  
  56.  
  57. %   $read_all(+Tokens)
  58. %   checks that there are no unparsed tokens left over.
  59.  
  60. $read_all([]) :- !.
  61. $read_all(S) :-
  62.         $read_syntax_error(['operator expected after expression'], S).
  63.  
  64.  
  65. %   $read_expect(Token, TokensIn, TokensOut)
  66. %   reads the next token, checking that it is the one expected, and
  67. %   giving an error message if it is not.  It is used to look for
  68. %   right brackets of various sorts, as they're all we can be sure of.
  69.  
  70. $read_expect(Token, [Token|Rest], Rest) :- !.
  71. $read_expect(Token, S0, _) :-
  72.         $read_syntax_error([Token,'or operator expected'], S0).
  73.  
  74.  
  75. %   I want to experiment with having the operator information held as
  76. %   ordinary Prolog facts.  For the moment the following predicates
  77. %   remain as interfaces to curr_op.
  78. %   $read_prefixop(O -> Self, Rarg)
  79. %   $read_postfixop(O -> Larg, Self)
  80. %   $read_infixop(O -> Larg, Self, Rarg)
  81.  
  82.  
  83. $read_prefixop(Op, Prec, Prec) :-
  84.         $read_curr_op(Prec, fy, Op), !.
  85. $read_prefixop(Op, Prec, Less) :-
  86.         $read_curr_op(Prec, fx, Op), !,
  87.         Less is Prec-1.
  88.  
  89.  
  90. $read_postfixop(Op, Prec, Prec) :-
  91.         $read_curr_op(Prec, yf, Op), !.
  92. $read_postfixop(Op, Less, Prec) :-
  93.         $read_curr_op(Prec, xf, Op), !, Less is Prec-1.
  94.  
  95.  
  96. $read_infixop(Op, Less, Prec, Less) :-
  97.         $read_curr_op(Prec, xfx, Op), !, Less is Prec-1.
  98. $read_infixop(Op, Less, Prec, Prec) :-
  99.         $read_curr_op(Prec, xfy, Op), !, Less is Prec-1.
  100. $read_infixop(Op, Prec, Prec, Less) :-
  101.         $read_curr_op(Prec, yfx, Op), !, Less is Prec-1.
  102.  
  103.  
  104. $read_ambigop(F, L1, O1, R1, L2, O2) :-
  105.         $read_postfixop(F, L2, O2),
  106.         $read_infixop(F, L1, O1, R1), !.
  107.  
  108.  
  109. %   $read(+TokenList, +Precedence, -Term, -LeftOver)
  110. %   parses a Token List in a context of given Precedence,
  111. %   returning a Term and the unread Left Over tokens.
  112.  
  113. $read([Token|RestTokens], Precedence, Term, LeftOver) :-
  114.         $read(Token, RestTokens, Precedence, Term, LeftOver).
  115. $read([], _, _, _) :-
  116.         $read_syntax_error(['expression expected'], []).
  117.  
  118.  
  119. %   $read(+Token, +RestTokens, +Precedence, -Term, -LeftOver)
  120.  
  121. $read(var(Variable,_), ['('|S1], Precedence, Answer, S) :- !,
  122.         $read(S1, 999, Arg1, S2),
  123.         $read_args(S2, RestArgs, S3), !,
  124.         $read_exprtl0(S3,apply(Variable,[Arg1|RestArgs]),Precedence,Answer,S).
  125.  
  126. $read(var(Variable,_), S0, Precedence, Answer, S) :- !,
  127.         $read_exprtl0(S0, Variable, Precedence, Answer, S).
  128.  
  129. $read(atom(-), [number(Num)|S1], Precedence, Answer, S) :-
  130.         Negative is -Num, !,
  131.         $read_exprtl0(S1, Negative, Precedence, Answer, S).
  132.  
  133. $read(atom(Functor), ['('|S1], Precedence, Answer, S) :- !,
  134.         $read(S1, 999, Arg1, S2),
  135.         $read_args(S2, RestArgs, S3),
  136.         $univ(Term,[Functor,Arg1|RestArgs]), !,
  137.         $read_exprtl0(S3, Term, Precedence, Answer, S).
  138.  
  139. $read(atom(Functor), S0, Precedence, Answer, S) :-
  140.         $read_prefixop(Functor, Prec, Right), !,
  141.         $read_aft_pref_op(Functor, Prec, Right, S0, Precedence, Answer, S).
  142.  
  143. $read(atom(Atom), S0, Precedence, Answer, S) :- !,
  144.         $read_exprtl0(S0, Atom, Precedence, Answer, S).
  145.  
  146. $read(number(Num), S0, Precedence, Answer, S) :- !,
  147.         $read_exprtl0(S0, Num, Precedence, Answer, S).
  148.  
  149. $read('[', [']'|S1], Precedence, Answer, S) :- !,
  150.         $read_exprtl0(S1, [], Precedence, Answer, S).
  151.  
  152. $read('[', S1, Precedence, Answer, S) :- !,
  153.         $read(S1, 999, Arg1, S2),
  154.         $read_list(S2, RestArgs, S3), !,
  155.         $read_exprtl0(S3, [Arg1|RestArgs], Precedence, Answer, S).
  156.  
  157. $read('(', S1, Precedence, Answer, S) :- !,
  158.         $read(S1, 1200, Term, S2),
  159.         $read_expect(')', S2, S3), !,
  160.         $read_exprtl0(S3, Term, Precedence, Answer, S).
  161.  
  162. $read(' (', S1, Precedence, Answer, S) :- !,
  163.         $read(S1, 1200, Term, S2),
  164.         $read_expect(')', S2, S3), !,
  165.         $read_exprtl0(S3, Term, Precedence, Answer, S).
  166.  
  167. $read('{', ['}'|S1], Precedence, Answer, S) :- !,
  168.         $read_exprtl0(S1, '{}', Precedence, Answer, S).
  169.  
  170. $read('{', S1, Precedence, Answer, S) :- !,
  171.         $read(S1, 1200, Term, S2),
  172.         $read_expect('}', S2, S3), !,
  173.         $read_exprtl0(S3, '{}'(Term), Precedence, Answer, S).
  174.  
  175. $read(string(List), S0, Precedence, Answer, S) :- !,
  176.         $read_exprtl0(S0, List, Precedence, Answer, S).
  177.  
  178. $read(Token, S0, _, _, _) :-
  179.         $read_syntax_error([Token,'cannot start an expression'], S0).
  180.  
  181.  
  182. %   $read_args(+Tokens, -TermList, -LeftOver)
  183. %   parses {',' expr(999)} ')' and returns a list of terms.
  184.  
  185. $read_args([Tok|S1], Term, S) :-
  186.     '_$savecp'(CP),
  187.     $read_args1(Tok,Term,S,S1,CP), '_$cutto'(CP).
  188. $read_args(S, _, _) :-
  189.         $read_syntax_error([', or ) expected in arguments'], S).
  190.  
  191.  
  192. $read_args1(',',[Term|Rest],S,S1,CP) :- 
  193.         $read(S1, 999, Term, S2), '_$cutto'(CP),
  194.         $read_args(S2, Rest, S).
  195. $read_args1(')',[],S,S,_).
  196.  
  197.  
  198.  
  199. %   $read_list(+Tokens, -TermList, -LeftOver)
  200. %   parses {',' expr(999)} ['|' expr(999)] ']' and returns a list of terms.
  201.  
  202. $read_list([Tok|S1],Term,S) :-
  203.     '_$savecp'(CP),
  204.     $read_list1(Tok,Term,S,S1,CP),
  205.     '_$cutto'(CP).
  206. $read_list(S, _, _) :-
  207.         $read_syntax_error([', | or ] expected in list'], S).
  208.  
  209.  
  210. $read_list1(',',[Term|Rest],S,S1,CP) :-
  211.         $read(S1, 999, Term, S2), '_$cutto'(CP),
  212.         $read_list(S2, Rest, S).
  213. $read_list1('|',Rest,S,S1,CP) :-
  214.         $read(S1, 999, Rest, S2), '_$cutto'(CP),
  215.         $read_expect(']', S2, S).
  216. $read_list1(']',[],S,S,_).
  217.  
  218.  
  219. %   $read_aft_pref_op(+Op, +Prec, +ArgPrec, +Rest, +Precedence, -Ans, -LeftOver)
  220.  
  221. $read_aft_pref_op(Op, Oprec, Aprec, S0, Precedence, _, _) :-
  222.         Precedence < Oprec, !,
  223.         $read_syntax_error(['prefix operator',Op,'in context with precedence '
  224.             ,Precedence], S0).
  225.  
  226. $read_aft_pref_op(Op, Oprec, Aprec, S0, Precedence, Answer, S) :-
  227.         $read_peepop(S0, S1),
  228.         $read_prefix_is_atom(S1, Oprec), % can't cut but would like to
  229.         $read_exprtl(S1, Oprec, Op, Precedence, Answer, S).
  230.  
  231. $read_aft_pref_op(Op, Oprec, Aprec, S1, Precedence, Answer, S) :-
  232.         $read(S1, Aprec, Arg, S2),
  233.         $univ(Term,[Op,Arg]), !,
  234.         $read_exprtl(S2, Oprec, Term, Precedence, Answer, S).
  235.  
  236.  
  237. %   The next clause fixes a bug concerning "mop dop(1,2)" where
  238. %   mop is monadic and dop dyadic with higher Prolog priority.
  239.  
  240. $read_peepop([atom(F),'('|S1], [atom(F),'('|S1]) :- !.
  241. $read_peepop([atom(F)|S1], [infixop(F,L,P,R)|S1]) :- 
  242.     $read_infixop(F, L, P, R).
  243. $read_peepop([atom(F)|S1], [postfixop(F,L,P)|S1]) :- 
  244.     $read_postfixop(F, L, P).
  245. $read_peepop(S0, S0).
  246.  
  247.  
  248. %   $read_prefix_is_atom(+TokenList, +Precedence)
  249. %   is true when the right context TokenList of a prefix operator
  250. %   of result precedence Precedence forces it to be treated as an
  251. %   atom, e.g. (- = X), p(-), [+], and so on.
  252.  
  253. $read_prefix_is_atom([Token|_], Precedence) :-
  254.         $read_prefix_is_atom(Token, Precedence).
  255.  
  256. $read_prefix_is_atom(infixop(_,L,_,_), P) :- L >= P.
  257. $read_prefix_is_atom(postfixop(_,L,_), P) :- L >= P.
  258. $read_prefix_is_atom(')', _).
  259. $read_prefix_is_atom(']', _).
  260. $read_prefix_is_atom('}', _).
  261. $read_prefix_is_atom('|', P) :- 1100 >= P.
  262. $read_prefix_is_atom(',', P) :- 1000 >= P.
  263. $read_prefix_is_atom([],  _).
  264.  
  265.  
  266. %   $read_exprtl0(+Tokens, +Term, +Prec, -Answer, -LeftOver)
  267. %   is called by read/4 after it has read a primary (the Term).
  268. %   It checks for following postfix or infix operators.
  269.  
  270. $read_exprtl0([Tok|S1], Term, Precedence, Answer, S) :-
  271.     '_$savecp'(CP),
  272.     $read_exprtl01(Tok,Term,Precedence,Answer,S,S1,CP),
  273.     '_$cutto'(CP).
  274. $read_exprtl0(S, Term, _, Term, S).
  275.  
  276.  
  277. $read_exprtl01(atom(F), Term, Precedence, Answer,S,S1,CP) :-
  278.         $read_ambigop(F, L1, O1, R1, L2, O2), '_$cutto'(CP),
  279.         ( $read_exprtl([infixop(F,L1,O1,R1)|S1],0,Term,Precedence,Answer,S)
  280.         ; $read_exprtl([postfixop(F,L2,O2) |S1],0,Term,Precedence,Answer,S)
  281.         ).
  282. $read_exprtl01(atom(F), Term, Precedence, Answer, S,S1,CP) :-
  283.         $read_infixop(F, L1, O1, R1), '_$cutto'(CP),
  284.         $read_exprtl([infixop(F,L1,O1,R1)|S1],0,Term,Precedence,Answer,S).
  285. $read_exprtl01(atom(F),Term,Precedence,Answer,S,S1,CP) :-
  286.         $read_postfixop(F, L2, O2), '_$cutto'(CP),
  287.         $read_exprtl([postfixop(F,L2,O2) |S1],0,Term,Precedence,Answer,S).
  288. $read_exprtl01(',', Term, Precedence, Answer, S,S1,CP) :-
  289.         Precedence >= 1000, '_$cutto'(CP),
  290.         $read(S1, 1000, Next, S2), '_$cutto'(CP),
  291.         $read_exprtl(S2, 1000, (Term,Next), Precedence, Answer, S).
  292. $read_exprtl01('|', Term, Precedence, Answer, S,S1,CP) :-
  293.         Precedence >= 1100, '_$cutto'(CP),
  294.         $read(S1, 1100, Next, S2), '_$cutto'(CP),
  295.         $read_exprtl(S2, 1100, (Term;Next), Precedence, Answer, S).
  296. $read_exprtl01(Thing, _, _, _, _,S1,CP) :-
  297.         $read_cfexpr(Thing, Culprit), '_$cutto'(CP),
  298.         $read_syntax_error([Culprit,'follows expression'], [Thing|S1]).
  299.  
  300.  
  301. $read_cfexpr(atom(_),       atom).
  302. $read_cfexpr(var(_,_),      variable).
  303. $read_cfexpr(number(_),     number).
  304. $read_cfexpr(string(_),     string).
  305. $read_cfexpr(' (',          bracket).
  306. $read_cfexpr('(',           bracket).
  307. $read_cfexpr('[',           bracket).
  308. $read_cfexpr('{',           bracket).
  309.  
  310.  
  311.  
  312. $read_exprtl([Tok|S1], C, Term, Precedence, Answer, S) :-
  313.     '_$savecp'(CP),
  314.     $read_exprtl1(Tok,C,Term,Precedence,Answer,S,S1,CP),
  315.     '_$cutto'(CP).
  316. $read_exprtl(S, _, Term, _, Term, S).
  317.  
  318. $read_exprtl1(infixop(F,L,O,R), C, Term, Precedence, Answer, S, S1,CP) :-
  319.         Precedence >= O, C =< L, '_$cutto'(CP),
  320.         $read(S1, R, Other, S2),
  321.         $univ(Expr,[F,Term,Other]), /*!,*/
  322.         $read_exprtl(S2, O, Expr, Precedence, Answer, S).
  323. $read_exprtl1(postfixop(F,L,O), C, Term, Precedence, Answer, S, S1,CP) :-
  324.         Precedence >= O, C =< L, '_$cutto'(CP),
  325.         $univ(Expr,[F,Term]),
  326.         $read_peepop(S1, S2),
  327.         $read_exprtl(S2, O, Expr, Precedence, Answer, S).
  328. $read_exprtl1(',', C, Term, Precedence, Answer, S, S1,CP) :-
  329.         Precedence >= 1000, C < 1000, '_$cutto'(CP),
  330.         $read(S1, 1000, Next, S2), /*!,*/
  331.         $read_exprtl(S2, 1000, (Term,Next), Precedence, Answer, S).
  332. $read_exprtl1('|', C, Term, Precedence, Answer, S, S1, CP) :-
  333.         Precedence >= 1100, C < 1100, '_$cutto'(CP),
  334.         $read(S1, 1100, Next, S2), /*!,*/
  335.         $read_exprtl(S2, 1100, (Term;Next), Precedence, Answer, S).
  336.  
  337.  
  338. %   This business of syntax errors is tricky.  When an error is detected,
  339. %   we have to write out a message.  We also have to note how far it was
  340. %   to the end of the input, and for this we are obliged to use the data-
  341. %   base.  Then we fail all the way back to $read(), and that prints the
  342. %   input list with a marker where the error was noticed.  If subgoal_of
  343. %   were available in compiled code we could use that to find the input
  344. %   list without hacking the data base.  The really hairy thing is that
  345. %   the original code noted a possible error and backtracked on, so that
  346. %   what looked at first sight like an error sometimes turned out to be
  347. %   a wrong decision by the parser.  This version of the parser makes
  348. %   fewer wrong decisions, and my goal was to get it to do no backtracking
  349. %   at all.  This goal has not yet been met, and it will still occasionally
  350. %   report an error message and then decide that it is happy with the input
  351. %   after all.  Sorry about that.
  352.  
  353. /*  Modified by Saumya Debray, Nov 18 1986, to use SB-Prolog's database
  354.     facilities to print out error messages.                */
  355.  
  356. $read_syntax_error(Message, List) :-
  357. /*    $print('**'), $print_list(Message), $nl, */
  358.  
  359.     $length(List,Length),
  360.     $symtype('_$synerr'(_),X),
  361.     ( (X =:= 0 ; not('_$synerr'(_))) ->    /* _$synerr/1 undefined */
  362.         $assert('_$synerr'(Length)) ;
  363.         true
  364.     ),
  365.     !,
  366.     fail.
  367.  
  368. $read_syntax_error(List) :-
  369.         $nl, $print('*** syntax error ***'), $nl,
  370.     '_$synerr'(AfterError),
  371.     $retract('_$synerr'(AfterError)),
  372.     $length(List,Length),
  373.     BeforeError is Length - AfterError,
  374.     $read_display_list(List,BeforeError), !,
  375.     fail.
  376.  
  377. $read_display_list(X, 0) :-
  378.     $print('<<here>> '), !,
  379.     $read_display_list(X, 99999).
  380. $read_display_list([Head|Tail], BeforeError) :-
  381.     $print_token(Head),
  382.     $writename(' '),
  383.     Left is BeforeError-1, !,
  384.     $read_display_list(Tail, Left).
  385. $read_display_list([], _) :-
  386.     $nl.
  387.  
  388.  
  389. $print_list([]) :- $nl.
  390. $print_list([Head|Tail]) :-
  391.     $tab(1),
  392.         $print_token(Head),
  393.         $print_list(Tail).
  394.  
  395. $print_token(atom(X))    :- !, $print(X).
  396. $print_token(var(V,X))   :- !, $print(X).
  397. $print_token(number(X)) :-  !, $print(X).
  398. $print_token(string(X))  :- !, $print(X).
  399. $print_token(X)          :-    $print(X).
  400.  
  401. /*      An attempt at defining the "curr_op" predicate for read.       */
  402.  
  403. /* could add the clause:
  404.     op(Prec,Assoc,Op) :- assert_fact($read_curr_op(Prec,Assoc,Op)).
  405.    to implement op */
  406.  
  407. $read_curr_op(1200,xfx,(':-')).
  408. $read_curr_op(1200,xfx,('-->')).
  409. $read_curr_op(1200,fx,(':-')).
  410. $read_curr_op(1198,xfx,('::-')).
  411. $read_curr_op(1100,xfy,';').
  412. $read_curr_op(1050,xfy,'->').
  413. $read_curr_op(1000,xfy,',').
  414. $read_curr_op(900,fy,not).
  415. $read_curr_op(900,fy,'\+').
  416. $read_curr_op(900,fy,spy).
  417. $read_curr_op(900,fy,nospy).
  418. $read_curr_op(700,xfx,'=').
  419. $read_curr_op(700,xfx,is).
  420. $read_curr_op(700,xfx,'=..').
  421. $read_curr_op(700,xfx,'==').
  422. $read_curr_op(700,xfx,'\==').
  423. $read_curr_op(700,xfx,'@<').
  424. $read_curr_op(700,xfx,'@>').
  425. $read_curr_op(700,xfx,'@=<').
  426. $read_curr_op(700,xfx,'@>=').
  427. $read_curr_op(700,xfx,'=:=').
  428. $read_curr_op(700,xfx,'=\=').
  429. $read_curr_op(700,xfx,'<').
  430. $read_curr_op(700,xfx,'>').
  431. $read_curr_op(700,xfx,'=<').
  432. $read_curr_op(700,xfx,'>=').
  433. $read_curr_op(661,xfy,'.').    /* !! */
  434. $read_curr_op(500,yfx,'+').
  435. $read_curr_op(500,yfx,'-').
  436. $read_curr_op(500,yfx,'/\').
  437. $read_curr_op(500,yfx,'\/').
  438. $read_curr_op(500,fx,'+').
  439. $read_curr_op(500,fx,'-').
  440. $read_curr_op(500,fx,'\').
  441. $read_curr_op(400,yfx,'*').
  442. $read_curr_op(400,yfx,'/').
  443. $read_curr_op(400,yfx,'//').
  444. $read_curr_op(400,yfx,'<<').
  445. $read_curr_op(400,yfx,'>>').
  446. $read_curr_op(300,xfx,mod).
  447. $read_curr_op(200,xfy,'^').
  448.  
  449.  
  450. /*
  451. %   File   : RDTOK.PL
  452. %   Author : R.A.O'Keefe
  453. %   Updated: 5 July 1984
  454. %   Purpose: Tokeniser in reasonably standard Prolog.
  455. */
  456. /*  This tokeniser is meant to complement the library READ routine.
  457.     It recognises Dec-10 Prolog with the following exceptions:
  458.  
  459.         %( is not accepted as an alternative to {
  460.  
  461.         %) is not accepted as an alternative to )
  462.  
  463.         NOLC convention is not supported (read_name could be made to do it)
  464.  
  465.         ,.. is not accepted as an alternative to | (hooray!)
  466.  
  467.         large integers are not read in as xwd(Top18Bits,Bottom18Bits)
  468.  
  469.         After a comma, "(" is read as ' (' rather than '('.  This does the
  470.         parser no harm at all, and the Dec-10 tokeniser's behaviour here
  471.         doesn't actually buy you anything.  This tokeniser guarantees never
  472.         to return '(' except immediately after an atom, yielding ' (' every
  473.         other where.
  474.  
  475.     In particular, radix notation is EXACTLY as in Dec-10 Prolog version 3.53.
  476.     Some times might be of interest.  Applied to an earlier version of this file:
  477.         this code took                  1.66 seconds
  478.         the Dec-10 tokeniser took       1.28 seconds
  479.         A Pascal version took           0.96 seconds
  480.     The Dec-10 tokeniser was called via the old RDTOK interface, with
  481.     which this file is compatible.  One reason for the difference in
  482.     speed is the way variables are looked up: this code uses a linear
  483.     list, while the Dec-10 tokeniser uses some sort of tree.  The Pascal
  484.     version is the program WLIST which lists "words" and their frequencies.
  485.     It uses a hash table.  Another difference is the way characters are
  486.     classified: the Dec-10 tokeniser and WLIST have a table which maps
  487.     ASCII codes to character classes, and don't do all this comparison
  488.     and and memberchking.  We could do that without leaving standard Prolog,
  489.     but what do you want from one evening's work?
  490. */    
  491.  
  492. /*  Modified by Saumya Debray to be compatible with C-Prolog syntax.  This
  493.     involved (i) deleting "public" and "mode" declarations, and (ii)
  494.     replacing ttynl/0 by nl/0, ttyput/1 by put/1.  (Apr 6, 1985)    */
  495.  
  496. /*
  497. %   $read_tokens(TokenList, Dictionary)
  498. %   returns a list of tokens.  It is needed to "prime" read_tokens/2
  499. %   with the initial blank, and to check for end of file.  The
  500. %   Dictionary is a list of AtomName=Variable pairs in no particular order.
  501. %   The way end of file is handled is that everything else FAILS when it
  502. %   hits character "-1", sometimes printing a warning.  It might have been
  503. %   an idea to return the atom 'end_of_file' instead of the same token list
  504. %   that you'd have got from reading "end_of_file. ", but (1) this file is
  505. %   for compatibility, and (b) there are good practical reasons for wanting
  506. %   this behaviour. */
  507.  
  508. $read_tokens(TokenList, Dictionary) :-
  509.         $read_tokens(32, Dict, ListOfTokens),
  510.         $append(Dict, [], Dict), !, /*  fill in the "hole" at the end */
  511.         Dictionary = Dict,              /*  unify explicitly so we read and */
  512.         TokenList = ListOfTokens.       /*  then check even with filled in */
  513.                     /*  arguments */
  514. $read_tokens([atom(end_of_file)], []).   /*  only thing that can go wrong */
  515.  
  516. /*  read_tokens/3 modified by Saumya Debray : June 18, 1985 : to consist
  517.      of a single clause with a search-tree structure over it that permits
  518.      more efficient compiled code to be generated.  The tree is skewed, so
  519.      that those characters expected to be encountered more often are
  520.      closer to the top of the tree (the assumption here is that lower
  521.      case letters are the most frequent, followed by upper case letters
  522.      and numbers).                              */
  523.  
  524. $read_tokens(Ch,Dict,Tokens) :-
  525.     ((Ch >= 97,
  526.       ((Ch =< 122, Tokens = [atom(A)|TokRest],
  527.         $read_name(Ch,S,NextCh), $name(A,S),
  528.         $read_aft_atom(NextCh,Dict,TokRest)
  529.        ) ;
  530.        (Ch > 122,
  531.         ((Ch =:= 124, Tokens = ['|'|TokRest],
  532.           $get0(NextCh), $read_tokens(NextCh,Dict,TokRest)
  533.          ) ;
  534.          (Ch =\= 124,
  535.           ((Ch =:= 123, Tokens = ['{'|TokRest], $get0(NextCh),
  536.             $read_tokens(NextCh,Dict,TokRest)
  537.            ) ;
  538.            (Ch =\= 123,
  539.             ((Ch =:= 125, Tokens = ['}'|TokRest], $get0(NextCh),
  540.           $read_tokens(NextCh,Dict,TokRest)
  541.          ) ;
  542.          (Ch =\= 125, Tokens = [atom(A)|TokRest], $get0(AnotherCh),
  543.           $read_symbol(AnotherCh,Chars,NextCh), $name(A,[Ch|Chars]),
  544.           $read_aft_atom(NextCh,Dict,Tokens)
  545.          ))))))))) ;
  546.      (Ch < 97,
  547.       ((Ch < 65,
  548.         ((Ch < 48,
  549.           ((Ch =< 39,
  550.             ((Ch =< 34,
  551.           ((Ch =< 32,
  552.             ((Ch >= 0,
  553.               ((Ch =:= 26, fail) ;
  554.                (Ch =\= 26,
  555.                 $get0(NextCh), $read_tokens(NextCh,Dict,Tokens)
  556.                )
  557.               )
  558.              ) ;
  559.              (Ch < 0, fail)
  560.             )
  561.            ) ;
  562.            (Ch > 32,
  563.             ((Ch =:= 33, Tokens = [atom('!')|TokRest],
  564.               $get0(NextCh), $read_tokens(NextCh,Dict,TokRest)
  565.              ) ;
  566.              (Ch =\= 33, Tokens = [string(S)|TokRest],
  567.               $read_string(S,34,NextCh),
  568.               $read_tokens(NextCh,Dict,TokRest)
  569.              ))))
  570.          ) ;
  571.          (Ch > 34,
  572.           ((Ch =< 37,
  573.             ((Ch =:= 37, $read_skip_comment,
  574.               $get0(NextCh), $read_tokens(NextCh,Dict,Tokens)
  575.              ) ;
  576.              (Ch =\= 37, 
  577.                       Tokens = [atom(A)|TokRest],
  578.                     $read_name(Ch,S,NextCh), $name(A,S),
  579.                     $read_aft_atom(NextCh,Dict,TokRest)
  580.              )
  581.             )
  582.            ) ;
  583.            (Ch > 37, Tokens = [atom(A)|TokRest],
  584.             ((Ch =:= 39, 
  585.               $read_string(S,39,NextCh), $name(A,S),
  586.               $read_aft_atom(NextCh,Dict,TokRest)
  587.              ) ;
  588.              (Ch =\= 39,
  589.               $get0(AnotherCh), $read_symbol(AnotherCh,Chars,NextCh),
  590.               $name(A,[Ch|Chars]),
  591.               $read_aft_atom(NextCh,Dict,TokRest)
  592.              ))))))
  593.            ) ;
  594.            (Ch > 39,
  595.             ((Ch =< 42,
  596.           ((Ch =:= 40, Tokens = [' ('|TokRest],
  597.             $get0(NextCh), $read_tokens(NextCh,Dict,TokRest)
  598.            ) ;
  599.            (Ch =\= 40,
  600.             ((Ch =:= 41, Tokens = [')'|TokRest],
  601.               $get0(NextCh), $read_tokens(NextCh,Dict,TokRest)
  602.              ) ;
  603.              (Ch =\= 41, Tokens = [atom(A)|TokRest],
  604.               $get0(AnotherCh), $read_symbol(AnotherCh,Chars,NextCh),
  605.               $name(A,[Ch|Chars]),
  606.               $read_aft_atom(NextCh,Dict,TokRest)
  607.              ))))
  608.          ) ;
  609.          (Ch > 42,
  610.           ((Ch =:= 44, Tokens = [','|TokRest],
  611.             $get0(NextCh), $read_tokens(NextCh,Dict,TokRest)
  612.            ) ;
  613.            (Ch =\= 44,
  614.             ((Ch =:= 46, $get0(NextCh),
  615.               $read_fullstop(NextCh,Dict,Tokens)
  616.              ) ;
  617.              (Ch =\= 46,
  618.               ((Ch =:= 47,
  619.                 $get0(NextCh), $read_solidus(NextCh,Dict,Tokens)
  620.                ) ;
  621.                (Ch =\= 47, Tokens = [atom(A)|TokRest],
  622.                 $get0(AnotherCh), $read_symbol(AnotherCh,Chars,NextCh),
  623.                 $name(A,[Ch|Chars]),
  624.                 $read_aft_atom(NextCh,Dict,TokRest)
  625.                ))))))))))
  626.          ) ;
  627.          (Ch >= 48,
  628.           ((Ch =< 57, Tokens = [number(I)|TokRest],
  629.             $read_number(Ch,I,NextCh),
  630.         (NextCh = '_$end_of_clause' ->
  631.             TokRest = [] ;
  632.             $read_tokens(NextCh,Dict,TokRest)
  633.         )
  634.            ) ;
  635.            (Ch > 57,
  636.             ((Ch =:= 59, Tokens = [atom((';'))|TokRest],
  637.           $get0(NextCh), $read_tokens(NextCh,Dict,TokRest)
  638.          ) ;
  639.          (Ch =\= 59, Tokens = [atom(A)|TokRest],
  640.           $get0(AnotherCh), $read_symbol(AnotherCh,Chars,NextCh),
  641.           $name(A,[Ch|Chars]), $read_aft_atom(NextCh,Dict,TokRest)
  642.          ))))))
  643.        ) ;
  644.        (Ch >= 65,
  645.         ((Ch =< 90, Tokens = [var(Var,Name)|TokRest],
  646.           $read_name(Ch,S,NextCh), $name(Name,S),
  647.           $read_lookup(Dict, Name=Var),
  648.           $read_tokens(NextCh,Dict,TokRest)
  649.          ) ;
  650.          (Ch > 90,
  651.           ((Ch =< 93,
  652.             ((Ch =:= 91, Tokens = ['['|TokRest],
  653.           $get0(NextCh), $read_tokens(NextCh,Dict,TokRest)  
  654.          ) ;
  655.          (Ch =\= 91,
  656.           ((Ch =\= 92, Tokens = [']'|TokRest],
  657.             $get0(NextCh), $read_tokens(NextCh,Dict,TokRest)
  658.            ) ;
  659.            (Ch =:= 92, Tokens = [atom(A)|TokRest],
  660.             $get0(AnotherCh),
  661.             $read_symbol(AnotherCh,Chars,NextCh),
  662.             $name(A,[Ch|Chars]),
  663.             $read_aft_atom(NextCh,Dict,TokRest)
  664.            ))))
  665.            ) ;
  666.            (Ch > 93,
  667.             ((Ch =:= 95, Tokens = [var(Var,Name)|TokRest],
  668.           $read_name(Ch,S,NextCh),
  669.           ((S = "_", Name = '_') ;
  670.            ($name(Name,S), $read_lookup(Dict, Name=Var))
  671.           ),
  672.           $read_tokens(NextCh,Dict,TokRest)
  673.          ) ;
  674.          (Ch =\= 95, Tokens = [atom(A)|TokRest],
  675.           $get0(AnotherCh), $read_symbol(AnotherCh,Chars,NextCh),
  676.           $name(A,[Ch|Chars]),
  677.           $read_aft_atom(NextCh,Dict,TokRest)
  678.          )))))))))
  679.     ).
  680.  
  681. $read_skip_comment :-
  682.     repeat,
  683.         $get0(Ch),
  684.         (Ch = 10 ; Ch < 0 ; Ch = 31 ; Ch = 26),
  685.     !,
  686.     Ch =\= 26,
  687.     Ch > 0.        /*  fail on EOF */
  688.  
  689.  
  690.  
  691. /*
  692. %   The only difference between $read_aft_atom(Ch, Dict, Tokens) and
  693. %   read_tokens/3 is what they do when Ch is "(".  rd_aft_atom
  694. %   finds the token to be '(', while read_tokens finds the token to be
  695. %   ' ('.  This is how the parser can tell whether <atom> <paren> must
  696. %   be an operator application or an ordinary function symbol application.
  697. %   See the library file READ.PL for details. */
  698.  
  699. /*  Modified by Saumya Debray : June 18, 1985 : to use the conditional
  700.     to avoid both the cut and the laying down of the choice point.    */
  701.  
  702. $read_aft_atom(Ch,Dict,Tokens) :-
  703.     ((Ch =:= 40, Tokens = ['('|TokRest], $get0(NextCh),
  704.       $read_tokens(NextCh,Dict,TokRest)
  705.      ) ;
  706.      (Ch =\= 40, $read_tokens(Ch,Dict,Tokens))
  707.     ).
  708.  
  709. /*
  710. %   $read_string(Chars, Quote, NextCh)
  711. %   reads the body of a string delimited by Quote characters.
  712. %   The result is a list of ASCII codes.  There are two complications.
  713. %   If we hit the end of the file inside the string this predicate FAILS.
  714. %   It does not return any special structure.  That is the only reason
  715. %   it can ever fail.  The other complication is that when we find a Quote
  716. %   we have to look ahead one character in case it is doubled.  Note that
  717. %   if we find an end-of-file after the quote we *don't* fail, we return
  718. %   a normal string and the end of file character is returned as NextCh.
  719. %   If we were going to accept C-like escape characters, as I think we
  720. %   should, this would need changing (as would the code for 0'x).  But
  721. %   the purpose of this module is not to present my ideal syntax but to
  722. %   present something which will read present-day Prolog programs. */
  723.  
  724. $read_string(Chars, Quote, NextCh) :-
  725.         $get0(Ch),
  726.         $read_string(Ch, Chars, Quote, NextCh).
  727.  
  728.  
  729. $read_string(Eofsym, _, Quote, Eofsym) :- 
  730.     (Eofsym is 26; Eofsym is -1),  /* new */
  731.         $print('! end of line or file in '), $put(Quote),
  732.         $print(token), $put(Quote), nl,
  733.         !, fail.
  734. $read_string(Quote, Chars, Quote, NextCh) :- !,
  735.         $get0(Ch),                               /* closing or doubled quote */
  736.         $read_more_string(Ch, Quote, Chars, NextCh).
  737. $read_string(Char, [Char|Chars], Quote, NextCh) :-
  738.         $read_string(Chars, Quote, NextCh).      /* ordinary character */
  739.  
  740.  
  741. $read_more_string(Quote, Quote, [Quote|Chars], NextCh) :- !,
  742.         $read_string(Chars, Quote, NextCh).      /* doubled quote */
  743. $read_more_string(NextCh, _, [], NextCh).             /* end */
  744.  
  745.  
  746. /*
  747. %   $read_solidus(Ch, Dict, Tokens)
  748. %   checks to see whether /Ch is a /* comment or a symbol.  If the
  749. %   former, it skips the comment.  If the latter it just calls read_symbol.
  750. %   We have to take great care with /* comments to handle end of file
  751. %   inside a comment, which is why read_solidus/2 passes back an end of
  752. %   file character or a (forged) blank that we can give to read_tokens.
  753. */
  754.  
  755. $read_solidus(42, Dict, Tokens) :- !,
  756.         $get0(Ch),
  757.         $read_solidus(Ch, NextCh),
  758.         $read_tokens(NextCh, Dict, Tokens).
  759. $read_solidus(Ch, Dict, [atom(A)|Tokens]) :-
  760.         $read_symbol(Ch, Chars, NextCh),         /* might read 0 chars */
  761.         $name(A, [47|Chars]),
  762.         $read_tokens(NextCh, Dict, Tokens).
  763. $read_solidus(Ch, LastCh) :-
  764.     Ch =:= -1,$print('! end of file in /*comment'), nl;
  765.     Ch =\= -1,
  766.      (Ch =:= 26,$print('! end of file in /*comment'), nl;
  767.       Ch =\= 26,$get0(NextCh),
  768.        (Ch =:= 42,
  769.          (NextCh =\= 47, $read_solidus(NextCh,LastCh);
  770.           NextCh =:= 47, LastCh=32)
  771.        ;
  772.         Ch =\= 42, $read_solidus(NextCh,LastCh)
  773.        )
  774.      ).
  775.  
  776. /* old read_solidus/2
  777. $read_solidus(Ch, Ch) :- (Ch is -1 ; Ch is 26), !,
  778.         $print('! end of file in /*comment'), nl.
  779. $read_solidus(42, LastCh) :-
  780.         $get0(NextCh),
  781.         NextCh =\= 47, !,      
  782.         $read_solidus(NextCh, LastCh).
  783. $read_solidus(42, 32) :- !.
  784. $read_solidus(_, LastCh) :-
  785.         $get0(NextCh),
  786.         $read_solidus(NextCh, LastCh).
  787. */
  788. /*
  789. %   $read_name(Char, String, LastCh)
  790. %   reads a sequence of letters, digits, and underscores, and returns
  791. %   them as String.  The first character which cannot join this sequence
  792. %   is returned as LastCh. */
  793.  
  794. /* modified by Saumya Debray : June 18, 1985 : to use search tree structure */
  795.  
  796. $read_name(Ch,ChList,LastCh) :-
  797.     ((Ch >= 65,
  798.       ((Ch =< 90, ChList = [Ch | Chars], 
  799.         $get0(NextCh), $read_name(NextCh, Chars, LastCh)
  800.        ) ;
  801.        (Ch > 90,
  802.         ((Ch =:= 95, ChList = [Ch | Chars], 
  803.               $get0(NextCh), $read_name(NextCh, Chars, LastCh)
  804.          ) ;
  805.          (Ch =\= 95,
  806.           ((Ch >= 97, 
  807.             ((Ch =< 122, ChList = [Ch | Chars], 
  808.               $get0(NextCh), $read_name(NextCh, Chars, LastCh)
  809.              ) ;
  810.          (Ch > 122, ChList = [], LastCh = Ch)
  811.         )) ;
  812.            (Ch < 97, ChList = [], LastCh = Ch)
  813.           )))))) ;
  814.      (Ch < 65, 
  815.       ((Ch >= 48,
  816.         ((Ch =< 57, ChList = [Ch | Chars], $get0(NextCh),
  817.           $read_name(NextCh,Chars,LastCh)
  818.          ) ;
  819.          (Ch > 57, ChList = [], LastCh = Ch)
  820.         )) ;
  821.        (Ch < 48, 
  822.         ((Ch =:= 36, ChList = [Ch | Chars], $get0(NextCh),
  823.           $read_name(NextCh,Chars,LastCh)
  824.          ) ;
  825.          (Ch =\= 36,
  826.           ChList = [], LastCh = Ch)
  827.          )
  828.        )
  829.       ))).
  830.       
  831. /* **********************************************************************
  832. $read_name(Char, [Char|Chars], LastCh) :-
  833.         ( Char >= 97, Char =< 122       % a..z
  834.         ; Char >= 65, Char =< 90        % A..Z 
  835.         ; Char >= 48, Char =< 57        % 0..9 
  836.         ; Char = 95                     %  _ 
  837.         ), !,
  838.         $get0(NextCh),
  839.         $read_name(NextCh, Chars, LastCh).
  840. $read_name(LastCh, [], LastCh).
  841. ********************************************************************** */
  842. /*
  843. %   $read_symbol(Ch, String, NextCh)
  844. %   reads the other kind of atom which needs no quoting: one which is
  845. %   a string of "symbol" characters.  Note that it may accept 0
  846. %   characters, this happens when called from read_fullstop. */
  847.  
  848. $read_symbol(Char, [Char|Chars], LastCh) :-
  849. /*        memberchk(Char, "#$&*+-./:<=>?@\^`~"), */
  850.     $read_chkspec(Char),
  851.         !,
  852.         $get0(NextCh),
  853.         $read_symbol(NextCh, Chars, LastCh).
  854. $read_symbol(LastCh, [], LastCh).
  855.  
  856. $read_chkspec(0'#).    % '#' 35
  857. $read_chkspec(0'$).    % '$' 36
  858. $read_chkspec(0'&).    % '&' 38
  859. $read_chkspec(0'*).    % '*' 42
  860. $read_chkspec(0'+).    % '+' 43
  861. $read_chkspec(0'-).    % '-' 45
  862. $read_chkspec(0'.).    % '.' 46
  863. $read_chkspec(0'/).    % '/' 47
  864. $read_chkspec(0':).    % ':' 58
  865. $read_chkspec(0'<).    % '<' 60
  866. $read_chkspec(0'=).    % '=' 61
  867. $read_chkspec(0'>).    % '>' 62
  868. $read_chkspec(0'?).    % '?' 63
  869. $read_chkspec(0'@).    % '@' 64
  870. $read_chkspec(0'\).    % '\' 92
  871. $read_chkspec(0'^).    % '^' 94
  872. $read_chkspec(0'`).    % '`' 96
  873. $read_chkspec(0'~).    % '~' 126
  874.  
  875. /*
  876. %   $read_fullstop(Char, Dict, Tokens)
  877. %   looks at the next character after a full stop.  There are
  878. %   three cases:
  879. %       (a) the next character is an end of file.  We treat this
  880. %           as an unexpected end of file.  The reason for this is
  881. %           that we HAVE to handle end of file characters in this
  882. %           module or they are gone forever; if we failed to check
  883. %           for end of file here and just accepted .<EOF> like .<NL>
  884. %           the caller would have no way of detecting an end of file
  885. %           and the next call would abort.
  886. %       (b) the next character is a layout character.  This is a
  887. %           clause terminator.
  888. %       (c) the next character is anything else.  This is just an
  889. %           ordinary symbol and we call read_symbol to process it.
  890. */
  891.  
  892. $read_fullstop(Ch, _, _) :-
  893.     (Ch =:= -1 ; Ch =:= 26), !,
  894.         $print('! end of file just after full stop'), $nl,
  895.         fail.
  896. $read_fullstop(Ch, _, []) :-
  897.         Ch =< 32, !.            /* END OF CLAUSE */
  898. $read_fullstop(Ch, Dict, [atom(A)|Tokens]) :-
  899.         $read_symbol(Ch, S, NextCh),
  900.         $name(A, [46|S]),
  901.         $read_tokens(NextCh, Dict, Tokens).
  902.  
  903.  
  904. /*
  905. %   read_number is complicated by having to understand radix notation.
  906. %   There are three forms of integer:
  907. %       0 ' <any character>     - the ASCII code for that character
  908. %       <digit> ' <digits>      - the digits, read in that base
  909. %       <digits>                - the digits, read in base 10.
  910. %   Note that radix 16 is not understood, because 16 is two digits,
  911. %   and that all the decimal digits are accepted in each base (this
  912. %   is also true of C).  So 2'89 = 25.  I can't say I care for this,
  913. %   but it does no great harm, and that's what Dec-10 Prolog does.
  914. %   The X =\= -1 (and 26) tests are to make sure we don't miss an end 
  915. %   of file character.  The tokeniser really should be in C, not least to
  916. %   make handling end of file characters bearable.  If we hit an end
  917. %   of file inside an integer, read_number will fail.
  918. */
  919.  
  920. /*
  921. %  Modified by Saumya Debray, Nov 1986, to handle floating point numbers
  922. */
  923.  
  924. $read_number(BaseChar, Val, NextCh) :-
  925.         Base is BaseChar - 48,
  926.         $get0(Ch),
  927.         Ch =\= 26, Ch > 0,
  928.         (   Ch =\= 39, $read_digits(Ch, Base, 10, Val, NextCh)
  929.         ;   Base >= 1, $read_digits(0, Base, Val, NextCh)
  930.         ;   $get0(Val), Val =\= 26, $get0(NextCh)
  931.         ),  !.
  932.  
  933. $read_digits(SoFar, Base, Value, NextCh) :-
  934.         $get0(Ch),
  935.     ((Ch > 0, Ch =\= 26) ->
  936.             $read_digits(Ch, SoFar, Base, Value, NextCh) ;
  937.         ($print('! end of file in number !'), fail)
  938.     ).
  939.  
  940. $read_digits(46, SoFar, Base, Value, NextCh) :-
  941.     !,
  942.     $get0(Ch),
  943.     ((Ch =:= 26 ; Ch < 0) ->
  944.         ($print('! end of file just after full stop'), $nl, fail) ;
  945.          ((Ch =< 32,                /* end of clause */
  946.           Value = SoFar, NextCh = '_$end_of_clause'
  947.              ) ;
  948.              (Ch > 32,
  949.               ( (Ch >= 48, Ch =< 57) -> 
  950.                     ($floor(Divisor,Base),
  951.               $read_fraction(Ch, 0, Base, Divisor, Fraction, NextCh),
  952.               Value is SoFar+Fraction) ;
  953.                  (Value = SoFar, NextCh = Ch)
  954.               )
  955.              )
  956.             )
  957.     ).
  958. $read_digits(Digit, SoFar, Base, Value, NextCh) :-
  959.         Digit >= 48, Digit =< 57,
  960.         !,
  961.         Next is SoFar*Base-48+Digit,
  962.         $read_digits(Next, Base, Value, NextCh).
  963. $read_digits(LastCh, Value, _, Value, LastCh).
  964.  
  965. $read_fraction(Digit, SoFar, Base, Divisor, Value, NextCh) :-
  966.         Digit >= 48, Digit =< 57,
  967.         !,
  968.         Next is SoFar + ((Digit-48)/Divisor),
  969.     Divisor1 is Divisor*Base,
  970.     $get0(Ch),
  971.     ((Ch < 0 ; Ch =:= 26) ->
  972.         ($print('! end of file in number !'), fail) ;
  973.             $read_fraction(Ch, Next, Base, Divisor1, Value, NextCh)
  974.     ).
  975. $read_fraction(LastCh, Value, _, _, Value, LastCh).
  976.     
  977.  
  978. /*
  979. %   read_lookup is identical to memberchk except for argument order and
  980. %   mode declaration.
  981. */
  982.  
  983. $read_lookup([X|_], X) :- !.
  984. $read_lookup([_|T], X) :- $read_lookup(T, X). 
  985.  
  986.