Skip to content

Allow inlining a function within its own argument forms #534

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
se-mz wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Allow inlining a function within its own argument forms #534

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 3 additions & 4 deletions compiler/nx0.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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*)))
Expand Down
32 changes: 22 additions & 10 deletions compiler/nx1.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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*)
Expand All @@ -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)
Expand Down Expand Up @@ -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.
Expand All @@ -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*)
Expand All @@ -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
Expand Down