X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1-translators.lisp;h=971550f40e457b2d28c0e40b45fbfdc47a5bf6f7;hb=b0b168c08b31a748150f404398af754f26fd4813;hp=a1c9556a989f81775a5f6a6991575798d4827428;hpb=d40a76606c86722b0aef8179155f9f2840739b72;p=sbcl.git diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index a1c9556..971550f 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -244,7 +244,7 @@ definitions fun) (declare (type function definitionize-fun fun)) - (declare (type (member :variables :functions) definitionize-keyword)) + (declare (type (member :vars :funs) definitionize-keyword)) (declare (type list definitions)) (unless (= (length definitions) (length (remove-duplicates definitions :key #'first))) @@ -278,7 +278,7 @@ `(lambda (,whole ,environment) ,@local-decls (block ,name ,body)))))))) - :functions + :funs definitions fun)) @@ -304,7 +304,7 @@ "The local symbol macro name ~S is not a symbol." name)) `(,name . (MACRO . ,expansion)))) - :variables + :vars definitions fun)) @@ -422,7 +422,7 @@ :debug-name (debug-namify "#'~S" thing)))) ((setf) - (let ((var (find-lexically-apparent-function + (let ((var (find-lexically-apparent-fun thing "as the argument to FUNCTION"))) (reference-leaf start cont var))) ((instance-lambda) @@ -433,7 +433,7 @@ (reference-leaf start cont res))) (t (compiler-error "~S is not a legal function name." thing))) - (let ((var (find-lexically-apparent-function + (let ((var (find-lexically-apparent-fun thing "as the argument to FUNCTION"))) (reference-leaf start cont var)))) @@ -514,8 +514,8 @@ ;;; variables are marked as such. Context is the name of the form, for ;;; error reporting purposes. (declaim (ftype (function (list symbol) (values list list list)) - extract-let-variables)) -(defun extract-let-variables (bindings context) + extract-let-vars)) +(defun extract-let-vars (bindings context) (collect ((vars) (vals) (names)) @@ -551,7 +551,7 @@ Value forms. The variables are bound in parallel after all of the Values are evaluated." (multiple-value-bind (forms decls) (sb!sys:parse-body body nil) - (multiple-value-bind (vars values) (extract-let-variables bindings 'let) + (multiple-value-bind (vars values) (extract-let-vars bindings 'let) (let* ((*lexenv* (process-decls decls vars nil cont)) (fun-cont (make-continuation)) (fun (ir1-convert-lambda-body @@ -566,7 +566,7 @@ Similar to LET, but the variables are bound sequentially, allowing each Value form to reference any of the previous Vars." (multiple-value-bind (forms decls) (sb!sys:parse-body body nil) - (multiple-value-bind (vars values) (extract-let-variables bindings 'let*) + (multiple-value-bind (vars values) (extract-let-vars bindings 'let*) (let ((*lexenv* (process-decls decls vars nil cont))) (ir1-convert-aux-bindings start cont forms vars values))))) @@ -599,9 +599,8 @@ ;;; ;;; The function names are checked for legality. CONTEXT is the name ;;; of the form, for error reporting. -(declaim (ftype (function (list symbol) (values list list)) - extract-flet-variables)) -(defun extract-flet-variables (definitions context) +(declaim (ftype (function (list symbol) (values list list)) extract-flet-vars)) +(defun extract-flet-vars (definitions context) (collect ((names) (defs)) (dolist (def definitions) @@ -627,7 +626,7 @@ the lexically apparent function definition in the enclosing environment." (multiple-value-bind (forms decls) (sb!sys:parse-body body nil) (multiple-value-bind (names defs) - (extract-flet-variables definitions 'flet) + (extract-flet-vars definitions 'flet) (let* ((fvars (mapcar (lambda (n d) (ir1-convert-lambda d :source-name n @@ -636,7 +635,7 @@ names defs)) (*lexenv* (make-lexenv :default (process-decls decls nil fvars cont) - :functions (pairlis names fvars)))) + :funs (pairlis names fvars)))) (ir1-convert-progn-body start cont forms))))) (def-ir1-translator labels ((definitions &body body) start cont) @@ -647,7 +646,7 @@ each other." (multiple-value-bind (forms decls) (sb!sys:parse-body body nil) (multiple-value-bind (names defs) - (extract-flet-variables definitions 'labels) + (extract-flet-vars definitions 'labels) (let* (;; dummy LABELS functions, to be used as placeholders ;; during construction of real LABELS functions (placeholder-funs (mapcar (lambda (name) @@ -662,8 +661,7 @@ ;; the real LABELS functions, compiled in a LEXENV which ;; includes the dummy LABELS functions (real-funs - (let ((*lexenv* (make-lexenv - :functions placeholder-fenv))) + (let ((*lexenv* (make-lexenv :funs placeholder-fenv))) (mapcar (lambda (name def) (ir1-convert-lambda def :source-name name @@ -685,7 +683,7 @@ ;; placeholder used earlier) so that if the ;; lexical environment is used for inline ;; expansion we'll get the right functions. - :functions (pairlis names real-funs)))) + :funs (pairlis names real-funs)))) (ir1-convert-progn-body start cont forms)))))) ;;;; the THE special operator, and friends @@ -774,17 +772,17 @@ ;;;; SETQ -;;; If there is a definition in LEXENV-VARIABLES, just set that, -;;; otherwise look at the global information. If the name is for a -;;; constant, then error out. +;;; If there is a definition in LEXENV-VARS, just set that, otherwise +;;; look at the global information. If the name is for a constant, +;;; then error out. (def-ir1-translator setq ((&whole source &rest things) start cont) (let ((len (length things))) (when (oddp len) (compiler-error "odd number of args to SETQ: ~S" source)) (if (= len 2) (let* ((name (first things)) - (leaf (or (lexenv-find name variables) - (find-free-variable name)))) + (leaf (or (lexenv-find name vars) + (find-free-var name)))) (etypecase leaf (leaf (when (constant-p leaf) @@ -799,7 +797,7 @@ (compiler-style-warn "~S is being set even though it was declared to be ignored." name))) - (set-variable start cont leaf (second things))) + (setq-var start cont leaf (second things))) (cons (aver (eq (car leaf) 'MACRO)) (ir1-convert start cont `(setf ,(cdr leaf) ,(second things)))) @@ -814,7 +812,7 @@ ;;; This is kind of like REFERENCE-LEAF, but we generate a SET node. ;;; This should only need to be called in SETQ. -(defun set-variable (start cont var value) +(defun setq-var (start cont var value) (declare (type continuation start cont) (type basic-var var)) (let ((dest (make-continuation))) (setf (continuation-asserted-type dest) (leaf-type var)) @@ -868,7 +866,7 @@ ;;; ;;; Note that environment analysis replaces references to escape ;;; functions with references to the corresponding NLX-INFO structure. -(def-ir1-translator %escape-function ((tag) start cont) +(def-ir1-translator %escape-fun ((tag) start cont) (let ((fun (ir1-convert-lambda `(lambda () (return-from ,tag (%unknown-values))) @@ -879,8 +877,8 @@ ;;; Yet another special special form. This one looks up a local ;;; function and smashes it to a :CLEANUP function, as well as ;;; referencing it. -(def-ir1-translator %cleanup-function ((name) start cont) - (let ((fun (lexenv-find name functions))) +(def-ir1-translator %cleanup-fun ((name) start cont) + (let ((fun (lexenv-find name funs))) (aver (lambda-p fun)) (setf (functional-kind fun) :cleanup) (reference-leaf start cont fun))) @@ -901,13 +899,13 @@ `(block ,exit-block (%within-cleanup :catch - (%catch (%escape-function ,exit-block) ,tag) + (%catch (%escape-fun ,exit-block) ,tag) ,@body))))) ;;; UNWIND-PROTECT is similar to CATCH, but hairier. We make the ;;; cleanup forms into a local function so that they can be referenced ;;; both in the case where we are unwound and in any local exits. We -;;; use %CLEANUP-FUNCTION on this to indicate that reference by +;;; use %CLEANUP-FUN on this to indicate that reference by ;;; %UNWIND-PROTECT isn't "real", and thus doesn't cause creation of ;;; an XEP. (def-ir1-translator unwind-protect ((protected &body cleanup) start cont) @@ -927,15 +925,15 @@ `(flet ((,cleanup-fun () ,@cleanup nil)) ;; FIXME: If we ever get DYNAMIC-EXTENT working, then ;; ,CLEANUP-FUN should probably be declared DYNAMIC-EXTENT, - ;; and something can be done to make %ESCAPE-FUNCTION have + ;; and something can be done to make %ESCAPE-FUN have ;; dynamic extent too. (block ,drop-thru-tag (multiple-value-bind (,next ,start ,count) (block ,exit-tag (%within-cleanup :unwind-protect - (%unwind-protect (%escape-function ,exit-tag) - (%cleanup-function ,cleanup-fun)) + (%unwind-protect (%escape-fun ,exit-tag) + (%cleanup-fun ,cleanup-fun)) (return-from ,drop-thru-tag ,protected))) (,cleanup-fun) (%continue-unwind ,next ,start ,count))))))) @@ -1078,7 +1076,7 @@ (ecase (info :function :kind name) ((nil)) (:function - (remhash name *free-functions*) + (remhash name *free-funs*) (undefine-fun-name name) (compiler-warn "~S is being redefined as a macro when it was ~