--- a/package.lisp Sat Nov 05 12:22:36 2016 +0000
+++ b/package.lisp Sat Nov 05 18:01:22 2016 +0000
@@ -12,6 +12,16 @@
:redump-gdl))
+(defpackage :scully.dag
+ (:use
+ :cl
+ :losh
+ :iterate
+ :cl-arrows
+ :trivia
+ :scully.quickutils)
+ (:export))
+
(defpackage :scully.zdd
(:use
:cl
@@ -24,6 +34,17 @@
:scully.quickutils)
(:export))
+(defpackage :scully.terms
+ (:use
+ :cl
+ :losh
+ :iterate
+ :cl-arrows
+ :trivia
+ :named-readtables
+ :scully.quickutils)
+ (:export))
+
(defpackage :scully.reasoners.prolog
(:use
:cl
--- a/scully.asd Sat Nov 05 12:22:36 2016 +0000
+++ b/scully.asd Sat Nov 05 18:01:22 2016 +0000
@@ -9,15 +9,20 @@
:depends-on (:iterate
:losh
+ :cl-graph
:temperance
:hunchentoot
- :optima
:smug
+ :named-readtables
+ :fare-quasiquote
+ :fare-quasiquote-readtable
:cl-dot
:cl-algebraic-data-type
:cl-arrows
:cl-ggp
:cl-hamt
+ :trivia
+ :trivia.quasiquote
:trivialib.bdd)
:serial t
@@ -27,7 +32,8 @@
(:file "package")
(:module "src" :serial t
:components ((:file "gdl")
- (:file "zdd")
+ #+no (:file "terms")
+ #+no (:file "zdd")
(:module "reasoners" :serial t
:components ((:file "prolog")))
(:module "grounders" :serial t
--- a/src/zdd.lisp Sat Nov 05 12:22:36 2016 +0000
+++ b/src/zdd.lisp Sat Nov 05 18:01:22 2016 +0000
@@ -589,15 +589,6 @@
;;;; Scratch ------------------------------------------------------------------
-(with-zdd
- (-<> (make-rule-tree *rules*)
- (print-through #'zdd-count <>)
- (print-through #'zdd-size <>)
- (draw <> :unique-sinks nil :unique-nodes t
- :hexp (lambda (v) (<= 1000 v)))
- (never <>)
- ))
-
(defun test (l)
(fixed-point #'collapse-positive-heads
(list (set-insert (empty-set)
--- a/vendor/make-quickutils.lisp Sat Nov 05 12:22:36 2016 +0000
+++ b/vendor/make-quickutils.lisp Sat Nov 05 18:01:22 2016 +0000
@@ -5,10 +5,12 @@
:utilities '(
:compose
+ :copy-hash-table
:curry
:ensure-boolean
:ensure-gethash
:ensure-list
+ :hash-table-keys
:map-product
:mkstr
:once-only
--- a/vendor/quickutils.lisp Sat Nov 05 12:22:36 2016 +0000
+++ b/vendor/quickutils.lisp Sat Nov 05 18:01:22 2016 +0000
@@ -2,7 +2,7 @@
;;;; See http://quickutil.org for details.
;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :MAP-PRODUCT :MKSTR :ONCE-ONLY :RCURRY :SET-EQUAL :WITH-GENSYMS :WITH-OUTPUT-TO-FILE) :ensure-package T :package "SCULLY.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :HASH-TABLE-KEYS :MAP-PRODUCT :MKSTR :ONCE-ONLY :RCURRY :SET-EQUAL :WITH-GENSYMS :WITH-OUTPUT-TO-FILE) :ensure-package T :package "SCULLY.QUICKUTILS")
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package "SCULLY.QUICKUTILS")
@@ -14,12 +14,13 @@
(when (boundp '*utilities*)
(setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
- :COMPOSE :CURRY :ENSURE-BOOLEAN
- :ENSURE-GETHASH :ENSURE-LIST :MAPPEND
- :MAP-PRODUCT :MKSTR :ONCE-ONLY :RCURRY
- :SET-EQUAL :STRING-DESIGNATOR
- :WITH-GENSYMS :WITH-OPEN-FILE*
- :WITH-OUTPUT-TO-FILE))))
+ :COMPOSE :COPY-HASH-TABLE :CURRY
+ :ENSURE-BOOLEAN :ENSURE-GETHASH
+ :ENSURE-LIST :MAPHASH-KEYS
+ :HASH-TABLE-KEYS :MAPPEND :MAP-PRODUCT
+ :MKSTR :ONCE-ONLY :RCURRY :SET-EQUAL
+ :STRING-DESIGNATOR :WITH-GENSYMS
+ :WITH-OPEN-FILE* :WITH-OUTPUT-TO-FILE))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun make-gensym-list (length &optional (x "G"))
"Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
@@ -73,6 +74,29 @@
,(compose-1 funs))))))
+ (defun copy-hash-table (table &key key test size
+ rehash-size rehash-threshold)
+ "Returns a copy of hash table `table`, with the same keys and values
+as the `table`. The copy has the same properties as the original, unless
+overridden by the keyword arguments.
+
+Before each of the original values is set into the new hash-table, `key`
+is invoked on the value. As `key` defaults to `cl:identity`, a shallow
+copy is returned by default."
+ (setf key (or key 'identity))
+ (setf test (or test (hash-table-test table)))
+ (setf size (or size (hash-table-size table)))
+ (setf rehash-size (or rehash-size (hash-table-rehash-size table)))
+ (setf rehash-threshold (or rehash-threshold (hash-table-rehash-threshold table)))
+ (let ((copy (make-hash-table :test test :size size
+ :rehash-size rehash-size
+ :rehash-threshold rehash-threshold)))
+ (maphash (lambda (k v)
+ (setf (gethash k copy) (funcall key v)))
+ table)
+ copy))
+
+
(defun curry (function &rest arguments)
"Returns a function that applies `arguments` and the arguments
it is called with to `function`."
@@ -115,6 +139,24 @@
(list list)))
+ (declaim (inline maphash-keys))
+ (defun maphash-keys (function table)
+ "Like `maphash`, but calls `function` with each key in the hash table `table`."
+ (maphash (lambda (k v)
+ (declare (ignore v))
+ (funcall function k))
+ table))
+
+
+ (defun hash-table-keys (table)
+ "Returns a list containing the keys of hash table `table`."
+ (let ((keys nil))
+ (maphash-keys (lambda (k)
+ (push k keys))
+ table)
+ keys))
+
+
(defun mappend (function &rest lists)
"Applies `function` to respective element(s) of each `list`, appending all the
all the result list to a single list. `function` must return a list."
@@ -293,8 +335,8 @@
,@body))
(eval-when (:compile-toplevel :load-toplevel :execute)
- (export '(compose curry ensure-boolean ensure-gethash ensure-list map-product
- mkstr once-only rcurry set-equal with-gensyms with-unique-names
- with-output-to-file)))
+ (export '(compose copy-hash-table curry ensure-boolean ensure-gethash
+ ensure-list hash-table-keys map-product mkstr once-only rcurry
+ set-equal with-gensyms with-unique-names with-output-to-file)))
;;;; END OF quickutils.lisp ;;;;