# HG changeset patch # User Steve Losh # Date 1478368882 0 # Node ID b7c02baa4fee8c1ad41da2850b3d467a32cbd89f # Parent 7fe3a52bf1f643fdf1b49ccd7b1fbc9166616551 Start the rule order/partitioning process diff -r 7fe3a52bf1f6 -r b7c02baa4fee package.lisp --- 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 diff -r 7fe3a52bf1f6 -r b7c02baa4fee scully.asd --- 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 diff -r 7fe3a52bf1f6 -r b7c02baa4fee src/zdd.lisp --- 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) diff -r 7fe3a52bf1f6 -r b7c02baa4fee vendor/make-quickutils.lisp --- 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 diff -r 7fe3a52bf1f6 -r b7c02baa4fee vendor/quickutils.lisp --- 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 ;;;;