home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / TESTS / LF / DISSOLVE.LF < prev    next >
Text File  |  1996-06-04  |  9KB  |  263 lines
  1. %
  2. % module(DissolvePattern).
  3. %
  4. % load(name_top_vars)?
  5. %
  6. %
  7. %        Dissolving a psi-term (not only patterns for a Life function call)
  8. %
  9. %
  10. %
  11.  
  12. %
  13. % The sort structure of dissolved forms
  14. %
  15.  
  16. diss_form <| @.
  17.  
  18. sort_eqn    := diss_form(var=>X,srt=>Y).            % s must match the root_sort_n of X (i.e. X:s)
  19. feature_eqn := diss_form(var1=>X,feat=>Y,var2=>Z).  % X.L is equal to Y
  20. coref_eqn   := diss_form(var1=>X,var2=>Y).          % X = Y
  21.  
  22. %
  23. % dissolve a psi-term (without executing it: this is why there is
  24. %                      the non_strict declaration).
  25. %
  26. % jolidissolve takes a string instead of a psi-term.
  27. non_strict(dissolve_psi)?
  28.  
  29. jolidissolve(X)   -> @ | W = parse(X), dissolve_psi(W).
  30. dissolve_psi(Psi) -> @ | (DissForm,Bindings) = dissolve((Dummy,Psi),[]), prettyprint(DissForm).
  31.  
  32. non_strict(dissolve)?
  33.  
  34. dissolve((V,Psi),Dejavu) ->
  35.         cond(assq(Psi,Dejavu)&bool(Name),
  36.              ([coref_eqn(var1=>V,var2=>Name)],Dejavu),
  37.              ([sort_eqn(var=>V,srt =>my_root_sort(Psi))| SubstEqn], NewDejavu) % generate the root sort constraint
  38.                 |                                       % generate the feature constraints by examining recursively the subtrees:
  39.                   (  FL = features_n(Psi),              % get the feature list
  40.              P=project_n(2=>Psi),
  41.                      FV = map(P,FL),% get the feature values list
  42.                      % FV = map(project_n & @(2=>Psi),FL),% get the feature values list
  43.                      (SubstEqn,NewDejavu) =
  44. flatten_accumulate(dissolve_features_of(psi=>Psi,var=>V),
  45.            FL,[(Psi,V)|Dejavu]))).
  46. % flatten_accumulate(dissolve_features_of & @(psi=>Psi,var=>V),FL,[(Psi,V)|Dejavu]))).
  47.  
  48. %
  49. % Find a "quoted" root_sort in case it is top
  50. %
  51.  
  52. my_root_sort(X) -> cond(var(X),"@",root_sort_n(X)).
  53.  
  54. %
  55. % 
  56. %
  57. non_strict(dissolve_features_of)?
  58.  
  59. dissolve_features_of(psi=>_,var=>_,[],Dejavu) -> ([],Dejavu).
  60.  
  61. dissolve_features_of(psi=>Psi,var=>V,Feature,Dejavu) ->
  62.         ([feature_eqn(var1=>V,feat=>Feature,var2 => NewVar)|EqnRest],NewDejavu)
  63.              |   FeatureValue = project_n(Feature,Psi),
  64.                  (EqnRest,NewDejavu) = dissolve((NewVar,FeatureValue),Dejavu).
  65.           
  66. %
  67. % Human readable output for debugging ...
  68. %
  69.                        
  70. %
  71. % Name the top variables, then print normally the psi-term.
  72. %
  73.  
  74. prettyprint(L) :- setq(my_gen_sym,1), pretty(name_vars(L)).
  75.  
  76. pretty([]):- !.
  77. pretty([X:diss_form|Rest]):- pretty_inst(X),pretty(Rest),!.
  78.  
  79. pretty_inst(sort_eqn(var=>X,srt=>Y)) :- write(X),write(":"),write(Y),pretty_sep,!.
  80. pretty_inst(feature_eqn(var1=>X,feat=>Y,var2=>Z)) :- write(X),write("."),write(Y),
  81.                                                      write("="),write(Z),pretty_sep,!.
  82. pretty_inst(coref_eqn(var1=>X,var2=>Y)) :- write(X),write("="),write(Y),pretty_sep,!.
  83.  
  84. pretty_sep:- write(", "),!.
  85.  
  86. %
  87. % Functional utilities to handle lists and associationb lists... better in a library
  88. %
  89.  
  90. %
  91. % assqq(X,L) is true iff  X occurs in the association  list L, in  which case
  92. % has the associated value as feature 1
  93. %
  94.  
  95. assq(X,[])            -> false.
  96. assq(X,[(Y,Value)|T]) -> cond(X===Y,true(Value),assq(X,T)).
  97.  
  98. %
  99. % Accumulate function: takes a function f:A->B->C, a list L of A, a B, and returns
  100. % the result of applying f to the each element of L, and to the progressively modified B
  101. %
  102.  
  103. flatten_accumulate(F,[],B) -> ([],B).
  104. flatten_accumulate(F,[Hd|T],B) -> (Flat,NewB) | (Nv,NB) = F(Hd,B), (Nl,NewB) = flatten_accumulate(F,T,NB), Flat = append(Nv,Nl).
  105.  
  106. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  107. %
  108. % to be done ...
  109. %
  110.  
  111. %
  112. % export(dissolve_psi).
  113. %
  114.  
  115. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  116. % FILE. . . . . /udir/dicosmo/life/code/name_top_vars
  117. % EDIT BY . . . Roberto Di Cosmo
  118. % ON MACHINE. . Prl341
  119. % STARTED ON. . Thu Sep 24 16:10:30 1992
  120. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  121.  
  122. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  123.  
  124. % Take a psi-term and return a copy of it  where all variables satisfying the
  125. % predicate "var"   (i.e.,  by  this time, being    of   sort @)    are named
  126. % consistently, by moving  them down  the sort hierarchy  to the  appropriate
  127. % string sort.
  128.  
  129. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  130.  
  131. % load(repair_list)?
  132.  
  133. %
  134. % The function genvar yields a new variable name each time it is called
  135. %
  136.  
  137. setq(my_gen_sym,0)?
  138.  
  139. genvar -> strcon("U",int2str(N)) | N = my_gen_sym, setq(my_gen_sym,N+1).
  140.  
  141. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  142.  
  143. % The  function `name_vars' takes a psi-term  and returns a  copy of it where
  144. % all variables satisfying the predicate "var" (i.e., by  this time, being of
  145. % sort  @) are named  consistently, by moving   them down to  the appropriate
  146. % string sort.
  147.  
  148. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  149.  
  150. name_vars(X) -> Y | Y = copy_term(X), name_top_vars(Y,[]).
  151.  
  152. name_vars_from_to(X,N,M) -> Y | setq(my_gen_sym,N),
  153.                                 Y = name_vars(X),
  154.                                 M = my_gen_sym.
  155.  
  156. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  157.  
  158. %
  159. % Since  the  root_sort of  a  list is  not "cons",  with  features "head" and
  160. % "tail", this function needs to use the  repaired life  version  of features
  161. % called features_n to navigate in every psi-term uniformly
  162. %
  163. % We  need here also a   table of already  seen elements  to avoid looping on
  164. % cyclic structures; the updated table is given back as the last argument
  165. %
  166.  
  167. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  168.  
  169. name_top_vars(X,Table,[X|Table])
  170.        :- var(X),!, X = genvar.
  171. name_top_vars(X,Table,NewTable)
  172.        :- name_top_vars_body(features_n(X),X,[X|Table],NewTable).
  173.  
  174. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  175.  
  176. % The   function `name_top_vars_body'  takes a  list   of pairs  of  the form
  177. % (attribute,psi-term) and a table  and returns a pair  made up of  a similar
  178. % list and a new table.
  179.  
  180. name_top_vars_body([],X,Table,Table)
  181.        :- !.
  182. name_top_vars_body([A|T],X,Table,NewTable)
  183.        :- Z=project_n(A,X),
  184.             cond(memq(Z,Table),
  185.                  name_top_vars_body(T,X,Table,NewTable),
  186.                  (name_top_vars(Z,Table,NT), name_top_vars_body(T,X,NT,NewTable))).
  187.  
  188. %
  189. % true iff X occurs in the list passed as second argument
  190. %
  191.  
  192. memq(X,[])    -> false.
  193. memq(X,[Y|T]) -> cond(X===Y,true,memq(X,T)).
  194.  
  195. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  196. % FILE. . . . . /udir/dicosmo/life/code/repair_list
  197. % EDIT BY . . . Roberto Di Cosmo
  198. % ON MACHINE. . Prl341
  199. % STARTED ON. . Thu Sep 18 16:10:30 1992
  200. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  201.  
  202. %
  203. % Repair buggy list sort definitions
  204. %
  205.  
  206. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  207.  
  208. % The built ins of the current version of  Wild_Life treat lists in a special
  209. % way, that renders it impossible to write programs  that navigate prsi terms
  210. % in a general uniform way.
  211. %
  212. % This file  provides the necessary   (not necessarily  efficient) workaround
  213. % while waiting for the definitive solution (in the compiler?).
  214. %
  215. % The functions features, root_sort, project, listify_body and bodify_list are
  216. % provided here  in a _n form that  works uniformly  on  psi-terms, even when
  217. % they are lists.
  218. %
  219.  
  220. %
  221. % Examples of applications are  to be found in dissolve.life, wam_bruno.life,
  222. % name_top_vars.life
  223. %
  224.  
  225. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  226.  
  227. %
  228. % To  avoid residuation  on variables, I fire  the function anyway, and  then
  229. % check what I have in hand, in the internal functions
  230. %
  231.  
  232. features_n(X) -> N | X:==@, N=features(X),!; N=features_internal(X).
  233. features_internal([])    -> [].
  234. features_internal([X|T]) -> [hd,tl].
  235. features_internal(X)     -> features(X).
  236.  
  237. root_sort_n(X) -> N | X:==@, N=@,!; N=root_sort_internal(X).
  238. root_sort_internal([])    -> nil.
  239. root_sort_internal([X|T]) -> cons.
  240. root_sort_internal(X)     -> root_sort(X).
  241.  
  242. project_n(A,X) -> N | X:==@, N=X.A,!; N=project_internal(A,X).
  243. project_internal(hd,[X|T]) -> X.
  244. project_internal(tl,[X|T]) -> T.
  245. project_internal(tl,[])    -> [].
  246. project_internal(A,X)      -> X.A.
  247.  
  248. %
  249. % Rebuild listify_body and  bodify_list using  the  repaired sort  navigation
  250. % functions
  251. %
  252.  
  253. listify_body_n(A) -> map(feature_subterm_n(2 => A),features_n(A)).
  254.  
  255. feature_subterm_n(A,B) -> A, project_n(A,B).
  256.  
  257. %
  258. % Specially handle new list sort manipulation
  259. %
  260. bodify_list_n([])                -> @.
  261. bodify_list_n([(hd, X),(tl, Y)]) -> [X|Y].
  262. bodify_list_n([(A, B)|C:@])      -> D:bodify_list_n(C) | B = project_n(A,D).
  263.