(clear) ;; Case 1 (defmodule A (export ?ALL)) (deftemplate A::foo) (defmodule MAIN (import A ?ALL) (export ?ALL)) (defmodule B (import MAIN ?ALL)) (deftemplate B::foo) (clear) ;; Case 2 (defmodule B) (defmodule B::foo) (clear) ;; Case 3 (defmodule ROOT (export ?ALL)) (deftemplate A) (defmodule CHILD-1 (import ROOT ?ALL) (export ?ALL)) (defmodule CHILD-2 (import ROOT ?ALL) (export ?ALL)) (defmodule CHILD-3 (import CHILD-1 ?ALL) (import CHILD-2 ?ALL)) (clear) ;; Case 4 (defmodule d3 (export ?ALL)) (deftemplate t1) (deftemplate t2) (defmodule d4 (export deftemplate t3 t4) (import d3 deftemplate t1)) (clear) ;; Case 5 (deftemplate foo (slot x) (slot y)) (defrule bar (foo (x 3) (x 4) (y 3)) =>) (clear) ;; Case 6 (deftemplate foo (slot x (type SYMBOL))) (defrule bar (foo (x ?x)) => (+ ?x 1)) (defrule bar (foo (x ?x)) => (assert (yak (+ ?x 1)))) (clear) ;; Case 7 (defmodule a) (assert (start)) (defrule foo (start) =>) (defmodule b) (assert (begin)) (defrule bar (begin) =>) (agenda) (agenda a) (agenda b) (agenda *) (clear) ;; Case 8 (defglobal ?*x* = 0) (defrule foo ?f <- (foo) => (bind ?*x* ?f)) (assert (foo)) (run) (fact-index ?*x*) (retract ?*x*) (fact-index ?*x*) (retract ?*x*) (clear) ;; Case 9 (defmodule FOO (export ?ALL)) (deftemplate FOO::foo) (defmodule BAR (export ?ALL) (import FOO ?ALL)) (deftemplate BAR::foo) (clear) ;; Case 10 (defmodule FOO (export ?ALL)) (deftemplate FOO::foo) (defmodule BAR (export ?ALL)) (deftemplate BAR::foo) (defmodule YAK (import FOO ?ALL) (import BAR ?ALL)) (clear) ;; Case 11 (deftemplate set (multislot members)) (deffacts stuff (set (members Q R S D T A B D))) (defrule remove-duplicates ?f <- (set (members $?b ?element $?m ?element $?e)) => (printout t ?b " " ?element " " ?m " " ?e crlf) (modify ?f (members ?b ?element ?m ?e))) (reset) (run) (facts) (clear) ;; Case 12 (deftemplate set (multislot m1) (multislot m2)) (deffacts stuff (set (m1 Q R S D T A B D X) (m2 Q R D A B D S X))) (defrule remove-duplicates ?f <- (set (m1 $?b1 ?element1 $?m1 ?element1 $?e1 X) (m2 $?b2 ?element2 $?m2 ?element2 $?e2 X)) => (printout t ?b1 " " ?element1 " " ?m1 " " ?e1 crlf) (printout t ?b2 " " ?element2 " " ?m2 " " ?e2 crlf) (modify ?f (m1 ?b1 ?element1 ?m1 ?e1) (m2 ?b2 ?element2 ?m2 ?e2))) (reset) (run) (facts) (clear) ;; Case 13 (deftemplate set (multislot m2)) (deffacts stuff (set (m2 D D S X))) (defrule remove-duplicates ?f <- (set (m2 ?l2 $?m2 ?l2 $?e2 X)) => (printout t ?l2 " " ?m2 " " ?e2 crlf) (modify ?f (m2 ?l2 ?m2 ?e2))) (reset) (run) (facts) (clear) ;; Case 14 (defglobal ?*x* = 0) (defmodule MAIN (export ?ALL)) (defmodule FOO (import MAIN defglobal ?ALL)) (bind ?*x* 1) ?*x* (clear) ;; Case 15 (defrule blah (m2 ?l2 $?m2 ?l2 $?e2 X) => (printout t ?l2 " " ?m2 " " ?e2 crlf)) (assert (m2 D D S X)) (run) (clear) ;; Case 16 (deftemplate adder (multislot #-1) (multislot #-2)) (deffacts adder-info (adder (#-1 1 0 1) (#-2 1 1)) (adder (#-1 1) (#-2 0))) (defrule another-bug (adder (#-1 $?n1 ?v) (#-2 $?n2 ~?v)) =>) (reset) (agenda) (clear) ;; Case 17 (defmodule MAIN (export ?ALL)) (defmodule A (import MAIN ?ALL) (export ?ALL)) (deftemplate A::a (slot x)) (defmodule B (import MAIN ?ALL) (import A ?ALL) (export ?ALL)) (deftemplate B::b (slot y)) (clear) ;; Case 18 (defrule foo (declare (salience 4)) (x) (not (and (a) (b))) (y) =>) (defrule bar (declare (salience 3)) (x) (not (and (a) (b))) (test (< 5 3)) (y) =>) (defrule dog (declare (salience 2)) (x) (z) (not (and (a) (b))) (test (< 5 3)) (y) =>) (defrule yak (declare (salience 1)) (x) (z) (not (and (a) (b))) (y) =>) (reset) (agenda) (assert (x)) (agenda) (assert (y)) (agenda) (assert (z)) (agenda) (assert (a)) (agenda) (assert (b)) (agenda) (clear) ;; Case 19 (assert (foo)) (defmodule BAR) (assert (bar)) (save-facts "Temp//bug.tmp") (bsave "Temp//bug.bin") (bload "Temp//bug.bin") (load-facts "Temp//bug.tmp") (facts) (clear) ;; Case 20 (defrule foo1 (declare (salience 10)) =>) (defrule foo2 (declare (auto-focus TRUE)) =>) (defrule foo3 (declare (auto-focus TRUE) (salience 10)) =>) (defrule foo4 (declare (salience 10) (auto-focus TRUE)) =>) (ppdefrule foo1) (ppdefrule foo2) (ppdefrule foo3) (ppdefrule foo4) (clear) ; watching specific items (unwatch all) (defglobal ?*foo* = 1) (defglobal ?*bar* = 2) (deftemplate foo) (deftemplate bar) (defrule foo (foo) => (assert (bar))) (defrule bar (bar) =>) (watch rules foo) (watch globals foo) (watch facts foo) (watch activations foo) (watch rules yak) (watch globals yak) (watch facts yak) (watch activations yak) (watch compilations foo) (watch statistics foo) (watch focus foo) (reset) (bind ?*foo* 3) (bind ?*bar* 4) (assert (foo)) (run) (list-watch-items) (list-watch-items globals) (list-watch-items facts) (list-watch-items rules) (list-watch-items activations) (list-watch-items compilations) (list-watch-items statistics) (list-watch-items focus) (unwatch all) (list-watch-items) (list-watch-items globals) (list-watch-items facts) (list-watch-items rules) (list-watch-items activations) (list-watch-items compilations) (list-watch-items statistics) (list-watch-items focus) (clear) ;; bsave-instances issue (defclass A (is-a USER) (slot x)) (make-instance a of A (x 1)) (bsave-instances "Temp//bug.bin") (reset) (bload-instances "Temp//bug.bin") (clear) ;; incremental reset issue (assert (B NP14 NP)) (defrule Rule1 (A ?NP) (B ?NP NP) =>) (matches Rule1) (defrule Rule2 (A ?PP) (B ?PP PP) =>) (matches Rule1) (clear) ;; garbage collection issue (defglobal ?*A* = (create$ 1 2 3 4 5 6 7 8 9 10)) (defglobal ?*B* = (create$ 1 2 3 4 5 6 7 8 9 10)) (defglobal ?*C* = (create$)) (deffunction dummy-not-OK () (bind ?i 1) (while (<= ?i 100) (foreach ?x ?*A* (foreach ?y ?*B* (bind ?*C* (create$ ?*C* (+ (* 100 ?i) (* 10 ?x) ?y))) ) ) (bind ?i (+ ?i 1)) ) ) (dummy-not-OK) (dummy-not-OK) (dummy-not-OK) (clear) ;; module order save issue (defmodule A (export deftemplate AT)) (deftemplate A::AT (slot x)) (defmodule MAIN (import A deftemplate AT)) (defrule MAIN::RAT (AT (x 3)) =>) (save "Temp//rules.sav") (clear) (load "Temp//rules.sav") (clear) ;; bsave/bload issue (defrule x_ba6 (Doklad KodDokladu ?V163_TV9040) (Doklad KodDokladu ?V163_TV9043) (or (test (eq ?V163_TV9040 "36")) (test (eq ?V163_TV9043 "37"))) =>) (defrule x_ba8 =>) (defrule x_baa =>) (defrule x_ba8 =>) (bsave "Temp//temp.bin") (clear) (bload "Temp//temp.bin") (rules) (clear) (watch compilations) (load "gnrcdef.clp") (unwatch compilations) (clear) ;; void value in implied deftemplate fact (assert (foo a (agenda) b (agenda) c (agenda))) (assert (foo (agenda) a)) (facts) (fact-slot-value 1 implied) (fact-slot-value 2 implied) (length$ (fact-slot-value 1 implied)) (length$ (fact-slot-value 2 implied)) (clear) ; Multifield wildcard not allowed in single field slot (deftemplate bar (slot x)) (defrule blah (bar (x $?)) =>) (clear) (defmethod clear ((?a EXTERNAL-ADDRESS))) ; Crash (undefgeneric clear) (clear) (deftemplate factoid (slot source) (slot status) (slot processed)) (deffacts initial (factoid (source input) (status normal) (processed no))) (defrule overwrite "" ?f <- (factoid (source input) (processed no)) => (modify ?f (processed yes)) (duplicate ?f (source output) (processed yes))) (reset) (run) (facts) (clear)