# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1469281866 0
# Node ID 4abb7eda96cb634f0ac3d907d5354d32b2a12e08
# Parent  3325913a9b16b0dc0b0949a494d838ac23cc8421
Add some tests from TAOP

diff -r 3325913a9b16 -r 4abb7eda96cb bones-test.asd
--- a/bones-test.asd	Fri Jul 22 20:32:51 2016 +0000
+++ b/bones-test.asd	Sat Jul 23 13:51:06 2016 +0000
@@ -13,5 +13,6 @@
                              (:file "circle")
                              (:file "paip")
                              (:file "wam")
-                             (:file "99")))))
+                             (:file "99")
+                             (:file "taop")))))
 
diff -r 3325913a9b16 -r 4abb7eda96cb package-test.lisp
--- a/package-test.lisp	Fri Jul 22 20:32:51 2016 +0000
+++ b/package-test.lisp	Sat Jul 23 13:51:06 2016 +0000
@@ -13,7 +13,10 @@
     #:result=
     #:results=
     #:should-fail
-    #:should-return))
+    #:should-return
+    #:%=
+    #:%not
+    #:%append))
 
 (defpackage #:bones-test.paip
   (:use
@@ -68,6 +71,28 @@
   (:import-from #:bones.utils
     #:symbolize))
 
+(defpackage #:bones-test.taop
+  (:use
+    #:cl
+    #:1am
+    #:bones-test.utils
+    #:bones.quickutils
+    #:bones.wam)
+  (:import-from #:bones.wam
+    #:with-fresh-database
+    #:push-logic-frame-with
+    #:rule
+    #:fact
+    #:facts
+    #:call
+    #:dump-wam-full
+    #:?
+    #:!
+    #:query
+    #:query-all)
+  (:import-from #:bones.utils
+    #:symbolize))
+
 (defpackage #:bones-test.circle
   (:use
     #:cl
diff -r 3325913a9b16 -r 4abb7eda96cb test/99.lisp
--- a/test/99.lisp	Fri Jul 22 20:32:51 2016 +0000
+++ b/test/99.lisp	Sat Jul 23 13:51:06 2016 +0000
@@ -6,22 +6,6 @@
 ;;; Solutions to at least a few of these, for testing purposes.
 
 
-(defun %= ()
-  (push-logic-frame-with
-    (fact (= ?x ?x))))
-
-(defun %not ()
-  (push-logic-frame-with
-    (rule (not ?x) (call ?x) ! fail)
-    (fact (not ?x))))
-
-(defun %append ()
-  (push-logic-frame-with
-    (fact (append nil ?l ?l))
-    (rule (append (list* ?x ?rest) ?l (list* ?x ?result))
-      (append ?rest ?l ?result))))
-
-
 (test p1
   ;; Find the last element of a list.
   (with-fresh-database
@@ -193,3 +177,33 @@
       ((compress (list (f cats ?) ?what (f ? dogs))
                  (list ?))
        (?what (f cats dogs))))))
+
+; (test p9
+;   (with-fresh-database
+;     (%=)
+;     (%not)
+
+;     (push-logic-frame-with
+;       (fact (pack nil nil))
+;       (fact (pack (list ?x) (list (list ?x))))
+
+;       (rule (pack (list* ?x ?tail)
+;                   (list* (list ?x) ?ptail))
+;         (pack ?tail ?ptail)
+;         (= ?ptail (list* (list* ?y ?) ?))
+;         (not (= ?x ?y)))
+
+;       (rule (pack (list* ?h ?tail)
+;                   (list* (list* ?h ?h ?hs) ?more))
+;         (pack ?tail (list* (list* ?h ?hs) ?more))))
+
+;     (should-return
+;       ((pack nil nil) empty)
+;       ((pack (list a) ?what)
+;        (?what ((a))))
+;       ((pack (list a a) ?what)
+;        (?what ((a a))))
+;       ((pack (list a a a) ?what)
+;        (?what ((a a a))))
+;       ((pack (list a a b a) ?what)
+;        (?what ((a a) (b) (a)))))))
diff -r 3325913a9b16 -r 4abb7eda96cb test/99.pl
--- a/test/99.pl	Fri Jul 22 20:32:51 2016 +0000
+++ b/test/99.pl	Sat Jul 23 13:51:06 2016 +0000
@@ -89,6 +89,18 @@
 my_pack([X | Tail], [[X, X | XS] | ResultTail]) :-
     my_pack(Tail, [[X | XS] | ResultTail]).
 
+
+
+
+
+
+
+
+
+
+
+
+
 their_pack([],[]).
 their_pack([X | Tail], [Chunk | PackedTail]) :-
     their_transfer(X, [X | Tail], Remaining, Chunk),
diff -r 3325913a9b16 -r 4abb7eda96cb test/utils.lisp
--- a/test/utils.lisp	Fri Jul 22 20:32:51 2016 +0000
+++ b/test/utils.lisp	Sat Jul 23 13:51:06 2016 +0000
@@ -28,3 +28,18 @@
                                (t results))
                            (query-all ,query))))))
 
+
+;;;; Prolog
+(defun %= ()
+  (push-logic-frame-with
+    (fact (= ?x ?x))))
+
+(defun %not ()
+  (push-logic-frame-with
+    (rule (not ?x) (call ?x) ! fail)
+    (fact (not ?x))))
+(defun %append ()
+  (push-logic-frame-with
+    (fact (append nil ?l ?l))
+    (rule (append (list* ?x ?rest) ?l (list* ?x ?result))
+      (append ?rest ?l ?result))))