From 0233f99f7ed5f30777e323ac243e6f9198ee0a51 Mon Sep 17 00:00:00 2001 From: Sebastian Melzer Date: Wed, 7 May 2025 16:52:10 +0200 Subject: [PATCH] Allow inlining a function within its own argument forms NX1-EXPAND-INLINE overzealously protects not just the body but also the argument forms from (mutually) recursive inlining. As a result, only the outer call is inlined in calls like (F X (F Y Z)). --- compiler/nx0.lisp | 7 +++---- compiler/nx1.lisp | 32 ++++++++++++++++++++++---------- 2 files changed, 25 insertions(+), 14 deletions(-) diff --git a/compiler/nx0.lisp b/compiler/nx0.lisp index 2a3d20a61..95e3583c9 100644 --- a/compiler/nx0.lisp +++ b/compiler/nx0.lisp @@ -2441,8 +2441,7 @@ Or something. Right? ~s ~s" var varbits)) (if (and (or (null spread-p) (eq (length args) 1))) (if (and token (not (memq token *nx-inline-expansions*))) (with-program-error-handler (lambda (c) (declare (ignore c)) nil) - (let* ((*nx-inline-expansions* (cons token *nx-inline-expansions*)) - (lambda-list (cadr lambda-form)) + (let* ((lambda-list (cadr lambda-form)) (body (cddr lambda-form)) (new-env (new-lexical-environment env))) (setf (lexenv.mdecls new-env) @@ -2452,8 +2451,8 @@ Or something. Right? ~s ~s" var varbits)) (compilation-speed . ,(compilation-speed-optimize-quantity old-env)) (debug . ,(debug-optimize-quantity old-env)))) (if spread-p - (nx1-destructure context lambda-list (car args) nil nil body new-env) - (nx1-lambda-bind context lambda-list args body new-env))))))) + (nx1-destructure context lambda-list (car args) nil nil body new-env token) + (nx1-lambda-bind context lambda-list args body new-env token))))))) ; note that regforms are reversed: arg_z is always in the car (defun nx1-arglist (args &optional (nregargs (backend-num-arg-regs *target-backend*))) diff --git a/compiler/nx1.lisp b/compiler/nx1.lisp index d9d90ecc5..3b6492152 100644 --- a/compiler/nx1.lisp +++ b/compiler/nx1.lisp @@ -642,7 +642,7 @@ ;;; not present in the current environment (and which does -not- generally ;;; contain whatever randomness is floating around at the point of ;;; application.) -(defun nx1-destructure (context lambda-list bindform cdr-p &whole-allowed-p forms &optional (body-env *nx-lexical-environment*)) +(defun nx1-destructure (context lambda-list bindform cdr-p &whole-allowed-p forms &optional (body-env *nx-lexical-environment*) inline-token) (declare (ignore cdr-p)) (let* ((old-env body-env) (*nx-bound-vars* *nx-bound-vars*) @@ -662,11 +662,14 @@ (let* ((acode (make-acode (%nx1-operator let*) (list temp-var) (list bindform) - (nx1-env-body context - `((destructuring-bind ,lambda-list ,temp-name - ,@decls - ,@body)) - old-env) + (let ((*nx-inline-expansions* (if inline-token + (cons inline-token *nx-inline-expansions*) + *nx-inline-expansions*))) + (nx1-env-body context + `((destructuring-bind ,lambda-list ,temp-name + ,@decls + ,@body)) + old-env)) *nx-new-p2decls*))) (nx1-check-var-bindings var-bound-vars) (nx1-punt-bindings vars vals) @@ -1923,10 +1926,13 @@ ;((lambda (lambda-list) . body) . args) -(defun nx1-lambda-bind (context lambda-list args body &optional (body-environment *nx-lexical-environment*)) +(defun nx1-lambda-bind (context lambda-list args body &optional (body-environment *nx-lexical-environment*) inline-token) (let* ((old-env body-environment) (arg-env *nx-lexical-environment*) (arglist nil) + (new-inline-expansions (if inline-token + (cons inline-token *nx-inline-expansions*) + *nx-inline-expansions*)) var-bound-vars vars vals vars* vals*) ;; If the lambda list contains &LEXPR, we can't do it. Yet. @@ -1935,14 +1941,19 @@ (when (and ok (or (eq (%car resttail) '&lexpr) ;*backend-use-linear-scan* (eq (%car keytail) '&key))) - (return-from nx1-lambda-bind (nx1-call context (nx1-form context `(lambda ,lambda-list ,@body)) args)))) + (let ((*nx-inline-expansions* new-inline-expansions)) + (return-from nx1-lambda-bind + (nx1-call context (nx1-form context `(lambda ,lambda-list ,@body)) args))))) (let* ((*nx-lexical-environment* body-environment) (*nx-bound-vars* *nx-bound-vars*)) (with-nx-declarations (pending) (multiple-value-bind (body decls) (parse-body body *nx-lexical-environment*) (nx-process-declarations pending decls) (multiple-value-bind (req opt rest keys auxen) - (nx-parse-simple-lambda-list pending lambda-list) + ;; This generates the default initforms for optional/key/aux + ;; arguments, which are part of the function's expansion. + (let ((*nx-inline-expansions* new-inline-expansions)) + (nx-parse-simple-lambda-list pending lambda-list)) (let* ((*nx-lexical-environment* arg-env)) (setq arglist (nx1-formlist context args))) (nx-effect-other-decls pending *nx-lexical-environment*) @@ -1955,7 +1966,8 @@ (push var vars) (push val vals) (when binding (push binding var-bound-vars)))) - (setq body (nx1-env-body context body old-env)) + (let ((*nx-inline-expansions* new-inline-expansions)) + (setq body (nx1-env-body context body old-env))) (nx1-check-var-bindings var-bound-vars) (nx1-punt-bindings vars vals) (destructuring-bind (&optional optvars inits spvars) opt