(destructuring-bind (name . thing) var
(declare (ignore name))
(etypecase thing
- (leaf nil)
+ ;; The evaluator will mark lexicals with :BOGUS when it
+ ;; translates an interpreter lexenv to a compiler
+ ;; lexenv.
+ ((or leaf #!+sb-eval (member :bogus)) nil)
(cons (aver (eq (car thing) 'macro))
t)
(heap-alien-info nil)))))
(values))
+(defun note-local-functional (fun)
+ (declare (type functional fun))
+ (when (and (leaf-has-source-name-p fun)
+ (eq (leaf-source-name fun) (functional-debug-name fun)))
+ (let ((name (leaf-source-name fun)))
+ (let ((defined-fun (gethash name *free-funs*)))
+ (when (and defined-fun
+ (defined-fun-p defined-fun)
+ (eq (defined-fun-functional defined-fun) fun))
+ (remhash name *free-funs*))))))
+
;;; Do stuff to delete the semantic attachments of a REF node. When
;;; this leaves zero or one reference, we do a type dispatch off of
;;; the leaf to determine if a special action is appropriate.
;;; of arguments changes, the transform must be prepared to return a
;;; lambda with a new lambda-list with the correct number of
;;; arguments.
-(defun extract-fun-args (lvar fun num-args)
+(defun splice-fun-args (lvar fun num-args)
#!+sb-doc
"If LVAR is a call to FUN with NUM-ARGS args, change those arguments
to feed directly to the LVAR-DEST of LVAR, which must be a
(flush-dest lvar)
(values))))))
+(defun extract-fun-args (lvar fun num-args)
+ (declare (type lvar lvar)
+ (type (or symbol list) fun)
+ (type index num-args))
+ (let ((fun (if (listp fun) fun (list fun))))
+ (let ((inside (lvar-uses lvar)))
+ (unless (combination-p inside)
+ (give-up-ir1-transform))
+ (let ((inside-fun (combination-fun inside)))
+ (unless (member (lvar-fun-name inside-fun) fun)
+ (give-up-ir1-transform))
+ (let ((inside-args (combination-args inside)))
+ (unless (= (length inside-args) num-args)
+ (give-up-ir1-transform))
+ (values (lvar-fun-name inside-fun) inside-args))))))
+
(defun flush-combination (combination)
(declare (type combination combination))
(flush-dest (combination-fun combination))