(let* ((forms (if for-value `(,form) `(,form nil)))
(res (ir1-convert-lambda-body
forms ()
- :debug-name (debug-namify "top level form ~S" form))))
+ :debug-name (debug-namify "top level form " form))))
(setf (functional-entry-fun res) res
(functional-arg-documentation res) ()
(functional-kind res) :toplevel)
(ir1-convert-lambda
opname
:debug-name (debug-namify
- "LAMBDA CAR ~S"
+ "LAMBDA CAR "
opname)
:allow-debug-catch-tag t))))))))
(values))
(when (lambda-var-ignorep var)
;; (ANSI's specification for the IGNORE declaration requires
;; that this be a STYLE-WARNING, not a full WARNING.)
- (compiler-style-warn "reading an ignored variable: ~S" name)))
+ #-sb-xc-host
+ (compiler-style-warn "reading an ignored variable: ~S" name)
+ ;; there's no need for us to accept ANSI's lameness when
+ ;; processing our own code, though.
+ #+sb-xc-host
+ (warn "reading an ignored variable: ~S" name)))
(reference-leaf start next result var))
(cons
(aver (eq (car var) 'MACRO))
(muffle-warning-or-die)))
#-(and cmu sb-xc-host)
(warning (lambda (c)
- (compiler-warn "~@<~A~:@_~A~@:_~A~:>"
- (wherestring) hint c)
+ (warn "~@<~A~:@_~A~@:_~A~:>"
+ (wherestring) hint c)
(muffle-warning-or-die)))
(error (lambda (c)
(compiler-error "~@<~A~:@_~A~@:_~A~:>"
(find-free-var var-name))))
(etypecase var
(leaf
- (flet ((process-var (var bound-var)
- (let* ((old-type (or (lexenv-find var type-restrictions)
- (leaf-type var)))
- (int (if (or (fun-type-p type)
- (fun-type-p old-type))
- type
- (type-approx-intersection2 old-type type))))
- (cond ((eq int *empty-type*)
- (unless (policy *lexenv* (= inhibit-warnings 3))
- (compiler-warn
- "The type declarations ~S and ~S for ~S conflict."
- (type-specifier old-type) (type-specifier type)
- var-name)))
- (bound-var (setf (leaf-type bound-var) int))
- (t
- (restr (cons var int)))))))
+ (flet
+ ((process-var (var bound-var)
+ (let* ((old-type (or (lexenv-find var type-restrictions)
+ (leaf-type var)))
+ (int (if (or (fun-type-p type)
+ (fun-type-p old-type))
+ type
+ (type-approx-intersection2
+ old-type type))))
+ (cond ((eq int *empty-type*)
+ (unless (policy *lexenv* (= inhibit-warnings 3))
+ (warn
+ 'type-warning
+ :format-control
+ "The type declarations ~S and ~S for ~S conflict."
+ :format-arguments
+ (list
+ (type-specifier old-type)
+ (type-specifier type)
+ var-name))))
+ (bound-var (setf (leaf-type bound-var) int))
+ (t
+ (restr (cons var int)))))))
(process-var var bound-var)
(awhen (and (lambda-var-p var)
(lambda-var-specvar var))
(make-lexenv
:default res
:policy (process-optimize-decl spec (lexenv-policy res))))
+ (muffle-conditions
+ (make-lexenv
+ :default res
+ :handled-conditions (process-muffle-conditions-decl
+ spec (lexenv-handled-conditions res))))
+ (unmuffle-conditions
+ (make-lexenv
+ :default res
+ :handled-conditions (process-unmuffle-conditions-decl
+ spec (lexenv-handled-conditions res))))
(type
(process-type-decl (cdr spec) res vars))
(values