home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / TESTS / IN / INTABS.IN < prev    next >
Text File  |  1996-06-04  |  3KB  |  140 lines
  1.  
  2. nl,nl,write("*** TESTING COMPABS ***") ?
  3.  
  4. concat(X,Y,Z) ::-- 
  5.     ( 
  6.         X = nil, Y = Z ; 
  7.         X = cons(A,L1), Z = cons(A,L2), concat(L1,Y,L2)
  8.     ) ?
  9.  
  10.  
  11. toto(X,Y) ::--
  12.     (
  13.         X = a, tata(Y) ;
  14.         X = b, tata(Y) ;
  15.         (
  16.         tutu(X,Y), ! ;
  17.         fail
  18.         )
  19.     )?
  20.  
  21. succeed '..' ?
  22.  
  23. listing(concat_proc)?
  24. listing(toto_proc) ?
  25.  
  26.  
  27. nl,nl,write("*** TESTING NORMALIZATION ***") ?
  28.  
  29. normalize(X:t(U,g(X,a)),parents=>[]), nl,write(X) ?
  30. normalize(X & t(X,g(b,a)),parents=>[]), nl,write(X) ?
  31.  
  32.  
  33. %
  34. % EXTEND, FIND_NODE
  35. %
  36.  
  37. nl,nl,write("*** TESTING EXTEND AND FIND_NODE ***") ?
  38.  
  39. init_solve(SAT) ?
  40.  
  41. extend( ground, p, sat) = @(SAT,NewNode,New), 
  42. set_sat(SAT) ? 
  43.  
  44. extend( free, q, sat) = @(SAT,NewNode,New), 
  45. set_sat(SAT)?
  46.  
  47. extend( non_var, q, sat) = @(SAT,Node1,New1), 
  48. extend( ground, q, SAT) = @(SAT,Node2,New2), 
  49. extend( ground, q, SAT) = @(SAT,Node3,New3),
  50. nl,nl ,write(Node2 === Node3,"  ",New2,"  ",not(New3)),
  51. find_node( ground, q, SAT) = Node6,
  52. nl,nl ,write(Node6 === Node3),
  53. extend( bot, q, SAT) = @(SAT,Node4,New4),
  54. extend( any, q, SAT) = @(SAT,Node5,New5),
  55. set_sat(SAT) ?
  56.  
  57.  
  58. %
  59. % ADJUST
  60. %
  61.  
  62. nl,nl,write("*** TESTING ADJUST ***") ?
  63.  
  64. adjust( ground, q, ground, sat) = @(SAT,Modified,AT),
  65. nl,nl,write(Modified),
  66. set_sat(SAT) ?
  67.  
  68. adjust( free, q, free, sat) = @(SAT,Modified,AT),
  69. nl,nl,write(Modified),
  70. set_sat(SAT) ?
  71.  
  72. %
  73. % SUSPENSION
  74. %
  75.  
  76. nl,nl,write("*** TESTING SUSPENSION ***") ?
  77.  
  78. find_node( ground, q, SAT:sat) = Node,
  79. cond( not_suspended(Node),
  80.       suspend(Node),
  81.       nl, nl, write( "Bug in not_suspended" )),
  82. cond( not_suspended(Node),
  83.       (
  84.       nl, nl, write( "Bug in suspend" )
  85.       ),
  86.       un_suspend(Node)),
  87. cond( not_suspended(Node),
  88.       (
  89.       nl, nl, write("OK")
  90.       ),
  91.       (
  92.       nl, nl, write("Bug in un_suspend")
  93.       )),
  94. suspend(Node),
  95. set_sat(SAT) ? 
  96.  
  97. %
  98. % DEPENDENCIES
  99. %
  100.  
  101. nl,nl,write("*** TESTING DEPENDENCIES ***") ?
  102.  
  103. find_node( non_var, q, SAT:sat) = Node,
  104. ext_dp(Node),
  105. add_dp(ground, p, Node, SAT),
  106. add_dp(free, q, Node, SAT),
  107. find_node( ground, q, SAT) = Node2,
  108. add_dp(free, q, Node2, SAT),
  109. remove_dp([find_node( ground, p, SAT)],SAT),
  110. nl,nl,write(SAT) ?
  111.  
  112.  
  113. nl,nl,write("*** TESTING ANALYSE WITH A SIMPLE DOMAIN ***") ?
  114.  
  115. tooo(X,Y) ::-- X = a, X = Y ?       
  116.  
  117. solve([free,free],tooo),
  118. nl,nl,pretty_write(sat) ?                      % simple
  119.  
  120. tata(X,Y) ::-- 
  121.     ( 
  122.         X = a, X = Y ;
  123.         succeed
  124.     )?
  125.  
  126. succeed '..' ?
  127.  
  128. solve([free,free],tata),
  129. nl,nl,pretty_write(sat) ?                      % disjunction
  130.  
  131. solve([ground,ground,free],concat),
  132. nl,nl,pretty_write(sat) ?                      %  recursion
  133.  
  134. tutu(X) ::-- X = cons(Y,Z), titi(Y,Z) ?
  135.  
  136. titi(X,Y) ::-- X = a, Y = b ?
  137.  
  138. solve([free],tutu),
  139. nl,nl,pretty_write(sat) ?                      % Back propagation
  140.