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