home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / TESTS / LF / WAMBRUNO.LF < prev    next >
Text File  |  1996-06-04  |  8KB  |  261 lines
  1.  
  2. % FILE. . . . . /udir/dicosmo/life/code/repair_list
  3. % EDIT BY . . . Roberto Di Cosmo
  4. % ON MACHINE. . Prl341
  5. % STARTED ON. . Thu Sep 18 16:10:30 1992
  6. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  7.  
  8. %
  9. % Repair buggy list sort definitions
  10. %
  11.  
  12. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  13.  
  14. % The built ins of the current version of  Wild_Life treat lists in a special
  15. % way, that renders it impossible to write programs  that navigate prsi terms
  16. % in a general uniform way.
  17. %
  18. % This file  provides the necessary   (not necessarily  efficient) workaround
  19. % while waiting for the definitive solution (in the compiler?).
  20. %
  21. % The functions features, root_sort, project, listify_body and bodify_list are
  22. % provided here  in a _n form that  works uniformly  on  psi-terms, even when
  23. % they are lists.
  24. %
  25.  
  26. %
  27. % Examples of applications are  to be found in dissolve.life, wam_bruno.life,
  28. % name_top_vars.life
  29. %
  30.  
  31. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  32.  
  33.  
  34. %
  35. % To  avoid residuation  on variables, I fire  the function anyway, and  then
  36. % check what I have in hand, in the internal functions
  37. %
  38.  
  39. features_n(X) -> N | var(X), N=[],!; N=features_internal(X).
  40. features_internal([])    -> [].
  41. features_internal([X|T]) -> [hd,tl].
  42. features_internal(X)     -> features(X).
  43.  
  44. root_sort_n(X) -> N | var(X), N=@,!; N=root_sort_internal(X).
  45. root_sort_internal([])    -> nil.
  46. root_sort_internal([X|T]) -> cons.
  47. root_sort_internal(X)     -> root_sort(X).
  48.  
  49. project_n(A,X) -> N | var(X), N=X.A,!; N=project_internal(A,X).
  50. project_internal(hd,[X|T]) -> X.
  51. project_internal(tl,[X|T]) -> T.
  52. project_internal(tl,[])    -> [].
  53. project_internal(A,X)      -> X.A.
  54.  
  55. %
  56. % Rebuild listify_body and  bodify_list using  the  repaired sort  navigation
  57. % functions
  58. %
  59.  
  60. listify_body_n(A) -> map(feature_subterm_n(2 => A),features_n(A)).
  61.  
  62. feature_subterm_n(A,B) -> A, project_n(A,B).
  63.  
  64. %
  65. % Specially handle new list sort manipulation
  66. %
  67. bodify_list_n([])                -> @.
  68. bodify_list_n([(hd, X),(tl, Y)]) -> [X|Y].
  69. bodify_list_n([(A, B)|C:@])      -> D:bodify_list_n(C) | B = project_n(A,D).
  70.  
  71. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  72. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  73.  
  74. % FILE. . . . . /udir/dicosmo/life/code/name_top_vars
  75. % EDIT BY . . . Roberto Di Cosmo
  76. % ON MACHINE. . Prl341
  77. % STARTED ON. . Thu Sep 24 16:10:30 1992
  78. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  79.  
  80. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  81.  
  82. % Take a psi-term and return a copy of it  where all variables satisfying the
  83. % predicate "var"   (i.e.,  by  this time, being    of   sort @)    are named
  84. % consistently, by moving  them down  the sort hierarchy  to the  appropriate
  85. % string sort.
  86.  
  87. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  88.  
  89. % load(repair_list)?
  90.  
  91. %
  92. % The function genvar yields a new variable name each time it is called
  93. %
  94.  
  95. setq(my_gen_sym,0)?
  96.  
  97. genvar -> strcon("U",int2str(N)) | N = my_gen_sym, setq(my_gen_sym,N+1).
  98.  
  99. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  100.  
  101. % The  function `name_vars' takes a psi-term  and returns a  copy of it where
  102. % all variables satisfying the predicate "var" (i.e., by  this time, being of
  103. % sort  @) are named  consistently, by moving   them down to  the appropriate
  104. % string sort.
  105.  
  106. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  107.  
  108. name_vars(X) -> Y | Y = copy_term(X), name_top_vars(Y,[]).
  109.  
  110. name_vars_from_to(X,N,M) -> Y | setq(my_gen_sym,N),
  111.                                 Y = name_vars(X),
  112.                                 M = my_gen_sym.
  113.  
  114. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  115.  
  116. %
  117. % Since  the  root_sort of  a  list is  not "cons",  with  features "head" and
  118. % "tail", this function needs to use the  repaired life  version  of features
  119. % called features_n to navigate in every psi-term uniformly
  120. %
  121. % We  need here also a   table of already  seen elements  to avoid looping on
  122. % cyclic structures; the updated table is given back as the last argument
  123. %
  124.  
  125. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  126.  
  127. name_top_vars(X,Table,[X|Table])
  128.        :- call_once(var(X)),!, X = genvar.
  129. name_top_vars(X,Table,NewTable)
  130.        :- name_top_vars_body(features_n(X),X,[X|Table],NewTable).
  131.  
  132. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  133.  
  134. % The   function `name_top_vars_body'  takes a  list   of pairs  of  the form
  135. % (attribute,psi-term) and a table  and returns a pair  made up of  a similar
  136. % list and a new table.
  137.  
  138. name_top_vars_body([],X,Table,Table)
  139.        :- !.
  140. name_top_vars_body([A|T],X,Table,NewTable)
  141.        :- Z=project_n(A,X),
  142.             cond(memq(Z,Table),
  143.                  name_top_vars_body(T,X,Table,NewTable),
  144.                  (name_top_vars(Z,Table,NT), name_top_vars_body(T,X,NT,NewTable))).
  145.  
  146. %
  147. % true iff X occurs in the list passed as second argument
  148. %
  149.  
  150. memq(X,[])    -> false.
  151. memq(X,[Y|T]) -> cond(X===Y,true,memq(X,T)).
  152.  
  153. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  154.  
  155.  
  156. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  157. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  158.  
  159. %
  160. %
  161. %        Unification WAM
  162. %
  163. %
  164. %
  165.  
  166. % load(name_top_vars)?
  167.  
  168. %
  169. %  map function, from left to right.
  170. %
  171. lrmap(F,[]) -> [].
  172. lrmap(F,[E|L]) -> [F(E)|L1] | L1=lrmap(F,L).
  173.  
  174. joliwam(V,T) :- joli(wam(V,T)).
  175.  
  176. wam(V,T) -> aplati(lrmap(transequ,expandequ(equ(V,T)))).
  177.  
  178. %
  179. %
  180. % Expansion de l'equation de depart
  181. %
  182. %
  183. expandequ(equ(V,T1)) -> [equ(V,T2)|expand(Listequ)]
  184.                               | split(T1,T2,Listequ).
  185.  
  186. expand(Listequ) -> aplati(map(expandequ,Listequ)).
  187.  
  188.  
  189. split(T1,T2,Listequ) :-
  190.                        Kmax = length(features(T1)),
  191.                       (Kmax=0, !, T2=T1, Listequ=[];
  192.                        aplat(T1,Kmax,[],T2,Listequ) ). 
  193.  
  194. aplat(T1,0,Listequ,root_sort(T1),Listequ):- !.
  195.  
  196. aplat(T1,N,Listprov,T2,Listequ) :- 
  197.                     projete(N,T1,T2,A),
  198.                     (
  199.                     var(A),!, aplat(T1,N-1,Listprov,T2,Listequ);
  200.             gc,
  201.                     aplat(T1,N-1,[equ(T2.N,A)|Listprov],T2,Listequ)
  202.                     ).
  203.  
  204. projete(N,T1,T2,A) :- 
  205.                     ( features(P:(T1.N))=[], !, T2.N=P ;
  206.                       A=P, T2.N=@ ).
  207.  
  208.  
  209.  
  210. %
  211. %
  212. % Premiere passe: traduction elementaire
  213. %
  214. %
  215.  
  216. consta(X) :- nonvar(X),arity(X)=0.
  217.  
  218. transequ(equ(V,T)) -> { ([get_const(V,T)] | consta(T),!) ;
  219.                         ([get_struct(V,root_sort(T),arity(T))| transsup(T)]
  220.                         | V=reg(U))}.
  221.  
  222. % For map:
  223. my_project(A,B) -> B.A.
  224.  
  225. transsup(T) -> lrmap(transarg,map(my_project(2=>T),features(T))).
  226.  
  227. transarg(Arg) -> { (unify_const(Arg) | consta(Arg),!) ;
  228.                    (unify_variable(Arg) | var(Arg),Arg=reg(U),!) ;
  229.                    unify_value(Arg)}.
  230.  
  231.  
  232.  
  233. %
  234. %
  235. % Ecriture
  236. %
  237. %
  238.  
  239. joli(X) :- setq(my_gen_sym,1), joli_internal(name_vars(X)).
  240. joli_internal([]).
  241. joli_internal([Inst|Listinst]) :- joli_write(Inst), joli_internal(Listinst),!.
  242.  
  243. joli_write(get_struct(V,Foncteur,Arite)) :- nl, 
  244.              write("get_struct ",V," ",Foncteur,"/",Arite).
  245. joli_write(get_const(V,Const)) :-  nl, 
  246.              write("get_const ",V," ",Const).
  247. joli_write(unify_const(Const)) :- nl, write("unify_const ",Const),!.
  248. joli_write(unify_variable(Var)) :- nl, write("unify_variable ",Var),!.
  249. joli_write(unify_value(Var)) :- nl, write("unify_value ",Var),!.
  250.  
  251. %
  252. %
  253. % Fonctions  et predicats utiles
  254. %
  255. %
  256.  
  257. arity(T) -> length(features(T)).
  258.  
  259. aplati([]) -> [].
  260. aplati([L1|L2]) -> append(L1,aplati(L2)).
  261.