# HG changeset patch # User Steve Losh # Date 1469306301 0 # Node ID 9c72baeb00f9976d93a64eab331c5cbba7529b75 # Parent cbde08d7548e41ca48437156791a3003be4688fb Add tests from TAOP section 2.2 diff -r cbde08d7548e -r 9c72baeb00f9 package-test.lisp --- a/package-test.lisp Sat Jul 23 15:20:48 2016 +0000 +++ b/package-test.lisp Sat Jul 23 20:38:21 2016 +0000 @@ -17,7 +17,8 @@ #:define-test #:%= #:%not - #:%append)) + #:%append + #:%member)) (defpackage #:bones-test.paip (:use diff -r cbde08d7548e -r 9c72baeb00f9 test/taop.lisp --- a/test/taop.lisp Sat Jul 23 15:20:48 2016 +0000 +++ b/test/taop.lisp Sat Jul 23 20:38:21 2016 +0000 @@ -110,56 +110,144 @@ (push-logic-frame-with ;; and gate - (facts (resistor power n1) - (resistor power n2) - (transistor n2 ground n1) - (transistor n3 n4 n2) - (transistor n5 ground n4)) + + ;; (resistor name node-1 node-2) + (facts (resistor r1 power n1) + (resistor r2 power n2)) - (rule (inverter ?input ?output) - (transistor ?input ground ?output) - (resistor power ?output)) + ;; (transistor name gate source drain) + (facts (transistor t1 n2 ground n1) + (transistor t2 n3 n4 n2) + (transistor t3 n5 ground n4)) + + (rule (inverter (inverter ?t ?r) ?input ?output) + (transistor ?t ?input ground ?output) + (resistor ?r power ?output)) - (rule (nand ?a ?b ?output) - (transistor ?a ?x ?output) - (transistor ?b ground ?x) - (resistor power ?output)) + (rule (nand (nand ?t1 ?t2 ?r) ?a ?b ?output) + (transistor ?t1 ?a ?x ?output) + (transistor ?t2 ?b ground ?x) + (resistor ?r power ?output)) - (rule (and ?a ?b ?output) - (nand ?a ?b ?x) - (inverter ?x ?output))) + (rule (and (and ?n ?i) ?a ?b ?output) + (nand ?n ?a ?b ?x) + (inverter ?i ?x ?output))) + (should-return - ((and ?a ?b ?out) - (?a n3 ?b n5 ?out n1))) + ((and ?g ?a ?b ?out) + (?a n3 ?b n5 ?out n1 ?g (and (nand t2 t3 r2) + (inverter t1 r1))))) (pop-logic-frame) (push-logic-frame-with ;; nor gate - (facts (resistor power o) - (transistor i1 ground o) - (transistor i2 ground o) - (resistor power no) - (transistor o ground no)) + (facts (resistor r1 power o) + (transistor t1 i1 ground o) + (transistor t2 i2 ground o) + (resistor r2 power no) + (transistor t3 o ground no)) - (rule (inverter ?input ?output) - (transistor ?input ground ?output) - (resistor power ?output)) + (rule (inverter (inverter ?t ?r) ?input ?output) + (transistor ?t ?input ground ?output) + (resistor ?r power ?output)) - (rule (or ?a ?b ?output) - (transistor ?a ground ?output) - (transistor ?b ground ?output) + (rule (or (or ?t1 ?t2 ?r) ?a ?b ?output) + (transistor ?t1 ?a ground ?output) + (transistor ?t2 ?b ground ?output) (not (= ?a ?b)) - (resistor power ?output)) + (resistor ?r power ?output)) - (rule (nor ?a ?b ?output) - (or ?a ?b ?x) - (inverter ?x ?output))) + (rule (nor (nor ?o ?i) ?a ?b ?output) + (or ?o ?a ?b ?x) + (inverter ?i ?x ?output))) (should-return - ((or ?a ?b ?out) - (?a i1 ?b i2 ?out o) - (?a i2 ?b i1 ?out o)) - ((nor ?a ?b ?out) - (?a i1 ?b i2 ?out no) - (?a i2 ?b i1 ?out no))))) + ((or ?g ?a ?b ?out) + (?a i1 ?b i2 ?out o ?g (or t1 t2 r1)) + (?a i2 ?b i1 ?out o ?g (or t2 t1 r1))) + ((nor ?g ?a ?b ?out) + (?a i1 ?b i2 ?out no ?g (nor (or t1 t2 r1) + (inverter t3 r2))) + (?a i2 ?b i1 ?out no ?g (nor (or t2 t1 r1) + (inverter t3 r2))))))) + +(define-test courses + (with-fresh-database + (push-logic-frame-with + (facts (course complexity + (time monday 9 11) + (lecturer david harel) + (location feinberg a)) + (course lisp + (time monday 10 12) + (lecturer alyssa p hacker) + (location main-hall)) + (course scheme + (time monday 12 15) + (lecturer alyssa p hacker) + (location online)) + (course prolog + (time tuesday 12 15) + (lecturer ben bitdiddle) + (location feinberg b)) + (course haskell + (time wednesday 12 15) + (lecturer ben bitdiddle) + (location online))) + + (rule (lecturer ?who ?course) + (course ?course ? ?who ?)) + + (rule (teaches-on ?who ?day) + (course ? (time ?day ? ?) ?who ?)) + + (rule (teaches-in ?who ?location) + (course ? ? ?who ?location)) + + (rule (location-of ?course ?location) + (course ?course ? ? ?location))) + + (should-return + ((lecturer ?who lisp) + (?who (lecturer alyssa p hacker))) + + ((teaches-in (lecturer alyssa p hacker) ?loc) + (?loc (location online)) + (?loc (location main-hall))) + + ((location-of lisp ?where) + (?where (location main-hall))) + + ((teaches-on ?who ?day) + (?who (lecturer alyssa p hacker) ?day monday) + (?who (lecturer ben bitdiddle) ?day tuesday) + (?who (lecturer ben bitdiddle) ?day wednesday) + (?who (lecturer david harel) ?day monday))))) + + +(define-test books + (with-fresh-database + (%member) + (push-logic-frame-with + (facts (book paip (list norvig) 1992) + (book sicp (list abelson sussman) 1996) + (book lol (list hoyte) 2008) + (book clos (list keene) 1988)) + + (rule (wrote ?who ?title) + (book ?title ?authors ?) + (member ?who ?authors)) + + (rule (published-in ?who ?year) + (book ? ?authors ?year) + (member ?who ?authors))) + + (should-return + ((wrote sussman ?what) + (?what sicp)) + ((published-in keene ?year) + (?year 1988)) + ((published-in ?who 1996) + (?who abelson) + (?who sussman))))) diff -r cbde08d7548e -r 9c72baeb00f9 test/utils.lisp --- a/test/utils.lisp Sat Jul 23 15:20:48 2016 +0000 +++ b/test/utils.lisp Sat Jul 23 20:38:21 2016 +0000 @@ -54,3 +54,9 @@ (fact (append nil ?l ?l)) (rule (append (list* ?x ?rest) ?l (list* ?x ?result)) (append ?rest ?l ?result)))) + +(defun %member () + (push-logic-frame-with + (fact (member ?x (list* ?x ?))) + (rule (member ?x (list* ? ?rest)) + (member ?x ?rest))))