X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=src%2Fcompiler%2Fir1tran.lisp;h=37ddb427cbee20c6f50bf36cf89b5f898e1ce9c1;hb=bf5a814edd504f1497ef1c04966d44310e54ef28;hp=e6f917fbdc05484e420593ffc3a3232660b0004a;hpb=9ce73d3eeef7ed9dda2f8029c5f42cc17798ad51;p=sbcl.git diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index e6f917f..37ddb42 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -49,6 +49,8 @@ gives non-ANSI, early-CMU-CL behavior. It can be useful for improving the efficiency of stable code.") +(defvar *fun-names-in-this-file* nil) + ;;; *ALLOW-DEBUG-CATCH-TAG* controls whether we should allow the ;;; insertion a (CATCH ...) around code to allow the debugger RETURN ;;; command to function. @@ -56,6 +58,13 @@ ;;;; namespace management utilities +(defun fun-lexically-notinline-p (name) + (let ((fun (lexenv-find name funs :test #'equal))) + ;; a declaration will trump a proclamation + (if (and fun (defined-fun-p fun)) + (eq (defined-fun-inlinep fun) :notinline) + (eq (info :function :inlinep name) :notinline)))) + ;;; Return a GLOBAL-VAR structure usable for referencing the global ;;; function NAME. (defun find-free-really-fun (name) @@ -72,13 +81,16 @@ ;; definedness at runtime, which is what matters. #-sb-xc-host (not (fboundp name))) (note-undefined-reference name :function)) - (make-global-var :kind :global-function - :%source-name name - :type (if (or *derive-function-types* - (eq where :declared)) - (info :function :type name) - (specifier-type 'function)) - :where-from where))) + (make-global-var + :kind :global-function + :%source-name name + :type (if (or *derive-function-types* + (eq where :declared) + (and (member name *fun-names-in-this-file* :test #'equal) + (not (fun-lexically-notinline-p name)))) + (info :function :type name) + (specifier-type 'function)) + :where-from where))) ;;; Has the *FREE-FUNS* entry FREE-FUN become invalid? ;;; @@ -129,7 +141,7 @@ ;;; names a macro or special form, then we error out using the ;;; supplied context which indicates what we were trying to do that ;;; demanded a function. -(declaim (ftype (function (t string) global-var) find-free-fun)) +(declaim (ftype (sfunction (t string) global-var) find-free-fun)) (defun find-free-fun (name context) (or (let ((old-free-fun (gethash name *free-funs*))) (and (not (invalid-free-fun-p old-free-fun)) @@ -154,12 +166,14 @@ :inline-expansion expansion :inlinep inlinep :where-from (info :function :where-from name) - :type (info :function :type name)) + :type (if (eq inlinep :notinline) + (specifier-type 'function) + (info :function :type name))) (find-free-really-fun name)))))))) ;;; Return the LEAF structure for the lexically apparent function ;;; definition of NAME. -(declaim (ftype (function (t string) leaf) find-lexically-apparent-fun)) +(declaim (ftype (sfunction (t string) leaf) find-lexically-apparent-fun)) (defun find-lexically-apparent-fun (name context) (let ((var (lexenv-find name funs :test #'equal))) (cond (var @@ -175,7 +189,7 @@ ;;; corresponding value. Otherwise, we make a new leaf using ;;; information from the global environment and enter it in ;;; *FREE-VARS*. If the variable is unknown, then we emit a warning. -(declaim (ftype (function (t) (or leaf cons heap-alien-info)) find-free-var)) +(declaim (ftype (sfunction (t) (or leaf cons heap-alien-info)) find-free-var)) (defun find-free-var (name) (unless (symbolp name) (compiler-error "Variable name is not a symbol: ~S." name)) @@ -215,7 +229,7 @@ ;;; CONSTANT might be circular. We also check that the constant (and ;;; any subparts) are dumpable at all. (eval-when (:compile-toplevel :load-toplevel :execute) - ;; The EVAL-WHEN is necessary for #.(1+ LIST-TO-HASH-TABLE-THRESHOLD) + ;; The EVAL-WHEN is necessary for #.(1+ LIST-TO-HASH-TABLE-THRESHOLD) ;; below. -- AL 20010227 (def!constant list-to-hash-table-threshold 32)) (defun maybe-emit-make-load-forms (constant) @@ -289,41 +303,32 @@ ;;;; some flow-graph hacking utilities ;;; This function sets up the back link between the node and the -;;; continuation which continues at it. -(defun link-node-to-previous-continuation (node cont) - (declare (type node node) (type continuation cont)) - (aver (not (continuation-next cont))) - (setf (continuation-next cont) node) - (setf (node-prev node) cont)) - -;;; This function is used to set the continuation for a node, and thus -;;; determine what receives the value and what is evaluated next. If -;;; 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 -;;; 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 -;;; assertion on CONT to be no stronger than the assertion on CONT in -;;; our scope. See the IR1-CONVERT method for THE. -#!-sb-fluid (declaim (inline use-continuation)) -(defun use-continuation (node cont) - (declare (type node node) (type continuation cont)) - (let ((node-block (continuation-block (node-prev node)))) - (case (continuation-kind cont) - (:unused - (setf (continuation-block cont) node-block) - (setf (continuation-kind cont) :inside-block) - (setf (continuation-use cont) node) - (setf (node-cont node) cont)) - (t - (%use-continuation node cont))))) -(defun %use-continuation (node cont) - (declare (type node node) (type continuation cont) (inline member)) - (let ((block (continuation-block cont)) - (node-block (continuation-block (node-prev node)))) - (aver (eq (continuation-kind cont) :block-start)) +;;; ctran which continues at it. +(defun link-node-to-previous-ctran (node ctran) + (declare (type node node) (type ctran ctran)) + (aver (not (ctran-next ctran))) + (setf (ctran-next ctran) node) + (setf (node-prev node) ctran)) + +;;; This function is used to set the ctran for a node, and thus +;;; determine what is evaluated next. If the ctran has no block, then +;;; we make it be in the block that the node is in. If the ctran heads +;;; its block, we end our block and link it to that block. +#!-sb-fluid (declaim (inline use-ctran)) +(defun use-ctran (node ctran) + (declare (type node node) (type ctran ctran)) + (if (eq (ctran-kind ctran) :unused) + (let ((node-block (ctran-block (node-prev node)))) + (setf (ctran-block ctran) node-block) + (setf (ctran-kind ctran) :inside-block) + (setf (ctran-use ctran) node) + (setf (node-next node) ctran)) + (%use-ctran node ctran))) +(defun %use-ctran (node ctran) + (declare (type node node) (type ctran ctran) (inline member)) + (let ((block (ctran-block ctran)) + (node-block (ctran-block (node-prev node)))) + (aver (eq (ctran-kind ctran) :block-start)) (when (block-last node-block) (error "~S has already ended." node-block)) (setf (block-last node-block) node) @@ -332,22 +337,29 @@ (setf (block-succ node-block) (list block)) (when (memq node-block (block-pred block)) (error "~S is already a predecessor of ~S." node-block block)) - (push node-block (block-pred block)) - (add-continuation-use node cont) - (unless (eq (continuation-asserted-type cont) *wild-type*) - (let* ((restriction (or (lexenv-find cont type-restrictions) - *wild-type*)) - (wrestriction (or (lexenv-find cont weakend-type-restrictions) - *wild-type*)) - (newatype (values-type-union (continuation-asserted-type cont) - restriction)) - (newctype (values-type-union (continuation-type-to-check cont) - wrestriction))) - (when (or (type/= newatype (continuation-asserted-type cont)) - (type/= newctype (continuation-type-to-check cont))) - (setf (continuation-asserted-type cont) newatype) - (setf (continuation-type-to-check cont) newctype) - (reoptimize-continuation cont)))))) + (push node-block (block-pred block)))) + +;;; This function is used to set the ctran for a node, and thus +;;; determine what receives the value. +(defun use-lvar (node lvar) + (declare (type valued-node node) (type (or lvar null) lvar)) + (aver (not (node-lvar node))) + (when lvar + (setf (node-lvar node) lvar) + (cond ((null (lvar-uses lvar)) + (setf (lvar-uses lvar) node)) + ((listp (lvar-uses lvar)) + (aver (not (memq node (lvar-uses lvar)))) + (push node (lvar-uses lvar))) + (t + (aver (neq node (lvar-uses lvar))) + (setf (lvar-uses lvar) (list node (lvar-uses lvar))))) + (reoptimize-lvar lvar))) + +#!-sb-fluid(declaim (inline use-continuation)) +(defun use-continuation (node ctran lvar) + (use-ctran node ctran) + (use-lvar node lvar)) ;;;; exported functions @@ -384,7 +396,7 @@ (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) @@ -434,17 +446,18 @@ ;;;; IR1-CONVERT, macroexpansion and special form dispatching +(declaim (ftype (sfunction (ctran ctran (or lvar null) t) (values)) + ir1-convert)) (macrolet (;; Bind *COMPILER-ERROR-BAILOUT* to a function that throws ;; out of the body and converts a proxy form instead. - (ir1-error-bailout ((start - cont + (ir1-error-bailout ((start next result form &optional (proxy ``(error 'simple-program-error :format-control "execution of a form compiled with errors:~% ~S" :format-arguments (list ',,form)))) &body body) - (let ((skip (gensym "SKIP"))) + (with-unique-names (skip) `(block ,skip (catch 'ir1-error-abort (let ((*compiler-error-bailout* @@ -452,46 +465,49 @@ (throw 'ir1-error-abort nil)))) ,@body (return-from ,skip nil))) - (ir1-convert ,start ,cont ,proxy))))) + (ir1-convert ,start ,next ,result ,proxy))))) ;; Translate FORM into IR1. The code is inserted as the NEXT of the - ;; continuation START. CONT is the continuation which receives the - ;; value of the FORM to be translated. The translators call this - ;; function recursively to translate their subnodes. + ;; CTRAN START. RESULT is the LVAR which receives the value of the + ;; FORM to be translated. The translators call this function + ;; recursively to translate their subnodes. ;; ;; As a special hack to make life easier in the compiler, a LEAF ;; IR1-converts into a reference to that LEAF structure. This allows ;; the creation using backquote of forms that contain leaf ;; references, without having to introduce dummy names into the ;; namespace. - (declaim (ftype (function (continuation continuation t) (values)) ir1-convert)) - (defun ir1-convert (start cont form) - (ir1-error-bailout (start cont form) + (defun ir1-convert (start next result form) + (ir1-error-bailout (start next result form) (let ((*current-path* (or (gethash form *source-paths*) (cons form *current-path*)))) (if (atom form) (cond ((and (symbolp form) (not (keywordp form))) - (ir1-convert-var start cont form)) + (ir1-convert-var start next result form)) ((leaf-p form) - (reference-leaf start cont form)) + (reference-leaf start next result form)) (t - (reference-constant start cont form))) + (reference-constant start next result form))) (let ((opname (car form))) - (cond ((symbolp opname) - (let ((lexical-def (lexenv-find opname funs))) + (cond ((or (symbolp opname) (leaf-p opname)) + (let ((lexical-def (if (leaf-p opname) + opname + (lexenv-find opname funs)))) (typecase lexical-def - (null (ir1-convert-global-functoid start cont form)) + (null + (ir1-convert-global-functoid start next result + form)) (functional - (ir1-convert-local-combination start - cont + (ir1-convert-local-combination start next result form lexical-def)) (global-var - (ir1-convert-srctran start cont lexical-def form)) + (ir1-convert-srctran start next result + lexical-def form)) (t (aver (and (consp lexical-def) (eq (car lexical-def) 'macro))) - (ir1-convert start cont + (ir1-convert start next result (careful-expand-macro (cdr lexical-def) form)))))) ((or (atom opname) (not (eq (car opname) 'lambda))) @@ -499,13 +515,12 @@ (t ;; implicitly (LAMBDA ..) because the LAMBDA ;; expression is the CAR of an executed form - (ir1-convert-combination start - cont + (ir1-convert-combination start next result form (ir1-convert-lambda opname :debug-name (debug-namify - "LAMBDA CAR ~S" + "LAMBDA CAR " opname) :allow-debug-catch-tag t)))))))) (values)) @@ -514,18 +529,19 @@ ;; if necessary. If we are producing a fasl file, make sure that ;; MAKE-LOAD-FORM gets used on any parts of the constant that it ;; needs to be. - (defun reference-constant (start cont value) - (declare (type continuation start cont) + (defun reference-constant (start next result value) + (declare (type ctran start next) + (type (or lvar null) result) (inline find-constant)) (ir1-error-bailout - (start cont value '(error "attempt to reference undumpable constant")) + (start next result value '(error "attempt to reference undumpable constant")) (when (producing-fasl-file) (maybe-emit-make-load-forms value)) (let* ((leaf (find-constant value)) - (res (make-ref (leaf-type leaf) leaf))) + (res (make-ref leaf))) (push res (leaf-refs leaf)) - (link-node-to-previous-continuation res start) - (use-continuation res cont))) + (link-node-to-previous-ctran res start) + (use-continuation res next result))) (values))) ;;; Add FUNCTIONAL to the COMPONENT-REANALYZE-FUNCTIONALS, unless it's @@ -543,7 +559,7 @@ (when (typep functional '(or optional-dispatch clambda)) ;; When FUNCTIONAL knows its component - (when (lambda-p functional) + (when (lambda-p functional) (aver (eql (lambda-component functional) *current-component*))) (pushnew functional @@ -555,62 +571,80 @@ ;;; needed. If LEAF represents a defined function which has already ;;; been converted, and is not :NOTINLINE, then reference the ;;; functional instead. -(defun reference-leaf (start cont leaf) - (declare (type continuation start cont) (type leaf leaf)) - (with-continuation-type-assertion - (cont (or (lexenv-find leaf type-restrictions) *wild-type*) - "in DECLARE") - (let* ((leaf (or (and (defined-fun-p leaf) - (not (eq (defined-fun-inlinep leaf) - :notinline)) - (let ((functional (defined-fun-functional leaf))) - (when (and functional - (not (functional-kind functional))) - (maybe-reanalyze-functional functional)))) - leaf)) - (res (make-ref (leaf-type leaf) - leaf))) - (push res (leaf-refs leaf)) - (setf (leaf-ever-used leaf) t) - (link-node-to-previous-continuation res start) - (use-continuation res cont)))) +(defun reference-leaf (start next result leaf) + (declare (type ctran start next) (type (or lvar null) result) (type leaf leaf)) + (when (functional-p leaf) + (assure-functional-live-p leaf)) + (let* ((type (lexenv-find leaf type-restrictions)) + (leaf (or (and (defined-fun-p leaf) + (not (eq (defined-fun-inlinep leaf) + :notinline)) + (let ((functional (defined-fun-functional leaf))) + (when (and functional + (not (functional-kind functional))) + (maybe-reanalyze-functional functional)))) + (when (and (lambda-p leaf) + (memq (functional-kind leaf) + '(nil :optional))) + (maybe-reanalyze-functional leaf)) + leaf)) + (ref (make-ref leaf))) + (push ref (leaf-refs leaf)) + (setf (leaf-ever-used leaf) t) + (link-node-to-previous-ctran ref start) + (cond (type (let* ((ref-ctran (make-ctran)) + (ref-lvar (make-lvar)) + (cast (make-cast ref-lvar + (make-single-value-type type) + (lexenv-policy *lexenv*)))) + (setf (lvar-dest ref-lvar) cast) + (use-continuation ref ref-ctran ref-lvar) + (link-node-to-previous-ctran cast ref-ctran) + (use-continuation cast next result))) + (t (use-continuation ref next result))))) ;;; Convert a reference to a symbolic constant or variable. If the ;;; 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-var (start cont name) - (declare (type continuation start cont) (symbol name)) +(defun ir1-convert-var (start next result name) + (declare (type ctran start next) (type (or lvar null) result) (symbol name)) (let ((var (or (lexenv-find name vars) (find-free-var name)))) (etypecase var (leaf (when (lambda-var-p var) - (let ((home (continuation-home-lambda-or-null start))) + (let ((home (ctran-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-warn "reading an ignored variable: ~S" name))) - (reference-leaf start cont var)) + #-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)) - (ir1-convert start cont (cdr var))) + ;; FIXME: [Free] type declarations. -- APD, 2002-01-26 + (ir1-convert start next result (cdr var))) (heap-alien-info - (ir1-convert start cont `(%heap-alien ',var))))) + (ir1-convert start next result `(%heap-alien ',var))))) (values)) ;;; Convert anything that looks like a special form, global function ;;; or compiler-macro call. -(defun ir1-convert-global-functoid (start cont form) - (declare (type continuation start cont) (list form)) +(defun ir1-convert-global-functoid (start next result form) + (declare (type ctran start next) (type (or lvar null) result) (list form)) (let* ((fun-name (first form)) (translator (info :function :ir1-convert fun-name)) (cmacro-fun (sb!xc:compiler-macro-function fun-name *lexenv*))) (cond (translator (when cmacro-fun (compiler-warn "ignoring compiler macro for special form")) - (funcall translator start cont form)) + (funcall translator start next result form)) ((and cmacro-fun ;; gotcha: If you look up the DEFINE-COMPILER-MACRO ;; macro in the ANSI spec, you might think that @@ -622,28 +656,28 @@ (let ((res (careful-expand-macro cmacro-fun form))) (if (eq res form) (ir1-convert-global-functoid-no-cmacro - start cont form fun-name) - (ir1-convert start cont res)))) + start next result form fun-name) + (ir1-convert start next result res)))) (t - (ir1-convert-global-functoid-no-cmacro start cont form fun-name))))) + (ir1-convert-global-functoid-no-cmacro start next result + form fun-name))))) ;;; 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)) +(defun ir1-convert-global-functoid-no-cmacro (start next result form fun) + (declare (type ctran start next) (type (or lvar null) result) + (list form)) ;; FIXME: Couldn't all the INFO calls here be converted into ;; standard CL functions, like MACRO-FUNCTION or something? ;; And what happens with lexically-defined (MACROLET) macros ;; here, anyway? (ecase (info :function :kind fun) (:macro - (ir1-convert start - cont + (ir1-convert start next result (careful-expand-macro (info :function :macro-function fun) form))) ((nil :function) - (ir1-convert-srctran start - cont + (ir1-convert-srctran start next result (find-free-fun fun "shouldn't happen! (no-cmacro)") form)))) @@ -692,7 +726,7 @@ ;; WHN 19990412 #+(and cmu sb-xc-host) (warning (lambda (c) - (compiler-note + (compiler-notify "~@<~A~:@_~ ~A~:@_~ ~@<(KLUDGE: That was a non-STYLE WARNING. ~ @@ -709,8 +743,8 @@ (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~:>" @@ -721,21 +755,21 @@ ;;; Convert a bunch of forms, discarding all the values except the ;;; last. If there aren't any forms, then translate a NIL. -(declaim (ftype (function (continuation continuation list) (values)) +(declaim (ftype (sfunction (ctran ctran (or lvar null) list) (values)) ir1-convert-progn-body)) -(defun ir1-convert-progn-body (start cont body) +(defun ir1-convert-progn-body (start next result body) (if (endp body) - (reference-constant start cont nil) + (reference-constant start next result nil) (let ((this-start start) (forms body)) (loop (let ((form (car forms))) (when (endp (cdr forms)) - (ir1-convert this-start cont form) + (ir1-convert this-start next result form) (return)) - (let ((this-cont (make-continuation))) - (ir1-convert this-start this-cont form) - (setq this-start this-cont + (let ((this-ctran (make-ctran))) + (ir1-convert this-start this-ctran nil form) + (setq this-start this-ctran forms (cdr forms))))))) (values)) @@ -744,35 +778,36 @@ ;;; Convert a function call where the function FUN is a LEAF. FORM is ;;; the source for the call. 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) +(declaim (ftype (sfunction (ctran ctran (or lvar null) list leaf) combination) ir1-convert-combination)) -(defun ir1-convert-combination (start cont form fun) - (let ((fun-cont (make-continuation))) - (reference-leaf start fun-cont fun) - (ir1-convert-combination-args fun-cont cont (cdr form)))) +(defun ir1-convert-combination (start next result form fun) + (let ((ctran (make-ctran)) + (fun-lvar (make-lvar))) + (ir1-convert start ctran fun-lvar `(the (or function symbol) ,fun)) + (ir1-convert-combination-args fun-lvar ctran next result (cdr form)))) ;;; Convert the arguments to a call and make the COMBINATION -;;; node. FUN-CONT is the continuation which yields the function to -;;; call. ARGS is the list of arguments for the call, which defaults -;;; to the cdr of source. We return the COMBINATION node. -(defun ir1-convert-combination-args (fun-cont cont args) - (declare (type continuation fun-cont cont) (list args)) - (let ((node (make-combination fun-cont))) - (setf (continuation-dest fun-cont) node) - (assert-continuation-type fun-cont - (specifier-type '(or function symbol)) - (lexenv-policy *lexenv*)) - (setf (continuation-%externally-checkable-type fun-cont) nil) - (collect ((arg-conts)) - (let ((this-start fun-cont)) +;;; node. FUN-LVAR yields the function to call. ARGS is the list of +;;; arguments for the call, which defaults to the cdr of source. We +;;; return the COMBINATION node. +(defun ir1-convert-combination-args (fun-lvar start next result args) + (declare (type ctran start next) + (type lvar fun-lvar) + (type (or lvar null) result) + (list args)) + (let ((node (make-combination fun-lvar))) + (setf (lvar-dest fun-lvar) node) + (collect ((arg-lvars)) + (let ((this-start start)) (dolist (arg args) - (let ((this-cont (make-continuation node))) - (ir1-convert this-start this-cont arg) - (setq this-start this-cont) - (arg-conts this-cont))) - (link-node-to-previous-continuation node this-start) - (use-continuation node cont) - (setf (combination-args node) (arg-conts)))) + (let ((this-ctran (make-ctran)) + (this-lvar (make-lvar node))) + (ir1-convert this-start this-ctran this-lvar arg) + (setq this-start this-ctran) + (arg-lvars this-lvar))) + (link-node-to-previous-ctran node this-start) + (use-continuation node next result) + (setf (combination-args node) (arg-lvars)))) node)) ;;; Convert a call to a global function. If not :NOTINLINE, then we do @@ -780,36 +815,40 @@ ;;; expansion, but is :INLINE, then give an efficiency note (unless a ;;; known function which will quite possibly be open-coded.) Next, we ;;; go to ok-combination conversion. -(defun ir1-convert-srctran (start cont var form) - (declare (type continuation start cont) (type global-var var)) +(defun ir1-convert-srctran (start next result var form) + (declare (type ctran start next) (type (or lvar null) result) + (type global-var var)) (let ((inlinep (when (defined-fun-p var) (defined-fun-inlinep var)))) (if (eq inlinep :notinline) - (ir1-convert-combination start cont form var) + (ir1-convert-combination start next result form var) (let ((transform (info :function :source-transform (leaf-source-name var)))) - (if transform - (multiple-value-bind (result pass) (funcall transform form) - (if pass - (ir1-convert-maybe-predicate start cont form var) - (ir1-convert start cont result))) - (ir1-convert-maybe-predicate start cont form var)))))) - -;;; If the function has the PREDICATE attribute, and the CONT's DEST + (if transform + (multiple-value-bind (transformed pass) (funcall transform form) + (if pass + (ir1-convert-maybe-predicate start next result form var) + (ir1-convert start next result transformed))) + (ir1-convert-maybe-predicate start next result form var)))))) + +;;; If the function has the PREDICATE attribute, and the RESULT's DEST ;;; isn't an IF, then we convert (IF