home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / TESTS / LF / COPY1.LF < prev    next >
Text File  |  1996-06-04  |  4KB  |  102 lines
  1.  
  2. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3.  
  4. % As a (useful) programming exercise, it is interesting to write in LIFE a
  5. % function that takes an arbitrary psi-term and returns a distinct clone
  6. % copy of it. The only real complication comes from the necessity to
  7. % respect faithfully all coreferences, including cycles.  The point, of
  8. % course, is to do it as `cleanly' as possible; i.e., without `assert' nor
  9. % `retract' and neither in-place assignment.
  10.  
  11. % This solution -- one of many, I am sure -- is purely functional.
  12.  
  13. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  14.  
  15. % The main function is called `copy'. It uses an auxiliary function
  16. % `memo_copy' that does the actual copying with the necessary book
  17. % keeping to enforce coreferences. It takes a pair of psi-term and a
  18. % list of pairs of psi-terms (a table of correspondence between nodes
  19. % that have been already copied and their actual copies), and returns a
  20. % similar object. So, copy just projects out the correspondence table
  21. % and keeps the first component of the pair (the fully copied x).
  22.  
  23. copy(X) -> memo_copy(X,[]).1.
  24.  
  25. % Another way of extracting a component of a structure is by unification
  26. % using the `where' function trick [defined as where -> @.] and define
  27. % `copy' as follows: 
  28.  
  29. % copy(X) -> C:where((C , _):memo_copy(X,[])).
  30.  
  31. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  32.  
  33. % The function `memo_copy' takes a psi-term and a table of the copies that
  34. % have already been made and returns a pair of the copy and updated table. 
  35.  
  36. memo_copy(X,Table:list) ->
  37.     cond( deja_vu(X,Table) & bool(Copy)
  38.         , (Copy , Table)
  39.         , (Copy&root_sort(X)&bodify_list(B) , New_Table)
  40.               & where((B , New_Table)
  41.                      & copy_body(listify_body(X),[(X , Copy)|Table]))
  42.             ).
  43.  
  44. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  45.  
  46. % The function `deja_vu' checks whether its first argument has already being
  47. % recorded as the left component of a pair in its second argument (a table in
  48. % the form of a list of pairs). It returns `false' if it is nout found, and
  49. % otherwise returns `true' augmented with feature 1 set to its corresponding
  50. % copy. 
  51.  
  52. deja_vu(@,[])        -> false.
  53. deja_vu(X,[(Y , V)|T]) -> cond( X===Y
  54.                 , true(V)
  55.                 , deja_vu(X,T)
  56.                 ).
  57.  
  58.  
  59. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  60.  
  61. % The function `copy_body' takes a list of pairs of the form
  62. % (attribute,psi-term) and a table and returns a pair made up
  63. % of a similar list and a new table.
  64.  
  65. copy_body([],Table:list)        -> ([] , Table).
  66. copy_body([(A , X)|T],Table:list) -> ([(A , CX)|CT] , New_Table)
  67.                    & where( (CX , NT) & memo_copy(X,Table)
  68.                          , (CT , New_Table) & copy_body(T,NT)
  69.                      ).
  70.  
  71. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  72.  
  73. % The function `bodify_list' rebuilds a psi-term body from a list of pairs of
  74. % the form (attr,subterm). 
  75.  
  76. bodify_list([]) -> @.
  77. bodify_list([(A , X)|T]) -> Y : bodify_list(T)
  78.                   | X = Y.A.
  79.  
  80. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  81.  
  82. % The function `listify_body' does the opposite -- i.e., it returns the body
  83. % of a psi-term in the form of a list of pairs (attr,subterm).
  84.  
  85. listify_body(X) -> map(feature_value(2=>X),features(X)).
  86.  
  87. feature_value(A,X) -> (A , X.A).
  88.  
  89. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  90.  
  91. %%%%%%%%% STRUCTURELLE EQUALITY
  92.  
  93. str_eq0(X,Y)->     cond(    copy(X)=copy(Y),
  94.             true,
  95.             false
  96.              ).
  97. str_eq1(X,Y) -> A=(copy(X) & copy(Y)).
  98. str_eq2(X,Y) -> copy(X) & copy(Y).
  99.  
  100.  
  101. where -> @.
  102.