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