projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
fix rounding of floats big enough to be bignums
[sbcl.git]
/
src
/
code
/
macros.lisp
diff --git
a/src/code/macros.lisp
b/src/code/macros.lisp
index
71d7bad
..
7525fbf
100644
(file)
--- a/
src/code/macros.lisp
+++ b/
src/code/macros.lisp
@@
-73,7
+73,7
@@
invoked. In that case it will store into PLACE and start over."
;; variable to work around Python's blind spot in type derivation.
;; For more complex places getting the type derived should not
;; matter so much anyhow.
;; variable to work around Python's blind spot in type derivation.
;; For more complex places getting the type derived should not
;; matter so much anyhow.
- (let ((expanded (sb!xc:macroexpand place env)))
+ (let ((expanded (%macroexpand place env)))
(if (symbolp expanded)
`(do ()
((typep ,place ',type))
(if (symbolp expanded)
`(do ()
((typep ,place ',type))
@@
-152,10
+152,9
@@
invoked. In that case it will store into PLACE and start over."
;; FIXME: warn about incompatible lambda list with
;; respect to parent function?
(setf (sb!xc:compiler-macro-function name) definition)
;; FIXME: warn about incompatible lambda list with
;; respect to parent function?
(setf (sb!xc:compiler-macro-function name) definition)
- #-sb-xc-host
- (setf (%fun-doc definition) doc)
,(when set-p
,(when set-p
- `(setf (%fun-lambda-list definition) lambda-list
+ `(setf (%fun-doc definition) doc
+ (%fun-lambda-list definition) lambda-list
(%fun-name definition) debug-name))
name))))
(progn
(%fun-name definition) debug-name))
name))))
(progn
@@
-166,7
+165,8
@@
invoked. In that case it will store into PLACE and start over."
(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
-(define-condition duplicate-case-key-warning (style-warning)
+;;; Make this a full warning during SBCL build.
+(define-condition duplicate-case-key-warning (#-sb-xc-host style-warning #+sb-xc-host warning)
((key :initarg :key
:reader case-warning-key)
(case-kind :initarg :case-kind
((key :initarg :key
:reader case-warning-key)
(case-kind :initarg :case-kind
@@
-304,11
+304,7
@@
invoked. In that case it will store into PLACE and start over."
(cond
,@(nreverse clauses)
,@(if errorp
(cond
,@(nreverse clauses)
,@(if errorp
- `((t (error 'case-failure
- :name ',name
- :datum ,keyform-value
- :expected-type ',expected-type
- :possibilities ',keys))))))))
+ `((t (case-failure ',name ,keyform-value ',keys))))))))
) ; EVAL-WHEN
(defmacro-mundanely case (keyform &body cases)
) ; EVAL-WHEN
(defmacro-mundanely case (keyform &body cases)