home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / LIB / STRUCTUR.LF < prev    next >
Text File  |  1996-06-04  |  5KB  |  203 lines
  1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2. %    $Id: structures.lf,v 1.3 1995/07/06 18:24:14 duchier Exp $    
  3. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  4. %
  5. % STRUCTURES LIBRARY
  6. %
  7. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  8. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  9.  
  10. module("structures") ?
  11.  
  12. public(+>=,+=<,+>,+<,+><,==,+\>=,+\=<,+\>,+\<,+\><,\==) ?
  13.  
  14.  
  15. import("lists") ?
  16.  
  17. %%% operators
  18.  
  19. op(600,xfx, +>= ) ?  %%% is more general than
  20. op(600,xfx, +=< ) ?  %%% is less general than
  21. op(600,xfx, +> ) ?   %%% is strictly more general than
  22. op(600,xfx, +< ) ?   %%% is strictly less general than
  23. op(600,xfx, +>< ) ?  %%% is comparable to
  24. op(600,xfx, ==  ) ?  %%% structurally equal to
  25. op(600,xfx, +\>= ) ? %%% is not more general than
  26. op(600,xfx, +\=< ) ? %%% is not less general than
  27. op(600,xfx, +\> ) ?  %%% is not strictly more general than
  28. op(600,xfx, +\< ) ?  %%% is not strictly less general than
  29. op(600,xfx, +\>< ) ? %%% is not comparable to
  30. op(600,xfx, \== ) ?  %%% is not structurally equal to
  31.  
  32.  
  33. add_man([structures,+>=,+=<,+>,+<,+><,==,+\>=,+\=<,+\>,+\<,+\><,\==],
  34.      " Structural Comparison Operators:
  35.  
  36.   +>=,+=<,+>,+<,+><,==,+\>=,+\=<,+\>,+\<,+\><,\==
  37.  
  38.   All these operators are of type xfx, precedence 600.
  39.   They are implemented as boolean functions.
  40.  
  41.   They all have two arguments that may be any psi-term.
  42.   They never residuate.
  43.  
  44.   The usual naming conventions for comparison operators are preserved
  45.   here. For example:
  46.  
  47.   X +>= Y returns true if X is structurally greater or identical to Y,  
  48.                   false otherwise.
  49.  
  50.   X == Y returns true if X is structurally identical to Y,   
  51.                  false otherwise.
  52.   ") ?
  53.  
  54.        
  55.  
  56. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  57. %
  58. % MAIN FUNCTIONS
  59. %
  60. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  61.  
  62. persistent(res) ?
  63. res <<- false ?
  64.  
  65. X +>= Y -> 
  66.     Bool 
  67.     | 
  68.         (
  69.         res <<- false,
  70.         is_struct_more_general(X, Y),
  71.         res <<- true,
  72.         fail                              
  73.     ;
  74.         Bool = res
  75.     ).
  76.  
  77. X +> Y -> 
  78.     Bool 
  79.     | 
  80.         (
  81.         res <<- false,
  82.         is_strict_struct_more_general(X,Y, strict => S),
  83.         res <<- (S :== true),
  84.         fail                              
  85.     ;
  86.         Bool = res
  87.     ).
  88.  
  89. X == Y -> 
  90.     Bool 
  91.     | 
  92.         (
  93.         res <<- false,
  94.         is_struct_equal(X,Y),
  95.         res <<- true,
  96.         fail                              
  97.     ;
  98.         Bool = res
  99.     ).
  100.  
  101. X +>< Y -> cond( X +>= Y, true, Y +> X ).
  102.  
  103. %%% symetries
  104.  
  105. X +=< Y -> Y +>= X.
  106. X +< Y -> Y +> X.
  107.  
  108. %%% negations
  109.  
  110. X +\>= Y -> not(X +>= Y).
  111. X +\=< Y -> not(X +=< Y).
  112. X +\>  Y -> not(X +>  Y).
  113. X +\<  Y -> not(X +<  Y).
  114. X +\>< Y -> not(X +>< Y).
  115. X \== Y  -> not(X ==  Y).
  116.  
  117.  
  118. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  119. %
  120. % COMPARISON PREDICATES
  121. %
  122. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  123.  
  124. %%% comparison
  125.  
  126. is_struct_more_general( A, B) :-
  127.     has_feature(visited,A), !,
  128.     project(visited,A) === B
  129.     ;
  130.     root_sort(A) :>= root_sort(B),
  131.     sort_order_included(Fa:features(A),features(B)),
  132.     build_features_list(Fa,A,B,LA,LB),
  133.     A = @(visited => B),
  134.     are_struct_more_general(LA, LB).
  135.  
  136.  
  137. are_struct_more_general([],[]) :- !.
  138. are_struct_more_general([F1A|FsA],[F1B|FsB]) :-
  139.     is_struct_more_general( F1A,F1B),
  140.     are_struct_more_general(FsA,FsB).
  141.  
  142.  
  143.  
  144. %%% strict comparison
  145.  
  146. is_strict_struct_more_general( A, B, strict => S) :-
  147.     has_feature(visited,A), !,
  148.     project(visited,A) === B
  149.     ;
  150.     Ra:root_sort(A) :>= Rb:root_sort(B),
  151.     Bool:sort_order_included(Fa:features(A),features(B)),
  152.     cond( Ra :> Rb or has_feature(visited,B) or project(1,Bool),
  153.           S = true),
  154.     build_features_list(Fa,A,B,LA,LB),
  155.     A = @(visited => B&@(visited => A)),
  156.     are_strict_struct_more_general(LA, LB, strict => S).
  157.  
  158.  
  159. are_strict_struct_more_general([],[]) :- !.
  160. are_strict_struct_more_general( [F1A|FsA], [F1B|FsB], strict => S) :-
  161.     is_strict_struct_more_general( F1A, F1B, strict => S),
  162.     are_strict_struct_more_general( FsA, FsB, strict => S).
  163.  
  164.  
  165. %%% equality
  166.  
  167. is_struct_equal( A, B) :-
  168.     has_feature(visited,A) or has_feature(visited,B), !,
  169.     project(visited,A) === B
  170.     ;
  171.     root_sort(A) :== root_sort(B),
  172.     Fa:features(A) = Fb:features(B),
  173.     build_features_list(Fa,A,B,LA,LB),
  174.     A = @(visited => B&@(visited => A)),
  175.     are_struct_equal(LA, LB).
  176.  
  177.  
  178. are_struct_equal([],[]) :- !.
  179. are_struct_equal([F1A|FsA],[F1B|FsB]) :-
  180.     is_struct_equal( F1A,F1B),
  181.     are_struct_equal(FsA,FsB).
  182.  
  183. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  184. %
  185. %    utilities
  186. %
  187. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  188.  
  189. build_features_list([],A,B,[],[]) :- !.
  190. build_features_list([F1|Fs],A,B,[FA|NFA],[FB|NFB]) :-
  191.     FA = project(F1,A),
  192.     FB = project(F1,B),
  193.     build_features_list(Fs,A,B,NFA,NFB).
  194.  
  195. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  196. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.