home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / TOOLS / ACCUMULA.LF < prev    next >
Text File  |  1996-06-04  |  30KB  |  1,155 lines
  1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2. %
  3. %                   EXPANDING ACCUMULATORS AND HIDDEN ARGUMENTS
  4. %
  5. % This file contains a preprocessor to add automatically accumulators and
  6. % passed arguments to predicates; in particular, it may be used to write DCG
  7. % like rules, in which psi-terms replace the standard prolog terms.
  8. %
  9. % All the necessary files are automatically loaded if they are in the same
  10. % directory.
  11. %
  12. % AUTHOR
  13. %
  14. % Bruno Dumant
  15. %
  16. % Copyright 1992-1993 Digital Equipment Corporation
  17. % All Rights Reserved
  18. %
  19. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  20. %    $Id: accumulators.lf,v 1.2 1994/12/08 23:49:47 duchier Exp $    
  21.  
  22. module("accumulators") ?
  23.  
  24. import("std_expander") ?
  25. open("acc_declarations") ? 
  26.  
  27. public(  --> , :--,
  28.      grammars_expander,accumulators_expander,
  29.      with, is, insert, inv, glob, init,
  30.      acc_info, pred_info, pass_info, clear_acc_def,
  31.      acc_auto,
  32.      in, out, dcg,
  33.      set_C, reset_C,
  34.      std_expander,comma,define,macro,
  35.      clauses,context,code,check_expansion,meta) ?
  36.  
  37. %%% operators
  38. op(1200,xfy,-->) ?
  39. non_strict(-->) ?
  40.  
  41. op(1200,xfy,:--) ?
  42. non_strict(:--) ?
  43.  
  44. op(500,xfy,=>) ?
  45. op(800,xfy,with) ?
  46. op(700,xfx,is)?
  47.  
  48. op( 1100, xfy, point_virgule) ?
  49.  
  50. %%% persistent and global variables
  51.  
  52. persistent(macros_table) ?
  53. persistent('C_function_name') ?
  54.  
  55. global(file,line,gram) ?
  56.  
  57.  
  58. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  59. %
  60. % main predicates
  61. %
  62. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  63.  
  64.  
  65. std_expander(accumulators_expander,
  66.          leaf => acc_leaf,
  67.          save => acc_save,
  68.          merge => acc_merge,
  69.          head => acc_head,
  70.          init => acc_init) ?
  71.  
  72. std_expander(grammars_expander,
  73.          leaf => acc_leaf,
  74.          save => gram_save,
  75.          merge => acc_merge,
  76.          head => acc_head,
  77.          init => gram_init)?
  78.  
  79. acc_init(in_clauses => Cl,out_clauses => Cl,
  80.      file => File,line => Line) :-
  81.     file = {File;"?"},
  82.     line = {Line;"?"},!,
  83.     gram <- false.
  84.  
  85. gram_init(in_clauses => Cl,out_clauses => Cl,
  86.       file => File,line => Line) :-
  87.     file = {File;"?"},
  88.     line = {Line;"?"},!,
  89.     gram <- true.
  90.  
  91. acc_head(Lhs,Lhs,
  92.      in_code => Code,out_code => Code,
  93.      in_context => InContext,out_context => OutContext,
  94.      in_clauses => Cl,out_clauses => Cl) :-
  95.         PredName = root_sort(Lhs),
  96.     ContextParams = list_of_accs(PredName,gram),
  97.      bind_params(ContextParams, Lhs, In, Out, Pass),
  98.     InContext.accs = In,
  99.     InContext.fold = true, 
  100.     InContext.pass = Pass,
  101.     OutContext.accs = Out, 
  102.     OutContext.pass = Pass,
  103.     OutContext.fold = @.
  104.  
  105. acc_save(in_code => Code1,out_code => Code2,
  106.      in_context => @(accs => In,pass => Pass,fold => Fold),
  107.      out_context => @(accs => Out,pass => Pass,fold => Fold)
  108.     ) :-
  109.     Code1 = (link_accs(features(In),false,In,Out) comma Code2).
  110.             
  111. gram_save(in_code => Code1,out_code => Code2,
  112.       in_context => @(accs => In,pass => Pass,fold => Fold),
  113.       out_context => @(accs => Out,pass => Pass,fold => NewFold)
  114.      ) :-
  115.     Code1 = (link_other_accs( features(In),
  116.                   false,dcg,In,Out)
  117.          comma Code2),
  118.     In.dcg = Out.dcg,
  119.     NewFold = false(false).
  120.             
  121. acc_merge(in_code => Code,out_code => Code,
  122.       in1 => @(accs => In,pass => Pass,fold => Fold1), 
  123.       in2 => @(accs => In,pass => Pass,fold => Fold2),
  124.       out => @(accs => In,pass => Pass,fold => Fold)) :-
  125.     Fold = Fold1 and Fold2.
  126.  
  127. acc_leaf(Leaf,
  128.      in_code => Code1,out_code => Code2,
  129.      in_clauses => Cl,out_clauses => Cl,
  130.      in_context => Co1,out_context => Co2) :-
  131.     ( has_feature(Leaf,acc_expand_pred_table,Pred),!,
  132.       root_sort(Pred) & @(Leaf,
  133.                   in_code => Code1,out_code => Code2,
  134.                   in_context => Co1,out_context => Co2)
  135.     ;
  136.       acc_pred_xpand(Leaf,
  137.              in_code => Code1,out_code => Code2,
  138.              in_context => Co1,out_context => Co2)
  139.     ).
  140.  
  141. persistent(acc_expand_pred_table) ?
  142. non_strict(add_pred) ?
  143.  
  144. add_pred(Symbol,Pred) :-
  145.     acc_expand_pred_table.psi2str(Symbol) <<- Pred.
  146.  
  147.  
  148. add_pred([],xpand_acc_dcg) ?
  149. add_pred(cons,xpand_acc_dcg) ?
  150. add_pred(!,xpand_cut) ?
  151. add_pred(disj,xpand_code) ?
  152. add_pred(with,xpand_with) ?
  153. add_pred((+),xpand_acc) ?
  154. add_pred(is,xpand_unif) ?
  155. add_pred(insert,xpand_insert) ?
  156. add_pred(meta,xpand_meta) ?
  157. add_pred(@,xpand_interpret) ?
  158.     
  159. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  160. %
  161. % translation of the symbols
  162. %
  163. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  164.  
  165. %%% accumulating 
  166.  
  167. non_strict(xpand_acc) ?
  168.  
  169. xpand_acc(A+B,
  170.       in_code => Code1,out_code => Code2,
  171.       in_context => @(accs => In,pass => Pass,fold => Fold),
  172.       out_context => @(accs => Out,pass => Pass,fold => Fold)) :-  
  173.     (
  174.         get_pass_info(B,A,Val,acc_pred => AccPred),!,
  175.         (
  176.         AccPred :< @,!,
  177.         cond( has_feature(B,Pass,Passed),
  178.               Passed = Val,
  179.               out_of_context_warning(B)
  180.             )
  181.         ;
  182.         accumulation_error(B)
  183.         )
  184.     ;    
  185.         get_acc_info(B,A,InAcc,OutAcc,acc_pred => AccPred),!,
  186.         (
  187.         AccPred :< @,!,
  188.         cond(  has_feature(B,In,InAcc),
  189.                Out.B = OutAcc,
  190.                out_of_context_warning(B)
  191.             )
  192.         ;
  193.             accumulation_error(B)
  194.         )
  195.     ;
  196.         non_declared_error(B)
  197.     ),
  198.     Code1 = (link_other_accs(features(In,current_module),
  199.                    true, B, In, Out) 
  200.          comma AccPred
  201.          comma Code2).
  202.  
  203. %%% accumulate in dcg
  204.  
  205. xpand_acc_dcg(Terms,
  206.           in_code => Code1,out_code => Code2,
  207.           in_context => @(accs => In,pass => Pass,fold => Fold),
  208.           out_context => @(accs => Out,pass => Pass,fold => true)) :-
  209.         cond( has_feature(dcg,In,Xs),
  210.           (
  211.           C = 'C'(Terms,Fold,Xs,Ys),
  212.           Out.dcg = Ys
  213.           ),
  214.           out_of_context_warning(dcg)
  215.         ),
  216.     Code1 = (link_other_accs(features(In),true,dcg,In,Out) 
  217.          comma C
  218.          comma Code2). 
  219.  
  220.  
  221. %%% unify with the current value of an accumulator or passed argument
  222.  
  223. xpand_unif(A is B,
  224.        in_code => Code1,out_code => Code2,
  225.        in_context => @(accs => In,pass => Pass,fold => Fold),
  226.        out_context => @(accs => Out,pass => Pass,fold => Fold)) :-  
  227.         cond( A :< @ and has_feature(A,In,AIn),
  228.           cond( B :< @ and has_feature(B,In,BIn),
  229.             Expr = (BIn = AIn),
  230.             cond( B :< @ and has_feature(B,Pass,BPass),
  231.               Expr = (BPass = AIn),
  232.               Expr = (AIn = B)
  233.             )
  234.           ),
  235.           cond( A :< @ and has_feature(A,Pass,APass),
  236.             cond( B :< @ and has_feature(B,In,BIn),
  237.               Expr = (BIn = APass),
  238.               cond( B :< @ and has_feature(B,Pass,BPass),
  239.                 Expr = (BPass = APass),
  240.                 Expr = (B = APass)
  241.                   )
  242.             ),
  243.             cond( B :< @ and has_feature(B,In,InB),
  244.               Expr = (A = InB),
  245.               cond( B :< @ and has_feature(B,Pass,BPass),
  246.                 Expr = (A = BPass),
  247.                 non_declared_error2(A,B) 
  248.                   )
  249.             )
  250.           )
  251.         ),
  252.     Code1 = (link_accs(features(In),true,In,Out) comma Expr comma Code2) .
  253.  
  254.  
  255. %%% insert in a chain
  256.  
  257. xpand_insert( insert(X,Y,Acc),
  258.           in_code => Code1,out_code => Code2,
  259.           in_context => @(accs => In,pass => Pass,fold => Fold),
  260.           out_context => @(accs => Out,pass => Pass,fold => Fold)) :-
  261.         cond( has_feature(Acc,In,AccIn),
  262.           Expr = (X = AccIn, Y = Out.Acc),
  263.           non_declared_error(Acc)
  264.         ),
  265.     link_other_accs( features(In,current_module), true, Acc, In, Out),
  266.     Code1 = (Expr comma Code2).
  267.  
  268. %%% cut
  269.  
  270. xpand_cut( _,
  271.        in_code => Code1,out_code => Code2,
  272.        in_context => @(accs => In,pass => Pass,fold => true),
  273.        out_context => @(accs => In,pass => Pass,fold => false)) :-
  274.     Code1 = (!,Code2).
  275.  
  276. xpand_cut( _,
  277.        in_code => Code1,out_code => Code2,
  278.        in_context => @(accs => In,pass => Pass,fold => Bool:false),
  279.        out_context => @(accs => Out,pass => Pass,fold => false)) :-
  280.     cond(   Bool.1 :== false,
  281.             (
  282.             link_other_accs(features(In),true,dcg,In,Out),
  283.             Code1 = (In.dcg = Out.dcg,!,Code2 )
  284.             ),
  285.             ( In = Out, Code1 = (!,Code2) )
  286.         ).
  287.  
  288. %%% insertion of code
  289.  
  290. xpand_code(Term,
  291.        in_code => Code1,out_code => Code2,
  292.        in_context => @(accs => In,pass => Pass,fold => true),
  293.        out_context => @(accs => In,pass => Pass,fold => false)) :-  
  294.     !,Code1 = (transLifeCode(Term) comma Code2).
  295. xpand_code(Term,
  296.        in_code => Code1,out_code => Code2,
  297.        in_context => @(accs => In,pass => Pass,fold => Bool:false),
  298.        out_context => @(accs => Out,pass => Pass,fold => false)) :-
  299.     cond(   Bool.1 :== false,
  300.             (
  301.             link_other_accs(features(In),
  302.                             true,dcg,In,Out),
  303.             Code1 = ( In.dcg = Out.dcg,
  304.                       transLifeCode( Term) comma Code2)
  305.             ),
  306.             ( In = Out, Code1 = (transLifeCode( Term) comma Code2))
  307.         ).
  308.  
  309. %%% meta
  310.  
  311. xpand_meta(meta(NonTerm,ListofParams),
  312.        in_code => Code1,out_code => Code2,
  313.        in_context => @(accs => In,pass => Pass,fold => FoldOk),
  314.        out_context => @(accs => Out,pass => Pass,fold => NewFoldOk)) :-
  315.     cond( Bool:gram,
  316.           NewFoldOk = true,
  317.           NewFoldOk = FoldOk
  318.         ),
  319.     (
  320.         ListofParams = {[];cons},!
  321.     ;
  322.         ListofParams <- [copy_pointer(ListofParams)]
  323.     ),
  324.     (
  325.         Bool,!,
  326.         (
  327.         s_member(ListofParams,dcg),!,
  328.         List = ListofParams 
  329.         ;
  330.         List = [dcg|ListofParams]
  331.         )
  332.     ;
  333.         List = ListofParams
  334.     ),
  335.     part_parameters(List,NonTerm,PredAccs,PredPassed),
  336.         
  337.     %% dealing with accumulators
  338.     part_sort(Fin:features(In,current_module),
  339.           PredAccs,CommonAccs,OnlyContextAccs,NonContextAccs),
  340.     bind_accs(CommonAccs, Args, In, Out),
  341.     init_accs(NonContextAccs, Args),
  342.     
  343.     %% dealing with passed arguments
  344.     part_sort(features(Pass,current_module),
  345.           PredPassed,CommonPass,_,NonContextPass),
  346.     bind_passed(CommonPass, Args, Pass),
  347.     init_passed(NonContextPass, Args),
  348.     
  349.     %% NewTerm
  350.     Code1 =  
  351.     (link_accs(OnlyContextAccs,true,In, Out)
  352.      comma `(NonTerm & Args) comma Code2
  353.     ).
  354.  
  355. %%% non-terminals
  356.  
  357. acc_pred_xpand(NonTerm,
  358.            in_code => Code1,out_code => Code2,
  359.            in_context => @(accs => In,pass => Pass,fold => FoldOk),
  360.            out_context => @(accs => Out,pass => Pass,fold => NewFoldOk)) :-
  361.  
  362.         PredName = root_sort(NonTerm),
  363.     cond( Bool:gram,
  364.           NewFoldOk = true,
  365.           NewFoldOk = FoldOk
  366.         ),
  367.     (
  368.         expandable(PredName),!,
  369.         List = list_of_accs(PredName,Bool),
  370.         part_parameters(List,PredName,PredAccs,PredPassed),
  371.         
  372.         %% dealing with accumulators
  373.         part_sort(Fin:features(In,current_module),
  374.               PredAccs,CommonAccs,OnlyContextAccs,NonContextAccs),
  375.         bind_accs(CommonAccs, NonTerm, In, Out),
  376.         init_accs(NonContextAccs, NonTerm),
  377.         
  378.         %% dealing with passed arguments
  379.         part_sort(features(Pass,current_module),
  380.               PredPassed,CommonPass,_,NonContextPass),
  381.         bind_passed(CommonPass, NonTerm, Pass),
  382.         init_passed(NonContextPass, NonTerm),
  383.         
  384.         %% NewTerm
  385.         Code1 =  
  386.         (link_accs(OnlyContextAccs,true,In, Out)
  387.          comma NonTerm comma Code2
  388.         )
  389.     ;
  390.         (gram,!,
  391.          bind_accs([dcg],NonTerm,In,Out),
  392.          link_other_accs(features(In),true,dcg,In,Out)
  393.         ;
  394.          link_accs(features(In),true,In,Out)
  395.         ),
  396.         Code1 = (NonTerm comma Code2)
  397.     ).
  398.          
  399.          
  400. %%% meta_symbols
  401.  
  402. xpand_interpret(Symbols,
  403.        in_code => Code1,out_code => Code2,
  404.        in_context => @(accs => In,pass => Pass,fold => FoldOk),
  405.        out_context => @(accs => Out,pass => Pass,fold => true)) :-
  406.     Bool = gram,
  407.     CName = root_sort('C_function_name'),
  408.         Code1 =
  409.     ( interpret_symbols(Symbols,
  410.                 in_context => @(accs => In,pass => Pass),
  411.                 out_context => @(accs => Out,pass => Pass),
  412.                 gram => Bool,
  413.                 c_name => CName) comma Code2),
  414.     interpretation_warning,
  415.     Out = create_out(features(In)).
  416.  
  417. %%% Contexts 
  418.  
  419. xpand_with( @(Expression,Constraints),
  420.         in_code => Code1,out_code => Code2,
  421.         in_context => @(accs => In,pass => Pass,fold => FoldOk),
  422.         out_context => @(accs => Out,pass => Pass,fold => NewFoldOk)) :-
  423.         create_context(Constraints,
  424.                    cur_ctxt => CC:@(In,Out,Pass),
  425.                new_ctxt => NC:@(NewIn,NewOut,NewPass),
  426.                globals => Globals,
  427.                used => Used),
  428.     add_other_parameters(NC,CC,Used,Globals),
  429.     accumulators_expander_traverse(Expression,NewExpression,
  430.                        in_code => Code1,
  431.                        out_code => Code2,
  432.                        in_context => @(accs => NewIn,
  433.                                pass => NewPass,
  434.                                fold => FoldOk),
  435.                        out_context => @(accs => NewOut,
  436.                             pass => NewPass,
  437.                             fold => NewFoldOk)).
  438.  
  439.     
  440. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  441. %
  442. % Dealing with contexts.
  443. %
  444. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  445.  
  446.  
  447. create_context(Constraints,
  448.            cur_ctxt => CC,new_ctxt => NC,
  449.            globals => Globals,used => Used) :-                 
  450.     cond( Constraints :== , ,
  451.           create_conjunction(Constraints,      
  452.                  cur_ctxt => CC,new_ctxt => NC,
  453.                  globals => Globals,used => Used),
  454.           cond( Constraints :== with,
  455.             (
  456.             create_context(Constraints.1,
  457.                        cur_ctxt => CC,new_ctxt => NC,
  458.                        globals => Globals,used => Used),
  459.             create_context(Constraints.2,
  460.                        cur_ctxt => CC,new_ctxt => NC,
  461.                        globals => Globals,used => Used)
  462.             ),
  463.             cond( Constraints :== =,
  464.               create_relation(Constraints,      
  465.                       cur_ctxt => CC,new_ctxt => NC,
  466.                       globals => Globals,used => Used),
  467.               @ = create_acc(Constraints,      
  468.                      cur_ctxt => CC,new_ctxt => NC,
  469.                      globals => Globals,used => Used)
  470.             ))).
  471.  
  472. create_conjunction(@(A,B),      
  473.            cur_ctxt => CC,new_ctxt => NC,
  474.            globals => Globals,used => Used) :-
  475.     !,
  476.     create_context(A,      
  477.                    cur_ctxt => CC,new_ctxt => NC,
  478.                globals => Globals,used => Used),
  479.     create_context(B,      
  480.                    cur_ctxt => CC,new_ctxt => NC,
  481.                globals => Globals,used => Used).
  482.  
  483.  
  484. create_relation(@(A,B),      
  485.         cur_ctxt => CC,new_ctxt => NC,
  486.         globals => Globals,used => Used) :-
  487.     !,
  488.     create_acc(A,cur_ctxt => CC,new_ctxt => NC,
  489.            globals => Globals,used => Used) 
  490.     =
  491.     create_acc(B,cur_ctxt => CC,new_ctxt => NC,
  492.            globals => Globals,used => Used).
  493.  
  494. create_acc(A,
  495.        cur_ctxt => CC,new_ctxt => NC,
  496.        globals => Globals,used => Used) ->
  497.         cond( A :== =>,
  498.           create_composition(A,
  499.                  cur_ctxt => CC,new_ctxt => NC,
  500.                  globals => Globals,used => Used),
  501.           cond( A :== glob,
  502.             create_global(A.1,
  503.                   cur_ctxt => CC,new_ctxt => NC,
  504.                   globals => Globals,used => Used),
  505.             cond( A :== inv,
  506.               create_inverse(A.1,
  507.                      cur_ctxt => CC,new_ctxt => NC,
  508.                      globals => Globals,used => Used),
  509.               cond( A :== init,
  510.                 create_init(A.1,A.2,
  511.                         cur_ctxt => CC,new_ctxt => NC,
  512.                         globals => Globals,used => Used),
  513.                 create_local(A,
  514.                          cur_ctxt => CC,new_ctxt => NC,
  515.                          globals => Globals,used => Used)
  516.                   )))).
  517.  
  518.  
  519. create_composition(@(A,B),
  520.            cur_ctxt => CC,new_ctxt => NC,
  521.            globals => Globals,used => Used) -> @(In,Out) |
  522.         In = (Aacc:create_acc(A,
  523.                           cur_ctxt => CC,new_ctxt => NC,
  524.                       globals => Globals,used => Used)).1,
  525.     Out = (Bacc:create_acc(B,
  526.                            cur_ctxt => CC,new_ctxt => NC,
  527.                        globals => Globals,used => Used)).2,
  528.     Aacc.2 = Bacc.1.
  529.  
  530.  
  531. create_global(A,
  532.           cur_ctxt => @(In,Out,Pass),new_ctxt => NC,
  533.           globals => Globals,used => Used) ->
  534.     cond( has_feature(A,In,AIn),
  535.           ( strip(A) & @(AIn,Out.A) | Globals.A = true ),
  536.           ( @ | undefined_global_error(A) )
  537.         ).
  538.  
  539. create_inverse(A,
  540.            cur_ctxt => CC,new_ctxt => NC,
  541.            globals => Globals,used => Used) -> @(Out,In) |
  542.         @(In,Out) = create_acc(A,
  543.                            cur_ctxt => CC,new_ctxt => NC,
  544.                    globals => Globals,used => Used).
  545.  
  546. create_init(Loc,Restriction,
  547.         cur_ctxt => CC,new_ctxt => NC,
  548.         globals => Globals,used => Used) ->
  549.     create_local(Loc,
  550.                  cur_ctxt => CC,new_ctxt => NC,
  551.                  globals => Globals,used => Used) & @(IS,OS) |
  552.     (
  553.         get_pass_info(Loc,start => S),!,
  554.         S = IS
  555.     ;
  556.         get_acc_info(Loc,in_start => IN, out_start => OUT),!,
  557.         cond( Restriction :== in,
  558.           IS = IN,
  559.           cond( Restriction :== out,
  560.             OS = OUT,
  561.             ( IS = IN, OS = OUT)
  562.               )
  563.         )
  564.     ;
  565.         initialization_error(Loc)
  566.     ).
  567.  
  568. create_local(A,
  569.          cur_ctxt => CC,new_ctxt => NC,
  570.          globals => Globals,used => Used) ->
  571.     cond( A :< @,
  572.           cond( is_passed(A),
  573.             (
  574.             A |
  575.             NC.3.A = A.1,
  576.             Used.A = true
  577.             ),
  578.             cond( is_acc(A),
  579.               create_new_local(A,
  580.                        cur_ctxt => CC,new_ctxt => NC,
  581.                        globals => Globals,used => Used),
  582.               (true | non_declared_error(A))
  583.             )
  584.           ),
  585.           strip(A)
  586.         ).
  587.  
  588. create_new_local(A,
  589.          cur_ctxt => CC,new_ctxt => @(In,Out,Pass),
  590.          globals => Globals,used => Used) ->
  591.     strip(A) & @(In.A,Out.A) |
  592.     Used.A = true.
  593.  
  594.  
  595. add_other_parameters(NC:@(NewIn,NewOut,NewPass),
  596.              CC:@(In,Out,Pass),Used,Globals) :-
  597.     add_other_accs(features(In),In,Out,NewIn,NewOut,Used,Globals),
  598.     add_other_passed(features(Pass),Pass,NewPass,Used,Globals).
  599.  
  600. add_other_accs([]) :- !.
  601. add_other_accs([A|B],In,Out,NewIn,NewOut,Used,Globals) :-
  602.     cond( has_feature(A,Used),
  603.           %% a local A has been created: the glob value has to be linked if
  604.           %% it not used.
  605.           cond( has_feature(A,Globals),
  606.             succeed, 
  607.             In.A = Out.A
  608.           ),
  609.           cond( has_feature(A,Globals),
  610.             succeed,
  611.             (            
  612.             In.A = NewIn.A,
  613.             Out.A = NewOut.A
  614.             )
  615.           )
  616.         ),  
  617.     add_other_accs(B,In,Out,NewIn,NewOut,Used,Globals).
  618.  
  619.  
  620. add_other_passed([]) :- !.
  621. add_other_passed([A|B],Passed,NewPassed,Used,Globals) :-
  622.     cond( has_feature(A,Used),
  623.           succeed,          
  624.           cond( has_feature(A,Globals),
  625.             succeed,
  626.             Passed.A = NewPassed.A
  627.           )
  628.         ),  
  629.     add_other_passed(B,Passed,NewPassed,Used,Globals).
  630.  
  631.  
  632.  
  633. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  634. %
  635. % interpreting symbols
  636. %
  637. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  638.  
  639. non_strict(interpret_symbols) ?
  640.  
  641. C:interpret_symbols(Symbols,
  642.             in_context => In,
  643.             out_context => Out,
  644.             gram => G,
  645.             c_name => Name)  :-
  646.     ( Symbols :< @,!,
  647.       CN = root_sort('C_function_name'),
  648.       CG = root_sort(gram),
  649.       set_C(Name),
  650.       gram <- G,
  651.       accumulators_expander_traverse(Symbols,
  652.                      in_code => X,
  653.                      out_code => succeed,
  654.                      in_context => In, 
  655.                      out_context => Out),
  656.       X,
  657.       set_C(CN),
  658.       gram <- CG
  659.     ;
  660.       residuate(Symbols,C)
  661.     ).
  662.  
  663.  
  664. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  665. %
  666. % Macros
  667. %
  668. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  669.  
  670. %%% acc_auto
  671. %%% allows to avoid the + sign, thanks to a new declaration.
  672. %%% should not be documented. Doesn't work with modules.
  673.  
  674. acc_auto(A,B) :-
  675.     make_acc_auto(A,B).
  676.  
  677.  
  678. associate_expanders(acc_auto,acc_auto_expander) ?
  679. acc_auto_expander(acc_auto(A,B),in_clauses => In,out_clauses => In) :-
  680.     make_acc_auto(A,B).
  681.  
  682.  
  683. %%%term_expansion(acc_auto(A,B),[]) :-
  684. %%%    make_acc_auto(A,B).
  685. make_acc_auto([Name1|Names],AccName) :-
  686.     define(Name1,Name1+AccName),
  687.     make_acc_auto(Names,AccName).
  688. make_acc_auto([]).
  689.  
  690.  
  691. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  692. %
  693. % Some debugging
  694. %
  695. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  696.  
  697. std_expander(check_pred,init => acc_init,
  698.          head => check_head,
  699.          leaf => check_leaf) ?
  700.  
  701. check_head(Lhs,Lhs,
  702.        in_code => Code,out_code => Code,
  703.        in_context => Context,out_context => Context,
  704.        in_clauses => Cl,out_clauses => Cl) :-
  705.         ( expandable(Lhs),!,
  706.       non_expanded_warning(Lhs,file,line)
  707.     ;
  708.       succeed
  709.     ).
  710.  
  711. check_leaf(Leaf,
  712.        in_code => Code1,out_code => Code2,
  713.        in_context => Context,out_context => Context,
  714.        in_clauses => Cl,out_clauses => Cl) :-
  715.         ( expandable(Leaf),!,
  716.       non_expanded_warning(Leaf,file,line)
  717.     ;
  718.       succeed
  719.     ),
  720.     Code1 = (Leaf comma Code2).
  721.  
  722.  
  723.  
  724. %%% Toggling check expansion
  725.  
  726. %%%C:check_expansion :-
  727. %%%    (
  728. %%%        has_feature(1,C,X),!,
  729. %%%        (
  730. %%%        X :== @,!,
  731. %%%        X = root_sort(check_expansion_flag)
  732. %%%        ;
  733. %%%        X :== true,!,
  734. %%%        set_check_expansion
  735. %%%        ;
  736. %%%        X :== false,
  737. %%%        reset_check_expansion
  738. %%%        )
  739. %%%    ;
  740. %%%        ( check_expansion_flag,!,
  741. %%%          reset_check_expansion
  742. %%%        ;
  743. %%%          set_check_expansion
  744. %%%        )
  745. %%%    ).
  746.  
  747. check_expansion :-
  748.     set_check_expansion.
  749.  
  750. set_check_expansion :-
  751.     remove_expanders(:-,check_pred),
  752.     add_expanders_a(:-,check_pred,:-),
  753.     set_error_expander,
  754.     check_expansion_flag <<- true.
  755.  
  756. reset_check_expansion :-
  757.     remove_expanders(:-,check_pred),
  758.     reset_error_expander,
  759.     check_expansion_flag <<- false.
  760.  
  761.  
  762. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  763. %
  764. % Predefined accumulators
  765. %
  766. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  767.  
  768. %%% dcg accumulator declaration
  769.  
  770. acc_info( dcg, Term, Xs, Ys, acc_pred => 'C'(Term,false,Xs,Ys)) ?
  771. %%,in_name => 0, out_name => rest) ?
  772.  
  773.  
  774. default_C( Terms: list, true, Xs, Ys ) -> 
  775.     succeed | Xs = termSequence(Terms, Ys).
  776. default_C( Terms: list, false, Xs, Ys) -> 
  777.     Xs = termSequence(Terms, Ys).
  778.  
  779.  
  780. set_C(Function_name) :-
  781.     set_func_arg('C'(Terms,FoldOk,Xs,Ys),
  782.                       Function_name(Terms,FoldOk,Xs,Ys)),
  783.     'C_function_name' <<- `Function_name.
  784.  
  785. reset_C :- 
  786.     set_func_arg('C'(Terms,FoldOk,Xs,Ys), 
  787.                       default_C(Terms,FoldOk,Xs,Ys)),
  788.     'C_function_name' <<- `default_C.
  789.  
  790. dynamic('C') ?
  791. 'C'(Terms,FoldOk,Xs,Ys) ->  
  792.     default_C(Terms,FoldOk,Xs,Ys).
  793.  
  794. 'C_function_name' <<- `default_C ?
  795.  
  796.  
  797. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  798. %
  799. % Standard symbols used
  800. %
  801. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  802.  
  803. associate_expanders(-->,grammars_expander,:-) ?
  804. associate_expanders(:--,accumulators_expander,:-) ?
  805.  
  806. (A :-- B) :-
  807.     accumulators_expander(@(A,B),file => "?",line => "?",
  808.                   in_clauses => Cl,out_clauses => []),
  809.     maprel(assert,Cl).
  810.  
  811.  
  812. (A --> B) :-
  813.     grammars_expander(@(A,B),file => "?",line => "?",
  814.               in_clauses => Cl,out_clauses => []),
  815.     maprel(assert,Cl). 
  816.  
  817.  
  818. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  819. %
  820. % special treatments
  821. %
  822. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  823.  
  824.  
  825. %%% Inserting Life code
  826.  
  827. non_strict(transLifeCode) ?
  828.  
  829. transLifeCode({A|B}) ->  A point_virgule transLifeCode(B).
  830. transLifeCode({}) -> fail.
  831. transLifeCode([]) -> fail.
  832.  
  833.  
  834. %%% dcg accumulator: handling terminals
  835.  
  836. termSequence( [], Ys)     -> Ys.
  837. termSequence( [T|Ts], Ys) -> [T|termSequence( Ts, Ys)].
  838.  
  839. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  840. % Errors
  841. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  842.  
  843. accumulation_error(Acc) :-
  844.     nl_err,
  845.     write_err("*** Error: In file """,file,""" near line ",line),nl_err,
  846.     write_err("    Accumulator ",Acc,
  847.               " has no accumulation predicate."),
  848.     fail.
  849.  
  850. undefined_global_error(A) :-
  851.     nl_err,
  852.     write_err("*** Error: In file """,file,""" near line ",line),nl_err, 
  853.     write_err("           ",A," should appear in global context."),
  854.     fail.
  855.  
  856. initialization_error(A) :-
  857.     nl_err,
  858.     write_err("*** Error: In file """,file,""" near line ",line),nl_err,
  859.     write_err("           No initialization information for accumulator: ",
  860.           A,"."),
  861.     fail.
  862.  
  863. non_declared_error(A) :-
  864.     nl_err,
  865.     write_err("*** Error: In file """,file,""" near line ",line),nl_err,
  866.     write_err("           ",A," is not declared as an accumulator "),
  867.     nl_err,
  868.     write_err("           or a passed argument."),
  869.     fail.
  870.  
  871. non_declared_error2(A,B) :-
  872.     nl_err,
  873.     write_err("*** Error: In file """,file,""" near line ",line),nl_err,
  874.     write_err("           Nor ",A," or ",B," is declared as an ",
  875.           "accumulator "),
  876.     nl_err,
  877.     write_err("           or a passed argument."),
  878.     fail.
  879.  
  880. pred_info_error(Acc,PredName) :-
  881.     nl_err,
  882.     write_err("*** Error: ",Acc," appearing in pred_info(",PredName,")"),
  883.     nl_err,
  884.     write_err("           is not declared as an accumulator ",
  885.           "or a passed argument."),
  886.     fail.
  887.  
  888. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  889. % Warnings
  890. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  891.  
  892. out_of_context_warning(B) :- quiet,!.
  893. out_of_context_warning(B) :-
  894.     nl_err,
  895.     write_err("*** Warning: In file ",file," near line ",line),nl_err,
  896.     write_err("             Attempt to accumulate in ",B,
  897.               " not appearing in the context."),
  898.     nl_err.
  899.  
  900. interpretation_warning :- quiet,!.
  901. interpretation_warning :-
  902.     nl_err,
  903.     write_err("*** Warning: In file ",file," near line ",line),nl_err,
  904.     write_err("             a symbol has to be interpreted."),
  905.     nl_err.
  906.  
  907.  
  908.  
  909. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  910. %
  911. % Dealing with parameters
  912. %
  913. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  914.  
  915.  
  916. %%% bind arguments of a term with In, Out or Pass
  917.  
  918. bind_params([]) :- !.
  919. bind_params( [A|B], X, In, Out, Pass) :-
  920.     bind_param( A, X, In, Out, Pass),
  921.     bind_params( B, X, In, Out, Pass).
  922.  
  923. bind_param(A,X,In,Out,Pass) :-
  924.     (
  925.         is_passed(A),!,
  926.         X.A = Pass.A
  927.     ;
  928.         get_acc_info( A, in_name => InName, out_name => OutName),
  929.         !,
  930.         X.InName = InVal,
  931.         In.A = InVal,
  932.         X.OutName = OutVal,
  933.         Out.A = OutVal
  934.     ;
  935.         pred_info_error(A,root_sort(X))
  936.     ).
  937.  
  938. %%% bind arguments of a term with In, Out
  939.  
  940. bind_accs([]) :- !.
  941. bind_accs( [A|B], X, In, Out) :- 
  942.     bind_acc( A, X, In, Out),
  943.     bind_accs( B, X, In, Out).
  944.  
  945. bind_acc(A,X,In,Out) :-
  946.     (
  947.         get_acc_info(A,in_name => InName,out_name => OutName)
  948.     ;
  949.         InName = strcon("in_",psi2str(A)),
  950.         OutName = strcon("out_",psi2str(A))
  951.     ),!,
  952.     X.InName = InVal,
  953.     In.A = InVal,
  954.     X.OutName = OutVal,
  955.     Out.A = OutVal.
  956.  
  957. %%% bind arguments of a term with Pass
  958.  
  959. bind_passed([]) :- !.
  960. bind_passed( [A|B], X, Pass) :- 
  961.     X.A = Pass.A,
  962.     bind_passed( B, X, Pass).
  963.  
  964. %%% link all accumulators of a list but one
  965.  
  966. link_other_accs([],_,C,In,Out) -> succeed |
  967.         cond( has_feature(C,In),
  968.           Out.C = @).
  969. link_other_accs([A|B],true,C,In,Out) -> succeed |
  970.     cond( A :\== C,
  971.           In.A = Out.A),
  972.     link_other_accs(B,true,C,In,Out).
  973. link_other_accs([A|B],false,C,In,Out) -> R |
  974.     cond( A :\== C,
  975.           (
  976.           Tin.A = In.A,
  977.           Tout.A = Out.A
  978.           )
  979.         ),
  980.     link_other_accs_false(B,C,In,Out,Tin,Tout),
  981.     cond( features(Tin) :== [],
  982.           R = succeed,
  983.           R = (Tin:accs = Tout:accs)
  984.         ).
  985.  
  986. link_other_accs_false([A|B],C,In,Out,Tin,Tout) :-
  987.     !,
  988.     cond( A :\== C,
  989.           (
  990.           Tin.A = In.A,
  991.           Tout.A = Out.A
  992.           )
  993.         ),
  994.     link_other_accs_false(B,C,In,Out,Tin,Tout).
  995. link_other_accs_false([],C,In,Out) :- 
  996.         cond( has_feature(C,In),
  997.           Out.C = @).
  998.  
  999.  
  1000. %%% link accumulators
  1001.  
  1002. link_accs([]) -> succeed.
  1003. link_accs([A|B],true,In,Out) -> succeed |
  1004.         In.A = Out.A,
  1005.            link_accs(B,true,In,Out).
  1006.  
  1007. link_accs(Fin,false,In,Out) -> R |
  1008.     cond(Fin :== [],
  1009.          R = succeed,
  1010.          (true |
  1011.           add_features(Fin,Out),
  1012.           R = (copy_pointer(In)&accs = copy_pointer(Out)&accs)
  1013.          )).
  1014.  
  1015. add_features([A|B],T) :-
  1016.     !,
  1017.     T.A = @,
  1018.     add_features(B,T).
  1019. add_features([]).
  1020.     
  1021.  
  1022.  
  1023. %%% give parameters their initial value
  1024.  
  1025. init_accs([]) :- !.
  1026. init_accs([A|B],NonTerm) :-
  1027.     (
  1028.        get_acc_info(A,in_name => InName, out_name => OutName,
  1029.                      in_start => In, out_start => Out),
  1030.             NonTerm.InName = In,
  1031.         NonTerm.OutName = Out
  1032.     ;
  1033.         succeed
  1034.     ),!,
  1035.     init_accs(B,NonTerm).
  1036.  
  1037. init_passed([]) :- !.
  1038. init_passed([A|B],NonTerm) :-
  1039.     get_pass_info(A,start => Start),!,
  1040.     NonTerm.A = Start,
  1041.     init_passed(B,NonTerm).
  1042.  
  1043. %%% create out
  1044.  
  1045. create_out([A|B]) -> C:create_out(B) | C.A = @ .
  1046. create_out([]) -> @.
  1047.  
  1048. %%% partition passed arguments and accumulators in a list
  1049.  
  1050. part_parameters([],PredName,[],[]) :- !.
  1051. part_parameters(L,PredName,Accs,Passed) :-
  1052.     part_params_2(L,PredName,[],Accs,[],Passed).
  1053.  
  1054. part_params_2([],PredName,L1,L1,L2,L2) :- !.
  1055. part_params_2([A|B],PredName,L1,L3,L4,L6) :-
  1056.     cond( is_passed(A),
  1057.           (
  1058.           L1 = L2,
  1059.           L5 = [A|L4]
  1060.           ),
  1061.           cond( is_acc(A),
  1062.             (
  1063.             L5 = L4,
  1064.             L2 = [A|L1]
  1065.             ),
  1066.             pred_info_error(A,PredName)
  1067.           )
  1068.         ),
  1069.     part_params_2(B,PredName,L2,L3,L5,L6).
  1070.  
  1071.  
  1072.  
  1073.  
  1074. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1075. % Utilities
  1076. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1077.  
  1078.  
  1079. map_pred([A|B],P) :-
  1080.     !,
  1081.     copy_pointer(P) & @(A),
  1082.     map_pred(B,P).
  1083. map_pred([]).
  1084.  
  1085.  
  1086. s_member([A|B],C) -> cond( A :\== C,s_member(B,C)).
  1087. s_member([]) -> false.
  1088.  
  1089.  
  1090.  
  1091. %%% setq for functions WITH arguments
  1092.  
  1093. non_strict(set_func_arg) ?
  1094. set_func_arg(A,B) :- 
  1095.     R = root_sort(A),
  1096.     retract(( R -> @ )),
  1097.     assert(( A -> B )). 
  1098.  
  1099.  
  1100.  
  1101. %%% list of the features of a term
  1102.  
  1103. feats(Term) -> feat_values2(features(Term),Term).
  1104. feat_values2([F1|Fs],Term) -> [Term.F1|feat_values2(Fs,Term)].
  1105. feat_values2([]) -> [].
  1106.  
  1107.  
  1108. A point_virgule B ->  cond( A :=< fail, B, cond( B :=< fail, A, (A;B))).
  1109.  
  1110. %%% flattenning a list of lists
  1111.  
  1112. flatten([A|B]) -> append(A,flatten(B)).
  1113. flatten([]) -> [].
  1114.  
  1115.  
  1116. %%% part_sort(L1,L2,L3,L4,L5): L3 is L1 inter L2, L4 is L1 \ L3, L5 is L2 \ L3
  1117.  
  1118. part_sort([],L2,[],[],L2) :- !.
  1119. part_sort(L1:[A|NewL1],L2,Intersect,RestL1,RestL2) :-
  1120.     cond( memberAndRest_sort(A,L2,InterRestL2),
  1121.           (
  1122.           part_sort(NewL1,InterRestL2,Intersect2,RestL1,RestL2),
  1123.           Intersect = [A|Intersect2]
  1124.           ),
  1125.           (
  1126.           part_sort(NewL1,L2,Intersect,RestNewL1,RestL2),
  1127.           RestL1 = [A|RestNewL1]
  1128.           )).
  1129.  
  1130. memberAndRest_sort(A,[],Rest) -> false.
  1131. memberAndRest_sort(A,[B|C],Rest) ->
  1132.     cond( A :== B,
  1133.           ( true | Rest = C),
  1134.           memberAndRest_sort(A,C,OtherRest) | Rest = [B|OtherRest] ).
  1135.  
  1136. %
  1137. % member in a list of sorts, using :==
  1138. %
  1139.  
  1140. sort_member(X,[Y|S]) -> cond( X :== Y,
  1141.                           true,
  1142.                   sort_member(X,S)).
  1143. sort_member(X,[]) -> false.
  1144.  
  1145.  
  1146. %%% difference of list of sorts: sorts_list_diff(A,B) -> A \ (A inter B)
  1147.  
  1148. sorts_list_diff([A|B],C) ->
  1149.     cond(   sort_member(A,C),
  1150.             sorts_list_diff(B,C),
  1151.         [A|sorts_list_diff(B,C)]
  1152.         ).
  1153. sorts_list_diff([],L) -> [].
  1154.  
  1155.