X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1tran.lisp;h=6d077229a8f84ee4d618fde0114f16462d8cb8dd;hb=80304981972c91c1b3f3fca75f36dacf1fecf307;hp=1881835e16196e0ebd9e3a8a39bacb4d70274b8a;hpb=29a9ccc860532b32c566aec095f570e999a9c52c;p=sbcl.git diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 1881835..6d07722 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -75,29 +75,6 @@ (specifier-type 'function)) :where-from where))) -;;; Return a SLOT-ACCESSOR structure usable for referencing the slot -;;; accessor NAME. CLASS is the structure class. -(defun find-structure-slot-accessor (class name) - (declare (type sb!xc:class class)) - (let* ((info (layout-info - (or (info :type :compiler-layout (sb!xc:class-name class)) - (class-layout class)))) - (accessor-name (if (listp name) (cadr name) name)) - (slot (find accessor-name (dd-slots info) - :key #'sb!kernel:dsd-accessor-name)) - (type (dd-name info)) - (slot-type (dsd-type slot))) - (unless slot - (error "can't find slot ~S" type)) - (make-slot-accessor - :%source-name name - :type (specifier-type - (if (listp name) - `(function (,slot-type ,type) ,slot-type) - `(function (,type) ,slot-type))) - :for class - :slot slot))) - ;;; Has the *FREE-FUNS* entry FREE-FUN become invalid? ;;; ;;; In CMU CL, the answer was implicitly always true, so this @@ -177,7 +154,7 @@ ;;; definition of NAME. (declaim (ftype (function (t string) leaf) find-lexically-apparent-fun)) (defun find-lexically-apparent-fun (name context) - (let ((var (lexenv-find name functions :test #'equal))) + (let ((var (lexenv-find name funs :test #'equal))) (cond (var (unless (leaf-p var) (aver (and (consp var) (eq (car var) 'macro))) @@ -187,22 +164,21 @@ (find-free-fun name context))))) ;;; Return the LEAF node for a global variable reference to NAME. If -;;; NAME is already entered in *FREE-VARIABLES*, then we just return -;;; the corresponding value. Otherwise, we make a new leaf using +;;; NAME is already entered in *FREE-VARS*, then we just return the +;;; corresponding value. Otherwise, we make a new leaf using ;;; information from the global environment and enter it in -;;; *FREE-VARIABLES*. If the variable is unknown, then we emit a -;;; warning. -(defun find-free-variable (name) +;;; *FREE-VARS*. If the variable is unknown, then we emit a warning. +(defun find-free-var (name) (declare (values (or leaf heap-alien-info))) (unless (symbolp name) (compiler-error "Variable name is not a symbol: ~S." name)) - (or (gethash name *free-variables*) + (or (gethash name *free-vars*) (let ((kind (info :variable :kind name)) (type (info :variable :type name)) (where-from (info :variable :where-from name))) (when (and (eq where-from :assumed) (eq kind :global)) (note-undefined-reference name :variable)) - (setf (gethash name *free-variables*) + (setf (gethash name *free-vars*) (case kind (:alien (info :variable :alien-info name)) @@ -471,14 +447,14 @@ (cons form *current-path*)))) (if (atom form) (cond ((and (symbolp form) (not (keywordp form))) - (ir1-convert-variable start cont form)) + (ir1-convert-var start cont form)) ((leaf-p form) (reference-leaf start cont form)) (t (reference-constant start cont form))) (let ((opname (car form))) (cond ((symbolp opname) - (let ((lexical-def (lexenv-find opname functions))) + (let ((lexical-def (lexenv-find opname funs))) (typecase lexical-def (null (ir1-convert-global-functoid start cont form)) (functional @@ -570,12 +546,12 @@ (use-continuation res cont))) ;;; Convert a reference to a symbolic constant or variable. If the -;;; symbol is entered in the LEXENV-VARIABLES we use that definition, +;;; symbol is entered in the LEXENV-VARS we use that definition, ;;; otherwise we find the current global definition. This is also ;;; where we pick off symbol macro and alien variable references. -(defun ir1-convert-variable (start cont name) +(defun ir1-convert-var (start cont name) (declare (type continuation start cont) (symbol name)) - (let ((var (or (lexenv-find name variables) (find-free-variable name)))) + (let ((var (or (lexenv-find name vars) (find-free-var name)))) (etypecase var (leaf (when (lambda-var-p var) @@ -876,8 +852,8 @@ (dolist (var-name (rest decl)) (let* ((bound-var (find-in-bindings vars var-name)) (var (or bound-var - (lexenv-find var-name variables) - (find-free-variable var-name)))) + (lexenv-find var-name vars) + (find-free-var var-name)))) (etypecase var (leaf (let* ((old-type (or (lexenv-find var type-restrictions) @@ -908,7 +884,7 @@ (if (or (restr) (new-vars)) (make-lexenv :default res :type-restrictions (restr) - :variables (new-vars)) + :vars (new-vars)) res)))) ;;; This is somewhat similar to PROCESS-TYPE-DECL, but handles @@ -965,7 +941,7 @@ (unless (assoc name (new-venv) :test #'eq) (new-venv (cons name (specvar-for-binding name)))))))) (if (new-venv) - (make-lexenv :default res :variables (new-venv)) + (make-lexenv :default res :vars (new-venv)) res))) ;;; Return a DEFINED-FUN which copies a GLOBAL-VAR but for its INLINEP. @@ -1008,7 +984,7 @@ new-fenv))))))) (if new-fenv - (make-lexenv :default res :functions new-fenv) + (make-lexenv :default res :funs new-fenv) res))) ;;; Like FIND-IN-BINDINGS, but looks for #'foo in the fvars. @@ -1086,10 +1062,12 @@ (if *suppress-values-declaration* res (let ((types (cdr spec))) - (do-the-stuff (if (eql (length types) 1) - (car types) - `(values ,@types)) - cont res 'values)))) + (ir1ize-the-or-values (if (eql (length types) 1) + (car types) + `(values ,@types)) + cont + res + 'values)))) (dynamic-extent (when (policy *lexenv* (> speed inhibit-warnings)) (compiler-note @@ -1127,7 +1105,7 @@ ;;; anonymous GLOBAL-VAR. (defun specvar-for-binding (name) (cond ((not (eq (info :variable :where-from name) :assumed)) - (let ((found (find-free-variable name))) + (let ((found (find-free-var name))) (when (heap-alien-info-p found) (compiler-error "~S is an alien variable and so can't be declared special." @@ -1166,7 +1144,7 @@ (compiler-error "The name of the lambda-variable ~S is a constant." name)) (cond ((eq kind :special) - (let ((specvar (find-free-variable name))) + (let ((specvar (find-free-var name))) (make-lambda-var :%source-name name :type (leaf-type specvar) :where-from (leaf-where-from specvar) @@ -1384,8 +1362,8 @@ ;;; Create a lambda node out of some code, returning the result. The ;;; bindings are specified by the list of VAR structures VARS. We deal -;;; with adding the names to the LEXENV-VARIABLES for the conversion. -;;; The result is added to the NEW-FUNS in the *CURRENT-COMPONENT* and +;;; with adding the names to the LEXENV-VARS for the conversion. The +;;; result is added to the NEW-FUNS in the *CURRENT-COMPONENT* and ;;; linked to the component head and tail. ;;; ;;; We detect special bindings here, replacing the original VAR in the @@ -1445,7 +1423,7 @@ (note-lexical-binding (leaf-source-name var)) (new-venv (cons (leaf-source-name var) var)))))) - (let ((*lexenv* (make-lexenv :variables (new-venv) + (let ((*lexenv* (make-lexenv :vars (new-venv) :lambda lambda :cleanup nil))) (setf (bind-lambda bind) lambda) @@ -1642,7 +1620,7 @@ (body `(when (oddp ,n-count) - (%odd-key-arguments-error))) + (%odd-key-args-error))) (body `(locally @@ -1657,7 +1635,7 @@ (unless allowp (body `(when (and ,n-losep (not ,n-allowp)) - (%unknown-key-argument-error ,n-losep))))))) + (%unknown-key-arg-error ,n-losep))))))) (let ((ep (ir1-convert-lambda-body `((let ,(temps) @@ -1963,12 +1941,11 @@ :default (process-decls decls nil nil (make-continuation) (make-null-lexenv)) - :variables (copy-list symbol-macros) - :functions - (mapcar (lambda (x) - `(,(car x) . - (macro . ,(coerce (cdr x) 'function)))) - macros) + :vars (copy-list symbol-macros) + :funs (mapcar (lambda (x) + `(,(car x) . + (macro . ,(coerce (cdr x) 'function)))) + macros) :policy (lexenv-policy *lexenv*)))) (ir1-convert-lambda `(lambda ,@body) :source-name source-name