home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / LIB / PARSER.LF < prev    next >
Text File  |  1996-06-04  |  24KB  |  934 lines
  1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2. %    $Id: parser.lf,v 1.2 1994/12/09 00:01:14 duchier Exp $    
  3. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  4. %%                                                                             
  5. %%                             A PARSER FOR LIFE            
  6. %%
  7. %%  This file contains a complete parser for Life that includes extensions to
  8. %%  the standard syntax of Life (the standard syntax being that defined by the
  9. %%  wild_LIFE parser), and the possibility to use local functions.
  10. %%
  11. %%  It is written like an attribute grammar, and translated in a Life program 
  12. %%  by the grammar translator (file accumulators.lf) The inputs of this
  13. %%  grammars are the tokens produced by the tokenizer in Life (file
  14. %%  tokenizer.lf). This grammar needs to know one token in advance to work. 
  15. %%
  16. %%  The extensions of the standard syntax are the following:
  17. %%  - Expressions may be used at label places:
  18. %%     foo( expr => bar ) 
  19. %%           where expr is any life expression is syntactic sugar for:
  20. %%     ( X:foo | project(expr,X) = bar )
  21. %%
  22. %%  Local Functions:
  23. %%  - lambda(attributes)(expr) defines a local function where all the
  24. %%    variables appearing in attributes are local to the expression. This works
  25. %%    also with recursive functions. For instance, factorial could be defined
  26. %%    by :
  27. %%    Fact = lambda_exp(X)(cond(X =:= 0, 1, X*Fact(X-1))) ?
  28. %%  - The possible syntaxes for application are the following:
  29. %%    - X(args) 
  30. %%        where X is a variable that has to be instantiated to a function
  31. %%        (local or not) at runtime, and args the list of arguments of the
  32. %%        function. 
  33. %%    - (expr)(args) 
  34. %%  - let X = expr in expr2 
  35. %%      is syntactic sugar for 
  36. %%      (lambda(X)(expr2))(expr)
  37. %%
  38. %%
  39. %%  Use of this file:
  40. %%      syntax(Filename) ? 
  41. %%  parses the file Filename and writes the obtained psi-terms in the file
  42. %%  Filename_expr. 
  43. %%    
  44. %%  All the necessary files are automatically loaded if they are in the same
  45. %%  directory.  
  46. %%
  47. %%
  48. %%  Author: Bruno Dumant
  49. %%
  50. %% Copyright 1992 Digital Equipment Corporation
  51. %% All Rights Reserved
  52. %%   
  53. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  54. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  55.  
  56. module("parser") ?
  57.  
  58. load("tokenizer") ?
  59.  
  60. open("accumulators") ?
  61. open("tokenizer") ?
  62.  
  63. public( syntax,prefix,infix,postfix,
  64.       prefix_table,post_infix_table) ?
  65.  
  66. persistent(prefix_table,post_infix_table) ?
  67.  
  68. %%% set the right function for handling terminals in the grammar.
  69.  
  70. set_C(parser_C) ?
  71.  
  72. parser_C([],true,Xs,Ys) -> succeed | Xs = Ys.
  73. parser_C([],false,Xs,Ys) -> Xs = Ys.
  74. parser_C([A],true,Xs,Ys) -> ( `evalin(D) = Ys ) | Xs = [A|D].
  75. parser_C([A],false,Xs,Ys) -> ( Xs = [A|D], `evalin(D) = Ys ).
  76.  
  77.  
  78. %%% operator declaration 
  79.  
  80. op(1000,xfy,virgule) ?    
  81.  
  82. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  83. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  84. %%
  85. %%  A GRAMMAR FOR LIFE
  86. %%
  87. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  88. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  89.  
  90. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  91. %%
  92. %% Terms
  93. %%
  94. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  95.  
  96. %%% The first feature of a non-terminal is the term that corresponds to it;
  97. %%% vars designate the environment of the expression
  98. %%% cons is a boolean that tells whether the expression is a simple constructor
  99. %%% or not.
  100.  
  101. dynamic(term) ?
  102.  
  103. term( T, vars => Vars, cons => Cons) --> 
  104.  
  105.     %% The token encountered is a constructor
  106.  
  107.     [construct(Term)],!,  
  108.     (
  109.         %% term with attributes
  110.  
  111.         attributes(Term, Conds, AuxTerm,
  112.                    vars => Vars ),
  113.         { 
  114.         (
  115.             Conds :== succeed, !,
  116.             T = Term
  117.         ;
  118.             T = `( Term |(Conds, AuxTerm = Term) )
  119.         ),
  120.         Cons = false
  121.         }
  122.     ; 
  123.         %% no attributes
  124.         { T = Term, Cons = true }
  125.     ), 
  126.     ! .
  127.  
  128. term( T, vars => Vars, cons => false) --> 
  129.  
  130.     %% The token encountered is a variable
  131.  
  132.     [variable(V)],!,
  133.     { get_variable(V,Var,Vars) },  %% keeping track of the environment 
  134.     %% of an expression
  135.     ( 
  136.         %% there are attributes (application)
  137.  
  138.         attributes(Term, Conds, AuxTerm, vars => Vars ),
  139.         {
  140.             !,
  141.             (
  142.                 Conds :== succeed, !,
  143.             T = `meta_apply(Var, Term)
  144.         ;
  145.                 T = `( R | (Conds, Term = AuxTerm,
  146.                 R = meta_apply(Var,Term )))
  147.         )
  148.         }
  149.     ; 
  150.         %% no attributes
  151.  
  152.         { T = Var }
  153.     ) .
  154.  
  155.  
  156. term( T, vars => Vars, cons => false) --> 
  157.     
  158.     %% The term is a list
  159.  
  160.     liste(X, vars => Vars ),!,
  161.     ( 
  162.         attributes(X, Conds, X, vars => Vars ),
  163.         {
  164.             Conds :== succeed, !,
  165.         T = X
  166.         ;
  167.             T = `( X | Conds)
  168.         }
  169.     ; 
  170.         { T = X }
  171.     ), 
  172.     ! .
  173. term( T, vars => Vars, cons => false) --> 
  174.  
  175.     %% The term is a disjunction
  176.  
  177.     disjunction(X, vars => Vars),  
  178.     ( 
  179.         attributes(X, Conds, X, vars => Vars),
  180.         {
  181.             Conds :== succeed, !,
  182.         T = X
  183.         ;
  184.             T = `(X |Conds)
  185.         }
  186.     ; 
  187.         { T = X }
  188.     ), 
  189.     ! .
  190.  
  191. syntact_object(lambda) ?
  192. term( T, vars => Vars, cons => false) --> 
  193.     ["lambda"],!,  
  194.     attributes( InScopeTerm, Conds, _, vars => LVars),
  195.     expr( T1, vars => LVars&@(ContextVars), max => 0, mask => 0),
  196.     {  
  197.             Args = features(InScopeTerm),
  198.         Env = feats(ContextVars),
  199.         T = lambda_exp(expr => T1, env => Env,
  200.                        args => Args)&InScopeTerm, 
  201.         Cons = false,
  202.         put_in_context(ContextVars, Vars)
  203.     } .
  204.  
  205.  
  206. syntact_object(let) ?
  207. syntact_object(in) ?
  208. term( T, vars => Vars, cons => false) --> 
  209.     ["let"],!,
  210.     [variable(X)],
  211.     { get_variable(X,Var,LVars)},
  212.     [atom(=)],
  213.     expr( T1, vars => Vars, max => 1200, mask => 0),
  214.     ["in"],
  215.     expr( T2, vars => LVars&@(ContextVars), max => 0,  mask => 0),
  216.     {
  217.         Env = feats(ContextVars),
  218.         T3 = lambda_exp(Var, expr => T2, env => Env,
  219.                         args => [1]), 
  220.         T = `meta_apply(T3,@(T1)),
  221.         Cons = false,
  222.         put_in_context(ContextVars, Vars)
  223.     } .
  224.  
  225. syntact_object(if) ?
  226. syntact_object(then) ?
  227. syntact_object(else)  ?
  228. term( T, vars => Vars, cons => false) --> 
  229.     ["if"],!,
  230.     expr( T1, vars => Vars, max => 999, mask => 0),
  231.     (
  232.         ["then"],!,
  233.         expr( Term2, vars => Vars, max => 999, mask => 0),
  234.         { T2 = `(true | Term2) }
  235.     ;
  236.         { T2 = true}
  237.     ),
  238.     (
  239.         ["else"],!,
  240.         expr( Term3, vars => Vars, max => 999, mask => 0),
  241.         { T3 = `(true | Term3) }
  242.     ;
  243.         { T3 = true}
  244.     ),
  245.     { T = `cond(T1,T2,T3)} . 
  246. %%    { T = `cond((true|T1),T2,T3)} . 
  247.  
  248. %%%
  249. %%% Attributes
  250. %%%
  251. %%% 
  252.  
  253. %%% Term is a reference to the root that bears the attributes;
  254. %%% CondOut is a conjunction of terms like " project(expr1,AuxTerm) = expr2 "
  255. %%% AuxTerm is unified with Term once the projections are performed.
  256.  
  257. attributes( Term, CondOut, AuxTerm, vars => Vars ) --> 
  258.     ["("], 
  259.     list_attributes( Term, AuxTerm, vars => Vars,
  260.                      succeed, CondOut, oldnb => 1) .
  261.  
  262.  
  263. %%% oldnb and newnb are used for numerical attributes
  264.  
  265. list_attributes( Term, AuxTerm, vars => Vars,
  266.              CondIn, CondOut, oldnb => ON, newnb => NN ) -->  
  267. attribute( Term, AuxTerm, vars => Vars,
  268.        CondIn, CondInt, oldnb => ON , newnb => NN1),
  269.     (
  270.         [")"] , { !, CondOut = CondInt }
  271.     ;
  272.         [atom(,)], 
  273.         list_attributes( Term, AuxTerm, vars => Vars, 
  274.                  CondInt, CondOut, oldnb => NN1, newnb => NN)
  275.     ) .
  276.  
  277. attribute( Term, AuxTerm, vars => Vars,
  278.        CondIn, CondOut, oldnb => ON , newnb => NN) --> 
  279.     expr( X, vars => Vars , cons => Cons,
  280.           mask => 9),
  281.     (
  282.         [atom(=>)],!,
  283.         expr( Y, vars => Vars, mask => 1),
  284.         {
  285.         (
  286.             Cons,!,
  287.             project(X,Term) = Y,
  288.             CondIn = CondOut
  289.         ;
  290.             CondOut = ((project(X,AuxTerm) = Y) virgule CondIn)
  291.         ), 
  292.         NN = ON
  293.         }
  294.     ;
  295.         { project(ON,Term) = X, NN=ON+1, CondIn = CondOut}
  296.     ).
  297.  
  298. %%%
  299. %%% Lists 
  300. %%% 
  301.  
  302. liste(L, vars => Vars )    --> 
  303.     ["["],!,
  304.     ( 
  305.         ["]"], { !, L = [] } 
  306.     ; 
  307.         end_list(L, vars => Vars )
  308.     ) .
  309.  
  310. liste(L, vars => Vars )    --> 
  311.     ["[|"],!,
  312.     expr( B, vars => Vars, mask => 0 ),
  313.     ["]"],
  314.     { L = cons(2 => B)} .
  315.  
  316. liste(cons, vars => Vars )    --> 
  317.     ["[|]"] .
  318.  
  319. end_list(L, vars => Vars ) --> 
  320.     expr( A, vars => Vars, mask => 5),
  321.     (
  322.         ["]"], { !, L = [A]}
  323.     ;
  324.         [atom(,)],!, 
  325.         end_list(B,  vars => Vars ),
  326.             { L = [A|B] }
  327.     ;
  328.         [atom(|)],!,
  329.         expr( B, vars => Vars, mask => 0 ),
  330.         ["]"],
  331.         { L = [A|B] }
  332.     ;
  333.         ["|]"],
  334.         { L = cons(A) }
  335.     ) .
  336.  
  337. %%%
  338. %%% disjunctions
  339. %%%
  340.  
  341. disjunction(L, vars => Vars ) --> 
  342.     ["{"],
  343.     ( 
  344.         ["}"], { !, L =`{}} 
  345.     ; 
  346.         end_disjunction(L, vars => Vars )
  347.     ) .
  348.  
  349. end_disjunction(L, vars => Vars ) --> 
  350.     expr( A, vars => Vars, mask => 2),
  351.     (
  352.         ["}"], { !, L = `{A} }
  353.     ;
  354.         [atom(;)],!, 
  355.         end_disjunction(B, vars => Vars ),
  356.             { L = `{A|B} }
  357.     ;
  358.         [atom(|)],
  359.         expr( B, vars => Vars, mask => 0 ),
  360.         ["}"],
  361.         { L = `{A|B} }
  362.     ) .
  363.  
  364. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  365. %%
  366. %% expressions
  367. %%
  368. %% expressions accept dynamically defined operators. The parse tree is obtained
  369. %% by reading the list of tokens once, from left to right.
  370. %%
  371. %%
  372. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  373.  
  374. %%% the max feature is the maximum possible precedence of the expression;
  375. %%% the tree feature is the syntactic tree of the expression: a psi term;
  376. %%% Mask indicate whether commas, semicolons, and | may be
  377. %%% considered as operators or just as syntactic objects, in the context of
  378. %%% the expression.
  379.  
  380. expr( Tree, cons => Bool, vars => Vars, 
  381.       mask => Mask, max => Max )    -->
  382.     start_expr( T, cons => Bool1, vars => Vars,
  383.             max => Max, mask => Mask),
  384.     end_expr( Tree, cons => Bool2, vars => Vars,
  385.           left_expr => T, max => Max, mask => Mask ),
  386.     { Bool = Bool1 and Bool2 }.
  387.  
  388.  
  389. start_expr( Tree, cons => Cons, vars => Vars,
  390.             mask => Mask) -->
  391. prefix_op( M, Operator, right_strict => S, max => 1200),
  392.     { Tree  = Operator},
  393.     (
  394.             ["("|_] is dcg, !,
  395.         attributes(Tree, vars => Vars ),
  396.         { Cons = false }
  397.     ;
  398.         
  399.         %% the operator is followed by an expression
  400.         
  401.         expr( T, vars => Vars, max => preced(S,M),
  402.               mask => Mask ),
  403.         { 
  404.             !,
  405.         project(1,Tree) = T,
  406.         Cons = false
  407.         }
  408.     ;
  409.         {cons = true}
  410.     ).
  411.  
  412. start_expr( Tree, cons => false, vars => Vars) --> 
  413.     ["("], !, 
  414.     expr( Tree1, vars => Vars, max => 1200) , 
  415.     [")"],
  416.     ( 
  417.         attributes(Term, Conds, AuxTerm, vars => Vars ),
  418.         !,
  419.         {
  420.             Conds :== succeed, !,
  421.         Tree = `meta_apply(Tree1, Term)
  422.         ;
  423.             Tree = `( R | (Conds, Term = AuxTerm,
  424.                            R = meta_apply(Tree1,Term )))
  425.         }
  426.     ; 
  427.         { Tree = Tree1 }
  428.     ) .
  429.  
  430. start_expr( T, vars => Vars, cons => Cons) --> 
  431.     term( T, vars => Vars, cons => Cons) .
  432.  
  433.  
  434. end_expr( T, cons => false, vars => Vars,
  435.           left_expr => L, left_prec => MLeft, max => Max,
  436.           mask => Mask)  --> 
  437. sub_expr( T1, vars => Vars, 
  438.       left_expr => L, left_prec => MLeft, prec => M, max => Max,
  439.       mask => Mask),!,
  440. end_expr( T, vars => Vars,
  441.       left_expr => T1, prec => M, max => Max, 
  442.       mask => Mask) .
  443.  
  444. end_expr( T, cons => true, left_expr => T) --> 
  445.     [] .
  446.  
  447. sub_expr( Tree, vars => Vars ,
  448.           left_expr => L, left_prec => MLeft, prec => N,  max => Max, 
  449.           mask => Mask) --> 
  450.     { MLeft =< preced(LS,M) },
  451.     post_or_infix_op( Type, M, Operator,
  452.               left_strict => LS, right_strict => RS, max => Max,
  453.               mask => Mask),
  454.     (
  455.         {   
  456.         Type :== postfix,!,
  457.         Tree = Operator & @(L),
  458.         N = 0
  459.         }
  460.     ;
  461.         { Type :== infix},
  462.         expr( R, vars => Vars, max => preced(RS,M),
  463.           mask => Mask),
  464.         { 
  465.         (
  466.             Operator :== `:,!,
  467.             ( 
  468.             var(L) or var(R),
  469.             Tree = ( L&R), !
  470.             ;
  471.             Tree = `(L & R)
  472.             )
  473.         ;
  474.             Tree = Operator & @(L,R)
  475.         ),
  476.         N = M
  477.         }
  478.     ) .
  479.  
  480.  
  481. %%
  482. %% operators: any Life operator may be used. 
  483. %%
  484.  
  485.  
  486. prefix_op( P, Operator, right_strict => RS,
  487.            0 => [C:atom(Operator)|_], max => Max) -->
  488.     {
  489.         has_feature(combined_name(Operator),prefix_table,
  490.             @(precedence => P, right_strict => RS)),
  491.         Max >= P
  492.     },
  493.     [TOK] .
  494.  
  495. %% comma_mask -> 1.
  496. %% semicolon_mask -> 2.
  497. %% bar_mask -> 4.
  498. %% =>_mask -> 8.
  499.  
  500. post_or_infix_op( Type, P, Operator, left_strict => LS, right_strict => RS,
  501.               mask => Mask,
  502.                   0 => [C:atom(Operator)|_], max => Max) -->
  503.     {
  504.         cond( (Mask /\ 1 =:= 1 and Operator :== ,) or
  505.           (Mask /\ 2 =:= 2 and Operator :== ;) or
  506.           (Mask /\ 4 =:= 4 and Operator :== `(|)) or
  507.           (Mask /\ 8 =:= 8 and Operator :== `(=>)),
  508.           fail ),
  509.         has_feature(combined_name(Operator),post_infix_table,
  510.             @( precedence => P,type => Type,
  511.                left_strict => LS, right_strict => RS)),
  512.         Max >= P
  513.     },
  514.     [TOK] .
  515.  
  516.  
  517. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  518. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  519. %%
  520. %%  Some Utilities
  521. %%
  522. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  523. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  524.  
  525.  
  526. preced(true,M) -> M-1.
  527. preced(false,M) -> M.
  528.  
  529. %%
  530. %% to recognise whether a variable has already been met in the term
  531. %%
  532. %% get_variable("_",Var,Vars) :- !.
  533.  
  534. get_variable(S,Var,Vars) :- 
  535.     cond( has_feature(S,Vars),
  536.           project(S,Vars) = Var,
  537.           cond( has_feature(1,Vars),
  538.                 get_variable(S,Var,project(1,Vars)),
  539.             project(S,Vars) = Var)).
  540.  
  541. put_in_context(ContextVars,Vars) :-
  542.     place_variables(features(ContextVars),ContextVars,Vars).
  543.  
  544. place_variables([],_,_) :- !.
  545. place_variables([A|B],ContextVars,Vars) :-
  546.     get_variable(A,project(A,ContextVars),Vars),
  547.     place_variables(B,ContextVars,Vars).
  548.  
  549. %%% to get rid of unnecessary succeed statements
  550.  
  551. non_strict(virgule) ?
  552. X virgule succeed -> X.
  553. X virgule Y -> (X,Y).
  554.  
  555. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  556. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  557. %%
  558. %%  Operators definition
  559. %%
  560. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  561. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  562.  
  563. module("built_ins") ?
  564.  
  565.  
  566. %%% changing the definition of op...
  567.  
  568. dynamic(op) ?
  569. asserta(( op(A,B,C,functor => C,kind => B,precedence => A) :-
  570.       !,
  571.       trace(D,E),
  572.       (op_parse(A,B,C),!,
  573.        trace(D,E) ; trace(D,E),
  574.        fail))) ?
  575. static(op) ?
  576.  
  577. %%% op_parse is exactly op_2, except that it adds the operator to the
  578. %%% hash table used by the parser.
  579.  
  580.  
  581. op_parse(A,B,C) :-
  582.         nonvar(A),
  583.         nonvar(B),
  584.         nonvar(C),
  585.         C = list,
  586.         !,
  587.         op_3(C,A,B).
  588. op_parse(@,@,A) :-
  589.         nonvar(A),
  590.         A = list,
  591.         !,
  592.         write_err("*** Error: invalid operator declaration."),
  593.         nl_err.
  594. op_parse(A,B,C) :-
  595.         nonvar(A),
  596.         nonvar(B),
  597.         nonvar(C),
  598.         !,
  599.         hash_op(A,B,C).
  600.  
  601. op_parse(A,B,C) :-
  602.         member(op(A,B,C),ops).
  603.  
  604.  
  605. %%% hash_op
  606. %%% puts operators in two different hash tables (one for prefix operators and
  607. %%% one for the other operators), and gives a warning if there is overloading
  608. %%% of operators.
  609.  
  610. hash_op( Precedence, Kind, Functor) :-
  611.  
  612.     %% extracting information from Kind
  613.  
  614.         Def = project(Kind,
  615.                   @(  fx  => @( type => 'parser#prefix',
  616.                             right_strict => true),
  617.                   fy  => @( type => 'parser#prefix',
  618.                             right_strict => false),
  619.               xf  => @( type => 'parser#postfix', 
  620.                             left_strict => true,
  621.                     right_strict => @),
  622.                   xfx => @( type => 'parser#infix', 
  623.                             left_strict => true, 
  624.                     right_strict => true),
  625.                   xfy => @( type => 'parser#infix', 
  626.                             left_strict => true, 
  627.                     right_strict => false),
  628.                   yf  => @( type => 'parser#postfix', 
  629.                             left_strict => false,
  630.                     right_strict => @),
  631.                   yfx => @( type => 'parser#infix', 
  632.                             left_strict => false, 
  633.                     right_strict => true)))
  634.     & @(type => Type, precedence => Precedence),
  635.     
  636.     %% checking overloading and adding the definition
  637.     Name = combined_name(Functor),
  638.  
  639.         cond( has_feature(Name,
  640.               'parser#prefix_table',PrevDef1) or
  641.           has_feature(Name,'parser#post_infix_table',PrevDef2 ),
  642.         
  643.           cond(   
  644.               equ_op(Def,PrevDef1) or equ_op(Def,PrevDef2),
  645.               succeed,    % the definition already exists
  646.               (
  647.               c_op(Precedence,Kind, Functor),
  648.               cond(   % add a new definition
  649.                   Type :== 'parser#prefix',
  650.                   'parser#prefix_table'.Name <<- Def,
  651.                   'parser#post_infix_table'.Name <<- Def
  652.                   ),
  653.               write_err("*** Warning: overloading definition",
  654.                     " of operator ",
  655.                     Functor," ***"),nl_err
  656.               )
  657.           ),
  658.           (
  659.           c_op(Precedence,Kind, Functor),
  660.           cond(   % create a new definition
  661.               Type :== 'parser#prefix',
  662.               'parser#prefix_table'.Name <<- Def,
  663.               'parser#post_infix_table'.Name <<- Def
  664.               )
  665.           )
  666.         ).
  667.  
  668. equ_op( @( precedence => Precedence1, type => Type1,
  669.        left_strict => LS1, right_strict => RS1),
  670.         Def2) -> Bool |
  671.     Def2 = @( precedence => Precedence2,
  672.               type => Type2, left_strict => LS2, right_strict => RS2),
  673.     Bool = ( Precedence1 =:= Precedence2 and Type1 :== Type2 
  674.                  and LS1 :== LS2 and RS1 :== RS2 ) .
  675.  
  676.  
  677.  
  678. module("parser") ?
  679.  
  680. %%% Initialization of the two hash_tables:
  681.  
  682. init_hash_op(op(Precedence, Kind, Functor)) :-
  683.  
  684.     %% extracting information from Kind
  685.  
  686.         Def = project(Kind,
  687.                   @(  fx  => @( type => prefix,
  688.                             right_strict => true),
  689.                   fy  => @( type => prefix,
  690.                             right_strict => false),
  691.               xf  => @( type => postfix, 
  692.                             left_strict => true),
  693.                   xfx => @( type => infix, 
  694.                             left_strict => true, 
  695.                     right_strict => true),
  696.                   xfy => @( type => infix, 
  697.                             left_strict => true, 
  698.                     right_strict => false),
  699.                   yf  => @( type => postfix, 
  700.                             left_strict => false),
  701.                   yfx => @( type => infix, 
  702.                             left_strict => false, 
  703.                     right_strict => true)))
  704.     & @(type => Type, precedence => Precedence),
  705.     cond(   % create a new definition
  706.             Type :== prefix,
  707.         prefix_table.combined_name(Functor) <<- Def,
  708.         post_infix_table.combined_name(Functor) <<- Def
  709.         ).
  710.  
  711. maprel(init_hash_op,ops) ?
  712.  
  713. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  714. %%
  715. %% defining open_close operators
  716. %%
  717. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  718.  
  719. open_close_op(A,B,C) :- 
  720.     syntact_object(A),
  721.     syntact_object(B),
  722.     AS = psi2str(A),
  723.     BS = psi2str(B),
  724.     (
  725.         term( T, vars => Vars, cons => false) --> 
  726.         [AS],!,
  727.         expr( Tree1, vars => Vars, max => 1200, mask => 0) , 
  728.         [BS],
  729.         { T = (C) & @(Tree1)}
  730.     ).
  731.  
  732. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  733. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  734. %%
  735. %% Dealing with lambda expressions
  736. %%
  737. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  738. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  739.  
  740. non_strict(meta_apply) ?
  741. non_strict(lambda_exp) ?
  742.  
  743. meta_apply(F:lambda_exp,T) -> X |              % application of a lambda
  744.  
  745.         G = copy_lambda(F),
  746.     diff_list(features(T),G.args,NewArgs), % for currying
  747.  
  748.     evalin(T) = G,                         % evaluate the arguments
  749.     ( 
  750.         NewArgs :== [], !,
  751.         Expr = G.expr,
  752.         X = evalin(Expr)
  753.     ;
  754.         T.args <- NewArgs,
  755.         X = T 
  756.         ).
  757. meta_apply(F:meta_apply,T) ->  X |
  758.     %% application of an application 
  759.      G = evalin(F), X = meta_apply(G,T).
  760.  
  761. meta_apply(F,T) -> X |                          
  762.     %% application of a standard
  763.     %% function 
  764.     X = apply(functor => F)&T,
  765.     X = evalin(X).
  766.  
  767. copy_lambda(F:lambda_exp) -> T |                    
  768.     %% make a copy of the lambda expression before
  769.     %% evaluation, and preserve the environment
  770.     T = copy_pointer(copy_term(F)),
  771.     restore_global(T.env,F.env).
  772.  
  773. restore_global([],[]) :- !.
  774. restore_global([A|As],[B|Bs])  :-
  775.         A <- B,          
  776.     restore_global(As,Bs) .
  777.  
  778.  
  779. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  780. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  781. %%
  782. %% Interface
  783. %%
  784. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  785. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  786.  
  787. syntax(InFile, OutFile) :-
  788.         open_in(InFile,S1),
  789.         open_out(cond(OutFile:<string,
  790.               OutFile,
  791.               strcon(InFile,"_expr")),
  792.          S2),
  793.         first_statement(S1),
  794.         close(S1),
  795.         close(S2).
  796.  
  797. first_statement(S1) :-
  798.     FT = first_token,
  799.     (
  800.         FT = [],
  801.         !,
  802.         open_out("stdout",_),
  803.         nl,nl,
  804.         write("Empty File"),
  805.         nl
  806.     ;
  807.             read_new_expr( FT, Bool, Expr, T, LeftToken),
  808.         cond( Bool,
  809.           cond( T :== assertion,
  810.             (
  811.                 nl, writeq(Expr),write(".")
  812.             ),
  813.             (
  814.                 nl, writeq(Expr),write("?")
  815.             )),
  816.           (
  817.               close(S1), 
  818.               nl_err,
  819.               write_err("Syntax error near line ",S1.line_count,
  820.                     " in file '",S1.input_file_name,"'"),
  821.               nl_err, !, fail
  822.           )),
  823.         (
  824.         LeftToken = [],!,
  825.         open_out("stdout",_),
  826.         nl,
  827.         write("*** File '",S1.input_file_name,"'  parsed"),
  828.         nl 
  829.         ;
  830.         fail
  831.         )
  832.     ;
  833.         next_statement(S1)
  834.     ).
  835.  
  836. next_statement(S1) :-
  837.     (
  838.             read_new_expr( [copy_term(rest_token)|`next_token], Bool, Expr, 
  839.                T, LeftToken),
  840.         cond( Bool,
  841.           cond(  T :== assertion,
  842.                  (
  843.                  nl, nl, writeq(Expr),write(".")
  844.              ),
  845.                  (
  846.                  nl, nl, writeq(Expr),write(" ?")
  847.              )),
  848.           (
  849.               close(S1),
  850.               nl_err,
  851.               write_err(
  852.                    "*** Syntax error near line ",S1.line_count,
  853.                    " in file '",S1.input_file_name,"'"),
  854.               nl_err,
  855.               !, fail
  856.           )),
  857.         (
  858.         LeftToken = [],!,
  859.         open_out("stdout",Str),
  860.         nl,
  861.         write("*** File '",S1.input_file_name,"' parsed"),
  862.         nl 
  863.         ;
  864.         fail
  865.         )
  866.     ;
  867.         next_statement(S1)
  868.     ).
  869.  
  870.  
  871. read_new_expr( R1, Bool, Expr, T, LeftToken) :- 
  872.     (
  873.         expr( Expr, vars => @,  mask => 0,
  874.               0 => R1, rest => R2, max => 1200),
  875.         (
  876.         R2 = ["."|LT], LeftToken = evalin(LT), T = assertion
  877.         ;
  878.             R2 = ["?"|LT], LeftToken = evalin(LT), T = query
  879.         ),
  880.         Bool = true,
  881.         !
  882.     ;
  883.         Bool = false
  884.     ).
  885.  
  886. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  887. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  888. %%%
  889. %%% reset default 'C'
  890. %%%
  891. reset_C ?
  892.  
  893.  
  894. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  895. %
  896. % Utilities
  897. %
  898. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  899.  
  900.  
  901.  
  902. %%% list of the features of a term (parser.lf)
  903.  
  904. public(feats) ?
  905. feats(L) -> map( project( 2 => L), features(L)).
  906.  
  907.  
  908.  
  909. %
  910. % diff_list(L1,L2,L3): L3 is L2 \ (L1 inter L2) (parser.lf)
  911. %
  912.  
  913. public(diff_list) ?
  914. diff_list([],L2,L2) :- !.
  915. diff_list(L1:[A|NewL1],L2,RestL2) :-
  916.     cond( memberAndRest(A,L2,InterRestL2),
  917.           diff_list(NewL1,InterRestL2,RestL2),
  918.           diff_list(NewL1,L2,RestL2)).
  919.  
  920. %
  921. % memberAndRest(A,List,Rest) returns true if A is a member of List, with Rest
  922. % containing the other members of List. 
  923. %
  924.  
  925. public(memberAndRest) ?
  926. memberAndRest(A,[],Rest) -> false.
  927. memberAndRest(A,[B|C],Rest) ->
  928.     cond( A = B, 
  929.           (true | Rest = C),
  930.           memberAndRest(A,C,OtherRest) | Rest = [B|OtherRest] ).
  931.  
  932.  
  933.  
  934.