(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)
(define-source-transform char-not-equal (&rest args)
(multi-not-equal 'char-equal args))
+;;; FIXME: can go away once bug 194 is fixed and we can use (THE REAL X)
+;;; as God intended
+(defun error-not-a-real (x)
+ (error 'simple-type-error
+ :datum x
+ :expected-type 'real
+ :format-control "not a REAL: ~S"
+ :format-arguments (list x)))
+
;;; Expand MAX and MIN into the obvious comparisons.
-(define-source-transform max (arg &rest more-args)
- (if (null more-args)
- `(values ,arg)
- (once-only ((arg1 arg)
- (arg2 `(max ,@more-args)))
- `(if (> ,arg1 ,arg2)
- ,arg1 ,arg2))))
-(define-source-transform min (arg &rest more-args)
- (if (null more-args)
- `(values ,arg)
- (once-only ((arg1 arg)
- (arg2 `(min ,@more-args)))
- `(if (< ,arg1 ,arg2)
- ,arg1 ,arg2))))
+(define-source-transform max (arg0 &rest rest)
+ (once-only ((arg0 arg0))
+ ;; ANSI says MAX should signal TYPE-ERROR if any arg isn't a REAL.
+ ;;
+ ;; KLUDGE: This UNLESS hackery is a workaround for bug 194.
+ ;; Better, when that bug is fixed, would be (THE REAL ,ARG0).
+ ;; -- WHN 2002-09-02
+ `(progn
+ (unless (realp ,arg0)
+ (error-not-a-real ,arg0))
+ ,(if (null rest)
+ arg0
+ `(let ((maxrest (max ,@rest)))
+ (if (> ,arg0 maxrest) ,arg0 maxrest))))))
+(define-source-transform min (arg0 &rest rest)
+ (once-only ((arg0 arg0))
+ ;; ANSI says MIN should signal TYPE-ERROR if any arg isn't a REAL.
+ ;;
+ ;; KLUDGE: This UNLESS hackery is a workaround for bug 194.
+ ;; Better, when that bug is fixed, would be (THE REAL ,ARG0).
+ ;; -- WHN 2002-09-02
+ `(progn
+ (unless (realp ,arg0)
+ (error-not-a-real ,arg0))
+ ,(if (null rest)
+ arg0
+ `(let ((minrest (min ,@rest)))
+ (if (< ,arg0 minrest) ,arg0 minrest))))))
\f
;;;; converting N-arg arithmetic functions
;;;;
*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)