diff --git a/src/cmp/cmptype-arith.lsp b/src/cmp/cmptype-arith.lsp
index 9e337f308..45d000868 100644
--- a/src/cmp/cmptype-arith.lsp
+++ b/src/cmp/cmptype-arith.lsp
@@ -79,7 +79,7 @@
 (defun trivial-type-p (type)
   (subtypep T type))
 
-(defun-equal-cached type-and (t1 t2)
+(defun-cached type-and (t1 t2) type-specifier=
   ;; FIXME! Should we allow "*" as type name???
   (when (or (eq t1 t2) (eq t2 '*))
     (return-from type-and t1))
@@ -128,7 +128,7 @@
          (let ((l (1- (length type))))
            (values l l)))))
 
-(defun-equal-cached values-type-primary-type (type)
+(defun-cached values-type-primary-type (type) type-specifier=
   ;; Extract the type of the first value returned by this form. We are
   ;; pragmatic and thus (VALUES) => NULL  [CHECKME!]
   (let (aux)
@@ -144,7 +144,7 @@
           (t
            aux))))
 
-(defun-equal-cached values-type-to-n-types (type length)
+(defun-cached values-type-to-n-types (type length) type-specifier=
   (when (plusp length)
     (do-values-type-to-n-types type length)))
 
@@ -195,7 +195,7 @@
           (return (values (nreverse required) (nreverse optional)
                           rest a-o-k)))))
 
-(defun-equal-cached values-type-or (t1 t2)
+(defun-cached values-type-or (t1 t2) type-specifier=
   (when (or (eq t2 'T) (equalp t2 '(VALUES &REST T)))
     (return-from values-type-or t2))
   (when (or (eq t1 'T) (equalp t1 '(VALUES &REST T)))
@@ -241,7 +241,7 @@
                  ,@(and opt (cons '&optional (nreverse opt)))
                  ,@(and rest (cons '&optional rest)))))))
 
-(defun-equal-cached values-type-and (t1 t2)
+(defun-cached values-type-and (t1 t2) type-specifier=
   (when (or (eq t2 'T) (equalp t2 '(VALUES &REST T)))
     (return-from values-type-and t1))
   (when (or (eq t1 'T) (equalp t1 '(VALUES &REST T)))
@@ -277,7 +277,7 @@
                  ,@(and opt (cons '&optional (nreverse opt)))
                  ,@(and rest (cons '&optional rest)))))))
 
-(defun-equal-cached type-or (t1 t2)
+(defun-cached type-or (t1 t2) type-specifier=
   ;; FIXME! Should we allow "*" as type name???
   (when (or (eq t1 t2) (eq t2 '*))
     (return-from type-or t1))
diff --git a/src/cmp/cmputil.lsp b/src/cmp/cmputil.lsp
index c65412987..77c127f42 100644
--- a/src/cmp/cmputil.lsp
+++ b/src/cmp/cmputil.lsp
@@ -436,6 +436,24 @@ comparing circular objects."
                          (equal-recursive (cdr x) (cdr y) x0 y0 t (ash path-spec 1) (the fixnum (1+ n))))))))
     (equal-recursive x y nil nil t 0 -1)))
 
+(defun type-specifier= (x y)
+  "Compares two type specifiers for syntactic equality."
+  ;; This function only checks if the arguments have the same name
+  ;; (and arguments in case of compound type specifiers) but not if
+  ;; they are aliases of each other. For example (OR REAL COMPLEX) and
+  ;; NUMBER are considered different by this function but are of
+  ;; course semantically equivalent.
+  ;;
+  ;; Note that type specifiers cannot be compared with EQUAL since in
+  ;; eql and member types the arguments have to compared using EQL.
+  (if (and (consp x) (consp y))
+      (if (and (member (first x) '(eql member))
+               (member (first y) '(eql member)))
+          (every #'eql x y)
+          (and (type-specifier= (car x) (car y))
+               (type-specifier= (cdr x) (cdr y))))
+      (eql x y)))
+
 ;; ----------------------------------------------------------------------
 ;; CACHED FUNCTIONS
 ;;
@@ -447,7 +465,7 @@ comparing circular objects."
          (hash-function (case test
                           (EQ 'SI::HASH-EQ)
                           (EQL 'SI::HASH-EQL)
-                          ((EQUAL EQUAL-WITH-CIRCULARITY) 'SI::HASH-EQUAL)
+                          ((EQUAL EQUAL-WITH-CIRCULARITY TYPE-SPECIFIER=) 'SI::HASH-EQUAL)
                           (t (setf test 'EQUALP) 'SI::HASH-EQUALP))))
     `(progn
        (defvar ,cache-name
@@ -469,8 +487,5 @@ comparing circular objects."
                    (setf (aref ,cache-name hash) (list ,@lambda-list output))
                    output))))))))
 
-(defmacro defun-equal-cached (name lambda-list &body body)
-  `(defun-cached ,name ,lambda-list equal-with-circularity ,@body))
-
 (defun same-fname-p (name1 name2)
   (equal name1 name2))