:ACCRUED-EXCEPTIONS (:INEXACT)
:FAST-MODE NIL)
-185: "top-level forms at the REPL"
- * (locally (defstruct foo (a 0 :type fixnum)))
- gives an error:
- ; caught ERROR:
- ; (in macroexpansion of (SB-KERNEL::%DELAYED-GET-COMPILER-LAYOUT BAR))
- however, compiling and loading the same expression in a file works
- as expected.
-
187: "type inference confusion around DEFTRANSFORM time"
(reported even more verbosely on sbcl-devel 2002-06-28 as "strange
bug in DEFTRANSFORM")
(defun test (x y) (the (values integer) (truncate x y)))
(test 10 4) => 2
+219: "DEFINE-COMPILER-MACRO in non-toplevel contexts evaluated at compile-time"
+ In sbcl-0.7.9:
+
+ * (defun foo (x)
+ (when x
+ (define-compiler-macro bar (&whole whole)
+ (declare (ignore whole))
+ (print "expanding compiler macro")
+ 1)))
+ FOO
+ * (defun baz (x) (bar))
+ [ ... ]
+ "expanding compiler macro"
+ BAZ
+ * (baz t)
+ 1
DEFUNCT CATEGORIES OF BUGS
IR1-#:
(sb-int:/show "done with warm.lisp, about to GC :FULL T")
(gc :full t))
+ ;; resetting compilation policy to neutral values in
+ ;; preparation for SAVE-LISP-AND-DIE as final SBCL core (not
+ ;; in warm.lisp because SB-C::*POLICY* has file scope)
+ (sb-int:/show "setting compilation policy to neutral values")
+ (proclaim '(optimize (compilation-speed 1)
+ (debug 1)
+ (inhibit-warnings 1)
+ (safety 1)
+ (space 1)
+ (speed 1)))
+
(sb-int:/show "done with warm.lisp, about to SAVE-LISP-AND-DIE")
;; Even if /SHOW output was wanted during build, it's probably
;; not wanted by default after build is complete. (And if it's
"MAKE-KEY-INFO" "MAKE-LISP-OBJ"
#!+long-float "MAKE-LONG-FLOAT"
"MAKE-MEMBER-TYPE" "MAKE-NAMED-TYPE"
- "MAKE-NULL-LEXENV" "MAKE-NUMERIC-TYPE"
+ "MAKE-NULL-LEXENV" "MAKE-NULL-INTERACTIVE-LEXENV"
+ "MAKE-NUMERIC-TYPE"
"MAKE-SINGLE-FLOAT" "MAKE-SPECIALIZABLE-ARRAY"
"%MAKE-INSTANCE"
"MAKE-VALUE-CELL"
(funcall (sb!c:compile-in-lexenv
(gensym "EVAL-TMPFUN-")
`(lambda ()
-
- ;; The user can reasonably expect that the
- ;; interpreter will be safe.
- (declare (optimize (safety 3)))
-
- ;; It's also good if the interpreter doesn't
- ;; spend too long thinking about each input
- ;; form, since if the user'd wanted the
- ;; tradeoff to favor quality of compiled code
- ;; over compilation speed, he'd've explicitly
- ;; asked for compilation.
- (declare (optimize (compilation-speed 2)))
-
- ;; Other properties are relatively unimportant.
- (declare (optimize (speed 1) (debug 1) (space 1)))
-
,expr)
lexenv)))
(let ((name (first exp))
(n-args (1- (length exp))))
(case name
- (function
+ ((function)
(unless (= n-args 1)
(error "wrong number of args to FUNCTION:~% ~S" exp))
(let ((name (second exp)))
(sb!c:lexenv-find name funs)))))
(fdefinition name)
(%eval original-exp lexenv))))
- (quote
+ ((quote)
(unless (= n-args 1)
(error "wrong number of args to QUOTE:~% ~S" exp))
(second exp))
(declare (ignore ct lt))
(when e
(eval-progn-body body lexenv)))))
+ ((locally)
+ (multiple-value-bind (body decls) (parse-body (rest exp) nil)
+ (let ((lexenv
+ ;; KLUDGE: Uh, yeah. I'm not anticipating
+ ;; winning any prizes for this code, which was
+ ;; written on a "let's get it to work" basis.
+ ;; These seem to be the variables that need
+ ;; bindings for PROCESS-DECLS to work
+ ;; (*FREE-FUNS* and *FREE-VARS* so that
+ ;; references to free functions and variables in
+ ;; the declarations can be noted;
+ ;; *UNDEFINED-WARNINGS* so that warnings about
+ ;; undefined things can be accumulated [and then
+ ;; thrown away, as it happens]). -- CSR, 2002-10-24
+ (let ((sb!c:*lexenv* lexenv)
+ (sb!c::*free-funs* (make-hash-table :test 'equal))
+ (sb!c::*free-vars* (make-hash-table :test 'eq))
+ (sb!c::*undefined-warnings* nil))
+ (sb!c::process-decls decls
+ nil nil
+ (sb!c::make-continuation)
+ lexenv))))
+ (eval-progn-body body lexenv))))
+ ((macrolet)
+ (destructuring-bind (definitions &rest body)
+ (rest exp)
+ ;; FIXME: shared code with FUNCALL-IN-FOOMACROLET-LEXENV
+ (declare (type list definitions))
+ (unless (= (length definitions)
+ (length (remove-duplicates definitions :key #'first)))
+ (style-warn "duplicate definitions in ~S" definitions))
+ (let ((lexenv
+ (sb!c::make-lexenv
+ :default lexenv
+ :funs (mapcar
+ (sb!c::macrolet-definitionize-fun
+ :eval
+ ;; I'm not sure that this is the correct
+ ;; LEXENV to be compiling local macros
+ ;; in...
+ lexenv)
+ definitions))))
+ (eval-in-lexenv `(locally ,@body) lexenv))))
+ ((symbol-macrolet)
+ (destructuring-bind (definitions &rest body)
+ (rest exp)
+ ;; FIXME: shared code with FUNCALL-IN-FOOMACROLET-LEXENV
+ (declare (type list definitions))
+ (unless (= (length definitions)
+ (length (remove-duplicates definitions :key #'first)))
+ (style-warn "duplicate definitions in ~S" definitions))
+ (let ((lexenv
+ (sb!c::make-lexenv
+ :default lexenv
+ :vars (mapcar
+ (sb!c::symbol-macrolet-definitionize-fun
+ :eval)
+ definitions))))
+ (eval-in-lexenv `(locally ,@body) lexenv))))
(t
(if (and (symbolp name)
(eq (info :function :kind name) :function))
(collect ((args))
(dolist (arg (rest exp))
- (args (eval arg)))
+ (args (eval-in-lexenv arg lexenv)))
(apply (symbol-function name) (args)))
(%eval original-exp lexenv))))))
(t
"Evaluate FORM, returning whatever it returns and adjusting ***, **, *,
+++, ++, +, ///, //, /, and -."
(setf - form)
- (let ((results (multiple-value-list (eval form))))
+ (let ((results
+ (multiple-value-list
+ (eval-in-lexenv form
+ (make-null-interactive-lexenv)))))
(setf /// //
// /
/ results
;;; through the cold boot process. They need to be set somewhere. Maybe the
;;; easiest thing to do is to read them out of package-data-list.lisp-expr
;;; now?
-\f
-;;;; resetting compilation policy to neutral values in preparation for
-;;;; SAVE-LISP-AND-DIE as final SBCL core
-
-(sb-int:/show "setting compilation policy to neutral values")
-(proclaim '(optimize (compilation-speed 1)
- (debug 1)
- (inhibit-warnings 1)
- (safety 1)
- (space 1)
- (speed 1)))
(*lexenv* (make-lexenv definitionize-keyword processed-definitions)))
(funcall fun definitionize-keyword processed-definitions)))
-;;; Tweak *LEXENV* to include the DEFINITIONS from a MACROLET, then
+;;; Tweak LEXENV to include the DEFINITIONS from a MACROLET, then
;;; call FUN (with no arguments).
;;;
;;; This is split off from the IR1 convert method so that it can be
-;;; shared by the special-case top level MACROLET processing code.
+;;; shared by the special-case top level MACROLET processing code, and
+;;; further split so that the special-case MACROLET processing code in
+;;; EVAL can likewise make use of it.
+(defmacro macrolet-definitionize-fun (context lexenv)
+ (flet ((make-error-form (control &rest args)
+ (ecase context
+ (:compile `(compiler-error ,control ,@args))
+ (:eval `(error 'simple-program-error
+ :format-control ,control
+ :format-arguments (list ,@args))))))
+ `(lambda (definition)
+ (unless (list-of-length-at-least-p definition 2)
+ ,(make-error-form "The list ~S is too short to be a legal local macro definition." 'definition))
+ (destructuring-bind (name arglist &body body) definition
+ (unless (symbolp name)
+ ,(make-error-form "The local macro name ~S is not a symbol." 'name))
+ (unless (listp arglist)
+ ,(make-error-form "The local macro argument list ~S is not a list." 'arglist))
+ (let ((whole (gensym "WHOLE"))
+ (environment (gensym "ENVIRONMENT")))
+ (multiple-value-bind (body local-decls)
+ (parse-defmacro arglist whole body name 'macrolet
+ :environment environment)
+ `(,name macro .
+ ,(compile-in-lexenv
+ nil
+ `(lambda (,whole ,environment)
+ ,@local-decls
+ (block ,name ,body))
+ ,lexenv))))))))
+
(defun funcall-in-macrolet-lexenv (definitions fun)
(%funcall-in-foomacrolet-lexenv
- (lambda (definition)
- (unless (list-of-length-at-least-p definition 2)
- (compiler-error
- "The list ~S is too short to be a legal local macro definition."
- definition))
- (destructuring-bind (name arglist &body body) definition
- (unless (symbolp name)
- (compiler-error "The local macro name ~S is not a symbol." name))
- (unless (listp arglist)
- (compiler-error "The local macro argument list ~S is not a list." arglist))
- (let ((whole (gensym "WHOLE"))
- (environment (gensym "ENVIRONMENT")))
- (multiple-value-bind (body local-decls)
- (parse-defmacro arglist whole body name 'macrolet
- :environment environment)
- `(,name macro .
- ,(compile-in-lexenv
- nil
- `(lambda (,whole ,environment)
- ,@local-decls
- (block ,name ,body))
- (make-restricted-lexenv *lexenv*)))))))
+ (macrolet-definitionize-fun :compile (make-restricted-lexenv *lexenv*))
:funs
definitions
fun))
(declare (ignore funs))
(ir1-translate-locally body start cont))))
-(defun funcall-in-symbol-macrolet-lexenv (definitions fun)
- (%funcall-in-foomacrolet-lexenv
- (lambda (definition)
- (unless (proper-list-of-length-p definition 2)
- (compiler-error "malformed symbol/expansion pair: ~S" definition))
+(defmacro symbol-macrolet-definitionize-fun (context)
+ (flet ((make-error-form (control &rest args)
+ (ecase context
+ (:compile `(compiler-error ,control ,@args))
+ (:eval `(error 'simple-program-error
+ :format-control ,control
+ :format-arguments (list ,@args))))))
+ `(lambda (definition)
+ (unless (proper-list-of-length-p definition 2)
+ ,(make-error-form "malformed symbol/expansion pair: ~S" 'definition))
(destructuring-bind (name expansion) definition
(unless (symbolp name)
- (compiler-error
- "The local symbol macro name ~S is not a symbol."
- name))
+ ,(make-error-form
+ "The local symbol macro name ~S is not a symbol."
+ 'name))
(let ((kind (info :variable :kind name)))
(when (member kind '(:special :constant))
- (compiler-error "Attempt to bind a ~(~A~) variable with SYMBOL-MACROLET: ~S" kind name)))
- `(,name . (MACRO . ,expansion))))
+ ,(make-error-form
+ "Attempt to bind a ~(~A~) variable with SYMBOL-MACROLET: ~S"
+ 'kind 'name)))
+ `(,name . (MACRO . ,expansion))))))1
+
+(defun funcall-in-symbol-macrolet-lexenv (definitions fun)
+ (%funcall-in-foomacrolet-lexenv
+ (symbol-macrolet-definitionize-fun :compile)
:vars
definitions
fun))
#!-sb-fluid (declaim (inline internal-make-lexenv)) ; only called in one place
(def!struct (lexenv
(:constructor make-null-lexenv ())
+ (:constructor make-null-interactive-lexenv
+ (&aux (policy (list '(safety . 3)
+ '(compilation-speed . 2)
+ '(speed . 1)
+ '(space . 1)
+ '(debug . 1)
+ '(inhibit-warnings . 1)))))
(:constructor internal-make-lexenv
(funs vars blocks tags type-restrictions
lambda cleanup policy)))
(*last-format-args* nil)
(*last-message-count* 0)
(*gensym-counter* 0)
+ (*policy* (lexenv-policy *lexenv*))
;; FIXME: ANSI doesn't say anything about CL:COMPILE
;; interacting with these variables, so we shouldn't. As
;; of SBCL 0.6.7, COMPILE-FILE controls its verbosity by
;;; FIXME: currently SBCL throws NAMESTRING-PARSE-ERROR: should this be
;;; a TYPE-ERROR?
-(assert (not (ignore-errors
- (make-pathname :host "FOO" :directory "!bla" :name "bar"))))
-
-;; error: name-component not valid
-(assert (not (ignore-errors
- (make-pathname :host "FOO" :directory "bla" :name "!bar"))))
-
-;; error: type-component not valid.
-(assert (not (ignore-errors
- (make-pathname :host "FOO" :directory "bla" :name "bar"
- :type "&baz"))))
+(locally
+ ;; MAKE-PATHNAME is UNSAFELY-FLUSHABLE
+ (declare (optimize safety))
+
+ (assert (not (ignore-errors
+ (make-pathname :host "FOO" :directory "!bla" :name "bar"))))
+
+ ;; error: name-component not valid
+ (assert (not (ignore-errors
+ (make-pathname :host "FOO" :directory "bla" :name "!bar"))))
+
+ ;; error: type-component not valid.
+ (assert (not (ignore-errors
+ (make-pathname :host "FOO" :directory "bla" :name "bar"
+ :type "&baz")))))
;;; We may need to parse the host as a LOGICAL-NAMESTRING HOST. The
;;; HOST in PARSE-NAMESTRING can be either a string or :UNSPECIFIC
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.7.9.5"
+"0.7.9.6"
projects / sbcl.git / commitdiff