home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / TESTS / LF / WAM.LF < prev    next >
Text File  |  1996-06-04  |  2KB  |  99 lines
  1. %
  2. %
  3. %        Unification WAM
  4. %
  5. %
  6. %
  7.  
  8. % For map, see below:
  9. my_project(A,B) -> B.A.
  10.  
  11. joliwam(V,T) :- joli(wam(V,T)).
  12.  
  13. wam(V,T) -> aplati(lrmap(transequ,expandequ(equ(V,T)))).
  14.  
  15. %
  16. %
  17. % Expansion de l'equation de depart
  18. %
  19. %
  20. expandequ(equ(V,T1)) -> [equ(V,T2)|expand(Listequ)]
  21.                               | split(T1,T2,Listequ).
  22.  
  23. expand(Listequ) -> aplati(map(expandequ,Listequ)).
  24.  
  25.  
  26. split(T1,T2,Listequ) :-
  27.                        Kmax = length(features(T1)),
  28.                       (Kmax=0, !, T2=T1, Listequ=[];
  29.                        aplat(T1,Kmax,[],T2,Listequ) ). 
  30.  
  31. aplat(T1,0,Listequ,root_sort(T1),Listequ):- !.
  32.  
  33. aplat(T1,N,Listprov,T2,Listequ) :- 
  34.                     projete(N,T1,T2,A),
  35.                     (
  36.                     var(A),!, aplat(T1,N-1,Listprov,T2,Listequ);
  37.                     aplat(T1,N-1,[equ(T2.N,A)|Listprov],T2,Listequ)
  38.                     ).
  39.  
  40. projete(N,T1,T2,A) :- 
  41.                     ( features(P:(T1.N))=[], !, T2.N=P ;
  42.                       A=P, T2.N=@ ).
  43.  
  44.  
  45.  
  46. %
  47. %
  48. % Premiere passe: traduction elementaire
  49. %
  50. %
  51.  
  52. consta(X) :- nonvar(X),arity(X)=0.
  53.  
  54. transequ(equ(V,T)) -> { ([get_const(V,T)] | consta(T),!) ;
  55.                         ([get_struct(V,root_sort(T),arity(T))| transsup(T)]
  56.                         | V=reg(U))}.
  57.  
  58. transsup(T) -> lrmap(transarg,map(my_project(2=>T),features(T))).
  59.  
  60. transarg(Arg) -> { (unify_const(Arg) | consta(Arg),!) ;
  61.                    (unify_variable(Arg) | var(Arg),Arg=reg(U),!);
  62.                    unify_value(Arg)}.
  63.  
  64.  
  65.  
  66. %
  67. %
  68. % Ecriture
  69. %
  70. %
  71.  
  72. joli([]).
  73. joli([Inst|Listinst]) :- joli_write(Inst), joli(Listinst),!.
  74.  
  75. joli_write(get_struct(V,Foncteur,Arite)) :- nl, 
  76.              write("get_struct ",V," ",Foncteur,"/",Arite).
  77. joli_write(get_const(V,Const)) :-  nl, 
  78.              write("get_const ",V," ",Const).
  79. joli_write(unify_const(Const)) :- nl, write("unify_const ",Const),!.
  80. joli_write(unify_variable(Var)) :- nl, write("unify_variable ",Var),!.
  81. joli_write(unify_value(Var)) :- nl, write("unify_value ",Var),!.
  82. %
  83. %
  84. % Fonctions  et predicats utiles
  85. %
  86. %
  87.  
  88. arity(T) -> length(features(T)).
  89.  
  90. aplati([]) -> [].
  91. aplati([L1|L2]) -> append(L1,aplati(L2)).
  92.  
  93. %
  94. %  map function, from left to right.
  95. %
  96.  
  97. lrmap(F,[]) -> [].
  98. lrmap(F,[E|L]) -> [F(E)|L1] | L1=lrmap(F,L).
  99.