X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1tran.lisp;h=8f680386f758ba556ec3d8783b16d17746a2e1bb;hb=683874b497a99cd2c11b6c5d9b47e2785b1ede5f;hp=7a10dc174b451feb47219132dbc618ef930903ff;hpb=0cfad881b88e03971a2b3ef0c0c0fc2e5f4f1bc8;p=sbcl.git diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 7a10dc1..8f68038 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -268,7 +268,7 @@ ;;; the continuation has no block, then we make it be in the block ;;; that the node is in. If the continuation heads its block, we end ;;; our block and link it to that block. If the continuation is not -;;; currently used, then we set the derived-type for the continuation +;;; currently used, then we set the DERIVED-TYPE for the continuation ;;; to that of the node, so that a little type propagation gets done. ;;; ;;; We also deal with a bit of THE's semantics here: we weaken the @@ -320,11 +320,10 @@ ;;; otherwise NIL is returned. ;;; ;;; This function may have arbitrary effects on the global environment -;;; due to processing of PROCLAIMs and EVAL-WHENs. All syntax error -;;; checking is done, with erroneous forms being replaced by a proxy -;;; which signals an error if it is evaluated. Warnings about possibly -;;; inconsistent or illegal changes to the global environment will -;;; also be given. +;;; due to processing of EVAL-WHENs. All syntax error checking is +;;; done, with erroneous forms being replaced by a proxy which signals +;;; an error if it is evaluated. Warnings about possibly inconsistent +;;; or illegal changes to the global environment will also be given. ;;; ;;; We make the initial component and convert the form in a PROGN (and ;;; an optional NIL tacked on the end.) We then return the lambda. We @@ -346,7 +345,7 @@ (res (ir1-convert-lambda-body forms () :debug-name (debug-namify "top level form ~S" form)))) - (setf (functional-entry-function res) res + (setf (functional-entry-fun res) res (functional-arg-documentation res) () (functional-kind res) :toplevel) res))) @@ -518,16 +517,20 @@ ;;; Convert a reference to a symbolic constant or variable. If the ;;; symbol is entered in the LEXENV-VARIABLES we use that definition, ;;; otherwise we find the current global definition. This is also -;;; where we pick off symbol macro and Alien variable references. +;;; where we pick off symbol macro and alien variable references. (defun ir1-convert-variable (start cont name) (declare (type continuation start cont) (symbol name)) (let ((var (or (lexenv-find name variables) (find-free-variable name)))) (etypecase var (leaf - (when (and (lambda-var-p var) (lambda-var-ignorep var)) - ;; (ANSI's specification for the IGNORE declaration requires - ;; that this be a STYLE-WARNING, not a full WARNING.) - (compiler-style-warning "reading an ignored variable: ~S" name)) + (when (lambda-var-p var) + (let ((home (continuation-home-lambda-or-null start))) + (when home + (pushnew var (lambda-calls-or-closes home)))) + (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-warning "reading an ignored variable: ~S" name))) (reference-leaf start cont var)) (cons (aver (eq (car var) 'MACRO)) @@ -554,8 +557,8 @@ (t (ir1-convert-global-functoid-no-cmacro start cont form fun))))) -;;; Handle the case of where the call was not a compiler macro, or was a -;;; compiler macro and passed. +;;; Handle the case of where the call was not a compiler macro, or was +;;; a compiler macro and passed. (defun ir1-convert-global-functoid-no-cmacro (start cont form fun) (declare (type continuation start cont) (list form)) ;; FIXME: Couldn't all the INFO calls here be converted into @@ -673,14 +676,15 @@ (return)) (let ((this-cont (make-continuation))) (ir1-convert this-start this-cont form) - (setq this-start this-cont forms (cdr forms))))))) + (setq this-start this-cont + forms (cdr forms))))))) (values)) ;;;; converting combinations ;;; Convert a function call where the function (i.e. the FUN argument) -;;; is a LEAF. We return the COMBINATION node so that we can poke at -;;; it if we want to. +;;; is a LEAF. We return the COMBINATION node so that the caller can +;;; poke at it if it wants to. (declaim (ftype (function (continuation continuation list leaf) combination) ir1-convert-combination)) (defun ir1-convert-combination (start cont form fun) @@ -1137,8 +1141,8 @@ key)))) key)) -;;; Parse a lambda-list into a list of VAR structures, stripping off -;;; any aux bindings. Each arg name is checked for legality, and +;;; Parse a lambda list into a list of VAR structures, stripping off +;;; any &AUX bindings. Each arg name is checked for legality, and ;;; duplicate names are checked for. If an arg is globally special, ;;; the var is marked as :SPECIAL instead of :LEXICAL. &KEY, ;;; &OPTIONAL and &REST args are annotated with an ARG-INFO structure @@ -1150,8 +1154,8 @@ ;;; 4. a list of the &AUX variables; and ;;; 5. a list of the &AUX values. (declaim (ftype (function (list) (values list boolean boolean list list)) - find-lambda-vars)) -(defun find-lambda-vars (list) + make-lambda-vars)) +(defun make-lambda-vars (list) (multiple-value-bind (required optional restp rest keyp keys allowp aux morep more-context more-count) (parse-lambda-list list) @@ -1354,8 +1358,8 @@ :%debug-name debug-name)) (result (or result (make-continuation)))) - ;; This function should fail internal assertions if we didn't set - ;; up a valid debug name above. + ;; just to check: This function should fail internal assertions if + ;; we didn't set up a valid debug name above. ;; ;; (In SBCL we try to make everything have a debug name, since we ;; lack the omniscient perspective the original implementors used @@ -1396,7 +1400,7 @@ (let ((block (continuation-block result))) (when block (let ((return (make-return :result result :lambda lambda)) - (tail-set (make-tail-set :functions (list lambda))) + (tail-set (make-tail-set :funs (list lambda))) (dummy (make-continuation))) (setf (lambda-tail-set lambda) tail-set) (setf (lambda-return lambda) return) @@ -1837,26 +1841,26 @@ form)) (unless (and (consp (cdr form)) (listp (cadr form))) (compiler-error - "The lambda expression has a missing or non-list lambda-list:~% ~S" + "The lambda expression has a missing or non-list lambda list:~% ~S" form)) (multiple-value-bind (vars keyp allow-other-keys aux-vars aux-vals) - (find-lambda-vars (cadr form)) + (make-lambda-vars (cadr form)) (multiple-value-bind (forms decls) (sb!sys:parse-body (cddr form)) - (let* ((cont (make-continuation)) + (let* ((result-cont (make-continuation)) (*lexenv* (process-decls decls (append aux-vars vars) - nil cont)) + nil result-cont)) (res (if (or (find-if #'lambda-var-arg-info vars) keyp) (ir1-convert-hairy-lambda forms vars keyp allow-other-keys - aux-vars aux-vals cont + aux-vars aux-vals result-cont :source-name source-name :debug-name debug-name) (ir1-convert-lambda-body forms vars :aux-vars aux-vars :aux-vals aux-vals - :result cont + :result result-cont :source-name source-name :debug-name debug-name)))) (setf (functional-inline-expansion res) form) @@ -2019,18 +2023,3 @@ (specifier-type 'function)))) (values)) - -;;;; hacking function names - -;;; This is like LAMBDA, except the result is tweaked so that FUN-NAME -;;; can extract a name. (Also possibly the name could also be used at -;;; compile time to emit more-informative name-based compiler -;;; diagnostic messages as well.) -(defmacro-mundanely named-lambda (name args &body body) - - ;; FIXME: For now, in this stub version, we just discard the name. A - ;; non-stub version might use either macro-level LOAD-TIME-VALUE - ;; hackery or customized IR1-transform level magic to actually put - ;; the name in place. - (aver (legal-fun-name-p name)) - `(lambda ,args ,@body))