home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / TOOLS / STD_EXPA.LF < prev    next >
Text File  |  1996-06-04  |  11KB  |  410 lines
  1. %    $Id: std_expander.lf,v 1.2 1994/12/08 23:54:02 duchier Exp $    
  2. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3. % 
  4. %                   STANDARD EXPANDER 
  5. % 
  6. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  7.  
  8. module("std_expander") ?
  9.  
  10.  
  11. import("acc_declarations") ?
  12.  
  13. public(std_expander,comma,
  14.        clauses,context,code,define,macro) ?
  15.  
  16. associate_expanders(std_expander,make_expander) ?
  17. op(1000,xfy,comma)?
  18.  
  19. global(init_method,head_method,traverse_method,leaf_method,
  20.        split_method,save_method,restore_method,merge_method,
  21.        terminate_method) ?
  22.  
  23. X:std_expander :-
  24.     make_expander(X,in_clauses => In,out_clauses => []),
  25.     maprel(assert,In),
  26.     fail.
  27.  
  28. make_expander(S:std_expander(Name,
  29.                  init => init_method,
  30.                  head => head_method,
  31.                  leaf => leaf_method,
  32.                  split => split_method,
  33.                  save => save_method,
  34.                  restore => restore_method,
  35.                  merge => merge_method,
  36.                  terminate   => terminate_method),
  37.           in_clauses => In,out_clauses => Out) :-
  38.     ( head_method = std,!
  39.     ;
  40.       pred_info(head_method,[context,clauses,code])
  41.     ),
  42.     ( save_method = std,!
  43.     ;
  44.       pred_info(save_method,[context,code])
  45.     ),      
  46.     ( restore_method = std,!
  47.     ;
  48.       pred_info(restore_method,[context,code])
  49.     ),
  50.     ( leaf_method = std,!
  51.     ;
  52.       pred_info(leaf_method,[clauses,context,code])
  53.     ),
  54.     ( init_method = std,!
  55.     ;
  56.       pred_info(init_method,[clauses])
  57.     ),
  58.     ( terminate_method = std,!
  59.     ;
  60.       pred_info(terminate_method,[code,clauses])
  61.     ),
  62.     split_method = {std;@},!, 
  63.     merge_method = {std;@},!,
  64.     
  65.     traverse_method = str2psi(strcon(psi2str(Name),"_traverse"),
  66.                   current_module),
  67.     
  68.     pred_info(Name,clauses),
  69.     pred_info(traverse_method,[context,clauses,code]),
  70.     
  71.     first_clause(Name,First),
  72.     conj_clause(Conj),
  73.     disj_clause(Disj), 
  74.     cond_clause(Cond),
  75.     macro_clause(Macro),
  76.     leaf_clause(Leaf),
  77.     In = [First,Conj,Disj,Cond,Macro,Leaf|Out].
  78.  
  79. first_clause(Name,First) :-
  80.     First =
  81.     (Name & @(Head :- Body,
  82.           in_clauses => Cl1,out_clauses => Cl6,
  83.           file => File, line => Line) :-
  84.        initialize(context => Co1,
  85.               in_clauses => Cl1,out_clauses => Cl2,
  86.               file => File,line => Line) comma
  87.        head(Head,NewHead,
  88.         in_code => Code1,out_code => Code2,
  89.         in_context => Co1,out_context => Co2,
  90.         in_clauses => Cl2,out_clauses => Cl3) comma
  91.        traverse(Body,
  92.             in_code => Code2,out_code => Code3,
  93.             in_context => Co1,out_context => Co2,
  94.             in_clauses => Cl3,out_clauses => Cl4) comma
  95.        terminate(in_code => Code3,out_code => succeed,
  96.              context => Co2,
  97.              in_clauses => Cl4,out_clauses => Cl5),
  98.      Cl5 = [`(NewHead :- Code1)|Cl6]
  99.     ).
  100.  
  101.  
  102. conj_clause(Conj) :-
  103.     Conj = 
  104.     (traverse(S1:@(A,B),
  105.           in_code => Code1,out_code => Code3,
  106.           in_context => Co1,out_context => Co3,
  107.           in_clauses => Cl1,out_clauses => Cl3):-
  108.      `(S1 :== ,),
  109.      !,
  110.      traverse(A,
  111.           in_code => Code1,out_code => Code2, 
  112.           in_context => Co1,out_context => Co2,
  113.           in_clauses => Cl1,out_clauses => Cl2),
  114.      traverse(B,
  115.           in_code => Code2,out_code => Code3,
  116.           in_context => Co2,out_context => Co3,
  117.           in_clauses => Cl2,out_clauses => Cl3)
  118.     ).
  119.  
  120.  
  121. disj_clause(Disj) :- 
  122.       Disj = 
  123.     (traverse(S2:@(A,B),
  124.           in_code => Code1,out_code => Code4,
  125.           in_context => Co1,out_context => Co2,
  126.           in_clauses => Cl1,out_clauses => Cl3) :-
  127.      `(S2 :== ;),
  128.      !,
  129.      split(in_code => Code1,out_code => Code2,
  130.            in => Co1,out1 => Co1A,out2 => Co1B) comma
  131.      (
  132.          save(in_code => CodeA,out_code => CodeA2,
  133.           in_context => Co1A,out_context => Co2A) comma
  134.          traverse(A,
  135.               in_code => CodeA2,out_code => CodeA3,
  136.               in_context => Co2A,out_context => Co3A,
  137.               in_clauses => Cl1,out_clauses => Cl2) comma
  138.          restore(in_code => CodeA3,out_code => succeed,
  139.              in_context => Co3A,out_context => Co4A)                  
  140.      ),
  141.          
  142.      (
  143.          save(in_code => CodeB,out_code => CodeB2,
  144.           in_context => Co1B,out_context => Co2B) comma
  145.          traverse(B,
  146.               in_code => CodeB2,out_code => CodeB3,
  147.               in_context => Co2B,out_context => Co3B,
  148.               in_clauses => Cl2,out_clauses => Cl3) comma
  149.          restore(in_code => CodeB3,out_code => succeed,
  150.              in_context => Co3B,out_context => Co4B)
  151.      ),
  152.      merge(in_code => Code3,out_code => Code4,
  153.            in1 => Co4A,in2 => Co4B,out => Co2),
  154.      Code2 = `((CodeA;CodeB) comma Code3)
  155.     ).
  156.  
  157. cond_clause(Cond) :-
  158.     Cond =
  159.     (traverse(S3,
  160.           in_code => Code1,out_code => Code4,
  161.           in_context => Co1,out_context => Co2,
  162.           in_clauses => Cl1,out_clauses => Cl3) :-
  163.      `(S3 :== `cond),
  164.      !,
  165.      (
  166.          `has_feature(1,S3,Condition),!
  167.      ;
  168.          Condition = "missing condition in the code!"  %% should not 
  169.                                %  be silent !!
  170.      ),
  171.      split(in_code => Code1,out_code => Code2,
  172.            in => Co1,out1 => Co1A,out2 => Co1B) comma
  173.      (
  174.          `has_feature(2,S3,Alt1),!,
  175.          save(in_code => CodeA,out_code => CodeA2,
  176.           in_context => Co1A,out_context => Co2A) comma
  177.          traverse(Alt1,
  178.               in_code => CodeA2,out_code => CodeA3,
  179.               in_context => Co2A,out_context => Co3A,
  180.               in_clauses => Cl1,out_clauses => Cl2) comma 
  181.          restore(in_code => CodeA3,out_code => succeed,
  182.              in_context => Co3A,out_context => Co4A)
  183.      ;
  184.          save(in_code => CodeA6,out_code => CodeA5,
  185.           in_context => Co1A,out_context => Co5A) comma
  186.          restore(in_code => CodeA5,out_code => succeed,
  187.              in_context => Co5A,out_context => Co4A) comma
  188.          Cl1 = Cl2,
  189.          CodeA = CodeA6
  190.      ),
  191.      (
  192.          `has_feature(3,S3,Alt2),!,
  193.          save(in_code => CodeB,out_code => CodeB2,
  194.           in_context => Co1B,out_context => Co2B) comma 
  195.          traverse(Alt2,
  196.               in_code => CodeB2,out_code => CodeB3,
  197.               in_context => Co2B,out_context => Co3B,
  198.               in_clauses => Cl2,out_clauses => Cl3) comma
  199.          restore(in_code => CodeB3,out_code => succeed,
  200.              in_context => Co3B,out_context => Co4B)
  201.          
  202.      ;
  203.          save(in_code => CodeB6,out_code => CodeB5,
  204.           in_context => Co1B,out_context => Co5B) comma
  205.          restore(in_code => CodeB5,out_code => succeed,
  206.              in_context => Co5B,out_context => Co4B) comma
  207.          Cl2 = Cl3,
  208.          CodeB = CodeB6
  209.      ),
  210.      merge(in_code => Code3,out_code => Code4,
  211.            in1 => Co4A,in2 => Co4B,out => Co2),
  212.      Code2 = `(`cond(Condition,
  213.              CodeA,
  214.              CodeB
  215.             ) comma Code3)
  216.     ).
  217.  
  218.  
  219. macro_clause(MacroClause) :-
  220.     MacroClause = 
  221.     (traverse(Leaf,
  222.           in_code => Code1,out_code => Code2,
  223.           in_context => Co1,out_context => Co2,
  224.           in_clauses => Cl1,out_clauses => Cl2) :-
  225.      `macro(Leaf,Def),!,
  226.      traverse(Def,
  227.           in_code => Code1,out_code => Code2,
  228.           in_context => Co1,out_context => Co2,
  229.           in_clauses => Cl1,out_clauses => Cl2)
  230.     ).
  231.  
  232.  
  233. leaf_clause(LeafClause) :-
  234.     LeafClause = 
  235.     (traverse(Leaf,
  236.           in_code => Code1,out_code => Code2,
  237.           in_context => Co1,out_context => Co2,
  238.           in_clauses => Cl1,out_clauses => Cl2) :-
  239.      leaf(Leaf,
  240.           in_code => Code1,out_code => Code2,
  241.           in_context => Co1,out_context => Co2,
  242.           in_clauses => Cl1,out_clauses => Cl2)
  243.     ).
  244.  
  245.  
  246. initialize(context => Co1,
  247.        in_clauses => Cl1,out_clauses => Cl2,
  248.        file => File,line => Line) ->    
  249.     cond( init_method :== std,
  250.           ( succeed | Cl1 = Cl2),
  251.           root_sort(init_method)
  252.           & @(context => Co1,
  253.           in_clauses => Cl1,out_clauses => Cl2,
  254.           file => File,line => Line)
  255.         ).
  256.  
  257. terminate(context => Co1,
  258.       in_code => Code1,out_code => Code2,
  259.       in_clauses => Cl1,out_clauses => Cl2) ->    
  260.     cond( terminate_method :== std,
  261.           ( succeed | Cl1 = Cl2, Code1 = Code2),
  262.           root_sort(terminate_method)
  263.         & @(context => Co1,
  264.             in_code => Code1,out_code => Code2,
  265.             in_clauses => Cl1,out_clauses => Cl2)
  266.         ).
  267.  
  268.  
  269. head(Head,NewHead,
  270.      in_code => Code1,out_code => Code2,
  271.      in_context => Co1,out_context => Co2,
  272.      in_clauses => Cl1,out_clauses => Cl2) ->
  273.     cond( head_method :== std,
  274.           ( succeed | Cl1 = Cl2, NewHead = Head, Code1 = Code2),
  275.           root_sort(head_method)
  276.           & @(Head,NewHead,
  277.           in_code => Code1,out_code => Code2,
  278.           in_context => Co1,out_context => Co2,
  279.           in_clauses => Cl1,out_clauses => Cl2)
  280.         ).
  281.           
  282.  
  283. traverse(Body,
  284.      in_code => Code1,out_code => Code2,
  285.      in_context => Co1,out_context => Co2,
  286.      in_clauses => Cl3,out_clauses => Cl4) ->
  287.     root_sort(traverse_method)
  288.     & @(Body,
  289.         in_code => Code1,out_code => Code2,
  290.         in_context => Co1,out_context => Co2,
  291.         in_clauses => Cl3,out_clauses => Cl4).
  292.  
  293.  
  294. split(in_code => Code1,out_code => Code2,
  295.       in => Co,out1 => Co1,out2 => Co2) ->
  296.     cond( split_method :== std,
  297.           (succeed | Co = Co1, Co1 = Co2, Code1 = Code2),
  298.           root_sort(split_method)
  299.           & @(in_code => Code1,out_code => Code2,
  300.           in => Co,out1 => Co1,out2 => Co2)
  301.         ).
  302. save(in_code => Code1,out_code => Code2,
  303.      in_context => Co1,out_context => Co2) ->
  304.     cond( save_method :== std,
  305.           (succeed | Co1 = Co2, Code1 = Code2),
  306.           root_sort(save_method)
  307.           & @(in_code => Code1,out_code => Code2,
  308.           in_context => Co1,out_context => Co2)
  309.         ).
  310.  
  311. restore(in_code => Code1,out_code => Code2,
  312.     in_context => Co1,out_context => Co2) ->
  313.     cond( restore_method :== std,
  314.           (succeed | Co1 = Co2, Code1 = Code2),
  315.           root_sort(restore_method)
  316.           & @(in_code => Code1,out_code => Code2,
  317.           in_context => Co1,out_context => Co2)
  318.         ).
  319.  
  320. merge(in_code => Code1,out_code => Code2,
  321.       in1 => Co1,in2 => Co2,out => Co) ->
  322.     cond( merge_method :== std,
  323.           (succeed | Co = Co1, Co1 = Co2, Code1 = Code2),
  324.           root_sort(merge_method)
  325.           & @(in_code => Code1,out_code => Code2,
  326.           in1 => Co1,in2 => Co2,out => Co)
  327.         ).
  328.     
  329. leaf(Leaf,
  330.      in_code => Code1,out_code => Code2,
  331.      in_context => Co1,out_context => Co2,
  332.      in_clauses => Cl1,out_clauses => Cl2) ->
  333.     cond( leaf_method :== std,
  334.           (succeed | Co1 = Co2, Cl1 = Cl2, Code1 = (Leaf comma Code2)),
  335.           root_sort(leaf_method)
  336.           & @(Leaf,
  337.           in_code => Code1,out_code => Code2,
  338.           in_context => Co1,out_context => Co2,
  339.           in_clauses => Cl1,out_clauses => Cl2)
  340.         ).
  341.  
  342.  
  343. X comma Y -> cond( X :== succeed,
  344.            Y,
  345.            cond( Y :== succeed,
  346.              X,
  347.              (X,Y))).
  348.  
  349.  
  350. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  351. %
  352. % Macros
  353. %
  354. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  355.  
  356. %%% macro definition
  357.  
  358. persistent(macros_table) ?
  359.  
  360. non_strict(define) ?
  361.  
  362. define(A,B) :-
  363.     macros_table.current_module.A <<- @(A,B).
  364.  
  365.  
  366. associate_expanders(define,define_expander) ?
  367. define_expander(define(A,B),in_clauses => In,out_clauses => In) :-
  368.     define(A,B).
  369.  
  370. macro(X,Def) ->
  371.     cond( X :< string,
  372.           submacro(features(macros_table.current_module),
  373.                X,Def),
  374.           macro2(X,Def)
  375.         ).
  376.  
  377.  
  378. macro2(X,Def) ->
  379.     cond( has_feature(X,macros_table.current_module,Def1),
  380.           ( true |
  381.         @(X,Def) = copy_term(Def1)
  382.           ),
  383.           cond( is_sort(X),
  384.             submacro(features(macros_table,current_module),
  385.                  X,Def),
  386.             false
  387.           )
  388.         ).
  389.  
  390. submacro([A|B],X,Def) ->
  391.     cond( X :< A,
  392.           ( true |
  393.         @(X,Def) = copy_term(macros_table.current_module.A)
  394.           ),
  395.           submacro(B,X,Def)
  396.         ).
  397. submacro([],_,_) -> false.
  398.  
  399.  
  400. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  401. %
  402. % Info for accumulation
  403. %
  404. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  405.  
  406. acc_info(clauses,X,In,Out,acc_pred => In = [X|Out]).
  407. acc_info(context).
  408. acc_info(code,X,In,Out,acc_pred => In = (X comma Out)).
  409.  
  410.