home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / TESTS / LF / PREPARSE.LF < prev    next >
Text File  |  1996-06-04  |  13KB  |  569 lines
  1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2. %                                                                             %
  3. % Translating grammars into LIFE                                              %
  4. %                                                                             %
  5. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  6.  
  7. op( 1000, xfy, comma) ?
  8. op( 1200, xfy, -->) ?
  9. non_strict(-->) ?
  10.  
  11. my_project(A,B) -> B.A.
  12.  
  13.  
  14. (Lhs --> Rhs) :- R = compileRule( Lhs, Rhs), assert(R), fail ; succeed.
  15.  
  16. %
  17. % compileRule: translates the grammar rules into clauses
  18. %
  19.  
  20. non_strict(compileRule) ?
  21. compileRule( Lhs, Rhs) -> 
  22.     (compileSymbols( Lhs, false, false, Xs, Ys, _) :- 
  23.          compileSeq( Rhs, true,  false, Xs, Ys, _)).
  24.  
  25. %
  26. % compileSeq is used to translate a sequence of symbols of the grammar into a
  27. % sequence of literals.
  28. %
  29.  
  30. compileSeq( Symbols, FoldOk, InDisj, Xs, Ys, NewFoldOk) -> 
  31.     cond( Symbols :== @,
  32.           `varSymbol( Symbols, 0 => Xs, rest => Ys) 
  33.       | NewFoldOk = FoldOk,
  34.           compileSymbols( Symbols, FoldOk, InDisj, Xs, Ys, NewFoldOk)).
  35.  
  36. %
  37. % compileSymbols is used to translate non-variable symbols.
  38. %
  39.  
  40. % conjunction
  41.   compileSymbols( ( Symb, Autres), FoldOk, InDisj, Xs, Ys, NewFoldOk) ->
  42.     compileSeq( Symb,   FoldOk,      InDisj, Xs, Ys1, InterFoldOk) comma 
  43.         compileSeq( Autres, InterFoldOk, InDisj, Ys1, Ys, NewFoldOk).
  44.  
  45. % disjunction
  46.   compileSymbols( ( List1 ; List2), FoldOk, _, Xs, Ys, NewFoldOk) -> 
  47.     X | Z = compileSeq( List1, FoldOk, true, Xs, Ys, InterFoldOk1),
  48.             T = compileSeq( List2, FoldOk, true, Xs, Ys, InterFoldOk2),
  49.             NewFoldOk = InterFoldOk1 and InterFoldOk2,
  50.         X = `( Z ; T ), 
  51.         ! .
  52.                                    
  53. % terminals
  54.   compileSymbols( Terms: list, true, false, Xs, Ys, NewFoldOk) -> 
  55.     succeed | Xs = termSequence(Terms, Ys), NewFoldOk = true.
  56.   compileSymbols( Terms: list, FoldOk, _, Xs, Ys, NewFoldOk) -> 
  57.     Xs = termSequence(Terms, Ys) | NewFoldOk = FoldOk.
  58.  
  59. % cut
  60.   compileSymbols( !, FoldOk, false, Xs, Ys, NewFoldOk) -> 
  61.     ! | NewFoldOk = false, Xs = Ys.  
  62.   compileSymbols( !, FoldOk, true, Xs, Ys, NewFoldOk) -> 
  63.     Xs = Ys, ! | NewFoldOk = false.
  64.  
  65. % insertion of code
  66.  
  67.   compileSymbols( Term: #, FoldOk, false, Xs, Ys, NewFoldOk)  -> 
  68.     transLifeCode( Term) | Xs = Ys, NewFoldOk = false.
  69.   compileSymbols( Term: #, FoldOk, true, Xs, Ys, NewFoldOk)  -> 
  70.     Xs = Ys, transLifeCode( Term) | NewFoldOk = false.
  71.  
  72.  
  73. % non-terminals
  74.   compileSymbols(NonTerm, FoldOk, _, Xs, Ys, NewFoldOk)    -> 
  75.     NonTerm  | NonTerm = @( 0 => Xs, rest => Ys), NewFoldOk = FoldOk.
  76.  
  77.  
  78. %
  79. % Inserting Life code
  80. %
  81.  
  82. transLifeCode( L) -> transList( feats(L)).
  83.  
  84. feats(L) -> map( my_project( 2 => L), features(L)).
  85.  
  86. transList( []) ->  succeed.
  87. transList( [A|B]) -> A comma transList( B).
  88.  
  89. %
  90. % handling terminals
  91. %
  92.  
  93. termSequence( [], Ys)     -> Ys.
  94. termSequence( [T|Ts], Ys) -> [T|termSequence( Ts, Ys)].
  95.  
  96. %
  97. % This definition is used at run-time to evaluate variable symbols
  98. %
  99.  
  100. varSymbol( X:list, 0 => Xs, rest => Ys) -> 
  101.     Xs = termSequence( X, Ys). 
  102. varSymbol( X, 0 => Xs, rest => Ys) -> 
  103.     X | X = @( 0 => Xs, rest => Ys).
  104.  
  105.  
  106. %
  107. % getting rid of unnecessary succeed statements
  108. %
  109.  
  110. succeed comma A -> A .
  111. A comma succeed -> A .
  112. A comma B -> A , B.
  113.  
  114. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  115. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  116. setq(list_of_words,[]) ?
  117.  
  118. readf( File ) -> 
  119.     L 
  120.     |   ( open_in(File,S),
  121.       read_all(L1),
  122.       setq(list_of_words,L1),
  123.       close(S),
  124.       fail ;
  125.       L = list_of_words ).
  126.       
  127.  
  128. read_all( L) :-
  129.         get(X),
  130.         cond( X :=< end_of_file , 
  131.               L=[] ,
  132.               (read_all(Y), L = [X|Y])).
  133.  
  134. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  135. %
  136. % TOKENIZER FOR LIFE
  137. %
  138. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  139. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  140. %
  141. % tokenize(File,L) reads in the file F, and returns the list of tokens
  142. % encountered. No  error message is given in the present implementation.
  143. %
  144. % the tokens are of the following types:
  145. %    - variable(X) where X is the name of the variable;
  146. %    - construct(X) represents a constructor X. 
  147. %      The type of a constructor is a subsort of construct: numb, chaine, or
  148. %      atom. An atom may be a simple_atom or a quoted_atom. 
  149. %      X is usually a string, except in numb(X), where X is the actual value.
  150. %    - any syntactic object like "[" or "?"
  151. %
  152. %
  153. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  154. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  155. %
  156. % Types: those definitions are not useful here, but in the parser.
  157. %
  158. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  159.  
  160. simple_atom <| atom.
  161. quoted_atom <| atom.
  162.  
  163. atom <| construct.
  164. numb <| construct.
  165. chaine <| construct.
  166.  
  167. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  168. %
  169. % Program
  170. %
  171. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  172.  
  173.  
  174. tokenize(File,L) :- 
  175.         W = readf(File),
  176.     tokens(L,0 => W, rest => []).
  177.  
  178.  
  179. tokens(T) --> 
  180.     void_chars,
  181.     (
  182.         token(L),!,
  183.         tokens(Ls), 
  184.         #( T = [L|Ls]);
  185.         #( T = [])
  186.     )?
  187.  
  188.  
  189.  
  190. void_chars -->                                     % space, tab, return
  191.     [X],
  192.     #( X =:= 9 or X =:= 32 or X =:= 10, !), 
  193.     void_chars ?   
  194. void_chars -->                                     % commentaires
  195.     [37],!, 
  196.     comment_chars, 
  197.     void_chars ?
  198. void_chars --> [] ?
  199.  
  200. comment_chars --> [10], ! ?                     % un commentaire s'arrete avec
  201.                         % return.
  202. comment_chars --> [X], comment_chars ?
  203.  
  204.  
  205. token( 0 => []) :- !, fail.
  206. token(_A,rest => Rest,0 => _C) :-
  207.         realToken(_A,rest => Rest,0 => _C).
  208.     
  209.  
  210. realToken(T,rest => R,0 => W:[A|B]) ->
  211.     cond( A >= 48 and A =< 57,
  212.               ( 
  213.           number(N,0 => W,rest => R),
  214.           T = numb(N)
  215.           ),
  216.           cond( A >= 65 and A=< 90,
  217.                 (
  218.             variable(V, 0 => W,rest => R),
  219.             T = variable(V)
  220.             ),
  221.             cond( A >= 97 and A =< 122,
  222.                   ( 
  223.                   non_quoted_atom(SA,0 => W,rest => R),
  224.                   T = simple_atom(SA)
  225.               ),
  226.               str2psi(strcon("token",int2str(A)))
  227.                  & @(T,0 => W,rest  => R)))).
  228.  
  229. %
  230. %
  231. % variables
  232. % 
  233. %
  234.  
  235. token95( variable(X)) -->                        % _...
  236.     [_],
  237.     simple_atom_cars(Y), 
  238.     #((Y = "", ! ); X = strcon("_",Y)) ?                  
  239.  
  240. variable(X) -->                                  % M...
  241.     [Y], 
  242.     simple_atom_cars(Z), 
  243.     #( X = strcon(charac(Y),Z)) ?
  244.  
  245.  
  246. %
  247. %
  248. % syntactic objects
  249. %
  250. %
  251.  
  252. token40( "(") --> [_] ?
  253. token41( ")") --> [_] ?
  254. token44( ",") --> [_] ?
  255. token46( ".") --> [_] ?
  256. token59( ";") --> [_] ?
  257. token63( "?") --> [_] ?
  258. token91( "[") --> [_] ?
  259. token93( "]") --> [_] ?
  260. token123( "{") --> [_] ?
  261. token124( "|") --> [_] ?
  262. token125( "}") --> [_] ?
  263.  
  264. %
  265. %
  266. % constructors
  267. %
  268. %
  269.  
  270. %
  271. % @
  272. %
  273.  
  274. token64( simple_atom("@")) --> [_] ?
  275.  
  276. %
  277. % quote
  278. %
  279.  
  280. token96( simple_atom("`"),0 => [_|Rest],rest => Rest).
  281.  
  282. %
  283. % simple atoms
  284. %             
  285.  
  286. non_quoted_atom(X) --> 
  287.     [Y], 
  288.     simple_atom_cars(Z), 
  289.     #( X = strcon(charac(Y),Z)) ?
  290.  
  291. simple_atom_cars(Z) --> 
  292.     simple_atom_car(X), !,
  293.     simple_atom_cars(Y), 
  294.     #( Z = strcon(X,Y)) ?
  295. simple_atom_cars("") --> [] ?
  296.  
  297. simple_atom_car(X) --> 
  298.     [Y],  
  299.     #(    Y >= 48 and Y =< 57    % chiffre
  300.            or Y >= 65 and Y =< 90    % majuscule
  301.            or Y =:= 95               % underscore
  302.            or Y >= 97 and Y =< 122,  % minuscule
  303.        X = charac(Y))?
  304.  
  305. %
  306. % quoted atoms
  307. %
  308.  
  309. token39( quoted_atom(X)) --> 
  310.     [_],
  311.         quoted_atom_end(X) ?
  312.  
  313. quoted_atom_end(X) --> 
  314.     [39], !,
  315.     ( [39], !,quoted_atom_end(Y), X = strcon("'",Y) ; 
  316.           # ( X = "" )) ?
  317. quoted_atom_end(X) --> 
  318.     quoted_atom_car(Y),
  319.     quoted_atom_end(Z),
  320.     #(  X = strcon(Y,Z)) ?
  321.  
  322. quoted_atom_car(Y) -->
  323.     [X], #( Y = charac(X) ) ?
  324.  
  325.  
  326. %
  327. % Numbers
  328. %
  329.  
  330. number(X) --> 
  331.     digits(V1),
  332.     ( [46], digits(V2,length => L2), !;
  333.           #( V2 = 0, L2= 0) ),
  334.     ( [101], !,exponent(E) ;
  335.       #(E = 0) ),
  336.     #( X = (V1 + V2 * 10^(-L2)) * 10^(E)) ?
  337.  
  338. digits(V, length=>L) --> 
  339.     digit( V1), 
  340.     ( digits(V2, length=>L2),!,
  341.       #( L = L2+1, V = V1*10^L2 + V2) ;
  342.           #( V = V1, L = 1)) ?
  343.  
  344. sign(-1) --> [45],! ?
  345. sign(1)  --> [43],! ?
  346. sign(1)  --> [] ?
  347.  
  348. exponent(V) --> sign(S), digits(V1), #(V = S*V1) ?
  349.  
  350. digit(N)    --> [48+N], #(N =< 9 and N >= 0)  ?
  351.  
  352.  
  353. %
  354. % Strings
  355. %
  356.  
  357. token34(chaine(X)) --> 
  358.     [_],
  359.         car_chaine_end(X) ?
  360.  
  361. car_chaine_end(X) --> 
  362.     [34], !,
  363.     ( [34], !,car_chaine_end(Y), #(X = strcon("""",Y)) ; 
  364.           # ( X = "" )) ?
  365. car_chaine_end(X) --> 
  366.     car_chaine_car(Y),
  367.     car_chaine_end(Z),
  368.     #(  X = strcon(Y,Z)) ?
  369.  
  370. car_chaine_car(Y) -->
  371.     [X], #( Y = charac(X) ) ?
  372.  
  373.  
  374. %
  375. % op_atoms
  376. %
  377. op_atom_car(X) -->
  378.     [Y],
  379.     #( cond( Y >= 33,
  380.              cond(    Y =< 38 and Y =\= 34 or Y =:= 42 
  381.                    or Y =:= 43 or Y =:= 45 or Y =:= 47,
  382.                3 => cond( Y >= 58,
  383.                           cond( Y =< 62,
  384.                             Y =\= 59,
  385.                     Y =:= 92 or Y =:= 94 or Y=:= 126),
  386.                   fail)),
  387.              fail),
  388.            X = charac(Y)) ?
  389.  
  390. op_atom_cars(X) --> 
  391.     op_atom_car(Y),!, 
  392.     op_atom_cars(Z),
  393.     #(  X = strcon(Y,Z)) ?
  394. op_atom_cars("") -->
  395.     [] ?
  396.  
  397.  
  398. token33( simple_atom(X)) --> 
  399.     [_],
  400.     op_atom_cars(Z),
  401.     #(  X = strcon("!",Z)) ?
  402. token35( simple_atom(X)) --> 
  403.     [_],
  404.     op_atom_cars(Z),
  405.     #(  X = strcon("#",Z)) ?
  406. token36( simple_atom(X)) --> 
  407.     [_],
  408.     op_atom_cars(Z),
  409.     #(  X = strcon("$",Z)) ?
  410. token37( simple_atom(X)) --> 
  411.     [_],
  412.     op_atom_cars(Z),
  413.     #(  X = strcon("%",Z)) ?
  414. token38( simple_atom(X)) --> 
  415.     [_],
  416.     op_atom_cars(Z),
  417.     #(  X = strcon("&",Z)) ?
  418. token42( simple_atom(X)) --> 
  419.     [_],
  420.     op_atom_cars(Z),
  421.     #(  X = strcon("*",Z)) ?
  422. token43( simple_atom(X)) --> 
  423.     [_],
  424.     op_atom_cars(Z),
  425.     #(  X = strcon("+",Z)) ?
  426. token45( simple_atom(X)) --> 
  427.     [_],
  428.     op_atom_cars(Z),
  429.     #(  X = strcon("-",Z)) ?
  430. token47( simple_atom(X)) --> 
  431.     [_],
  432.     op_atom_cars(Z),
  433.     #(  X = strcon("/",Z)) ?
  434. token58( simple_atom(X)) --> 
  435.     [_],
  436.     op_atom_cars(Z),
  437.     #(  X = strcon(":",Z)) ?
  438. token60( simple_atom(X)) --> 
  439.     [_],
  440.     op_atom_cars(Z),
  441.     #(  X = strcon("<",Z)) ?
  442. token61( simple_atom(X)) --> 
  443.     [_],
  444.     op_atom_cars(Z),
  445.     #(  X = strcon("=",Z)) ?
  446. token62( simple_atom(X)) --> 
  447.     [_],
  448.     op_atom_cars(Z),
  449.     #(  X = strcon(">",Z)) ?
  450. token92( simple_atom(X)) --> 
  451.     [_],
  452.     op_atom_cars(Z),
  453.     #(  X = strcon("\",Z)) ?
  454. token94( simple_atom(X)) --> 
  455.     [_],
  456.     op_atom_cars(Z),
  457.     #(  X = strcon("^",Z)) ?
  458. token126( simple_atom(X)) --> 
  459.     [_],
  460.     op_atom_cars(Z),
  461.     #(  X = strcon("~",Z)) ?
  462.  
  463.  
  464. charac(Z) -> psi2str(chr(Z)) .
  465. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  466. %
  467. % GRAMMAR FOR ARITHMETIC EXPRESSIONS WITH DYNAMIC OPERATORS
  468. %
  469. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  470.  
  471.  
  472. %
  473. % list_express recognizes lists of expressions separated by dots
  474. %
  475.  
  476. list_express( list=>[A|B]) --> 
  477.     expr( tree => A, rest => L),
  478.     ["."], !,
  479.     list_express( list => B ) ?
  480.  
  481. list_express( list => []) --> ! ?
  482. list_express( list => [error]).
  483.     
  484. %
  485. % a term is a number or a variable (use the Life tokenizer)
  486. %
  487.  
  488.  
  489. term( tree => X) --> [numb(X)],!  ?
  490. term( tree => X) --> [variable(X)] ?
  491.  
  492. %
  493. % expressions
  494. %
  495.  
  496. expr( tree => Tree) --> ["("], !, expr( tree => Tree) , [")"] ?
  497. expr( max => Max, tree => Tree)    -->
  498.     start_expr( M, max => Max, tree => T),
  499.     end_expr( M, max => Max, left => T, tree => Tree) ?
  500.  
  501.  
  502. start_expr( 0, tree => T) --> term( tree => T), ! ?
  503. start_expr( M, max => Max, tree => Tree) -->
  504.     oper( prefix, M, Name, right_strict => S),
  505.     #(M =< Max),!,
  506.     expr( max => preced(S,M), tree => T),
  507.     #( Tree = Name&@(T) ) ?
  508.  
  509. end_expr( MLeft, max => Max, left => L, tree => T)  --> 
  510.     sub_expr( M, Mleft, max => Max, left => L, tree => T1),!,
  511.     end_expr( M, max => Max, left => T1, tree => T) ?
  512. end_expr( left => T, tree => T) --> [] ?
  513.  
  514. sub_expr(M, Mleft, max => Max, left => L, tree => Tree) --> 
  515.     oper( Type, M, Name, left_strict => LS, right_strict => RS),
  516.     #( M =< Max,
  517.        Mleft =< preced(LS,M)),
  518.     (
  519.         #( Type = postfix,!,
  520.            Tree = Name&@(L) )
  521.     ;
  522.         #( Type = infix),
  523.         expr( max => preced(RS,M), tree => R),
  524.         #( Tree = Name&@(L,R)) 
  525.     )?
  526.  
  527.  
  528. %
  529. % operators: any Life operator may be used
  530. %
  531.  
  532. oper( Type, P, Name, 
  533.       left_strict => LS, 
  534.       right_strict => RS) -->
  535.     [atom(Name)],
  536.     # (
  537.          op_member(ops,Precedence,T,Name),
  538.          P = Precedence,
  539.          cond( T :== xfx,
  540.                ( LS = true, RS = true, Type = infix),
  541.          cond( T :== xfy,
  542.                ( LS = true, RS = false,  Type = infix),         
  543.          cond( T :== yfx,
  544.                ( LS = false,  RS = true, Type = infix),
  545.              cond( T :== fx,
  546.                ( RS = true,  Type = prefix),
  547.          cond( T :== fy,,
  548.                ( RS = false, Type = prefix), 
  549.          cond( T :== xf,
  550.                ( LS = true,  Type = postfix),
  551.          cond( T :== yf,,
  552.                ( LS = false, Type = postfix))))))))
  553.           ) ?
  554.  
  555. preced(true,M) -> M-1.
  556. preced(false,M) -> M.
  557.  
  558. op_member([op(P1,T1,Oper)|OOps],Precedence,Type,Name) :-
  559.     (
  560.         Name = psi2str(`Oper), Precedence = P1, Type = T1;
  561.         op_member(OOps, Precedence,Type,Name)
  562.     ).
  563.  
  564.     
  565.  
  566.  
  567.  
  568.  
  569.