# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1478088560 0
# Node ID 060160061ec6aba4371a356d78965aba9ac3042c
# Parent  2a71a4230eb3a2ae7d8bf3a6eda7aa445cc3a062
Rename `leaf` -> `sink`

diff -r 2a71a4230eb3 -r 060160061ec6 src/zdd.lisp
--- a/src/zdd.lisp	Wed Nov 02 12:03:29 2016 +0000
+++ b/src/zdd.lisp	Wed Nov 02 12:09:20 2016 +0000
@@ -9,9 +9,6 @@
                   (tg:gc :full t :verbose t))
            args)))
 
-(defpattern sink (&optional content)
-  `(structure leaf :content ,content))
-
 (defun never (val)
   (declare (ignore val))
   (values))
@@ -29,6 +26,21 @@
   '----------------------------------------)
 
 
+;;;; Bullshit -----------------------------------------------------------------
+;;; The BDD lib defines a pattern for `node` but not for `leaf`.  It's awkward
+;;; to have two different syntaxes.  But if we define a pattern for `leaf` and
+;;; then try to reload the BDD lib it will explode, because the lib uses the
+;;; second syntax!  So basically we'll just rename "leaf" to "sink" and get on
+;;; with our lives.  Christ.
+(defpattern sink (&optional content)
+  `(structure leaf :content ,content))
+
+(defun sink (thing)
+  (leaf thing))
+
+(deftype sink () 'leaf)
+
+
 ;;;; GraphViz -----------------------------------------------------------------
 (setf cl-dot:*dot-path* "/usr/local/bin/dot")
 (defparameter *draw-unique-sinks* nil)
@@ -160,7 +172,7 @@
 (defun unit-patch (z)
   (ematch z
     ((sink t) z)
-    ((sink nil) (leaf t))
+    ((sink nil) (sink t))
     ((node variable hi lo)
      (zdd-node variable hi (unit-patch lo)))))
 
@@ -187,14 +199,14 @@
 (defun zdd-union (&rest zdds)
   (if zdds
     (reduce #'zdd-union% zdds)
-    (leaf nil)))
+    (sink nil)))
 
 (defun zdd-intersection% (a b)
   (ematch* (a b)
     (((node) (sink)) (zdd-intersection% b a))
 
-    (((sink nil) _) (leaf nil))
-    ((_ (sink nil)) (leaf nil))
+    (((sink nil) _) (sink nil))
+    ((_ (sink nil)) (sink nil))
 
     (((sink t) (sink _)) b)
     (((sink t) (node _ _ lo)) (zdd-intersection% a lo))
@@ -211,12 +223,12 @@
 (defun zdd-intersection (&rest zdds)
   (if zdds
     (reduce #'zdd-intersection% zdds)
-    (leaf nil)))
+    (sink nil)))
 
 (defun zdd-join% (a b)
   (ematch* (a b)
-    (((sink nil) _) (leaf nil))
-    ((_ (sink nil)) (leaf nil))
+    (((sink nil) _) (sink nil))
+    ((_ (sink nil)) (sink nil))
 
     (((sink t) b) b)
     ((a (sink t)) a)
@@ -239,15 +251,15 @@
 (defun zdd-join (&rest zdds)
   (if zdds
     (reduce #'zdd-join% zdds)
-    (leaf nil)))
+    (sink nil)))
 
 (defun zdd-meet% (a b)
   (ematch* (a b)
-    (((sink nil) _) (leaf nil))
-    ((_ (sink nil)) (leaf nil))
+    (((sink nil) _) (sink nil))
+    ((_ (sink nil)) (sink nil))
 
-    (((sink t) _) (leaf t))
-    ((_ (sink t)) (leaf t))
+    (((sink t) _) (sink t))
+    ((_ (sink t)) (sink t))
 
     (((node var-a hi-a lo-a)
       (node var-b hi-b lo-b))
@@ -265,7 +277,7 @@
 (defun zdd-meet (&rest zdds)
   (if zdds
     (reduce #'zdd-meet% zdds)
-    (leaf nil)))
+    (sink nil)))
 
 
 (defun zdd-family (&rest sets)
@@ -275,16 +287,16 @@
 (defun zdd-keep-supersets-of% (zdd set)
   (ematch* (zdd set)
     ((_ nil) zdd)
-    (((sink) _) (leaf nil))
+    (((sink) _) (sink nil))
     (((node var hi lo) (list* el remaining))
      (cond
        ((= var el) (zdd-node var
                              (zdd-keep-supersets-of% hi remaining)
-                             (leaf nil)))
+                             (sink nil)))
        ((< var el) (zdd-node var
                              (zdd-keep-supersets-of% hi set)
                              (zdd-keep-supersets-of% lo set)))
-       ((> var el) (leaf nil))))))
+       ((> var el) (sink nil))))))
 
 (defun zdd-keep-supersets-of (zdd set)
   (zdd-keep-supersets-of% zdd (sort set #'<)))
@@ -292,7 +304,7 @@
 
 (defun zdd-remove-supersets-of% (zdd set)
   (ematch* (zdd set)
-    ((_ nil) (leaf nil))
+    ((_ nil) (sink nil))
     (((sink) _) zdd)
     (((node var hi lo) (list* el remaining))
      (cond
@@ -328,12 +340,12 @@
   (recursively ((zdd zdd) (set set))
     (ematch zdd
       ;; If Z = ∅, there are no candidates for matching.
-      ((sink nil) (leaf nil))
+      ((sink nil) (sink nil))
 
       ;; If Z = {∅}, the only set ∅ can match is the empty set.
       ((sink t) (if set
-                  (leaf nil)
-                  (leaf t)))
+                  (sink nil)
+                  (sink t)))
 
       ;; Otherwise Z is a real node.
       ((node var hi lo)
@@ -349,7 +361,7 @@
          ;; If our target set is empty, that's perfect.  But if it's NOT empty,
          ;; we're never gonna satisfy it.
          ((> var upper-bound) (if set
-                                (leaf nil)
+                                (sink nil)
                                 zdd))
 
          ;; Otherwise Z's var is within the universe.
@@ -365,13 +377,13 @@
                  ;; branch because the hi branch contains something unwanted.
                  ((< var element) (recur lo set))
                  ;; If we're above the target element, we can never match.
-                 ((> var element) (leaf nil))
+                 ((> var element) (sink nil))
                  ;; Otherwise, we recur down the hi branch with the rest of our
                  ;; target (the lo branch is always missing this element).
                  ((= var element) (zdd-node var
                                             (recur hi remaining)
                                             ;        jeeeeeeeesus
-                                            (leaf nil))))))))))))
+                                            (sink nil))))))))))))
 
 (defun zdd-match (zdd set lower-bound upper-bound)
   (zdd-match% zdd (sort set #'<) lower-bound upper-bound))
@@ -582,7 +594,7 @@
          )
     (mapprint-through #'enumerate <>)
     (print-through #'line <>)
-    (zdd-match <> '(100 200) 100 999)
+    (zdd-match <> '() 100 999)
     (mapprint-through #'enumerate <>)
     (draw <> :hexp (lambda (v) (>= 999 v 100)))
     (never <>)