drtest08.bat

NASA 开发使用的一个专家系统

(reset)                   ; DR0675
(defrule foo (initial-fact) (test (> 4 3)) =>)
(agenda)
(assert (a))
(defrule bar (initial-fact) (or (test (> 5 3)) (a)) =>)
(agenda)
(reset)
(assert (a))
(agenda)
(clear)
(defmethod foo (?a)       ; DR0676
  (bind ?b 10)
  (call-next-method)
  ?b)
(defmethod foo ($?any)
  (bind ?b 20))
(foo bar)
(clear)
(call-next-method 0)      ; DR0677
(next-methodp 0)
(preview-generic)
(clear)
(delete-instance 0)       ; DR0678
(init-slots 0)
(ppinstance 0)
(clear)
(print-region 1 2 3)      ; DR0679
(print-region t 2 3)
(clear)
(defclass A (is-a USER))  ; DR0680
(class-superclasses A inherit)
(defclass A (is-a USER))
(class-superclasses A inherit)
(clear)
;; DRs 0681, 0682 and 0683 involve recompiling CLIPS
(while 1 do ?a)           ; DR0684
(clear)
(printout t ?a crlf)      ; DR0685
(defrule foo =>
   (printout t ?a)
   (bind ?a 1))
(reset)
(run)
(clear)
(str-cat abc (eval "(+ abc)") def) ; DR0686
(sym-cat abc (eval "(+ abc)") def)
(clear)
(deffunction foo (?a))    ; DR0687
(foo (eval "(+ abc)"))
(clear)
(defgeneric any-instancep) ; DR0688
(defgeneric assert)
(defgeneric bind)
(defgeneric break)
(defgeneric call-next-handler)
(defgeneric call-next-method)
(defgeneric delayed-do-for-all-instances)
(defgeneric do-for-all-instances)
(defgeneric do-for-instance)
(defgeneric duplicate)
(defgeneric expand$)
(defgeneric find-all-instances)
(defgeneric find-instance)
(defgeneric if)
(defgeneric initialize-instance)
(defgeneric make-instance)
(defgeneric modify)
(defgeneric next-handlerp)
(defgeneric next-methodp)
(defgeneric override-next-handler)
(defgeneric progn)
(defgeneric retract)
(defgeneric return)
(defgeneric while)
(clear)
(defmethod blah  ;; DR0689
  ((?a (progn (undefmethod blah *) TRUE))))
(blah 1)
(clear)
(defgeneric foo)  ;; DR0690
(foo (progn (undefgeneric foo) 1))
(deffunction bar (?a))
(bar (progn (undeffunction bar) 1))
(clear)
(printout t (eval "(+ abc)") " OOPS " (eval "(+ abc)") crlf)  ;; DR0691
(clear)
(deftemplate foo             ;; DR0692
  (multifield linkTagList))
(defrule foo
   ?w<-(foo)
   =>
   (modify ?w (linkTagList ?linktag ?linktagx ?a $?b)))
(clear)
(unwatch all)  ;; DR0693
(defrule foo (logical (not (a))) => (assert (b)))
(watch facts)
(reset)
(run)
(assert (a))
(reset)
(defrule bar (declare (salience -1)) => (assert (a)))
(run)
(unwatch all)
(clear)
(defclass A (is-a USER) (role concrete)
  (slot foo (create-accessor read-write))
  (multislot bar (create-accessor read-write))) ;; DR0697 and DR0700
(make-instance fribban of A)
(make-instance quoxnar of A)
(send [quoxnar] put-foo (instance-address [fribban]))
(send [quoxnar] put-bar (mv-append))
(unmake-instance [fribban])
(send (send [quoxnar] get-foo) print)
(save-instances "badfile.tmp")
(reset)
(restore-instances "badfile.tmp")
(send [quoxnar] print)
(clear)
(defglobal ?*x* = 0) ;; DR0698 and DR0701
(deffunction create-number-2 ()
  (bind ?*x* (nth 1 (str-explode "2.0")))
  BOGUS)
(deffunction create-number ()
  (create-number-2))
(deffunction force-garbage-collection ()
  (bind ?i 0)      
  (while (< ?i 10000) do
    (gensym*)
    (bind ?i (+ ?i 1))))
(mv-append (create-number) ?*x* (bind ?*x* 0)
  (force-garbage-collection) (float (random))
     (float (random)))
(clear)
(deffunction foo ()      ;; DR0699
   (printout t Foo crlf))
(defmethod bar () (foo))
(bar)
(undeffunction *)
(bar)
(ppdeffunction foo)
(clear) ;; DR0700
(defclass A (is-a USER) (role concrete) (multislot foo (create-accessor read-write)))
(make-instance a of A (foo (mv-append)))
(send [a] print)
(save-instances "ins.tmp")
(unmake-instance [a])
(load-instances "ins.tmp")
(send [a] print)
(clear) ;; DR0704
(defrule foo => (printout t [hdh] crlf))
(reset)
(run)
(bsave foo.bin)
(clear)
(bload foo.bin)
(clear) ;; DR0705
(= 5 (read))
Whatever
(clear) ;; DR0707
(defclass A (is-a USER) (role concrete) (slot foo (create-accessor read-write)))
(make-instance a of A (foo "\"This is a string\""))
(send [a] print)
(save-instances bogus.tmp)
(reset)
(instances)
(load-instances bogus.tmp)
(send [a] print)
(clear) ;; DR0713

(defclass TEST
  (is-a USER)
  (role concrete)
  (slot item (create-accessor write)))
(make-instance a of TEST)
(message-modify-instance [a] (item 3))
(clear)