Update of /cvsroot/sbcl/sbcl/src/compiler
In directory usw-pr-cvs1:/tmp/cvs-serv4559/src/compiler
Modified Files:
float-tran.lisp ir1-translators.lisp ir1opt.lisp knownfun.lisp
macros.lisp seqtran.lisp srctran.lisp typetran.lisp
Log Message:
0.7.2.13:
merged APD "obsolete byte-compiler support" patch (sbcl-devel
2002-04-13)
merged CSR BUGS serialization patch
Index: float-tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/float-tran.lisp,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -d -r1.20 -r1.21
*** float-tran.lisp 9 Feb 2002 17:20:53 -0000 1.20
--- float-tran.lisp 17 Apr 2002 02:19:38 -0000 1.21
***************
*** 19,32 ****
(defknown %double-float (real) double-float (movable foldable flushable))
! (deftransform float ((n &optional f) (* &optional single-float) * :when :both)
'(%single-float n))
! (deftransform float ((n f) (* double-float) * :when :both)
'(%double-float n))
! (deftransform %single-float ((n) (single-float) * :when :both)
'n)
! (deftransform %double-float ((n) (double-float) * :when :both)
'n)
--- 19,32 ----
(defknown %double-float (real) double-float (movable foldable flushable))
! (deftransform float ((n &optional f) (* &optional single-float) *)
'(%single-float n))
! (deftransform float ((n f) (* double-float) *)
'(%double-float n))
! (deftransform %single-float ((n) (single-float) *)
'n)
! (deftransform %double-float ((n) (double-float) *)
'n)
***************
*** 34,39 ****
(macrolet ((frob (fun type)
`(deftransform random ((num &optional state)
! (,type &optional *) *
! :when :both)
"Use inline float operations."
'(,fun num (or state *random-state*)))))
--- 34,38 ----
(macrolet ((frob (fun type)
`(deftransform random ((num &optional state)
! (,type &optional *) *)
"Use inline float operations."
'(,fun num (or state *random-state*)))))
***************
*** 140,156 ****
(movable foldable flushable))
! (deftransform decode-float ((x) (single-float) * :when :both)
'(decode-single-float x))
! (deftransform decode-float ((x) (double-float) * :when :both)
'(decode-double-float x))
! (deftransform integer-decode-float ((x) (single-float) * :when :both)
'(integer-decode-single-float x))
! (deftransform integer-decode-float ((x) (double-float) * :when :both)
'(integer-decode-double-float x))
! (deftransform scale-float ((f ex) (single-float *) * :when :both)
(if (and #!+x86 t #!-x86 nil
(csubtypep (continuation-type ex)
--- 139,155 ----
(movable foldable flushable))
! (deftransform decode-float ((x) (single-float) *)
'(decode-single-float x))
! (deftransform decode-float ((x) (double-float) *)
'(decode-double-float x))
! (deftransform integer-decode-float ((x) (single-float) *)
'(integer-decode-single-float x))
! (deftransform integer-decode-float ((x) (double-float) *)
'(integer-decode-double-float x))
! (deftransform scale-float ((f ex) (single-float *) *)
(if (and #!+x86 t #!-x86 nil
(csubtypep (continuation-type ex)
***************
*** 159,163 ****
'(scale-single-float f ex)))
! (deftransform scale-float ((f ex) (double-float *) * :when :both)
(if (and #!+x86 t #!-x86 nil
(csubtypep (continuation-type ex)
--- 158,162 ----
'(scale-single-float f ex)))
! (deftransform scale-float ((f ex) (double-float *) *)
(if (and #!+x86 t #!-x86 nil
(csubtypep (continuation-type ex)
***************
*** 293,297 ****
;;; float (such as 0).
(macrolet ((frob (op)
! `(deftransform ,op ((x y) (float rational) * :when :both)
"open-code FLOAT to RATIONAL comparison"
(unless (constant-continuation-p y)
--- 292,296 ----
;;; float (such as 0).
(macrolet ((frob (op)
! `(deftransform ,op ((x y) (float rational) *)
"open-code FLOAT to RATIONAL comparison"
(unless (constant-continuation-p y)
***************
*** 399,403 ****
(deftransform ,name ((x) (single-float) ,rtype)
`(coerce (,',prim (coerce x 'double-float)) 'single-float))
! (deftransform ,name ((x) (double-float) ,rtype :when :both)
`(,',prim x)))))
(def exp %exp *)
--- 398,402 ----
(deftransform ,name ((x) (single-float) ,rtype)
`(coerce (,',prim (coerce x 'double-float)) 'single-float))
! (deftransform ,name ((x) (double-float) ,rtype)
`(,',prim x)))))
(def exp %exp *)
***************
*** 434,438 ****
`(coerce (,',prim (coerce x 'double-float)) 'single-float)))
#!-x86 `(coerce (,',prim (coerce x 'double-float)) 'single-float))
! (deftransform ,name ((x) (double-float) * :when :both)
#!+x86 (cond ((csubtypep (continuation-type x)
(specifier-type '(double-float
--- 433,437 ----
`(coerce (,',prim (coerce x 'double-float)) 'single-float)))
#!-x86 `(coerce (,',prim (coerce x 'double-float)) 'single-float))
! (deftransform ,name ((x) (double-float) *)
#!+x86 (cond ((csubtypep (continuation-type x)
(specifier-type '(double-float
***************
*** 454,458 ****
`(coerce (%atan2 (coerce x 'double-float) (coerce y 'double-float))
'single-float))
! (deftransform atan ((x y) (double-float double-float) * :when :both)
`(%atan2 x y))
--- 453,457 ----
`(coerce (%atan2 (coerce x 'double-float) (coerce y 'double-float))
'single-float))
! (deftransform atan ((x y) (double-float double-float) *)
`(%atan2 x y))
***************
*** 460,469 ****
`(coerce (%pow (coerce x 'double-float) (coerce y 'double-float))
'single-float))
! (deftransform expt ((x y) ((double-float 0d0) double-float) * :when :both)
`(%pow x y))
(deftransform expt ((x y) ((single-float 0f0) (signed-byte 32)) *)
`(coerce (%pow (coerce x 'double-float) (coerce y 'double-float))
'single-float))
! (deftransform expt ((x y) ((double-float 0d0) (signed-byte 32)) * :when :both)
`(%pow x (coerce y 'double-float)))
--- 459,468 ----
`(coerce (%pow (coerce x 'double-float) (coerce y 'double-float))
'single-float))
! (deftransform expt ((x y) ((double-float 0d0) double-float) *)
`(%pow x y))
(deftransform expt ((x y) ((single-float 0f0) (signed-byte 32)) *)
`(coerce (%pow (coerce x 'double-float) (coerce y 'double-float))
'single-float))
! (deftransform expt ((x y) ((double-float 0d0) (signed-byte 32)) *)
`(%pow x (coerce y 'double-float)))
***************
*** 474,478 ****
;;; Handle some simple transformations.
! (deftransform abs ((x) ((complex double-float)) double-float :when :both)
'(%hypot (realpart x) (imagpart x)))
--- 473,477 ----
;;; Handle some simple transformations.
! (deftransform abs ((x) ((complex double-float)) double-float)
'(%hypot (realpart x) (imagpart x)))
***************
*** 482,486 ****
'single-float))
! (deftransform phase ((x) ((complex double-float)) double-float :when :both)
'(%atan2 (imagpart x) (realpart x)))
--- 481,485 ----
'single-float))
! (deftransform phase ((x) ((complex double-float)) double-float)
'(%atan2 (imagpart x) (realpart x)))
***************
*** 490,494 ****
'single-float))
! (deftransform phase ((x) ((float)) float :when :both)
'(if (minusp (float-sign x))
(float pi x)
--- 489,493 ----
'single-float))
! (deftransform phase ((x) ((float)) float)
'(if (minusp (float-sign x))
(float pi x)
Index: ir1-translators.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1-translators.lisp,v
retrieving revision 1.19
retrieving revision 1.20
diff -C2 -d -r1.19 -r1.20
*** ir1-translators.lisp 7 Feb 2002 20:37:53 -0000 1.19
--- ir1-translators.lisp 17 Apr 2002 02:19:38 -0000 1.20
***************
*** 466,470 ****
;;; (not symbols). %FUNCALL is used directly in some places where the
;;; call should always be open-coded even if FUNCALL is :NOTINLINE.
! (deftransform funcall ((function &rest args) * * :when :both)
(let ((arg-names (make-gensym-list (length args))))
`(lambda (function ,@arg-names)
--- 466,470 ----
;;; (not symbols). %FUNCALL is used directly in some places where the
;;; call should always be open-coded even if FUNCALL is :NOTINLINE.
! (deftransform funcall ((function &rest args) * *)
(let ((arg-names (make-gensym-list (length args))))
`(lambda (function ,@arg-names)
***************
*** 491,495 ****
(deftransform %coerce-callable-to-fun ((thing) (function) *
- :when :both
:important t)
"optimize away possible call to FDEFINITION at runtime"
--- 491,494 ----
Index: ir1opt.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1opt.lisp,v
retrieving revision 1.35
retrieving revision 1.36
diff -C2 -d -r1.35 -r1.36
*** ir1opt.lisp 7 Feb 2002 20:37:53 -0000 1.35
--- ir1opt.lisp 17 Apr 2002 02:19:38 -0000 1.36
***************
*** 983,1000 ****
(policy node (> speed inhibit-warnings))))
(*compiler-error-context* node))
! (cond ((not (member (transform-when transform)
! '(:native :both)))
! ;; FIXME: Make sure that there's a transform for
! ;; (MEMBER SYMBOL ..) into MEMQ.
! ;; FIXME: Note that when/if I make SHARE operation to shared
! ;; constant data between objects in the system, remember that a
! ;; SHAREd list, or other SHAREd compound object, can be processed
! ;; recursively, so that e.g. the two lists above can share their
! ;; '(:BOTH) tail sublists.
! (let ((when (transform-when transform)))
! (not (or (eq when :both)
! (eq when :native))))
! t)
! ((or (not constrained)
(valid-fun-use node type :strict-result t))
(multiple-value-bind (severity args)
--- 983,987 ----
(policy node (> speed inhibit-warnings))))
(*compiler-error-context* node))
! (cond ((or (not constrained)
(valid-fun-use node type :strict-result t))
(multiple-value-bind (severity args)
Index: knownfun.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/knownfun.lisp,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -d -r1.18 -r1.19
*** knownfun.lisp 7 Feb 2002 20:37:53 -0000 1.18
--- knownfun.lisp 17 Apr 2002 02:19:38 -0000 1.19
***************
*** 136,155 ****
(note (missing-arg) :type string)
;; T if we should emit a failure note even if SPEED=INHIBIT-WARNINGS.
! (important nil :type (member t nil))
! ;; usable for byte code, native code, or both?
! ;;
! ;; FIXME: Now that there's no byte compiler, this is stale and could
! ;; all go away.
! (when :native :type (member :byte :native :both)))
! (defprinter (transform) type note important when)
;;; Grab the FUN-INFO and enter the function, replacing any old
;;; one with the same type and note.
(declaim (ftype (function (t list function &optional (or string null)
! (member t nil) (member :native :byte :both))
*)
%deftransform))
! (defun %deftransform (name type fun &optional note important (when :native))
(let* ((ctype (specifier-type type))
(note (or note "optimize"))
--- 136,150 ----
(note (missing-arg) :type string)
;; T if we should emit a failure note even if SPEED=INHIBIT-WARNINGS.
! (important nil :type (member t nil)))
! (defprinter (transform) type note important)
;;; Grab the FUN-INFO and enter the function, replacing any old
;;; one with the same type and note.
(declaim (ftype (function (t list function &optional (or string null)
! (member t nil))
*)
%deftransform))
! (defun %deftransform (name type fun &optional note important)
(let* ((ctype (specifier-type type))
(note (or note "optimize"))
***************
*** 158,163 ****
(and (type= (transform-type x) ctype)
(string-equal (transform-note x) note)
! (eq (transform-important x) important)
! (eq (transform-when x) when)))
(fun-info-transforms info))))
(if old
--- 153,157 ----
(and (type= (transform-type x) ctype)
(string-equal (transform-note x) note)
! (eq (transform-important x) important)))
(fun-info-transforms info))))
(if old
***************
*** 165,169 ****
(transform-note old) note)
(push (make-transform :type ctype :function fun :note note
! :important important :when when)
(fun-info-transforms info)))
name))
--- 159,163 ----
(transform-note old) note)
(push (make-transform :type ctype :function fun :note note
! :important important)
(fun-info-transforms info)))
name))
Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/macros.lisp,v
retrieving revision 1.25
retrieving revision 1.26
diff -C2 -d -r1.25 -r1.26
*** macros.lisp 15 Jan 2002 01:06:10 -0000 1.25
--- macros.lisp 17 Apr 2002 02:19:38 -0000 1.26
***************
*** 387,397 ****
;;; transform fails even if INHIBIT-WARNINGS=SPEED (but not if
;;; INHIBIT-WARNINGS>SPEED).
- ;;; :WHEN {:NATIVE | :BYTE | :BOTH}
- ;;; - Indicates whether this transform applies to native code,
- ;;; byte-code or both (default :native.)
(defmacro deftransform (name (lambda-list &optional (arg-types '*)
(result-type '*)
&key result policy node defun-only
! eval-name important (when :native))
&body body-decls-doc)
(when (and eval-name defun-only)
--- 387,394 ----
;;; transform fails even if INHIBIT-WARNINGS=SPEED (but not if
;;; INHIBIT-WARNINGS>SPEED).
(defmacro deftransform (name (lambda-list &optional (arg-types '*)
(result-type '*)
&key result policy node defun-only
! eval-name important)
&body body-decls-doc)
(when (and eval-name defun-only)
***************
*** 434,439 ****
(lambda ,@stuff)
,doc
! ,(if important t nil)
! ,when)))))))
;;;; DEFKNOWN and DEFOPTIMIZER
--- 431,435 ----
(lambda ,@stuff)
,doc
! ,(if important t nil))))))))
;;;; DEFKNOWN and DEFOPTIMIZER
Index: seqtran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/seqtran.lisp,v
retrieving revision 1.24
retrieving revision 1.25
diff -C2 -d -r1.24 -r1.25
*** seqtran.lisp 7 Feb 2002 20:37:53 -0000 1.24
--- seqtran.lisp 17 Apr 2002 02:19:38 -0000 1.25
***************
*** 215,225 ****
,push-dacc))))))))))
! (deftransform elt ((s i) ((simple-array * (*)) *) * :when :both)
'(aref s i))
! (deftransform elt ((s i) (list *) * :when :both)
'(nth i s))
! (deftransform %setelt ((s i v) ((simple-array * (*)) * *) * :when :both)
'(%aset s i v))
--- 215,225 ----
,push-dacc))))))))))
! (deftransform elt ((s i) ((simple-array * (*)) *) *)
'(aref s i))
! (deftransform elt ((s i) (list *) *)
'(nth i s))
! (deftransform %setelt ((s i v) ((simple-array * (*)) * *) *)
'(%aset s i v))
***************
*** 229,233 ****
(macrolet ((def (name)
`(deftransform ,name ((e l &key (test #'eql)) * *
! :node node :when :both)
(unless (constant-continuation-p l)
(give-up-ir1-transform))
--- 229,233 ----
(macrolet ((def (name)
`(deftransform ,name ((e l &key (test #'eql)) * *
! :node node)
(unless (constant-continuation-p l)
(give-up-ir1-transform))
Index: srctran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/srctran.lisp,v
retrieving revision 1.43
retrieving revision 1.44
diff -C2 -d -r1.43 -r1.44
*** srctran.lisp 15 Apr 2002 15:58:26 -0000 1.43
--- srctran.lisp 17 Apr 2002 02:19:38 -0000 1.44
***************
*** 41,45 ****
;;; destination is a FUNCALL, then do the &REST APPLY thing, and let
;;; MV optimization figure things out.
! (deftransform complement ((fun) * * :node node :when :both)
"open code"
(multiple-value-bind (min max)
--- 41,45 ----
;;; destination is a FUNCALL, then do the &REST APPLY thing, and let
;;; MV optimization figure things out.
! (deftransform complement ((fun) * * :node node)
"open code"
(multiple-value-bind (min max)
***************
*** 2493,2497 ****
;;; Handle the case of a constant BOOLE-CODE.
! (deftransform boole ((op x y) * * :when :both)
"convert to inline logical operations"
(unless (constant-continuation-p op)
--- 2493,2497 ----
;;; Handle the case of a constant BOOLE-CODE.
! (deftransform boole ((op x y) * *)
"convert to inline logical operations"
(unless (constant-continuation-p op)
***************
*** 2522,2526 ****
;;; If arg is a constant power of two, turn * into a shift.
! (deftransform * ((x y) (integer integer) * :when :both)
"convert x*2^k to shift"
(unless (constant-continuation-p y)
--- 2522,2526 ----
;;; If arg is a constant power of two, turn * into a shift.
! (deftransform * ((x y) (integer integer) *)
"convert x*2^k to shift"
(unless (constant-continuation-p y)
***************
*** 2609,2613 ****
;;; Do the same for MOD.
! (deftransform mod ((x y) (integer integer) * :when :both)
"convert remainder mod 2^k to LOGAND"
(unless (constant-continuation-p y)
--- 2609,2613 ----
;;; Do the same for MOD.
! (deftransform mod ((x y) (integer integer) *)
"convert remainder mod 2^k to LOGAND"
(unless (constant-continuation-p y)
***************
*** 2646,2650 ****
;;; And the same for REM.
! (deftransform rem ((x y) (integer integer) * :when :both)
"convert remainder mod 2^k to LOGAND"
(unless (constant-continuation-p y)
--- 2646,2650 ----
;;; And the same for REM.
! (deftransform rem ((x y) (integer integer) *)
"convert remainder mod 2^k to LOGAND"
(unless (constant-continuation-p y)
***************
*** 2665,2670 ****
;;; identity function or a constant.
(macrolet ((def (name identity result)
! `(deftransform ,name ((x y) (* (constant-arg (member ,identity)))
! * :when :both)
"fold identity operations"
',result)))
--- 2665,2669 ----
;;; identity function or a constant.
(macrolet ((def (name identity result)
! `(deftransform ,name ((x y) (* (constant-arg (member ,identity))) *)
"fold identity operations"
',result)))
***************
*** 2679,2688 ****
;;; 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-arg (member 0)) rational) *
! :when :both)
"convert (- 0 x) to negate"
'(%negate y))
! (deftransform * ((x y) (rational (constant-arg (member 0))) *
! :when :both)
"convert (* x 0) to 0"
0)
--- 2678,2685 ----
;;; 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-arg (member 0)) rational) *)
"convert (- 0 x) to negate"
'(%negate y))
! (deftransform * ((x y) (rational (constant-arg (member 0))) *)
"convert (* x 0) to 0"
0)
***************
*** 2726,2730 ****
;;; If y is not constant, not zerop, or is contagious, or a positive
;;; float +0.0 then give up.
! (deftransform + ((x y) (t (constant-arg t)) * :when :both)
"fold zero arg"
(let ((val (continuation-value y)))
--- 2723,2727 ----
;;; If y is not constant, not zerop, or is contagious, or a positive
;;; float +0.0 then give up.
! (deftransform + ((x y) (t (constant-arg t)) *)
"fold zero arg"
(let ((val (continuation-value y)))
***************
*** 2739,2743 ****
;;; If y is not constant, not zerop, or is contagious, or a negative
;;; float -0.0 then give up.
! (deftransform - ((x y) (t (constant-arg t)) * :when :both)
"fold zero arg"
(let ((val (continuation-value y)))
--- 2736,2740 ----
;;; If y is not constant, not zerop, or is contagious, or a negative
;;; float -0.0 then give up.
! (deftransform - ((x y) (t (constant-arg t)) *)
"fold zero arg"
(let ((val (continuation-value y)))
***************
*** 2750,2755 ****
;;; Fold (OP x +/-1)
(macrolet ((def (name result minus-result)
! `(deftransform ,name ((x y) (t (constant-arg real))
! * :when :both)
"fold identity operations"
(let ((val (continuation-value y)))
--- 2747,2751 ----
;;; Fold (OP x +/-1)
(macrolet ((def (name result minus-result)
! `(deftransform ,name ((x y) (t (constant-arg real)) *)
"fold identity operations"
(let ((val (continuation-value y)))
***************
*** 2788,2792 ****
(macrolet ((def (name)
`(deftransform ,name ((x y) ((constant-arg (integer 0 0)) integer)
! * :when :both)
"fold zero arg"
0)))
--- 2784,2788 ----
(macrolet ((def (name)
`(deftransform ,name ((x y) ((constant-arg (integer 0 0)) integer)
! *)
"fold zero arg"
0)))
***************
*** 2796,2800 ****
(macrolet ((def (name)
`(deftransform ,name ((x y) ((constant-arg (integer 0 0)) integer)
! * :when :both)
"fold zero arg"
'(values 0 0))))
--- 2792,2796 ----
(macrolet ((def (name)
`(deftransform ,name ((x y) ((constant-arg (integer 0 0)) integer)
! *)
"fold zero arg"
'(values 0 0))))
***************
*** 2850,2855 ****
;;; then the result is definitely false.
(deftransform simple-equality-transform ((x y) * *
! :defun-only t
! :when :both)
(cond ((same-leaf-ref-p x y)
t)
--- 2846,2850 ----
;;; then the result is definitely false.
(deftransform simple-equality-transform ((x y) * *
! :defun-only t)
(cond ((same-leaf-ref-p x y)
t)
***************
*** 2879,2883 ****
;;; -- If Y is a fixnum, then we quietly pass because the back end can
;;; handle that case, otherwise give an efficiency note.
! (deftransform eql ((x y) * * :when :both)
"convert to simpler equality predicate"
(let ((x-type (continuation-type x))
--- 2874,2878 ----
;;; -- If Y is a fixnum, then we quietly pass because the back end can
;;; handle that case, otherwise give an efficiency note.
! (deftransform eql ((x y) * *)
"convert to simpler equality predicate"
(let ((x-type (continuation-type x))
***************
*** 2905,2909 ****
;;; Convert to EQL if both args are rational and complexp is specified
;;; and the same for both.
! (deftransform = ((x y) * * :when :both)
"open code"
(let ((x-type (continuation-type x))
--- 2900,2904 ----
;;; Convert to EQL if both args are rational and complexp is specified
;;; and the same for both.
! (deftransform = ((x y) * *)
"open code"
(let ((x-type (continuation-type x))
***************
*** 2983,2998 ****
(give-up-ir1-transform))))))
! (deftransform < ((x y) (integer integer) * :when :both)
(ir1-transform-< x y x y '>))
! (deftransform > ((x y) (integer integer) * :when :both)
(ir1-transform-< y x x y '<))
#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
! (deftransform < ((x y) (float float) * :when :both)
(ir1-transform-< x y x y '>))
#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
! (deftransform > ((x y) (float float) * :when :both)
(ir1-transform-< y x x y '<))
--- 2978,2993 ----
(give-up-ir1-transform))))))
! (deftransform < ((x y) (integer integer) *)
(ir1-transform-< x y x y '>))
! (deftransform > ((x y) (integer integer) *)
(ir1-transform-< y x x y '<))
#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
! (deftransform < ((x y) (float float) *)
(ir1-transform-< x y x y '>))
#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
! (deftransform > ((x y) (float float) *)
(ir1-transform-< y x x y '<))
Index: typetran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/typetran.lisp,v
retrieving revision 1.24
retrieving revision 1.25
diff -C2 -d -r1.24 -r1.25
*** typetran.lisp 16 Jan 2002 02:10:42 -0000 1.24
--- typetran.lisp 17 Apr 2002 02:19:38 -0000 1.25
***************
*** 98,103 ****
;;; If FIND-CLASS is called on a constant class, locate the CLASS-CELL
;;; at load time.
! (deftransform find-class ((name) ((constant-arg symbol)) *
! :when :both)
(let* ((name (continuation-value name))
(cell (find-class-cell name)))
--- 98,102 ----
;;; If FIND-CLASS is called on a constant class, locate the CLASS-CELL
;;; at load time.
! (deftransform find-class ((name) ((constant-arg symbol)) *)
(let* ((name (continuation-value name))
(cell (find-class-cell name)))
***************
*** 386,390 ****
;;; and signal an error if so. Otherwise, look up the indirect
;;; class-cell and call CLASS-CELL-TYPEP at runtime.
! (deftransform %instance-typep ((object spec) (* *) * :node node :when :both)
(aver (constant-continuation-p spec))
(let* ((spec (continuation-value spec))
--- 385,389 ----
;;; and signal an error if so. Otherwise, look up the indirect
;;; class-cell and call CLASS-CELL-TYPEP at runtime.
! (deftransform %instance-typep ((object spec) (* *) * :node node)
(aver (constant-continuation-p spec))
(let* ((spec (continuation-value spec))
***************
*** 527,531 ****
;;;; coercion
! (deftransform coerce ((x type) (* *) * :when :both)
(unless (constant-continuation-p type)
(give-up-ir1-transform))
--- 526,530 ----
;;;; coercion
! (deftransform coerce ((x type) (* *) *)
(unless (constant-continuation-p type)
(give-up-ir1-transform))
|