home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / LF / TERM_EXP.LF < prev    next >
Text File  |  1996-06-04  |  11KB  |  497 lines
  1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2. %
  3. %                   TERM EXPANSION
  4. %
  5. % Author: Bruno Dumant
  6. %
  7. % Copyright 1993-1994 Digital Equipment Corporation
  8. % All rights reserved 
  9. %
  10. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  11. %    $Id: term_expansion.lf,v 1.2 1994/12/08 23:34:30 duchier Exp $    
  12.  
  13. public(associate_expanders,quiet_associate_expanders,
  14.        add_expanders_a,add_expanders_z,remove_expanders,
  15.        term_expansion,term_xpand,
  16.        expand_load,
  17.        load_exp,import_exp,
  18.        new_suffix)?
  19.  
  20. persistent(consulted)?
  21. persistent(expansion_methods_table) ?
  22. global(loading_file,line) ?
  23.  
  24.  
  25.  
  26. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  27. %
  28. % associating expanders with symbols
  29. %
  30. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  31.  
  32. %%% Association
  33.  
  34. associate_expanders(Sort,Expanders,Type) :-
  35.     cond( has_feature(combined_name(Sort),expansion_methods_table),
  36.           warn("redefining expansion methods for: ",Sort,".")
  37.         ),
  38.     quiet_associate_expanders(Sort,Expanders,Type).
  39.  
  40. quiet_associate_expanders(Sort,Expanders,Type) :-
  41.     cond( Expanders :< list,
  42.           expansion_methods_table.combined_name(Sort)
  43.           <<- (Expanders,Type),
  44.           expansion_methods_table.combined_name(Sort)
  45.           <<- ([Expanders],Type)
  46.         ).
  47.  
  48. %%%associate_expander(associate_expander,make_association) ?
  49. %%%make_association(associate_expander(Sort,Expander,Type),
  50. %%%         in_clauses => In,
  51. %%%         out_clauses => In) :-
  52. %%%    associate_expander(Sort,Expander,Type).
  53.  
  54.  
  55. add_expanders_a(Sort,Expanders,Type) :-
  56.     ( has_feature(combined_name(Sort),expansion_methods_table,E),!,
  57.       ( Expanders :< list,!,
  58.         E.1 <<- append(Expanders,E.1)
  59.       ;
  60.         E.1 <<- [Expanders|copy_pointer(E.1)]
  61.       ),
  62.       cond( Type :\== @,
  63.         cond( Type :\== E.2,
  64.               ( warn("Changing the type of the expansion ",
  65.                 "method for ",
  66.                 Sort,"."),
  67.             E.2 <<- Type
  68.               )
  69.             )
  70.           )
  71.     ;
  72.       quiet_associate_expanders(Sort,Expanders,Type)
  73.     ).
  74.         
  75. %%%associate_expander(add_expander_a,assoc_a) ?
  76. %%%assoc_a(add_expander_a(Sort,Expander,Type),
  77. %%%    in_clauses => In,
  78. %%%    out_clauses => In) :-
  79. %%%    add_expander_a(Sort,Expander,Type).
  80.  
  81.  
  82. add_expanders_z(Sort,Expanders,Type) :-
  83.     ( has_feature(combined_name(Sort),expansion_methods_table,E),!,
  84.       ( Expanders :< list,!,
  85.         E.1 <<- append(E.1,Expanders) 
  86.       ;
  87.         E.1 <<- append(E.1,[Expanders])
  88.       ),
  89.       cond( Type :\== @,
  90.         cond( Type :\== E.2,
  91.               ( warn("Changing the type of the expansion ",
  92.                 "method for ",
  93.                 Sort,"."),
  94.             E.2 <<- Type
  95.               )
  96.             )
  97.           )
  98.     ;
  99.       quiet_associate_expanders(Sort,Expanders,Type)
  100.     ).
  101.  
  102. %%%associate_expander(add_expander_z,assoc_z) ?
  103. %%%assoc_z(add_expander_z(Sort,Expander,Type),
  104. %%%    in_clauses => In,
  105. %%%    out_clauses => In) :-
  106. %%%    add_expander_z(Sort,Expander,Type).
  107.  
  108.  
  109. remove_expanders(Sort,Expanders) :-
  110.     ( has_feature(combined_name(Sort),expansion_methods_table,E),!,
  111.       E.1 <<- rm_exp(Expanders,E.1)
  112.     ;
  113.       succeed
  114.     ).
  115.  
  116. rm_exp([A|B],L) -> rm_exp(B,rm_exp1(L,A)).
  117. rm_exp([],L) -> L.
  118. rm_exp(A,L) -> rm_exp1(L,A).
  119.  
  120. rm_exp1([A|B],Exp) -> cond( Exp :== A,
  121.                 rm_exp1(B,Exp),
  122.                 [A|rm_exp1(B,Exp)]
  123.               ).
  124. rm_exp1([],Exp) -> [].
  125.     
  126. %%% expanding
  127.  
  128. composed_expansion(A,B,(Exp,Type),file => File,line => Line) :-
  129.     ( Exp :== [],!,
  130.       B = [A]
  131.     ;
  132.       cond( Type :== @,
  133.         Clauses = [A],
  134.         Clauses = [root_sort(Type) & strip(A)]
  135.           ),
  136.       apply_expanders(Exp,Clauses,B,
  137.               file => File, line => Line)
  138.     ).
  139.  
  140. apply_expanders([Exp|Exps],In,Out,
  141.         file => File, line => Line) :-
  142.     !,
  143.     apply_expander(In,Exp,
  144.                in_clauses => Inter,out_clauses => [],
  145.                file => File, line => Line),
  146.     apply_expanders(Exps,Inter,Out,
  147.             file => File, line => Line).
  148. apply_expanders([],Clauses,Clauses).
  149.  
  150.  
  151. apply_expander([Cl1|Cls],Expander,
  152.            in_clauses => In,out_clauses => Out,
  153.            file => File, line => Line) :-
  154.     !,
  155.     copy_term(Expander) & @(Cl1,
  156.                 in_clauses => In,
  157.                 out_clauses => Inter,
  158.                 file => File, line => Line),
  159.     apply_expander(Cls,Expander,
  160.                in_clauses => Inter,
  161.                out_clauses => Out,
  162.                symbol => Symbol,file => File, line => Line).
  163. apply_expander([],in_clauses => In,out_clauses => In).
  164.  
  165.  
  166. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  167. %
  168. % term_expansion
  169. %
  170. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  171.  
  172. dynamic(term_expansion) ?
  173. assert(term_expansion),retract(term_expansion) ?
  174.  
  175. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  176. %
  177. % simple_exp_load
  178. %
  179. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  180.  
  181. %%% simple_exp_load
  182. %%% a 'simple_load' predicate using read, expanding facts when necessary,
  183. %%% and writing the expanded version if asked.
  184.  
  185. simple_exp_load(File) :-
  186.     OldFile <- root_sort(loading_file),
  187.     OldLine <- root_sort(line),
  188.     line <- @,
  189.     cond( OldFile :== @, OldFile = "?"),
  190.     loading_file <- File,
  191.     CM = current_module,
  192.     open_in(File,StreamIn),
  193.     cond( expand2file,
  194.           open_out(new_suffix(File,".exp"),StreamOut)
  195.         ),
  196.     consulted.File <<- true,
  197.     load_expanded(StreamIn,StreamOut),
  198.     set_module(CM),
  199.     file <- OldFile,
  200.     line <- OldLine.
  201.  
  202. load_expanded(StreamIn,StreamOut) :-
  203.     (
  204.         next_rule(Expr,Type,End,line),
  205.         ( End,!,
  206.           close(StreamIn),
  207.           cond( expand2file,
  208.             close(StreamOut)
  209.           )
  210.         ;
  211.           cond( Type :== declaration,
  212.             process_declaration(Expr,StreamOut),
  213.             cond( Type :== query,
  214.               process_query(Expr,StreamIn,StreamOut),
  215.               (
  216.                   set_choice(top_load),
  217.                   write_syntax_error(StreamIn,StreamOut)
  218.               )
  219.             )
  220.           ),
  221.           fail
  222.         )
  223.     ;
  224.         load_expanded(StreamIn,StreamOut)
  225.     ).
  226.  
  227. next_rule(X,Type,Bool,Line) :-
  228.     read(X,Type,Line),
  229.     Bool = ( X :=< end_of_file).
  230.  
  231.  
  232.  
  233. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  234. %
  235. % processing queries
  236. %
  237. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  238.  
  239. %%% proving queries of a file
  240.  
  241. non_strict(process_query) ?
  242. process_query(Query,StreamIn,StreamOut) :-
  243.     (
  244. %%%        has_feature(combined_name(Query),expansion_methods_table,M),
  245. %%%        M :\== [],!,
  246. %%%        process_declaration(Query,StreamOut)
  247. %%%    ;
  248.         
  249.         retract(( load_query :- @ )),
  250.         assert(( load_query :- Query )),
  251.         open_in("stdin",_),
  252.         
  253.         @ = call_once(load_query),
  254.         
  255.         set_input(StreamIn),
  256.         cond( expand2file,
  257.             output_query(Query,StreamOut)
  258.         ),
  259.         fail
  260.     ;
  261.         succeed
  262.     ).
  263.  
  264. dynamic(load_query) ?
  265. load_query.
  266.  
  267.  
  268. output_query(Query,StreamOut) :-
  269.     set_output(StreamOut),
  270.     cond( Query :== load,
  271.           write_canonical(modify_load(Query)),
  272.           cond( Query :== import,
  273.             write_canonical(modify_import(Query)),
  274.             write_canonical(Query)
  275.           )
  276.         ),
  277.     write("?"),nl,nl,
  278.     open_out("stdout",_).
  279.  
  280. modify_load(X) ->
  281.     load_exp & strip(X).
  282. modify_import(X) ->
  283.     import_exp&strip(X).
  284.  
  285.  
  286.  
  287. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  288. %
  289. % Processing declarations
  290. %
  291. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  292.  
  293.  
  294. %%% asserting declarations of a file
  295.  
  296. process_declaration(Declaration,StreamOut) :-
  297.     (
  298.         term_xpand(Declaration,NewDefs),!,
  299.         process_defs(NewDefs,StreamOut)
  300.     ;
  301.         nl_err,
  302.         write_err("*** Error: "),nl_err,write_err("    "),
  303.         writeq_err(Declaration),write_err("."),nl_err,
  304.         write_err("    could not be expanded in file """,
  305.                        loading_file,""""," near line ",line,"."),
  306.         nl_err
  307.     ).
  308.  
  309.  
  310. term_xpand(A,B) :-
  311.     (
  312.         has_feature(combined_name(A),expansion_methods_table,M),!,
  313.         composed_expansion(A,B,M,file => loading_file,line => line),! 
  314.     ;
  315.         (
  316.         clause(( term_expansion(A) :- @ ))
  317.         ;
  318.             clause(( term_expansion(A) ))
  319.         ),!,
  320.         term_expansion(A,B,
  321.                file => loading_file,
  322.                line => line),!
  323.     ;
  324.         A = B
  325.     ).
  326.  
  327.  
  328. process_defs(NewDefs,StreamOut) :-
  329.     (
  330.         expand2file,
  331.         set_output(StreamOut),
  332.         cond( NewDefs :=< list,
  333.           maprel(write_def, NewDefs),
  334.           write_def(NewDefs)
  335.         ),
  336.         open_out("stdout",_),
  337.         fail
  338.     ;
  339.         assert_rules,
  340.         cond( NewDefs :=< list,
  341.           maprel(assert_def, NewDefs),
  342.           assert_def(NewDefs)
  343.         ),
  344.         fail
  345.     ;
  346.         succeed
  347.     ).
  348.  
  349. assert_def(X) :-
  350.     cond( Bool:(consulted.loading_file),
  351.           cond( X :== (->),
  352.             Bool.current_module.functions.(X.1) <<- true,
  353.             cond( X :== (:-),
  354.               Bool.current_module.preds.(X.1) <<- true,
  355.               cond( X :== (<|) or X :== (::) or X :== (:=),
  356.                 succeed,
  357.                 Bool.current_module.preds.X <<- true 
  358.                   )
  359.             )
  360.           )
  361.         ),
  362.     assert(X).
  363.  
  364. write_def(X) :-
  365.     write_canonical(X),
  366.     write("."),
  367.     nl,nl.
  368.  
  369.  
  370.  
  371. %%% writing syntax errors
  372.  
  373. write_syntax_error(StreamIn,StreamOut) :-
  374.     close(StreamIn),
  375.     cond( expand2file,
  376.         close(StreamOut)
  377.     ),
  378.     fail.    
  379.  
  380.  
  381.  
  382. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  383. %
  384. % load options
  385. %
  386. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  387.  
  388. %%% setting options
  389.  
  390. persistent(assert_rules)?   %% will expanded rules be asserted ?
  391. assert_rules <<- false ?    
  392.  
  393. persistent(expand2file) ?   %% will expanded rules be written in a file ?
  394. expand2file <<- false ?
  395.  
  396.  
  397. %%% load_option is defined in built_ins.lf. It is used to decide whether term
  398. %%% expansion is used or not.
  399.  
  400. expand_load(Assert,Expand2File) :-
  401.     cond( var(Assert),
  402.           Assert = copy_term(assert_rules),
  403.           (
  404.           Assert :< bool,
  405.           assert_rules <<- Assert
  406.           )
  407.         ),
  408.     cond( var(Expand2File),
  409.           Expand2File = copy_term(expand2file),
  410.           (
  411.           Expand2File :< bool,
  412.           expand2file <<- Expand2File
  413.           )
  414.         ),
  415.     load_option <<- assert_rules or expand2file. 
  416.  
  417.  
  418.  
  419.  
  420. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  421. %
  422. % Loading expanded files
  423. %
  424. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  425.  
  426.  
  427. non_strict(load_exp)?
  428. X:load_exp :-
  429.     CM = current_module,
  430.     F = features(X),
  431.     (
  432.         loading,!,
  433.         load_exp_2(F,X)
  434.     ;
  435.         loading <<- true,
  436.         top_load <<- get_choice,
  437.         load_exp_2(F,X),!,loading <<- false
  438.     ;
  439.         open_out("stdout",_),
  440.         open_in("stdin",_),
  441.         set_module(CM),
  442.         loading <<- false,
  443.         fail
  444.     ).
  445.  
  446. load_exp_2([F|L],X) :-
  447.     (
  448.         find_file(new_suffix(X.F,".exp"),CF),!,
  449.         (
  450.         has_feature(CF,consulted,Bool),!,
  451.         quiet_write_err("*** File """,CF,""" is already loaded.")
  452.         ;
  453.         consulted.CF <<- false,
  454.         quiet_write_err("*** Loading File """,CF,""""),
  455.         simple_load(CF)
  456.         ),
  457.         load_exp_2(L,X)
  458.     ;
  459.         set_choice(top_load),fail
  460.     ).
  461. load_exp_2([]).
  462.  
  463. X:import_exp :-
  464.     load_exp&strip(X),
  465.     open&strip(X).
  466.  
  467. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  468. %
  469. % utilities
  470. %
  471. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  472.  
  473. new_suffix(F,S) -> strcon(prefix(F),S).
  474.  
  475. prefix(F) -> prefix2(F,1,strlen(F)).
  476.  
  477.  
  478. prefix2(F,N,Length) ->
  479.     cond(asc(substr(F,N,1)) =:= asc("."),
  480.          substr(F,1,N-1),
  481.          cond( N =:= Length,
  482.              F,
  483.          prefix2(F,N+1,Length)
  484.          )
  485.      ).
  486.  
  487. warn :- quiet,!.
  488. X:warn :-
  489.     write_err("*** Warning: "),
  490.     write_err&strip(X),
  491.     nl_err.
  492.  
  493. quiet_write_err :- quiet,!.
  494. C:quiet_write_err :-
  495.     write_err&strip(C),
  496.     nl_err.
  497.