6ff8b64f6041

Start sketching out the actual reasoning logic
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sun, 11 Dec 2016 16:25:09 -0500
parents 8a22df7c2b9d
children 51bc78b22d98
branches/tags (none)
files package.lisp src/logic.lisp src/zdd.lisp vendor/make-quickutils.lisp vendor/quickutils.lisp

Changes

--- a/package.lisp	Wed Dec 07 17:52:35 2016 -0500
+++ b/package.lisp	Sun Dec 11 16:25:09 2016 -0500
@@ -44,7 +44,9 @@
     :trivia
     :trivialib.bdd
     :scully.quickutils)
-  (:export))
+  (:export)
+  (:shadowing-import-from :hamt
+    :hash-set))
 
 (defpackage :scully.rule-trees
   (:use
@@ -77,6 +79,7 @@
     :cl
     :losh
     :iterate
+    :trivia
     :cl-arrows
     :scully.quickutils))
 
--- a/src/logic.lisp	Wed Dec 07 17:52:35 2016 -0500
+++ b/src/logic.lisp	Sun Dec 11 16:25:09 2016 -0500
@@ -1,6 +1,5 @@
 (in-package :scully.logic)
 
-
 (defparameter *rules*
   (scully.gdl::read-gdl "gdl/tictactoe-grounded.gdl")
   ; (scully.gdl::read-gdl "gdl/hanoi-grounded.gdl")
@@ -9,14 +8,69 @@
   )
 
 
