X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsrctran.lisp;h=54da0eefdcc015a3d4a556608429e934d2fcb570;hb=8a19c6876412b8ad1cf729297c2a373d63a0d0ec;hp=db2a38515138ccca7e175a320851b783c5de09e6;hpb=ec2616d216958a608581802c47496c0194478dc8;p=sbcl.git

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index db2a385..54da0ee 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -40,7 +40,7 @@
 ;;; lambda with the appropriate fixed number of args. If the
 ;;; destination is a FUNCALL, then do the &REST APPLY thing, and let
 ;;; MV optimization figure things out.
-(deftransform complement ((fun) * * :node node :when :both)
+(deftransform complement ((fun) * * :node node)
   "open code"
   (multiple-value-bind (min max)
       (fun-type-nargs (continuation-type fun))
@@ -180,7 +180,8 @@
 (define-source-transform logtest (x y) `(not (zerop (logand ,x ,y))))
 (define-source-transform logbitp (index integer)
   `(not (zerop (logand (ash 1 ,index) ,integer))))
-(define-source-transform byte (size position) `(cons ,size ,position))
+(define-source-transform byte (size position)
+  `(cons ,size ,position))
 (define-source-transform byte-size (spec) `(car ,spec))
 (define-source-transform byte-position (spec) `(cdr ,spec))
 (define-source-transform ldb-test (bytespec integer)
@@ -355,11 +356,11 @@
 (defun interval-bounded-p (x how)
   (declare (type interval x))
   (ecase how
-    ('above
+    (above
      (interval-high x))
-    ('below
+    (below
      (interval-low x))
-    ('both
+    (both
      (and (interval-low x) (interval-high x)))))
 
 ;;; signed zero comparison functions. Use these functions if we need
@@ -732,9 +733,9 @@
 (defun interval-abs (x)
   (declare (type interval x))
   (case (interval-range-info x)
-    ('+
+    (+
      (copy-interval x))
-    ('-
+    (-
      (interval-neg x))
     (t
      (destructuring-bind (x- x+) (interval-split 0 x t t)
@@ -2492,7 +2493,7 @@
 		 "place constant arg last"))
 
 ;;; Handle the case of a constant BOOLE-CODE.
-(deftransform boole ((op x y) * * :when :both)
+(deftransform boole ((op x y) * *)
   "convert to inline logical operations"
   (unless (constant-continuation-p op)
     (give-up-ir1-transform "BOOLE code is not a constant."))
@@ -2521,7 +2522,7 @@
 ;;;; converting special case multiply/divide to shifts
 
 ;;; If arg is a constant power of two, turn * into a shift.
-(deftransform * ((x y) (integer integer) * :when :both)
+(deftransform * ((x y) (integer integer) *)
   "convert x*2^k to shift"
   (unless (constant-continuation-p y)
     (give-up-ir1-transform))
@@ -2608,7 +2609,7 @@
     (frob y t)))
 
 ;;; Do the same for MOD.
-(deftransform mod ((x y) (integer integer) * :when :both)
+(deftransform mod ((x y) (integer integer) *)
   "convert remainder mod 2^k to LOGAND"
   (unless (constant-continuation-p y)
     (give-up-ir1-transform))
@@ -2645,7 +2646,7 @@
 		   (logand x ,mask))))))
 
 ;;; And the same for REM.
-(deftransform rem ((x y) (integer integer) * :when :both)
+(deftransform rem ((x y) (integer integer) *)
   "convert remainder mod 2^k to LOGAND"
   (unless (constant-continuation-p y)
     (give-up-ir1-transform))
@@ -2664,8 +2665,7 @@
 ;;; Flush calls to various arith functions that convert to the
 ;;; identity function or a constant.
 (macrolet ((def (name identity result)
-             `(deftransform ,name ((x y) (* (constant-arg (member ,identity)))
-                                    * :when :both)
+             `(deftransform ,name ((x y) (* (constant-arg (member ,identity))) *)
                 "fold identity operations"
                 ',result)))
   (def ash 0 x)
@@ -2678,12 +2678,10 @@
 
 ;;; 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)
+(deftransform - ((x y) ((constant-arg (member 0)) rational) *)
   "convert (- 0 x) to negate"
   '(%negate y))
-(deftransform * ((x y) (rational (constant-arg (member 0))) *
-		 :when :both)
+(deftransform * ((x y) (rational (constant-arg (member 0))) *)
   "convert (* x 0) to 0"
   0)
 
@@ -2725,7 +2723,7 @@
 ;;;
 ;;; 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)
+(deftransform + ((x y) (t (constant-arg t)) *)
   "fold zero arg"
   (let ((val (continuation-value y)))
     (unless (and (zerop val)
@@ -2738,7 +2736,7 @@
 ;;;
 ;;; 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)
+(deftransform - ((x y) (t (constant-arg t)) *)
   "fold zero arg"
   (let ((val (continuation-value y)))
     (unless (and (zerop val)
@@ -2749,8 +2747,7 @@
 
 ;;; Fold (OP x +/-1)
 (macrolet ((def (name result minus-result)
-             `(deftransform ,name ((x y) (t (constant-arg real))
-                                    * :when :both)
+             `(deftransform ,name ((x y) (t (constant-arg real)) *)
                 "fold identity operations"
                 (let ((val (continuation-value y)))
                   (unless (and (= (abs val) 1)
@@ -2787,7 +2784,7 @@
 ;;; doing them?  -- WHN 19990917
 (macrolet ((def (name)
              `(deftransform ,name ((x y) ((constant-arg (integer 0 0)) integer)
-                                   * :when :both)
+                                   *)
                 "fold zero arg"
                 0)))
   (def ash)
@@ -2795,7 +2792,7 @@
 
 (macrolet ((def (name)
              `(deftransform ,name ((x y) ((constant-arg (integer 0 0)) integer)
-                                   * :when :both)
+                                   *)
                 "fold zero arg"
                 '(values 0 0))))
   (def truncate)
@@ -2849,8 +2846,7 @@
 ;;; if 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
-					 :when :both)
+					 :defun-only t)
   (cond ((same-leaf-ref-p x y)
 	 t)
 	((not (types-equal-or-intersect (continuation-type x)
@@ -2878,7 +2874,7 @@
 ;;;    these interesting cases.
 ;;; -- 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)
+(deftransform eql ((x y) * *)
   "convert to simpler equality predicate"
   (let ((x-type (continuation-type x))
 	(y-type (continuation-type y))
@@ -2904,7 +2900,7 @@
 
 ;;; Convert to EQL if both args are rational and complexp is specified
 ;;; and the same for both.
-(deftransform = ((x y) * * :when :both)
+(deftransform = ((x y) * *)
   "open code"
   (let ((x-type (continuation-type x))
 	(y-type (continuation-type y)))
@@ -2982,18 +2978,18 @@
 	      (t
 	       (give-up-ir1-transform))))))
 
-(deftransform < ((x y) (integer integer) * :when :both)
+(deftransform < ((x y) (integer integer) *)
   (ir1-transform-< x y x y '>))
 
-(deftransform > ((x y) (integer integer) * :when :both)
+(deftransform > ((x y) (integer integer) *)
   (ir1-transform-< y x x y '<))
 
 #-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
-(deftransform < ((x y) (float float) * :when :both)
+(deftransform < ((x y) (float float) *)
   (ir1-transform-< x y x y '>))
 
 #-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
-(deftransform > ((x y) (float float) * :when :both)
+(deftransform > ((x y) (float float) *)
   (ir1-transform-< y x x y '<))
 
 ;;;; converting N-arg comparisons
@@ -3057,7 +3053,7 @@
   (multi-compare 'char-lessp args t))
 
 ;;; This function does source transformation of N-arg inequality
-;;; functions such as /=. This is similar to Multi-Compare in the <3
+;;; functions such as /=. This is similar to MULTI-COMPARE in the <3
 ;;; arg cases. If there are more than two args, then we expand into
 ;;; the appropriate n^2 comparisons only when speed is important.
 (declaim (ftype (function (symbol list) *) multi-not-equal))
@@ -3305,7 +3301,7 @@
               *universal-type*)))))
 
 (defoptimizer (array-element-type derive-type) ((array))
-  (let* ((array-type (continuation-type array)))
+  (let ((array-type (continuation-type array)))
     (labels ((consify (list)
               (if (endp list)
                   '(eql nil)