home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / LISP Related / U. Mass AI & LISP Tools / MODULES / DNET / DNET-Test.lisp < prev    next >
Encoding:
Text File  |  1990-06-22  |  8.2 KB  |  179 lines  |  [TEXT/MACA]
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ; File:         DNET-TEST.LISP
  3. ; Author:       Dan Suthers
  4. ; Created:      08-Jun-88 19:35:47
  5. ; Modified:     24-Nov-89 01:34:03 (Dan Suthers)
  6. ; Language:     LISP
  7. ; Package:      USER
  8. ;
  9. ; Description:  For testing DNET.LISP when it is changed.  One should load
  10. ;               this file after loading DNET and check the printed results.
  11. ;               Do it for both uncompiled and compiled versions of this
  12. ;               file, in SEPARATE lisp sessions.
  13. ;
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15.  
  16. (in-package :USER)
  17.  
  18. (require :DNET)
  19.  
  20. (use-package :DNET)
  21.  
  22. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  23.  
  24. (format T "~%~%-------------------- DNET TESTS --------------------")
  25. (format T "~%~%---------- Variable Defining (x, y, z) ----------")
  26. (defvariable x)
  27. (defvariable y)
  28. (defvariable z)
  29.  
  30. (format T "~%~%---------- DNET Manipulation ----------")
  31. (format t "~%Making a DNET called TEST with a NEW-EXPR-HOOK that prints stuff:")
  32. (format t " ~S" (make-dnet 'test  
  33.                            :indexpr-hook '(lambda (expr terminal) 
  34.                                            (format T "~&<indexpr-hook> ~S indexed in ~S"
  35.                                                    expr terminal))
  36.                            :delexpr-hook '(lambda (expr terminal) 
  37.                                            (format T "~&<delexpr-hook> ~S deleted from ~S"
  38.                                                    expr terminal))))
  39.  
  40. (format T "~%Setting the INFO of TEST to say what it is for ...")
  41. (setf (dnet-info 'test) "A discrimination net for testing the DNET code.")
  42. (format T "~%Now its INFO is:~%~S" (dnet-info 'test))
  43.  
  44. (format T "~%~%---------- Indexing Expressions ----------")
  45. (format T "~%Initializing TEST with four expressions:")
  46. (indexpr 'x 'test)
  47. (indexpr '(a b c) 'test)
  48. (indexpr '(a b junk this one) 'test)
  49. (indexpr '(x y z) 'test)
  50. (format T "~%All Expressions are
  51. (X (A B JUNK THIS ONE) (A B C) (X Y Z)): ~%~S"
  52.           (all-expressions 'test))
  53.  
  54. (let ((*print-pretty* t))  
  55.   (format T "~%The net itself should look like:~%")
  56.   (print '(TEST
  57.            (:BEGIN-LIST (X (Y (Z (:END-LIST . <VECTOR>))))
  58.                         (A (B (JUNK (THIS (ONE (:END-LIST . <VECTOR>))))
  59.                               (C (:END-LIST . <VECTOR>)))))
  60.            (X . <VECTOR>)))
  61.   (print (dnet::dnet-link (sm:gets 'dnet:dnet 'test)))
  62.   (values))
  63.  
  64. (format T "~%~%---------- Deleting Expressions ----------")
  65. (format T "~%Deleting (a b junk this one):")
  66. (format T " ~S" (delexpr '(a b junk this one) 'test))
  67.  
  68. (let ((*print-pretty* t))  
  69.   (format T "~%After deletion of the junk expression, the net should look like:~%")
  70.   (print
  71.    '(TEST
  72.      (:BEGIN-LIST (X (Y (Z (:END-LIST . <VECTOR>))))
  73.                   (A (B (C (:END-LIST . <VECTOR>)))))
  74.      (X . <VECTOR>)))
  75.   (print (dnet::dnet-link (sm:gets 'dnet:dnet 'test)))
  76.   (values))
  77.   
  78. (format T "~%~%---------- More Indexing and INFO ----------")
  79. (format t "~%Adding four more test expressions: ")
  80. (indexpr '(a (b) c) 'test)
  81. (indexpr '((1) ((2)) (((3)))) 'test)
  82. (indexpr 'nil 'test)
  83. (indexpr '(nil) 'test)
  84. (format T 
  85.         "~%Now All expressions are:~%(X NIL (A B C) (A (B) C) (X Y Z) ((1) ((2)) (((3)))) (NIL))~%~S"
  86.         (all-expressions 'test))
  87. (format T "~%Adding info to expression ((1) ((2)) (((3)))) ... ")
  88. (setf (expr-info '((1) ((2)) (((3)))) 'test) 
  89.       "A list of numbers where each number is enclosed with as many parentheses.")
  90. (format T "~%Accessing that info yields:~%~S" (expr-info '((1) ((2)) (((3)))) 'test))
  91.   
  92. (format T "~%~%---------- GETEXPRing  ----------")
  93. (format T "~%GETEXPR '(a (b) c): ~S" (getexpr '(a (b) c) 'test))
  94. (format T "~%GETEXPR 'nil: ~S" (getexpr 'nil 'test))
  95. (format T "~%GETEXPR '(nil): ~S" (getexpr '(nil) 'test))
  96.  
  97. (format T "~%~%---------- Pattern to Expression Matching  ----------")
  98. (format T "~%MATCH-PATTERN '(?:x) => ~%((nil)) with bindings (((?:X))):")
  99. (multiple-value-bind (r b) (match-pattern '(?:x) 'test) (print r) (print b))
  100. (format T 
  101.         "~%MATCH-PATTERN '(a ?:x c) ==> ~%((A (B) C) (A B C)) with bindings (((?:X B)) ((?:X . B))):")
  102. (multiple-value-bind (r b) (match-pattern '(a ?:x c) 'test) (print r) (print b))
  103. (format T 
  104.         "~%MATCH-PATTERN '((?:x) ((?:y)) (((?:z)))) ==> ~%(((1) ((2)) (((3))))) with bindings (((?:Z . 3) (?:Y . 2) (?:X . 1))):")
  105. (multiple-value-bind (r b) (match-pattern '((?:x) ((?:y)) (((?:z)))) 'test) (print r) (print b))
  106. (format T "~%MATCH-PATTERN '(a ?:x ?:x) ==> no match:")
  107. (multiple-value-bind (r b) (match-pattern '(a ?:x ?:x) 'test) (print r) (print b))
  108. (format T "~%MATCH-PATTERN '(?:x ?:x) ==> no match (this found a bug once):")
  109. (multiple-value-bind (r b) (match-pattern '(?:x ?:x) 'test) (print r) (print b))
  110.  
  111. (format T "~%~%---------- Expression to Pattern Matching  ----------")
  112. (format T "~%INDEXPR (a ?:x ?:y):")
  113. (indexpr '(a ?:x ?:y) 'test)
  114.  
  115. (format T "~%MATCH-EXPRESSION 'x ==> ~%(X) with bindings (NIL):")
  116. (multiple-value-bind (r b) (match-expression 'x 'test) (print r) (print b))
  117.  
  118. (format T "~%MATCH-EXPRESSION 'nil ==> ~%(NIL) with bindings (NIL):")
  119. (multiple-value-bind (r b) (match-expression 'nil 'test) (print r) (print b))
  120.  
  121. (format T "~%MATCH-EXPRESSION '(nil) ==> ~%((NIL)) with bindings (NIL):")
  122. (multiple-value-bind (r b) (match-expression '(nil) 'test) (print r) (print b))
  123.  
  124. (format T "~%MATCH-EXPRESSION '(a b c) ==> ~%((A B C) (A ?:X ?:Y)) with bindings (NIL ((?:Y . C) (?:X . B))):")
  125. (multiple-value-bind (r b) (match-expression '(a b c) 'test) (print r) (print b))
  126.  
  127. (format T "~%MATCH-EXPRESSION '?:x ==> NIL and NIL:")
  128. (multiple-value-bind (r b) (match-expression '?:x 'test) (print r) (print b))
  129.  
  130. (format T "~%But now we add ?:x to the dnet (which matches anything) ...")
  131. (indexpr '?:x 'test)
  132.  
  133. (format T "~%MATCH-EXPRESSION '?:x ==> ~%(?:X) with bindings (((?:X . ?:X))):")
  134. (multiple-value-bind (r b) (match-expression '?:x 'test) (print r) (print b))
  135.  
  136. (format T "~%That was to test for removing duplicates.")
  137.  
  138. (format T "~%MATCH-EXPRESSION '(a small dog) ==> ~%((A ?:X ?:Y) ?:X) with bindings (((?:Y . DOG) (?:X . SMALL)) ((?:X A SMALL DOG))):")
  139. (multiple-value-bind (r b) (match-expression '(a small dog) 'test) (print r) (print b))
  140.  
  141. (format T "~%~%---------- Pattern to Pattern Matching  ----------")
  142. (format T "~%To prepare, INDEXPR (a ?:y ?:y) and (a b b) and DELEXPR ?:x and (a (b) c) ...")
  143. (indexpr '(a ?:y ?:y) 'test)
  144. (indexpr '(a b b) 'test)
  145. (delexpr '?:x 'test)
  146. (delexpr '(a (b) c) 'test)
  147.  
  148. (format T "~%MATCH '(a b c) ==> ~%((A B C) (A ?:X ?:Y)) with bindings (NIL NIL) and (NIL ((?:Y . C) (?:X . B))):")
  149. (multiple-value-bind (r b1 b2) (match '(a b c) 'test) (print r) (print b1) (print b2) (values))
  150.  
  151. (format T "~%MATCH '(a c c) ==> ~%((A ?:X ?:Y) (A ?:Y ?:Y)); (NIL NIL); (((?:Y . C) (?:X . C)) ((?:Y . C))):")
  152. (multiple-value-bind (r b1 b2) (match '(a c c) 'test) (print r) (print b1) (print b2) (values))
  153.  
  154. (format T "~%MATCH '(a ?:x c) ==> ~%((A B C) (A ?:Y ?:Y) (A ?:X ?:Y)); (((?:X . B)) ((?:X . ?:Y)) NIL); (NIL ((?:Y . C)) ((?:Y . C))):")
  155. (multiple-value-bind (r b1 b2) (match '(a ?:x c) 'test) (print r) (print b1) (print b2) (values))
  156.  
  157. (format T "~%MATCH '(a b ?:y) ==> ~%((A B B) (A B C) (A ?:X ?:Y) (A ?:Y ?:Y)); (((?:Y . B)) ((?:Y . C)) NIL NIL); (NIL NIL ((?:X . B)) ((?:Y . B))):")
  158. (multiple-value-bind (r b1 b2) (match '(a b ?:y) 'test) (print r) (print b1) (print b2) (values))
  159.  
  160. (format T "~%MATCH '(a ?:x ?:y) ==> ~%((A ?:Y ?:Y) (A ?:X ?:Y) (A B B) (A B C)); (((?:X . ?:Y)) NIL ((?:Y . B) (?:X . B)) ((?:Y . C) (?:X . B))); (NIL NIL NIL NIL):")
  161. (multiple-value-bind (r b1 b2) (match '(a ?:x ?:y) 'test) (print r) (print b1) (print b2) (values))
  162.  
  163. (format T "~%~%---------- Substitute Vars  ----------")
  164. (format T "~%((?:x . mortal) (?:y . socrates)) into (implies (man ?:y) (?:x ?:y)) ==>~
  165.            ~%(IMPLIES (MAN SOCRATES) (MORTAL SOCRATES))")
  166. (format T "~%~A" (substitute-bindings '((?:x . mortal) (?:y . socrates))
  167.                 '(implies (man ?:y) (?:x ?:y))))
  168. (format T "~%Substitute NIL into '(a b (c) d): ~S"
  169.     (substitute-bindings nil '(a b (c) d)))
  170. (format T "~%Substitute '((?:x . foo)) into NIL: ~S"
  171.     (substitute-bindings '((?:x . foo)) nil))
  172.  
  173. (format T "~%~%---------- END OF DNET TEST ----------
  174. Note: to be sure, try loading both lisp and compiled versions of this
  175. test, IN DIFFERENT LISP SESSIONS, so the second test does not rely on
  176. things defined in the first.~%")
  177.  
  178. ;;; EOF
  179.