+(defun slot-definition (conc-name slot)
+  (destructuring-bind (name &key
+                            type
+                            documentation
+                            (accessor (symb conc-name name))
+                            (initarg (intern (symbol-name name) :keyword)))
+      (ensure-list slot)
+    `(,name :initarg ,initarg :accessor ,accessor
+            ,@(when type `(:type ,type))
+            ,@(when documentation `(:documentation ,documentation)))))
+
+(defmacro defclass* (name-and-options direct-superclasses slots &rest options)
+  (destructuring-bind (name &key (conc-name (symb name '-)))
+      (ensure-list name-and-options)
+    `(defclass ,name ,direct-superclasses
+       ,(mapcar (curry #'slot-definition conc-name) slots)
+       ,@options)))
+
+(defclass* (logic-manager :conc-name lm-) ()
+  (rules
+   roles
+   term->number
+   number->term
+   initial-zdd
+   legal-zdd
+   goal-zdd
+   terminal-zdd
+   possible-forest
+   happens-forest))
+
+
+(defun find-initial-state (rules term->number)
+  (-<> rules
+    (mapcan (lambda-match
+              ((list (list* 'ggp-rules::init body))
+               `((ggp-rules::true ,@body))))
+            <>)
+    (mapcar (lambda (term) (gethash term term->number)) <>)))
+
+(defun find-roles (rules)
+  (mapcan (lambda-match
+            ((list (list 'ggp-rules::role r))
+             (list r)))
+          rules))
+
+(defun make-predicate-zdd (predicate term->number)
+  (-<> term->number
+    hash-table-alist
+    (remove-if-not (lambda (rule)
+                     (eql predicate (first (first rule))))
+                   <>)
+    (mapcar #'cdr <>)
+    (scully.zdd::zdd-set <>)))
+
 (defun make-stratum-rule-trees (stratum)
   (-<> stratum
     (group-by #'car <>)
     hash-table-values
     (mapcar #'scully.rule-trees::make-rule-tree <>)))
 
-(defun make-rule-forests (rules)
-  "Turn a set of grounded GDL rules into rule forests and mapping tables.
+
+(defun make-logic-manager (rules)
+  "Turn a set of grounded GDL rules into a logic manager.
 
   A rule forest is a collection of individual rule trees in a single layer,
   stratified as necessary:
@@ -29,29 +83,61 @@
                  \/
          (rule-tree-1 rule-tree-2 ...)
 
-  Returns a list of:
+  "
+  (let ((rules (scully.gdl::normalize-rules rules)))
+    (destructuring-bind (term->number number->term rule-layers)
+        (scully.terms::integerize-rules rules)
+      (flet ((make-forest (layer)
+               (-<> rule-layers
+                 (gethash layer <>)
+                 scully.terms::stratify-layer
+                 (mapcar #'make-stratum-rule-trees <>))))
+        (scully.zdd::with-zdd
+          (make-instance 'logic-manager
+            :rules rules
+            :roles (find-roles rules)
+            :possible-forest (make-forest :possible)
+            :happens-forest (make-forest :happens)
+            :initial-zdd (scully.zdd::zdd-set (find-initial-state rules term->number))
+            :legal-zdd (make-predicate-zdd 'ggp-rules::legal term->number)
+            :goal-zdd (make-predicate-zdd 'ggp-rules::goal term->number)
+            :terminal-zdd (make-predicate-zdd 'ggp-rules::terminal term->number)
+            :term->number term->number
+            :number->term number->term))))))
 
-  * The :possible layer's rule forest.
-  * The :happens layer's rule forest.
-  * The term->number hash table.
-  * The number->term hash table.
+
+(defun initial-iset (logic-manager)
+  "Return the initial information set of the game."
+  (lm-initial-zdd logic-manager))
 
-  "
-  (destructuring-bind (term->number number->term rule-layers)
-      (-> rules
-        scully.gdl::normalize-rules
-        scully.terms::integerize-rules)
-    (flet ((make-forest (layer)
-             (-<> rule-layers
-               (gethash layer <>)
-               scully.terms::stratify-layer
-               (mapcar #'make-stratum-rule-trees <>))))
-      (list (make-forest :possible)
-            (make-forest :happens)
-            term->number
-            number->term))))
+(defun number-to-term (logic-manager number)
+  (gethash number (lm-number->term logic-manager)))
+
+(defun term-to-number (logic-manager term)
+  (gethash term (lm-term->number logic-manager)))
+
+(defun rand-state (logic-manager iset)
+  "Select a random member of the given information set."
+  (mapcar (curry #'number-to-term logic-manager)
+          (scully.zdd::zdd-random-member iset)))
 
-; (make-rule-forest *rules*)
+(defun terminalp (logic-manager iset)
+  "Return whether the given information set is a terminal state."
+  (-<> iset
+    (scully.zdd::zdd-meet <> (lm-terminal-zdd logic-manager))
+    scully.zdd::zdd-unit-p
+    not))
+
+(defun draw-zdd (logic-manager zdd)
+  (flet ((label (n)
+           (let ((*package* (find-package :ggp-rules)))
+             (-<> n
+               (number-to-term logic-manager <>)
+               (structural-string <>)))))
+    (scully.graphviz::draw-zdd zdd :label-fn #'label)))
+
+
+(defparameter *l* (make-logic-manager *rules*))
 
 
 ; (defun apply-rule-tree (zdd rule-tree head-bound)
--- a/src/zdd.lisp	Wed Dec 07 17:52:35 2016 -0500
+++ b/src/zdd.lisp	Sun Dec 11 16:25:09 2016 -0500
@@ -37,6 +37,18 @@
              (enumerate lo)))))
 
 
+(defun zdd-empty-p (zdd)
+  (ematch zdd
+    ((sink nil) t)
+    ((sink t) nil)
+    ((node _ _ _) nil)))
+
+(defun zdd-unit-p (zdd)
+  (ematch zdd
+    ((sink nil) nil)
+    ((sink t) t)
+    ((node _ _ _) nil)))
+
 (defun zdd-count (zdd)
   "Return the number of members of `zdd`."
   (ematch zdd
@@ -93,45 +105,44 @@
   (make-set elements))
 
 
-(defun zdd-union% (a b)
-  (ematch* (a b)
-    (((node) (sink)) (zdd-union% b a))
+(defun-ematch* zdd-union% (a b)
+  (((node) (sink)) (zdd-union% b a))
 
-    (((sink nil) b) b)
-    (((sink t) b) (unit-patch b))
+  (((sink nil) b) b)
+  (((sink t) b) (unit-patch b))
 
-    (((node var-a hi-a lo-a)
-      (node var-b hi-b lo-b))
-     (cond
-       ((< var-a var-b) (zdd-node var-a hi-a (zdd-union% lo-a b)))
-       ((> var-a var-b) (zdd-node var-b hi-b (zdd-union% lo-b a)))
-       ((= var-a var-b) (zdd-node var-a
-                                  (zdd-union% hi-a hi-b)
-                                  (zdd-union% lo-a lo-b)))))))
+  (((node var-a hi-a lo-a)
+    (node var-b hi-b lo-b))
+   (cond
+     ((< var-a var-b) (zdd-node var-a hi-a (zdd-union% lo-a b)))
+     ((> var-a var-b) (zdd-node var-b hi-b (zdd-union% lo-b a)))
+     ((= var-a var-b) (zdd-node var-a
+                                (zdd-union% hi-a hi-b)
+                                (zdd-union% lo-a lo-b))))))
 (defun zdd-union (&rest zdds)
   "Return the union of ZDDs: {α | α ∈ Z₁ or α ∈ Z₂}."
   (if zdds
     (reduce #'zdd-union% zdds)
     (sink nil)))
 
-(defun zdd-intersection% (a b)
-  (ematch* (a b)
-    (((node) (sink)) (zdd-intersection% b a))
 
-    (((sink nil) _) (sink nil))
-    ((_ (sink nil)) (sink nil))
+(defun-ematch* zdd-intersection% (a b)
+  (((node) (sink)) (zdd-intersection% b a))
+
+  (((sink nil) _) (sink nil))
+  ((_ (sink nil)) (sink nil))
 
-    (((sink t) (sink _)) b)
-    (((sink t) (node _ _ lo)) (zdd-intersection% a lo))
+  (((sink t) (sink _)) b)
+  (((sink t) (node _ _ lo)) (zdd-intersection% a lo))
 
-    (((node var-a hi-a lo-a)
-      (node var-b hi-b lo-b))
-     (cond
-       ((< var-a var-b) (zdd-intersection% lo-a b))
-       ((> var-a var-b) (zdd-intersection% lo-b a))
-       ((= var-a var-b) (zdd-node var-a
-                                  (zdd-intersection% hi-a hi-b)
-                                  (zdd-intersection% lo-a lo-b)))))))
+  (((node var-a hi-a lo-a)
+    (node var-b hi-b lo-b))
+   (cond
+     ((< var-a var-b) (zdd-intersection% lo-a b))
+     ((> var-a var-b) (zdd-intersection% lo-b a))
+     ((= var-a var-b) (zdd-node var-a
+                                (zdd-intersection% hi-a hi-b)
+                                (zdd-intersection% lo-a lo-b))))))
 
 (defun zdd-intersection (&rest zdds)
   "Return the intersection of ZDDs: {α | α ∈ Z₁ and α ∈ Z₂}."
@@ -139,28 +150,28 @@
     (reduce #'zdd-intersection% zdds)
     (sink nil)))
 
-(defun zdd-join% (a b)
-  (ematch* (a b)
-    (((sink nil) _) (sink nil))
-    ((_ (sink nil)) (sink nil))
 
-    (((sink t) b) b)
-    ((a (sink t)) a)
+(defun-ematch* zdd-join% (a b)
+  (((sink nil) _) (sink nil))
+  ((_ (sink nil)) (sink nil))
+
+  (((sink t) b) b)
+  ((a (sink t)) a)
 
-    (((node var-a hi-a lo-a)
-      (node var-b hi-b lo-b))
-     (cond
-       ((< var-a var-b) (zdd-node var-a
-                                  (zdd-join% hi-a b)
-                                  (zdd-join% lo-a b)))
-       ((> var-a var-b) (zdd-node var-b
-                                  (zdd-join% hi-b a)
-                                  (zdd-join% lo-b a)))
-       ((= var-a var-b) (zdd-node var-a
-                                  (zdd-union (zdd-join% hi-a lo-b)
-                                             (zdd-join% lo-a hi-b)
-                                             (zdd-join% hi-a hi-b))
-                                  (zdd-join% lo-a lo-b)))))))
+  (((node var-a hi-a lo-a)
+    (node var-b hi-b lo-b))
+   (cond
+     ((< var-a var-b) (zdd-node var-a
+                                (zdd-join% hi-a b)
+                                (zdd-join% lo-a b)))
+     ((> var-a var-b) (zdd-node var-b
+                                (zdd-join% hi-b a)
+                                (zdd-join% lo-b a)))
+     ((= var-a var-b) (zdd-node var-a
+                                (zdd-union (zdd-join% hi-a lo-b)
+                                           (zdd-join% lo-a hi-b)
+                                           (zdd-join% hi-a hi-b))
+                                (zdd-join% lo-a lo-b))))))
 
 (defun zdd-join (&rest zdds)
   "Return the relational join of ZDDs: {α ∪ β | α ∈ Z₁ and β ∈ Z₂}."
@@ -168,26 +179,26 @@
     (reduce #'zdd-join% zdds)
     (sink nil)))
 
-(defun zdd-meet% (a b)
-  (ematch* (a b)
-    (((sink nil) _) (sink nil))
-    ((_ (sink nil)) (sink nil))
 
-    (((sink t) _) (sink t))
-    ((_ (sink t)) (sink t))
+(defun-ematch* zdd-meet% (a b)
+  (((sink nil) _) (sink nil))
+  ((_ (sink nil)) (sink nil))
+
+  (((sink t) _) (sink t))
+  ((_ (sink t)) (sink t))
 
-    (((node var-a hi-a lo-a)
-      (node var-b hi-b lo-b))
-     (cond
-       ((< var-a var-b) (zdd-union (zdd-meet% hi-a b)
-                                   (zdd-meet% lo-a b)))
-       ((> var-a var-b) (zdd-union (zdd-meet% hi-b a)
-                                   (zdd-meet% lo-b a)))
-       ((= var-a var-b) (zdd-node var-a
-                                  (zdd-meet% hi-a hi-b)
-                                  (zdd-union (zdd-meet% hi-a lo-b)
-                                             (zdd-meet% lo-a hi-b)
-                                             (zdd-meet% lo-a lo-b))))))))
+  (((node var-a hi-a lo-a)
+    (node var-b hi-b lo-b))
+   (cond
+     ((< var-a var-b) (zdd-union (zdd-meet% hi-a b)
+                                 (zdd-meet% lo-a b)))
+     ((> var-a var-b) (zdd-union (zdd-meet% hi-b a)
+                                 (zdd-meet% lo-b a)))
+     ((= var-a var-b) (zdd-node var-a
+                                (zdd-meet% hi-a hi-b)
+                                (zdd-union (zdd-meet% hi-a lo-b)
+                                           (zdd-meet% lo-a hi-b)
+                                           (zdd-meet% lo-a lo-b)))))))
 
 (defun zdd-meet (&rest zdds)
   "Return the relational meet of ZDDs: {α ∩ β | α ∈ Z₁ and β ∈ Z₂}."
@@ -201,55 +212,52 @@
   (reduce #'zdd-union (mapcar #'zdd-set sets)))
 
 
-(defun zdd-keep-supersets-of% (zdd set)
-  (ematch* (zdd set)
-    ((_ nil) zdd)
-    (((sink) _) (sink nil))
-    (((node var hi lo) (list* el remaining))
-     (cond
-       ((= var el) (zdd-node var
-                             (zdd-keep-supersets-of% hi remaining)
-                             (sink nil)))
-       ((< var el) (zdd-node var
-                             (zdd-keep-supersets-of% hi set)
-                             (zdd-keep-supersets-of% lo set)))
-       ((> var el) (sink nil))))))
+(defun-ematch* zdd-keep-supersets-of% (zdd set)
+  ((_ nil) zdd)
+  (((sink) _) (sink nil))
+  (((node var hi lo) (list* el remaining))
+   (cond
+     ((= var el) (zdd-node var
+                           (zdd-keep-supersets-of% hi remaining)
+                           (sink nil)))
+     ((< var el) (zdd-node var
+                           (zdd-keep-supersets-of% hi set)
+                           (zdd-keep-supersets-of% lo set)))
+     ((> var el) (sink nil)))))
 
 (defun zdd-keep-supersets-of (zdd set)
   "Return a ZDD of all supersets of `set` in `zdd`: {α | α ∈ Z and α ⊇ S}."
   (zdd-keep-supersets-of% zdd (sort set #'<)))
 
 
-(defun zdd-remove-supersets-of% (zdd set)
-  (ematch* (zdd set)
-    ((_ nil) (sink nil))
-    (((sink) _) zdd)
-    (((node var hi lo) (list* el remaining))
-     (cond
-       ((= var el) (zdd-node var
-                             (zdd-remove-supersets-of% hi remaining)
-                             lo))
-       ((< var el) (zdd-node var
-                             (zdd-remove-supersets-of% hi set)
-                             (zdd-remove-supersets-of% lo set)))
-       ((> var el) zdd)))))
+(defun-ematch* zdd-remove-supersets-of% (zdd set)
+  ((_ nil) (sink nil))
+  (((sink) _) zdd)
+  (((node var hi lo) (list* el remaining))
+   (cond
+     ((= var el) (zdd-node var
+                           (zdd-remove-supersets-of% hi remaining)
+                           lo))
+     ((< var el) (zdd-node var
+                           (zdd-remove-supersets-of% hi set)
+                           (zdd-remove-supersets-of% lo set)))
+     ((> var el) zdd))))
 
 (defun zdd-remove-supersets-of (zdd set)
   "Return a ZDD of all non-supersets of `set` in `zdd`: {α | α ∈ Z and α ⊉ S}."
   (zdd-remove-supersets-of% zdd (sort set #'<)))
 
 
-(defun zdd-keep-avoiders-of% (zdd set)
-  (ematch* (zdd set)
-    ((_ nil) zdd)
-    (((sink) _) zdd)
-    (((node var hi lo) (list* el remaining))
-     (cond
-       ((= var el) (zdd-keep-avoiders-of% lo remaining))
-       ((< var el) (zdd-node var
-                             (zdd-keep-avoiders-of% hi set)
-                             (zdd-keep-avoiders-of% lo set)))
-       ((> var el) (zdd-keep-avoiders-of% zdd remaining))))))
+(defun-ematch* zdd-keep-avoiders-of% (zdd set)
+  ((_ nil) zdd)
+  (((sink) _) zdd)
+  (((node var hi lo) (list* el remaining))
+   (cond
+     ((= var el) (zdd-keep-avoiders-of% lo remaining))
+     ((< var el) (zdd-node var
+                           (zdd-keep-avoiders-of% hi set)
+                           (zdd-keep-avoiders-of% lo set)))
+     ((> var el) (zdd-keep-avoiders-of% zdd remaining)))))
 
 (defun zdd-keep-avoiders-of (zdd set)
   "Return a ZDD of members of `zdd` avoiding `set`: {α | α ∈ Z and α ∩ S = ø}."
--- a/vendor/make-quickutils.lisp	Wed Dec 07 17:52:35 2016 -0500
+++ b/vendor/make-quickutils.lisp	Sun Dec 11 16:25:09 2016 -0500
@@ -12,6 +12,7 @@
                :ensure-list
                :extremum
                :flatten-once
+               :hash-table-alist
                :hash-table-keys
                :hash-table-values
                :map-product
--- a/vendor/quickutils.lisp	Wed Dec 07 17:52:35 2016 -0500
+++ b/vendor/quickutils.lisp	Sun Dec 11 16:25:09 2016 -0500
@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :SUBDIVIDE :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :EXTREMUM :FLATTEN-ONCE :HASH-TABLE-KEYS :HASH-TABLE-VALUES :MAP-PRODUCT :MKSTR :ONCE-ONLY :RCURRY :SET-EQUAL :SYMB :WITH-GENSYMS :WITH-OUTPUT-TO-FILE :WRITE-STRING-INTO-FILE :YES-NO) :ensure-package T :package "SCULLY.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :EXTREMUM :FLATTEN-ONCE :HASH-TABLE-ALIST :HASH-TABLE-KEYS :HASH-TABLE-VALUES :MAP-PRODUCT :MKSTR :ONCE-ONLY :RCURRY :SET-EQUAL :SUBDIVIDE :SYMB :WITH-GENSYMS :WITH-OUTPUT-TO-FILE :WRITE-STRING-INTO-FILE :YES-NO) :ensure-package T :package "SCULLY.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "SCULLY.QUICKUTILS")
@@ -14,13 +14,14 @@
 
 (when (boundp '*utilities*)
   (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
-                                         :COMPOSE :COPY-HASH-TABLE :SUBDIVIDE
-                                         :CURRY :ENSURE-BOOLEAN :ENSURE-GETHASH
+                                         :COMPOSE :COPY-HASH-TABLE :CURRY
+                                         :ENSURE-BOOLEAN :ENSURE-GETHASH
                                          :ENSURE-LIST :EXTREMUM :FLATTEN-ONCE
-                                         :MAPHASH-KEYS :HASH-TABLE-KEYS
-                                         :MAPHASH-VALUES :HASH-TABLE-VALUES
-                                         :MAPPEND :MAP-PRODUCT :MKSTR
-                                         :ONCE-ONLY :RCURRY :SET-EQUAL :SYMB
+                                         :HASH-TABLE-ALIST :MAPHASH-KEYS
+                                         :HASH-TABLE-KEYS :MAPHASH-VALUES
+                                         :HASH-TABLE-VALUES :MAPPEND
+                                         :MAP-PRODUCT :MKSTR :ONCE-ONLY :RCURRY
+                                         :SET-EQUAL :SUBDIVIDE :SYMB
                                          :STRING-DESIGNATOR :WITH-GENSYMS
                                          :WITH-OPEN-FILE* :WITH-OUTPUT-TO-FILE
                                          :WRITE-STRING-INTO-FILE :YES-NO))))
@@ -100,28 +101,6 @@
       copy))
   
 
-  (defun subdivide (sequence chunk-size)
-    "Split `sequence` into subsequences of size `chunk-size`."
-    (check-type sequence sequence)
-    (check-type chunk-size (integer 1))
-    
-    (etypecase sequence
-      ;; Since lists have O(N) access time, we iterate through manually,
-      ;; collecting each chunk as we pass through it. Using SUBSEQ would
-      ;; be O(N^2).
-      (list (loop :while sequence
-                  :collect
-                  (loop :repeat chunk-size
-                        :while sequence
-                        :collect (pop sequence))))
-      
-      ;; For other sequences like strings or arrays, we can simply chunk
-      ;; by repeated SUBSEQs.
-      (sequence (loop :with len := (length sequence)
-                      :for i :below len :by chunk-size
-                      :collect (subseq sequence i (min len (+ chunk-size i)))))))
-  
-
   (defun curry (function &rest arguments)
     "Returns a function that applies `arguments` and the arguments
 it is called with to `function`."
@@ -217,6 +196,16 @@
             :collect x))
   
 
+  (defun hash-table-alist (table)
+    "Returns an association list containing the keys and values of hash table
+`table`."
+    (let ((alist nil))
+      (maphash (lambda (k v)
+                 (push (cons k v) alist))
+               table)
+      alist))
+  
+
   (declaim (inline maphash-keys))
   (defun maphash-keys (function table)
     "Like `maphash`, but calls `function` with each key in the hash table `table`."
@@ -351,6 +340,28 @@
                  (return nil))))))
   
 
+  (defun subdivide (sequence chunk-size)
+    "Split `sequence` into subsequences of size `chunk-size`."
+    (check-type sequence sequence)
+    (check-type chunk-size (integer 1))
+    
+    (etypecase sequence
+      ;; Since lists have O(N) access time, we iterate through manually,
+      ;; collecting each chunk as we pass through it. Using SUBSEQ would
+      ;; be O(N^2).
+      (list (loop :while sequence
+                  :collect
+                  (loop :repeat chunk-size
+                        :while sequence
+                        :collect (pop sequence))))
+      
+      ;; For other sequences like strings or arrays, we can simply chunk
+      ;; by repeated SUBSEQs.
+      (sequence (loop :with len := (length sequence)
+                      :for i :below len :by chunk-size
+                      :collect (subseq sequence i (min len (+ chunk-size i)))))))
+  
+
   (defun symb (&rest args)
     "Receives any number of objects, concatenates all into one string with `#'mkstr` and converts them to symbol.
 
@@ -462,10 +473,10 @@
     nil)
   
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(compose copy-hash-table subdivide curry ensure-boolean
-            ensure-gethash ensure-list extremum flatten-once hash-table-keys
-            hash-table-values map-product mkstr once-only rcurry set-equal symb
-            with-gensyms with-unique-names with-output-to-file
+  (export '(compose copy-hash-table curry ensure-boolean ensure-gethash
+            ensure-list extremum flatten-once hash-table-alist hash-table-keys
+            hash-table-values map-product mkstr once-only rcurry set-equal
+            subdivide symb with-gensyms with-unique-names with-output-to-file
             write-string-into-file yes no)))
 
 ;;;; END OF quickutils.lisp ;;;;