diff --git a/compiler/array-tran.lisp b/compiler/array-tran.lisp
index 28ea744e454485d4cdba15dd7d23d9fce877a459..409e596fbd3047568bfe06aa6ccd6ae09466d17c 100644
--- a/compiler/array-tran.lisp
+++ b/compiler/array-tran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.14 1991/11/12 14:14:14 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.15 1993/05/11 13:49:57 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -157,16 +157,19 @@
 ;;; Convert VECTOR into a make-array followed by setfs of all the elements.
 ;;;
 (def-source-transform vector (&rest elements)
-  (let ((len (length elements))
-	(n -1))
-    (once-only ((n-vec `(make-array ,len)))
-      `(progn 
-	 ,@(mapcar #'(lambda (el)
-		       (once-only ((n-val el))
-			 `(locally (declare (optimize (safety 0)))
-			    (setf (svref ,n-vec ,(incf n)) ,n-val))))
-		   elements)
-	 ,n-vec))))
+  (if *byte-compiling*
+      (values nil t)
+      (let ((len (length elements))
+	    (n -1))
+	(once-only ((n-vec `(make-array ,len)))
+	  `(progn 
+	     ,@(mapcar #'(lambda (el)
+			   (once-only ((n-val el))
+			     `(locally (declare (optimize (safety 0)))
+				       (setf (svref ,n-vec ,(incf n))
+					     ,n-val))))
+		       elements)
+	     ,n-vec)))))
 
 
 ;;; MAKE-STRING  --  source-transform.
