home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / TESTS / LF / Z_GCTOKE.LF < prev    next >
Text File  |  1996-06-04  |  10KB  |  496 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. % non_strict(setq)?
  12. % 
  13. % setq(X,V) :- Value = eval(V), retract((X->@)), !, assert((X->Value)).
  14. % setq(X,V) :- dynamic(X), Value = eval(V), assert((X->Value)).
  15. % 
  16.  
  17. (Lhs --> Rhs) :- R = compileRule( Lhs, Rhs), assert(R).
  18.  
  19. %
  20. % compileRule: translates the grammar rules into clauses
  21. %
  22.  
  23. non_strict(compileRule) ?
  24. compileRule( Lhs, Rhs) -> 
  25.     (compileSymbols( Lhs, false, false, Xs, Ys, _) :- 
  26.          compileSeq( Rhs, true,  false, Xs, Ys, _)).
  27.  
  28. %
  29. % compileSeq is used to translate a sequence of symbols of the grammar into a
  30. % sequence of literals.
  31. %
  32.  
  33. compileSeq( Symbols, FoldOk, InDisj, Xs, Ys, NewFoldOk) -> 
  34.     cond( Symbols :== @,
  35.           `varSymbol( Symbols, words => Xs, rest => Ys) 
  36.       | NewFoldOk = FoldOk,
  37.           compileSymbols( Symbols, FoldOk, InDisj, Xs, Ys, NewFoldOk)).
  38.  
  39. %
  40. % compileSymbols is used to translate non-variable symbols.
  41. %
  42.  
  43. % conjunction
  44.   compileSymbols( ( Symb, Autres), FoldOk, InDisj, Xs, Ys, NewFoldOk) ->
  45.     compileSeq( Symb,   FoldOk,      InDisj, Xs, Ys1, InterFoldOk) comma 
  46.         compileSeq( Autres, InterFoldOk, InDisj, Ys1, Ys, NewFoldOk).
  47.  
  48. % disjunction
  49.   compileSymbols( ( List1 ; List2), FoldOk, _, Xs, Ys, NewFoldOk) -> 
  50.     X | Z = compileSeq( List1, FoldOk, true, Xs, Ys, InterFoldOk1),
  51.             T = compileSeq( List2, FoldOk, true, Xs, Ys, InterFoldOk2),
  52.             NewFoldOk = InterFoldOk1 and InterFoldOk2,
  53.         X = `( Z ; T ), 
  54.         ! .
  55.                                    
  56. % terminals
  57.   compileSymbols( Terms: list, true, false, Xs, Ys, NewFoldOk) -> 
  58.     succeed | Xs = termSequence(Terms, Ys), NewFoldOk = true.
  59.   compileSymbols( Terms: list, FoldOk, _, Xs, Ys, NewFoldOk) -> 
  60.     Xs = termSequence(Terms, Ys) | NewFoldOk = FoldOk.
  61.  
  62. % cut
  63.   compileSymbols( !, FoldOk, false, Xs, Ys, NewFoldOk) -> 
  64.     ! | NewFoldOk = false, Xs = Ys.  
  65.   compileSymbols( !, FoldOk, true, Xs, Ys, NewFoldOk) -> 
  66.     Xs = Ys, ! | NewFoldOk = false.
  67.  
  68. % insertion of code
  69.  
  70.   compileSymbols( Term: #, FoldOk, false, Xs, Ys, NewFoldOk)  -> 
  71.     transLifeCode( Term) | Xs = Ys, NewFoldOk = false.
  72.   compileSymbols( Term: #, FoldOk, true, Xs, Ys, NewFoldOk)  -> 
  73.     Xs = Ys, transLifeCode( Term) | NewFoldOk = false.
  74.  
  75.  
  76. % non-terminals
  77.   compileSymbols(NonTerm, FoldOk, _, Xs, Ys, NewFoldOk)    -> 
  78.     NonTerm  | NonTerm = @( words => Xs, rest => Ys), NewFoldOk = FoldOk.
  79.  
  80.  
  81. %
  82. % Inserting Life code
  83. %
  84.  
  85. transLifeCode( L) -> transList( feats(L)).
  86.  
  87. % For map:
  88. my_project(A,B) -> B.A.
  89.  
  90. feats(L) -> map( my_project( 2 => L), features(L)).
  91.  
  92. transList( []) ->  succeed.
  93. transList( [A|B]) -> A comma transList( B).
  94.  
  95. %
  96. % handling terminals
  97. %
  98.  
  99. termSequence( [], Ys)     -> Ys.
  100. termSequence( [T|Ts], Ys) -> [T|termSequence( Ts, Ys)].
  101.  
  102. %
  103. % This definition is used at run-time to evaluate variable symbols
  104. %
  105.  
  106. varSymbol( X:list, words => Xs, rest => Ys) -> 
  107.     Xs = termSequence( X, Ys). 
  108. varSymbol( X, words => Xs, rest => Ys) -> 
  109.     X | X = @( words => Xs, rest => Ys).
  110.  
  111.  
  112. %
  113. % getting rid of unnecessary succeed statements
  114. %
  115.  
  116. succeed comma A -> A .
  117. A comma succeed -> A .
  118. A comma B -> A , B.
  119. readf( File ) -> 
  120.     L 
  121.     |   open_in(File,S),
  122.     read_all(L),
  123.     close(S).
  124.  
  125. read_all(L) :-
  126.         get(X),
  127.         cond( X :=< end_of_file , 
  128.               L=[] ,
  129.               ( read_all(Y), L=[X|Y])).
  130.  
  131. %
  132. % load selectif
  133. %
  134.  
  135. loadl(X)  :- 
  136.     ( 
  137.     loadpath(X,".lf") ;
  138.     loadpath(X,".life")  
  139.     ), !.
  140. loadl(F) :-
  141.     write("*** File ",F,".l.. not found."), nl.
  142. loadin(X) :- loadpath(X,".in"), !.
  143. loadin(F) :-
  144.     write("*** File ",F,".in not found."), nl.
  145. loadgr(X) :- loadpath(X,".gr"), !.
  146. loadgr(F) :-
  147.     write("*** File ",F,".gr not found."), nl.
  148.  
  149.  
  150. loadpath(X:string,Suffix) :- 
  151.     !,
  152.     Y = load_path,
  153.     Z=strcon(strcon(Y,X), Suffix),
  154.     exists(Z),
  155.         !,
  156.     load_if_needed(Z).
  157.  
  158. loadpath(X,Suffix) :- loadpath(psi2str(X),Suffix).
  159.  
  160.  
  161.  
  162. %
  163. %  map function, from left to right.
  164. %
  165. lrmap(F,[]) -> [].
  166. lrmap(F,[E|L]) -> [F(E)|L1] | L1=lrmap(F,L).
  167.  
  168. %
  169. % For compatibility with old versions
  170. %
  171.  
  172. op(670,xfx,isa)?
  173. X isa Y -> (X :=< Y).
  174.  
  175. %
  176. % setq for predicates
  177. %
  178. setPred(A,B) :-
  179.         C = eval(B),
  180.         retract(A),
  181.         !,
  182.         U=root_sort(A),
  183.         U=@(C),
  184.         assert(U).
  185. setPred(A,B) :-
  186.         dynamic(A),
  187.         C = eval(B),
  188.         U=A,
  189.         U=@(C),
  190.         assert(U).
  191.  
  192. non_strict(setPred)?
  193.  
  194. %
  195. % pi !
  196. % 
  197. pi -> 3.14159265359 .
  198.  
  199. %
  200. % Opens  default_display and default_window.
  201. %
  202.  
  203. initWindow(DX:{700;real},DY:{700;real},
  204.            x=> X, y=>Y,
  205.            color => C,
  206.            windowtitle => T ,
  207.            permanent => B:{false ; bool }) :-  !,
  208.     x_window( DX, DY, x=>X, y=>Y, 
  209.                      title => T ,color=>C, permanent => B).
  210.  
  211.      
  212.  
  213. %
  214. % Produit d'une matrice 2x2 avec une matrice 2X1
  215. %
  216.  
  217. xmat2((X1,Y1),(X2,Y2),A,B) -> (A*X1+B*X2,A*Y1+B*Y2).
  218.  
  219.  
  220. %
  221. % setq Economique
  222. %
  223.  
  224. setEco(A,B) :- retract(A->@),
  225.                assert(A->B).
  226.  
  227. non_strict(setEco)?
  228.  
  229.  
  230. %
  231. %  make a new root from an old one and a suffix
  232. %
  233. suffixRoot(P,S:string) -> str2psi(strcon(psi2str(P),S)).
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242. %
  243. % Tokenizer for Life
  244. %
  245.  
  246. main :- tokenize("LF/z_gctoken1.lf").
  247.  
  248. tokenize(File) :- 
  249.         W = readf(File), 
  250.     setq(rest,[]), setq(listTokens,[]),
  251.     tokens(words => W, rest => []).
  252.  
  253.  
  254. dynamic(tokens) ?
  255.  
  256. tokens([],words=>[]) :- !.
  257. tokens(T) --> 
  258.     tokenN(L), 
  259.     tokens(Ls), 
  260.     #( T = append(L,Ls)) ?
  261.  
  262. tokenN( TokenNs, rest => RestN, words => Words) :-
  263.         token_N( Tokens, 50, rest => Rest, words => Words),
  264.         setEco(rest,Rest),
  265.         setEco(listTokens,Tokens),
  266.         fail ; 
  267.         TokenNs = listTokens,
  268.         RestN = rest.
  269.  
  270. token_N( [], 0) --> ! ?
  271. token_N( Tokens, Counter) -->
  272.     void_chars,
  273.     (
  274.         token( Token),
  275.         !, 
  276.         token_N( NewToks, Counter - 1),
  277.         #( Tokens = [ Token| NewToks]) ;
  278.         #( Tokens = [])
  279.     ) ?
  280.  
  281. void_chars --> [{32;9;10}],!, void_chars ?         % blanc, tab, return
  282. void_chars --> [37],!, comment_chars, void_chars ? % commentaires
  283. void_chars --> [] ?
  284.  
  285. comment_chars --> [10], ! ?                     % un commentaire s'arrete avec
  286.                         % return.
  287. comment_chars --> [X], comment_chars ?
  288.  
  289.  
  290.  
  291. dynamic(token) ?
  292.  
  293. token( words => []) :- !, fail.
  294. token(T) --> 
  295.     ( 
  296.         variable(Y), 
  297.         #( !, T = variable(Y)) ;
  298.         syntact_object(Y), 
  299.         #( !, T = syntact_object(Y)) ;
  300.         construct( Y, type => Z), 
  301.         #( T = construct( Y, type => Z))
  302.     ) ?
  303.  
  304.  
  305. %
  306. %
  307. % variables
  308. % 
  309. %
  310.  
  311. variable(_) -->                               % @
  312.     [64], ! ?          
  313. variable(X) -->                               % _...
  314.     [95], !,
  315.     simple_atom_cars(Y), 
  316.     #((Y = "", ! ); X = strcon("_",Y)) ?
  317. variable(X) -->                               % M...
  318.     majuscule(Y), 
  319.     simple_atom_cars(Z), 
  320.     #( X = strcon(Y,Z)) ?
  321.  
  322.  
  323. %
  324. %
  325. % syntactic objects
  326. %
  327. %
  328.  
  329. syntact_object(X) --> 
  330.     [Y:{40;41;44;46;59;63;91;93;123;124;125}],
  331.     #( !, X = charac(Y)) ?
  332.  
  333.  
  334.  
  335. %
  336. %
  337. % constructors
  338. %
  339. %
  340.  
  341.  
  342. construct( Y, type=>T) --> 
  343.     quote(Y), #( !, T = quote);
  344.     simple_atom(Y), #( !, T = simple_atom); 
  345.     quoted_atom(Y), #( !, T = quoted_atom); 
  346.     number(Y), #( !, T = number);
  347.     car_chaine(Y), #( !, T = car_chaine); 
  348.     op_atom(Y), #( !, T = op_atom) ?
  349.  
  350. %
  351. % quote
  352. %
  353.  
  354. quote("`") --> [96] ?
  355.  
  356. %
  357. % simple atoms
  358. %             
  359.  
  360. simple_atom(X) --> 
  361.     minuscule(Y), 
  362.     simple_atom_cars(Z), 
  363.     #( X = strcon(Y,Z)) ?
  364.  
  365. simple_atom_cars(Z) --> 
  366.     simple_atom_car(X), !,
  367.     simple_atom_cars(Y), 
  368.     #( Z = strcon(X,Y)) ?
  369. simple_atom_cars("") --> [] ?
  370.  
  371. simple_atom_car(X) --> 
  372.     [Y], 
  373.     #( Y >= 48,
  374.        cond( Y =< 57,                                  % chiffre
  375.                  succeed,
  376.                  ( 
  377.              Y >= 65 , 
  378.              cond( Y =< 90 ,                       % majuscule
  379.                    succeed,
  380.                cond( Y =:= 95,                 % underscore
  381.                  succeed,
  382.                  ( Y >= 97 , Y =< 122)))   % minuscule
  383.          )
  384.           ),
  385.       X = charac(Y)) ?
  386.  
  387. %
  388. % quoted atoms
  389. %
  390.  
  391. quoted_atom(X) --> 
  392.     [39],
  393.         quoted_atom_end(X) ?
  394.  
  395. quoted_atom_end(X) --> 
  396.     [39], !,
  397.     ( [39], quoted_atom_end(Y), X = strcon("'",Y) ; 
  398.           # ( X = "" )) ?
  399. quoted_atom_end(X) --> 
  400.     quoted_atom_car(Y),
  401.     quoted_atom_end(Z),
  402.     #(  X = strcon(Y,Z)) ?
  403.  
  404. quoted_atom_car(Y) -->
  405.     [X], #( Y = charac(X) ) ?
  406.  
  407.  
  408. %
  409. % Numbers
  410. %
  411.  
  412. number(X) --> 
  413.     digits(V1),
  414.     ( [46], digits(V2,length => L2), !;
  415.           #( V2 = 0, L2= 0) ),
  416.     ( [101], !,exponent(E) ;
  417.       #(E = 0) ),
  418.     #( X = (V1 + V2 * 10^(-L2)) * 10^(E)) ?
  419.  
  420. digits(V, length=>L) --> 
  421.     digit( V1), 
  422.     ( digits(V2, length=>L2),!,
  423.       #( L = L2+1, V = V1*10^L2 + V2) ;
  424.           #( V = V1, L = 1)) ?
  425.  
  426. sign(-1) --> [45],! ?
  427. sign(1)  --> [43],! ?
  428. sign(1)  --> [] ?
  429.  
  430. exponent(V) --> sign(S), digits(V1), #(V = S*V1) ?
  431.  
  432. digit(N:int) --> [48+N], #(N =< 9, N >= 0)  ?
  433.  
  434.  
  435. %
  436. % Strings
  437. %
  438.  
  439. car_chaine(X) --> 
  440.     [34],
  441.         car_chaine_end(X) ?
  442.  
  443. car_chaine_end(X) --> 
  444.     [34], !,
  445.     ( [34], !,car_chaine_end(Y), #(X = strcon("""",Y)) ; 
  446.           # ( X = "" )) ?
  447. car_chaine_end(X) --> 
  448.     car_chaine_car(Y),
  449.     car_chaine_end(Z),
  450.     #(  X = strcon(Y,Z)) ?
  451.  
  452. car_chaine_car(Y) -->
  453.     [X], #( Y = charac(X) ) ?
  454.  
  455.  
  456. %
  457. % op_atoms
  458. %
  459.  
  460. op_atom(X) --> 
  461.     op_atom_car(Y),!, 
  462.     op_atom_cars(Z),
  463.     #(  X = strcon(Y,Z)) ?
  464.  
  465. op_atom_car(X) -->
  466.     [Y:{33;35;36;37;38;42;43;45;47;58;60;61;62;92;94;126}],!,
  467.     #( X = charac(Y)) ?
  468.  
  469. op_atom_cars(X) --> 
  470.     op_atom_car(Y),!, 
  471.     op_atom_cars(Z),
  472.     #(  X = strcon(Y,Z)) ?
  473. op_atom_cars("") -->
  474.     [] ?
  475.                       
  476.  
  477. minuscule(Y) --> [X], #( X >= 97, X =< 122, Y = charac(X) ) ?
  478. majuscule(Y) --> [X], #( X >= 65, X =< 90,  Y = charac(X) ) ?
  479.  
  480. charac(Z) -> chr(Z).
  481.  
  482.  
  483.  
  484.  
  485.  
  486.  
  487.  
  488.  
  489.  
  490.  
  491.  
  492.  
  493.  
  494.  
  495.  
  496.