[movitz-cvs] CVS movitz

[ffjeld]

Update of /project/movitz/cvsroot/movitz
In directory clnet:/tmp/cvs-serv7215

Modified Files:
	compiler.lisp 
Log Message:
Improved tree-search, for speed.


--- /project/movitz/cvsroot/movitz/compiler.lisp	2008/02/16 23:35:22	1.191
+++ /project/movitz/cvsroot/movitz/compiler.lisp	2008/02/17 00:10:11	1.192
@@ -8,7 +8,7 @@
 ;;;; Created at:    Wed Oct 25 12:30:49 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: compiler.lisp,v 1.191 2008/02/16 23:35:22 ffjeld Exp $
+;;;; $Id: compiler.lisp,v 1.192 2008/02/17 00:10:11 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -3256,12 +3256,24 @@
 	   (binding-eql x (forwarding-binding-target y)))))
 
 (defun tree-search (tree items)
-  (etypecase tree
-    (atom (if (atom items)
-	      (eql tree items)
-	    (member tree items)))
-    (cons (or (tree-search (car tree) items)
-	      (tree-search (cdr tree) items)))))
+  (if (and (atom items)			; make common case fast(er), hopefully.
+	   (not (numberp items)))
+      (labels ((tree-search* (tree item)
+		 (etypecase tree
+		   (null nil)
+		   (cons
+		    (or (tree-search* (car tree) item)
+			(tree-search* (cdr tree) item)))
+		   (t (eq tree item)))))
+	(tree-search* tree items))
+    (etypecase tree
+      (atom
+       (if (atom items)
+	   (eql tree items)
+	 (member tree items)))
+      (cons
+       (or (tree-search (car tree) items)
+	   (tree-search (cdr tree) items))))))
 
 (defun operator (x)
   (if (atom x) x (car x)))