@@ -174,9 +177,11 @@
 ;;; Just convert it into a make-array.
 ;;;
 (def-source-transform make-string (length &key (initial-element #\NULL))
-  `(make-array (the index ,length)
-	       :element-type 'base-char
-	       :initial-element ,initial-element))
+  (if *byte-compiling*
+      (values nil t)
+      `(make-array (the index ,length)
+		   :element-type 'base-char
+		   :initial-element ,initial-element)))
 
 (defconstant array-info
   '((base-char #\NULL 8 vm:simple-string-type)
@@ -499,9 +504,13 @@
 (macrolet ((frob (reffer setter type)
 	     `(progn
 		(def-source-transform ,reffer (a &rest i)
-		  `(aref (the ,',type ,a) ,@i))
+		  (if *byte-compiling*
+		      (values nil t)
+		      `(aref (the ,',type ,a) ,@i)))
 		(def-source-transform ,setter (a &rest i)
-		  `(%aset (the ,',type ,a) ,@i)))))
+		  (if *byte-compiling*
+		      (values nil t)
+		      `(%aset (the ,',type ,a) ,@i))))))
   (frob svref %svset simple-vector)
   (frob schar %scharset simple-string)
   (frob char %charset string)
diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp
index adabfb3662fb2b3e6761f028e488d6c14a704ac4..d1a39e7cf204a579507cbfd49afa2cd062f203f5 100644
--- a/compiler/float-tran.lisp
+++ b/compiler/float-tran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.15 1993/05/07 16:03:05 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.16 1993/05/11 13:50:47 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -24,26 +24,30 @@
 (defknown %single-float (real) single-float (movable foldable flushable))
 (defknown %double-float (real) double-float (movable foldable flushable))
 
-(deftransform float ((n &optional f) (* &optional single-float))
+(deftransform float ((n &optional f) (* &optional single-float) *
+		     :when :both)
+		     
   '(%single-float n))
 
-(deftransform float ((n f) (* double-float))
+(deftransform float ((n f) (* double-float) * :when :both)
   '(%double-float n))
 
-(deftransform %single-float ((n) (single-float))
+(deftransform %single-float ((n) (single-float) * :when :both)
   'n)
 
-(deftransform %double-float ((n) (double-float))
+(deftransform %double-float ((n) (double-float) * :when :both)
   'n)
 
 (deftransform coerce ((n type)
 		      (* (constant-argument
-			  (member float short-float single-float))))
+			  (member float short-float single-float)))
+		      * :when :both)
   '(%single-float n))
 
 (deftransform coerce ((n type)
 		      (* (constant-argument
-			  (member double-float long-float))))
+			  (member double-float long-float)))
+		      * :when :both)
   '(%double-float n))
 
 ;;; Not strictly float functions, but primarily useful on floats:
@@ -63,7 +67,8 @@
 ;;;
 (macrolet ((frob (fun type)
 	     `(deftransform random ((num &optional state)
-				    (,type &optional *))
+				    (,type &optional *) *
+				    :when :both)
 		"use inline float operations"
 		'(,fun num state))))
   (frob %random-single-float single-float)
@@ -100,16 +105,17 @@
 (defun double-float-low-bits (x) (double-float-low-bits x))
 
 (def-source-transform float-sign (float1 &optional (float2 nil f2-p))
-  (let ((n-f1 (gensym)))
-    (if f2-p
-	`(* (float-sign ,float1) (abs ,float2))
-	`(let ((,n-f1 ,float1))
-	   (declare (float ,n-f1))
-	   (if (minusp (if (typep ,n-f1 'single-float)
-			   (single-float-bits ,n-f1)
-			   (double-float-high-bits ,n-f1)))
-	       (float -1 ,n-f1)
-	       (float 1 ,n-f1))))))
+  (cond (*byte-compiling* (values nil t))
+	(f2-p `(* (float-sign ,float1) (abs ,float2)))
+	(t
+	 (let ((n-f1 (gensym)))
+	   `(let ((,n-f1 ,float1))
+	      (declare (float ,n-f1))
+	      (if (minusp (if (typep ,n-f1 'single-float)
+			      (single-float-bits ,n-f1)
+			      (double-float-high-bits ,n-f1)))
+		  (float -1 ,n-f1)
+		  (float 1 ,n-f1)))))))
 
 
 ;;;; DECODE-FLOAT, INTEGER-DECODE-FLOAT, SCALE-FLOAT:
@@ -169,22 +175,22 @@
 (defknown scale-double-float (double-float fixnum) double-float
   (movable foldable flushable))
 
-(deftransform decode-float ((x) (single-float))
+(deftransform decode-float ((x) (single-float) * :when :both)
   '(decode-single-float x))
 
-(deftransform decode-float ((x) (double-float))
+(deftransform decode-float ((x) (double-float) * :when :both)
   '(decode-double-float x))
 
-(deftransform integer-decode-float ((x) (single-float))
+(deftransform integer-decode-float ((x) (single-float) * :when :both)
   '(integer-decode-single-float x))
 
-(deftransform integer-decode-float ((x) (double-float))
+(deftransform integer-decode-float ((x) (double-float) * :when :both)
   '(integer-decode-double-float x))
 
-(deftransform scale-float ((f ex) (single-float *))
+(deftransform scale-float ((f ex) (single-float *) * :when :both)
   '(scale-single-float f ex))
 
-(deftransform scale-float ((f ex) (double-float *))
+(deftransform scale-float ((f ex) (double-float *) * :when :both)
   '(scale-double-float f ex))
 
 
@@ -221,7 +227,7 @@
 ;;; has a precise representation as a float (such as 0).
 ;;;
 (macrolet ((frob (op)
-	     `(deftransform ,op ((x y) (float rational))
+	     `(deftransform ,op ((x y) (float rational) :when :both)
 		(unless (constant-continuation-p y)
 		  (give-up "Can't open-code float to rational comparison."))
 		(let ((val (continuation-value y)))
@@ -283,7 +289,7 @@
   (destructuring-bind (name prim rtype) stuff
     (deftransform name ((x) '(single-float) rtype :eval-name t)
       `(coerce (,prim (coerce x 'double-float)) 'single-float))
-    (deftransform name ((x) '(double-float) rtype :eval-name t)
+    (deftransform name ((x) '(double-float) rtype :eval-name t :when :both)
       `(,prim x))))
 
 (dolist (stuff '((expt %pow t)
@@ -293,7 +299,7 @@
       `(coerce (,prim (coerce x 'double-float)
 		      (coerce y 'double-float))
 	       'single-float))
-    (deftransform name ((x y) '(double-float) rtype :eval-name t)
+    (deftransform name ((x y) '(double-float) rtype :eval-name t :when :both)
       `(,prim x y))))
 
 (deftransform log ((x y) (float float) float)
diff --git a/compiler/seqtran.lisp b/compiler/seqtran.lisp
index bd1b9f7cb4cac5560aba29dae4b0f0029c2472fa..60b8c73e252faa52614ca51e57e9c401207b3fe0 100644
--- a/compiler/seqtran.lisp
+++ b/compiler/seqtran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/seqtran.lisp,v 1.16 1992/08/05 00:36:42 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/seqtran.lisp,v 1.17 1993/05/11 13:50:50 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -72,20 +72,20 @@
 (def-source-transform mapcon (function list &rest more-lists)
   (mapper-transform function (cons list more-lists) :nconc nil))
 
-(deftransform elt ((s i) ((simple-array * (*)) *))
+(deftransform elt ((s i) ((simple-array * (*)) *) * :when :both)
   '(aref s i))
 
-(deftransform elt ((s i) (list *))
+(deftransform elt ((s i) (list *) * :when :both)
   '(nth i s))
 
-(deftransform %setelt ((s i v) ((simple-array * (*)) * *))
+(deftransform %setelt ((s i v) ((simple-array * (*)) * *) * :when :both)
   '(%aset s i v))
 
 (deftransform %setelt ((s i v) (list * *))
   '(setf (car (nthcdr i s)) v))
 
 
-(deftransform member ((e l &key (test #'eql)) * * :node node)
+(deftransform member ((e l &key (test #'eql)) * * :node node :when :both)
   (unless (constant-continuation-p l) (give-up))
   
   (let ((val (continuation-value l)))
@@ -421,7 +421,7 @@
   (destructuring-bind (fun pred*) stuff
     (deftransform fun ((string1 string2 &key (start1 0) end1
 				(start2 0) end2)
-		       '* '* :eval-name t)
+		       '* '* :eval-name t :when :both)
       `(,pred* string1 string2 start1 end1 start2 end2))))
 
 
diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp
index 164783a2c952b6e353f44982f89ec9047624b8c0..455d6c58423fcf826be931dc6582837944018c9a 100644
--- a/compiler/srctran.lisp
+++ b/compiler/srctran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.40 1993/02/03 18:26:14 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.41 1993/05/11 13:50:52 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -62,7 +62,7 @@
 ;;; FUNCALL, then do the &REST APPLY thing, and let MV optimization figure
 ;;; things out.
 ;;;
-(deftransform complement ((fun) * * :node node)
+(deftransform complement ((fun) * * :node node :when :both)
   "open code"
   (multiple-value-bind (min max)
 		       (function-type-nargs (continuation-type fun))
@@ -84,34 +84,27 @@
 
 ;;;
 ;;; Translate CxxR into car/cdr combos.
-(def-source-transform caar (x) `(car (car ,x)))
-(def-source-transform cadr (x) `(car (cdr ,x)))
-(def-source-transform cdar (x) `(cdr (car ,x)))
-(def-source-transform cddr (x) `(cdr (cdr ,x)))
-(def-source-transform caaar (x) `(car (car (car ,x))))
-(def-source-transform caadr (x) `(car (car (cdr ,x))))
-(def-source-transform cadar (x) `(car (cdr (car ,x))))
-(def-source-transform caddr (x) `(car (cdr (cdr ,x))))
-(def-source-transform cdaar (x) `(cdr (car (car ,x))))
-(def-source-transform cdadr (x) `(cdr (car (cdr ,x))))
-(def-source-transform cddar (x) `(cdr (cdr (car ,x))))
-(def-source-transform cdddr (x) `(cdr (cdr (cdr ,x))))
-(def-source-transform caaaar (x) `(car (car (car (car ,x)))))
-(def-source-transform caaadr (x) `(car (car (car (cdr ,x)))))
-(def-source-transform caadar (x) `(car (car (cdr (car ,x)))))
-(def-source-transform caaddr (x) `(car (car (cdr (cdr ,x)))))
-(def-source-transform cadaar (x) `(car (cdr (car (car ,x)))))
-(def-source-transform cadadr (x) `(car (cdr (car (cdr ,x)))))
-(def-source-transform caddar (x) `(car (cdr (cdr (car ,x)))))
-(def-source-transform cadddr (x) `(car (cdr (cdr (cdr ,x)))))
-(def-source-transform cdaaar (x) `(cdr (car (car (car ,x)))))
-(def-source-transform cdaadr (x) `(cdr (car (car (cdr ,x)))))
-(def-source-transform cdadar (x) `(cdr (car (cdr (car ,x)))))
-(def-source-transform cdaddr (x) `(cdr (car (cdr (cdr ,x)))))
-(def-source-transform cddaar (x) `(cdr (cdr (car (car ,x)))))
-(def-source-transform cddadr (x) `(cdr (cdr (car (cdr ,x)))))
-(def-source-transform cdddar (x) `(cdr (cdr (cdr (car ,x)))))
-(def-source-transform cddddr (x) `(cdr (cdr (cdr (cdr ,x)))))
+
+(defun source-transform-cxr (form)
+  (if (or *byte-compiling* (/= (length form) 2))
+      (values nil t)
+      (let ((name (symbol-name (car form))))
+	(do ((i (- (length name) 2) (1- i))
+	     (res (cadr form)
+		  `(,(ecase (char name i)
+		       (#\A 'car)
+		       (#\D 'cdr))
+		    ,res)))
+	    ((zerop i) res)))))
+
+(do ((i 2 (1+ i))
+     (b '(1 0) (cons i b)))
+    ((= i 5))
+  (dotimes (j (ash 1 i))
+    (setf (info function source-transform
+		(intern (format nil "C~{~:[A~;D~]~}R"
+				(mapcar #'(lambda (x) (logbitp x j)) b))))
+	  #'source-transform-cxr)))
 
 ;;;
 ;;; Turn First..Fourth and Rest into the obvious synonym, assuming whatever is
@@ -875,7 +868,7 @@
 
 ;;; Handle the case of a constant boole-code.
 ;;;
-(deftransform boole ((op x y))
+(deftransform boole ((op x y) * * :when :both)
   "convert to inline logical ops"
   (unless (constant-continuation-p op)
     (give-up "BOOLE code is not a constant."))
@@ -905,7 +898,7 @@
 
 ;;; If arg is a constant power of two, turn * into a shift.
 ;;;
-(deftransform * ((x y) (integer integer))
+(deftransform * ((x y) (integer integer) * :when :both)
   "convert x*2^k to shift"
   (unless (constant-continuation-p y) (give-up))
   (let* ((y (continuation-value y))
@@ -981,17 +974,17 @@
 			      (- (logand (- x) ,mask)))
 		     `(values (ash x ,shift)
 			      (logand x ,mask))))))))
-  (deftransform floor ((x y) (integer integer))
+  (deftransform floor ((x y) (integer integer) *)
     "convert division by 2^k to shift"
     (frob y nil))
-  (deftransform ceiling ((x y) (integer integer))
+  (deftransform ceiling ((x y) (integer integer) *)
     "convert division by 2^k to shift"
     (frob y t)))
 
 
 ;;; Do the same for mod.
 ;;;
-(deftransform mod ((x y) (integer integer))
+(deftransform mod ((x y) (integer integer) * :when :both)
   "convert remainder mod 2^k to LOGAND"
   (unless (constant-continuation-p y) (give-up))
   (let* ((y (continuation-value y))
@@ -1027,7 +1020,7 @@
 
 ;;; And the same for rem.
 ;;;
-(deftransform rem ((x y) (integer integer))
+(deftransform rem ((x y) (integer integer) * :when :both)
   "convert remainder mod 2^k to LOGAND"
   (unless (constant-continuation-p y) (give-up))
   (let* ((y (continuation-value y))
@@ -1055,7 +1048,7 @@
 		 (logxor 0 x)))
   (destructuring-bind (name identity result) stuff
     (deftransform name ((x y) `(* (constant-argument (member ,identity))) '*
-			:eval-name t)
+			:eval-name t :when :both)
       "fold identity operations"
       result)))
 
@@ -1063,11 +1056,13 @@
 ;;; These are restricted to rationals, because (- 0 0.0) is 0.0, not -0.0, and
 ;;; (* 0 -4.0) is -0.0.
 ;;;
-(deftransform - ((x y) ((constant-argument (member 0)) rational))
+(deftransform - ((x y) ((constant-argument (member 0)) rational) *
+		 :when :both)
   "convert (- 0 x) to negate"
   '(%negate y))
 ;;;
-(deftransform * ((x y) (rational (constant-argument (member 0))))
+(deftransform * ((x y) (rational (constant-argument (member 0))) *
+		 :when :both)
   "convert (* x 0) to 0."
   0)
 
@@ -1094,7 +1089,8 @@
 		 (- x)
 		 (expt 1)))
   (destructuring-bind (name result) stuff
-    (deftransform name ((x y) '(t (constant-argument t)) '* :eval-name t)
+    (deftransform name ((x y) '(t (constant-argument t)) '* :eval-name t
+			:when :both)
       "fold zero arg"
       (let ((val (continuation-value y)))
 	(unless (and (zerop val)
@@ -1109,7 +1105,8 @@
 		 (/ x (%negate x))
 		 (expt x (/ 1 x))))
   (destructuring-bind (name result minus-result) stuff
-    (deftransform name ((x y) '(t (constant-argument real)) '* :eval-name t)
+    (deftransform name ((x y) '(t (constant-argument real)) '* :eval-name t
+			:when :both)
       "fold identity operations"
       (let ((val (continuation-value y)))
 	(unless (and (= (abs val) 1)
@@ -1171,7 +1168,8 @@
 ;;; there is no intersection between the types of the arguments, then the
 ;;; result is definitely false.
 ;;;
-(deftransform simple-equality-transform ((x y) * * :defun-only t)
+(deftransform simple-equality-transform ((x y) * * :defun-only t
+					 :when :both)
   (cond ((same-leaf-ref-p x y)
 	 't)
 	((not (types-intersect (continuation-type x) (continuation-type y)))
@@ -1198,7 +1196,7 @@
 ;;; -- If Y is a fixnum, then we quietly pass because the back end can handle
 ;;;    that case, otherwise give an efficency note.
 ;;;
-(deftransform eql ((x y))
+(deftransform eql ((x y) * * :when :both)
   "convert to simpler equality predicate"
   (let ((x-type (continuation-type x))
 	(y-type (continuation-type y))
@@ -1230,7 +1228,7 @@
 ;;; either both rational or both floats of the same format.  Complexp must also
 ;;; be specified and identical.
 ;;; 
-(deftransform = ((x y))
+(deftransform = ((x y) * * :when :both)
   "open code"
   (let ((x-type (continuation-type x))
 	(y-type (continuation-type y)))
@@ -1289,10 +1287,10 @@
 	       (give-up))))))
 	      
 
-(deftransform < ((x y) (integer integer))
+(deftransform < ((x y) (integer integer) * :when :both)
   (ir1-transform-< x y x y '>))
 
-(deftransform > ((x y) (integer integer))
+(deftransform > ((x y) (integer integer) * :when :both)
   (ir1-transform-< y x x y '<))
 
 
@@ -1511,7 +1509,8 @@
 ;;; string is a function (i.e. formatter), then convert the call to format to
 ;;; just a funcall of that function.
 ;;; 
-(deftransform format ((dest control &rest args) (t simple-string &rest t))
+(deftransform format ((dest control &rest args) (t simple-string &rest t) *
+		      :policy (> speed space))
   (unless (constant-continuation-p control)
     (give-up "Control string is not a constant."))
   (let ((arg-names (mapcar #'(lambda (x) (declare (ignore x)) (gensym)) args)))
@@ -1519,13 +1518,15 @@
        (declare (ignore control))
        (format dest (formatter ,(continuation-value control)) ,@arg-names))))
 ;;;
-(deftransform format ((stream control &rest args) (stream function &rest t))
+(deftransform format ((stream control &rest args) (stream function &rest t) *
+		      :policy (> speed space))
   (let ((arg-names (mapcar #'(lambda (x) (declare (ignore x)) (gensym)) args)))
     `(lambda (stream control ,@arg-names)
        (funcall control stream ,@arg-names)
        nil)))
 ;;;
-(deftransform format ((tee control &rest args) ((member t) function &rest t))
+(deftransform format ((tee control &rest args) ((member t) function &rest t) *
+		      :policy (> speed space))
   (let ((arg-names (mapcar #'(lambda (x) (declare (ignore x)) (gensym)) args)))
     `(lambda (tee control ,@arg-names)
        (declare (ignore tee))
diff --git a/compiler/typetran.lisp b/compiler/typetran.lisp
index 1ca78e94e5cdfeae5b686b9fb7649df032c28269..27cd0b8441a7ed69eff31f8bcdd6153a11fb2767 100644
--- a/compiler/typetran.lisp
+++ b/compiler/typetran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/typetran.lisp,v 1.18 1993/03/13 17:27:23 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/typetran.lisp,v 1.19 1993/05/11 13:50:58 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -425,32 +425,35 @@
 ;;; If the type is Type= to a type that has a predicate, then expand to that
 ;;; predicate.  Otherwise, we dispatch off of the type's type.  These
 ;;; transformations can increase space, but it is hard to tell when, so we
-;;; ignore policy and always do them.
+;;; ignore policy and always do them.  When byte-compiling, we only do
+;;; transforms that have potential for control simplification.
 ;;;
 (def-source-transform typep (object spec)
   (if (and (consp spec) (eq (car spec) 'quote))
-      (let* ((type (specifier-type (cadr spec)))
-	     (pred (cdr (assoc type (backend-type-predicates *backend*)
-			       :test #'type=))))
-	(if pred
-	    `(,pred ,object)
+      (let ((type (specifier-type (cadr spec))))
+	(or (let ((pred (cdr (assoc type (backend-type-predicates *backend*)
+				    :test #'type=))))
+	      (when pred `(,pred ,object)))
 	    (typecase type
-	      (numeric-type
-	       (source-transform-numeric-typep object type))
 	      (hairy-type
 	       (source-transform-hairy-typep object type))
 	      (union-type
 	       (source-transform-union-typep object type))
 	      (member-type
 	       `(member ,object ',(member-type-members type)))
-	      (class
-	       (source-transform-instance-typep object type))
 	      (args-type
 	       (compiler-warning "Illegal type specifier for Typep: ~S."
 				 (cadr spec))
 	       `(%typep ,object ,spec))
-	      (array-type
-	       (source-transform-array-typep object type))
-	      (t
-	       `(%typep ,object ,spec)))))
+	      (t nil))
+	    (and (not *byte-compiling*)
+		 (typecase type
+		   (numeric-type
+		    (source-transform-numeric-typep object type))
+		   (class
+		    (source-transform-instance-typep object type))
+		   (array-type
+		    (source-transform-array-typep object type))
+		   (t nil)))
+	    `(%typep ,object ,spec)))
       (values nil t)))