# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1468273083 0
# Node ID ab7ad2d6f641083d7c6d6fb21c882ce74537cdc5
# Parent  d2ede3f3926a47ee303546ac78a3e7609ffd7b52
Optimize `find-anonymous-variables`

After some profiling I found that this function was taking 4% of the total
runtime just on its own.  The culprit was `tree-collect`, which does some
expensive things (like `(gensym)`).  Because we know exactly what we need we can
write something much faster, and profiling confirms that this function isn't
even on the map any more.

diff -r d2ede3f3926a -r ab7ad2d6f641 package.lisp
--- a/package.lisp	Mon Jul 11 20:30:27 2016 +0000
+++ b/package.lisp	Mon Jul 11 21:38:03 2016 +0000
@@ -13,7 +13,6 @@
     #:recursively
     #:recur
     #:when-let
-    #:unique-items
     #:dis
     #:megabytes
     #:gethash-or-init
diff -r d2ede3f3926a -r ab7ad2d6f641 src/utils.lisp
--- a/src/utils.lisp	Mon Jul 11 20:30:27 2016 +0000
+++ b/src/utils.lisp	Mon Jul 11 21:38:03 2016 +0000
@@ -42,19 +42,6 @@
   `(let ((,symbol ,value))
      (when ,symbol ,@body)))
 
-(defun unique-items (list)
-  "Return a list of the items that appear exactly once in `list`."
-  (loop
-    :with once = nil
-    :with seen = nil
-    :for item :in list
-    :do (if (member item seen)
-          (when (member item once)
-            (setf once (delete item once)))
-          (progn (push item seen)
-                 (push item once)))
-    :finally (return once)))
-
 (defmacro dis (arglist &body body)
   "Disassemble the code generated for a `lambda*` with `arglist` and `body`.
 
diff -r d2ede3f3926a -r ab7ad2d6f641 src/wam/compiler.lisp
--- a/src/wam/compiler.lisp	Mon Jul 11 20:30:27 2016 +0000
+++ b/src/wam/compiler.lisp	Mon Jul 11 21:38:03 2016 +0000
@@ -364,7 +364,19 @@
   Anonymous variables are variables that are only ever used once.
 
   "
-  (unique-items (tree-collect #'variablep clause)))
+  (let ((seen nil)
+        (once nil))
+    (recursively ((term clause))
+      (cond
+        ((variablep term)
+         (if (member term seen)
+           (when (member term once)
+             (setf once (delete term once)))
+           (progn (push term seen)
+                  (push term once))))
+        ((consp term) (recur (car term))
+                      (recur (cdr term)))))
+    once))
 
 
 (defun* determine-clause-properties (head body)