diff --git a/src/cmp/cmpspecial.lsp b/src/cmp/cmpspecial.lsp
index 67bc14ed3..acd27d897 100644
--- a/src/cmp/cmpspecial.lsp
+++ b/src/cmp/cmpspecial.lsp
@@ -105,9 +105,12 @@
 	     (fun-env fun) 0)))
     (otherwise
      (setf (fun-env fun) 0 (fun-level fun) 0)))
-  (let ((previous (dolist (old *local-funs*)
-		    (when (similar fun old)
-		      (return old)))))
+  (let ((previous
+         nil
+         #+(or)
+         (dolist (old *local-funs*)
+           (when (similar fun old)
+             (return old)))))
     (if previous
 	(progn
           (if (eq (fun-closure fun) 'CLOSURE)
diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp
index 405ff84ec..4e658823d 100644
--- a/src/cmp/cmptop.lsp
+++ b/src/cmp/cmptop.lsp
@@ -303,6 +303,7 @@
 ;;; Mechanism for sharing code:
 ;;; FIXME! Revise this 'DEFUN stuff.
 (defun new-defun (new &optional no-entry)
+  #|
   (unless (fun-exported new)
     ;; Check whether this function is similar to a previous one and
     ;; share code with it.
@@ -315,58 +316,83 @@
 	      (fun-minarg new) (fun-minarg old)
 	      (fun-maxarg new) (fun-maxarg old))
 	(return))))
+  |#
   (push new *global-funs*))
 
 (defun print-function (x)
   (format t "~%<a FUN: ~A, CLOSURE: ~A, LEVEL: ~A, ENV: ~A>"
 	  (fun-name x) (fun-closure x) (fun-level x) (fun-env x)))
 
+(defmacro and! (&body body)
+  `(let ((l (list ,@body)))
+     (pprint (list* 'l? l))
+     (every #'identity l)))
+
+#|
 (defun similar (x y)
-  ;; FIXME! This could be more accurate
-  (labels ((similar-ref (x y)
-	     (and (equal (ref-ref-ccb x) (ref-ref-ccb y))
-		  (equal (ref-ref-clb x) (ref-ref-clb y))
-		  (equal (ref-ref x) (ref-ref y))))
-	   (similar-var (x y)
-	     (and (similar-ref x y)
-		  (equal (var-name x) (var-name y))
-		  (equal (var-kind x) (var-kind y))
-		  (equal (var-loc x) (var-loc y))
-		  (equal (var-type x) (var-type y))
-		  (equal (var-index x) (var-index y))))
-	   (similar-c1form (x y)
-	     (and (equal (c1form-name x) (c1form-name y))
-		  (similar (c1form-args x) (c1form-args y))
-		  (similar (c1form-local-vars x) (c1form-local-vars y))
-		  (eql (c1form-sp-change x) (c1form-sp-change y))
-		  (eql (c1form-volatile x) (c1form-volatile y))))
-	   (similar-fun (x y)
-	     (and (similar-ref x y)
-		  (eql (fun-global x) (fun-global y))
-		  (eql (fun-exported x) (fun-exported y))
-		  (eql (fun-closure x) (fun-closure y))
-		  (similar (fun-var x) (fun-var y))
-		  (similar (fun-lambda x) (fun-lambda y))
-		  (= (fun-level x) (fun-level y))
-		  (= (fun-env x) (fun-env y))
-		  (= (fun-minarg x) (fun-minarg y))
-		  (eql (fun-maxarg x) (fun-maxarg y))
-		  (similar (fun-local-vars x) (fun-local-vars y))
-		  (similar (fun-referred-vars x) (fun-referred-vars y))
-		  (similar (fun-referred-funs x) (fun-referred-funs y))
-		  (similar (fun-child-funs x) (fun-child-funs y)))))
-    (and (eql (type-of x) (type-of y))
-	 (typecase x
-	   (CONS (and (similar (car x) (car y))
-		      (similar (cdr x) (cdr y))))
-	   (VAR (similar-var x y))
-	   (FUN (similar-fun x y))
-	   (REF (similar-ref x y))
-	   (TAG NIL)
-	   (BLK NIL)
-	   (C1FORM (similar-c1form x y))
-	   (SEQUENCE (and (every #'similar x y)))
-	   (T (equal x y))))))
+  (let ((*processed* (make-hash-table :test #'equal)))
+    ;; FIXME! This could be more accurate
+    (labels ((similar (x y)
+               (when (eql x y)
+                 (return-from similar t))
+               (let ((pair (cons x y)))
+                 (case (gethash pair *processed* :not-found)
+                   ((nil) (return-from similar nil))
+                   ((t) (return-from similar t))
+                   ((:ongoing) (return-from similar t))
+                   ((:not-found)))
+                 (setf (gethash pair *processed*) :ongoing)
+                 (setf (gethash pair *processed*)
+                       (and (eql (type-of x) (type-of y))
+                            (typecase x
+                              (CONS (and (similar (car x) (car y))
+                                         (similar (cdr x) (cdr y))))
+                              (VAR (similar-var x y))
+                              (FUN (similar-fun x y))
+                              (REF (similar-ref x y))
+                              (TAG NIL)
+                              (BLK NIL)
+                              (C1FORM (similar-c1form x y))
+                              (SEQUENCE (and (every #'similar x y)))
+                              (T (equal x y)))))))
+             (similar-list (x y)
+               (null (set-difference x y)))
+             (similar-ref (x y)
+               (and (equal (ref-ref-ccb x) (ref-ref-ccb y))
+                    (equal (ref-ref-clb x) (ref-ref-clb y))
+                    (equal (ref-ref x) (ref-ref y))))
+             (similar-var (x y)
+               (print (list (var-loc x) (var-loc y)))
+               (and! (similar-ref x y)
+                    (equal (var-name x) (var-name y))
+                    (equal (var-kind x) (var-kind y))
+                    (equal (var-loc x) (var-loc y))
+                    (equal (var-type x) (var-type y))
+                    (equal (var-index x) (var-index y))))
+             (similar-c1form (x y)
+               (and (equal (c1form-name x) (c1form-name y))
+                    (similar (c1form-args x) (c1form-args y))
+                    (similar (c1form-local-vars x) (c1form-local-vars y))
+                    (eql (c1form-sp-change x) (c1form-sp-change y))
+                    (eql (c1form-volatile x) (c1form-volatile y))))
+             (similar-fun (x y)
+               (print (list '? (fun-name x) (fun-name y)))
+               (and! (similar-ref x y)
+                    (eql (fun-global x) (fun-global y))
+                    (eql (fun-exported x) (fun-exported y))
+                    (eql (fun-closure x) (fun-closure y))
+                    (similar (fun-var x) (fun-var y))
+                    (similar (fun-lambda x) (fun-lambda y))
+                    (= (fun-level x) (fun-level y))
+                    (= (fun-env x) (fun-env y))
+                    (= (fun-minarg x) (fun-minarg y))
+                    (eql (fun-maxarg x) (fun-maxarg y))
+                    (every #'similar (fun-local-vars x) (fun-local-vars y))
+                    (every #'similar (fun-referred-vars x) (fun-referred-vars y))
+                    (every #'similar (fun-referred-funs x) (fun-referred-funs y))
+                    (every #'similar (fun-child-funs x) (fun-child-funs y)))))
+      (similar x y))))
+|#
 
 (defun wt-function-prolog (&optional sp local-entry)
   (wt " VT" *reservation-cmacro*