From 57beb4c52cc1f6a51e0e69cf05c093bfa641e9c6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?David=20V=C3=A1zquez=20P=C3=BAa?= Date: Tue, 17 Feb 2026 21:48:36 +0100 Subject: [PATCH 1/3] Intrastructure to make the compiler support statements --- docs/compiler.md | 48 ++++++++++ src/compiler/compiler.lisp | 187 ++++++++++++++++++++++++++++--------- 2 files changed, 189 insertions(+), 46 deletions(-) diff --git a/docs/compiler.md b/docs/compiler.md index cfafc880..5831520c 100644 --- a/docs/compiler.md +++ b/docs/compiler.md @@ -110,3 +110,51 @@ state so the caller can inspect or save it. This is used when the compiler needs to **observe** the secondary values rather than just propagate them. + +## Targets + +`*target*` tells a compilation handler how the result should be +delivered. Handlers see three targets: + +- `:return` — emit a return statement +- `(:assign v)` — assign to the JS variable `v` +- `:discard` — execute for side effects only + +Callers of `convert` may also request `:expression` (the default), +but `convert` translates this to `(:assign tmp)` before calling +`convert-1`, so handlers never see it directly. + +### The `convert` functions + +- **`(convert sexp &key multiple-value-p target)`** — compile a + subform whose value is needed in the given target. +- **`(convert-tail sexp &key target)`** — compile a subform in tail + position, preserving the current `*multiple-value-p*`. +- **`(convert-for-value sexp &optional multiple-value-p)`** — compile + a subform and return `(values preceding-stmts js-expression)`, + introducing a temporary variable if needed. + +### Writing compilation handlers + +Handlers fall into two categories: + +**Leaf compilations** Some compilation are very simple, like symbol +variables, constants, etc. They do not have subforms, or they will +most likely be constants. For these, it makes sense to return +expression: + +```lisp +(define-builtin car (x) + `(get ,x "$$jscl_car")) +``` + +**Propagator compilations** have a subforms that are likely to compile +to statements. In this case, it is better to compose them and continue +returning statements. + +For example, `if`, + +```lisp +(define-compilation if (condition true &optional false) + ...) +``` diff --git a/src/compiler/compiler.lisp b/src/compiler/compiler.lisp index 0c090020..a7859325 100644 --- a/src/compiler/compiler.lisp +++ b/src/compiler/compiler.lisp @@ -55,6 +55,23 @@ ;;; function call. (defvar *multiple-value-p* nil) +;;; The target specifies how the compiled form's result should be +;;; delivered. It is set by `convert' and `convert-1' so that +;;; compilation handlers can read it. Handlers only see: +;;; +;;; :return -- emit a return statement +;;; :discard -- the value is unused (side effects only) +;;; (:assign V) -- emit an assignment to the JS variable V +;;; +;;; The :expression target is never passed to handlers; `convert' +;;; translates it to (:assign tmp) before calling `convert-1'. +;;; +;;; Legacy handlers ignore *target* and always produce an expression. +;;; `convert' adapts it to the target automatically. Migrated +;;; handlers may read *target* and return (values ast :block) to +;;; emit statements directly. +(defvar *target* :expression) + ;;; When in multiple-value position, wrap JSEXPR in a values1() call ;;; to clear _mv signaling a single return value. In non-MV position, ;;; return JSEXPR unchanged. @@ -278,10 +295,10 @@ (define-compilation if (condition true &optional false) (multiple-value-bind (value constantp) (constant-value condition *environment*) (if constantp - (convert (if value true false) *multiple-value-p*) + (convert-tail (if value true false)) `(if (!== ,(convert condition) ,(convert nil)) - ,(convert true *multiple-value-p*) - ,(convert false *multiple-value-p*))))) + ,(convert-tail true) + ,(convert-tail false))))) (defvar *ll-keywords* '(&optional &rest &key &allow-other-keys)) @@ -1001,7 +1018,7 @@ ;; capture it in a closure. (if multiple-value-p `(selfcall - (var (_r (call-internal |withMV| (function () (return ,(convert value t)))))) + (var (_r (call-internal |withMV| (function () (return ,(convert value :multiple-value-p t)))))) (throw (new (call-internal |BlockNLX| ,(binding-value b) (get _r "result") @@ -1030,7 +1047,7 @@ (define-compilation throw (id value) `(selfcall - (var (_r (call-internal |withMV| (function () (return ,(convert value t)))))) + (var (_r (call-internal |withMV| (function () (return ,(convert value :multiple-value-p t)))))) (throw (new (call-internal |CatchNLX| ,(convert id) (get _r "result") @@ -1102,7 +1119,7 @@ `(selfcall (var _r) (try - (= _r (call-internal |withMV| (function () (return ,(convert form t)))))) + (= _r (call-internal |withMV| (function () (return ,(convert form :multiple-value-p t)))))) (finally ,(convert-block clean-up)) (= (internal |_mv|) (get _r "mv")) @@ -1123,7 +1140,7 @@ (progn ,@(with-collect (dolist (form forms) - (collect `(= _r (call-internal |withMV| (function () (return ,(convert form t)))))) + (collect `(= _r (call-internal |withMV| (function () (return ,(convert form :multiple-value-p t)))))) (collect `(if (!== (get _r "mv") null) (= args (method-call args "concat" (get _r "mv"))) (method-call args "push" (get _r "result"))))))) @@ -1132,7 +1149,7 @@ (define-compilation multiple-value-prog1 (first-form &rest forms) (if *multiple-value-p* `(selfcall - (var (_r (call-internal |withMV| (function () (return ,(convert first-form t)))))) + (var (_r (call-internal |withMV| (function () (return ,(convert first-form :multiple-value-p t)))))) (progn ,@(mapcar #'convert forms)) (= (internal |_mv|) (get _r "mv")) (return (get _r "result"))) @@ -1142,7 +1159,7 @@ (return result)))) (define-compilation the (value-type form) - (convert form *multiple-value-p*)) + (convert-tail form)) ;;; Primitives @@ -1798,24 +1815,27 @@ (error "Bad function descriptor"))))) -(defun convert (sexp &optional multiple-value-p) +(defun convert-1 (sexp &optional multiple-value-p (target :expression)) (multiple-value-bind (sexp expandedp) (!macroexpand-1 (compiler-macroexpand sexp) *environment*) (when expandedp - (return-from convert (convert sexp multiple-value-p))) + (return-from convert-1 (convert-1 sexp multiple-value-p target))) ;; The expression has been macroexpanded. Now compile it! - (let ((*multiple-value-p* multiple-value-p)) + (let ((*multiple-value-p* multiple-value-p) + (*target* target)) (cond ((symbolp sexp) (let ((b (lookup-in-lexenv sexp *environment* 'variable))) - (cond - ((and b (not (member 'special (binding-declarations b)))) - (value1 (binding-value b))) - ((or (keywordp sexp) - (and b (member 'constant (binding-declarations b)))) - (value1 `(get ,(convert `',sexp) "value"))) - (t - (convert `(symbol-value ',sexp)))))) + (values + (cond + ((and b (not (member 'special (binding-declarations b)))) + (value1 (binding-value b))) + ((or (keywordp sexp) + (and b (member 'constant (binding-declarations b)))) + (value1 `(get ,(convert `',sexp) "value"))) + (t + (convert `(symbol-value ',sexp)))) + :expression))) ((listp sexp) (let* ((name (car sexp)) (args (cdr sexp))) @@ -1823,15 +1843,86 @@ ;; Special forms ((gethash name *compilations*) (let ((comp (gethash name *compilations*))) - (apply comp args))) + ;; Migrated handlers return (values ast :block). + ;; Legacy handlers return just ast; kind defaults to nil. + (multiple-value-bind (ast kind) (apply comp args) + (values ast (or kind :expression))))) ;; Built-in functions ((and (gethash name *builtins*) (not (claimp name 'function 'notinline))) - (apply (gethash name *builtins*) args)) + (values (apply (gethash name *builtins*) args) :expression)) (t - (compile-funcall name args))))) + (values (compile-funcall name args) :expression))))) (t - (value1 (literal sexp))))))) + (values (value1 (literal sexp)) :expression)))))) + +;;; Compile SEXP to JavaScript AST. +;;; +;;; MULTIPLE-VALUE-P controls whether the compiled code must preserve +;;; multiple values (see *multiple-value-p*). Defaults to NIL, meaning +;;; only the primary value matters. +;;; +;;; TARGET controls how the result is delivered (see *target*). +;;; Possible values: +;;; +;;; :expression -- return a JS expression (the default). Handlers +;;; never see this target; `convert' translates it +;;; to (:assign tmp) before calling `convert-1'. +;;; :return -- emit a return statement +;;; :discard -- the value is unused (side effects only) +;;; (:assign V) -- emit an assignment to the JS variable V +;;; +;;; Most internal call sites use plain (convert subform) for subforms +;;; whose value is consumed as an expression. Use `convert-tail' for +;;; subforms in tail position, and `convert-for-value' when you need +;;; to separate preceding statements from a value expression. +(defun convert (sexp &key multiple-value-p (target :expression)) + (if (eq target :expression) + ;; Expression target: we call convert-1 with (:assign tmp) so + ;; that handlers never see :expression as the target. + ;; + ;; We use convert-1 (not convert) deliberately: convert would + ;; always produce an assignment statement, forcing every + ;; expression into a selfcall IIFE — even simple ones like + ;; variable references or (car x). By calling convert-1, we + ;; can inspect the kind: legacy handlers ignore the target and + ;; return :expression, letting us use the expression directly + ;; without an IIFE. Migrated handlers honor the (:assign tmp) + ;; target and return :block, which we wrap in a selfcall. + (let ((tmp (gvarname 'tmp))) + (multiple-value-bind (ast kind) + (convert-1 sexp multiple-value-p `(:assign ,tmp)) + (ecase kind + (:expression ast) + (:block `(selfcall (var ,tmp) ,ast (return ,tmp)))))) + ;; Statement targets: pass through directly. + (multiple-value-bind (ast kind) (convert-1 sexp multiple-value-p target) + (ecase kind + (:expression + (ecase (if (consp target) :assign target) + (:return `(return ,ast)) + (:assign `(= ,(cadr target) ,ast)) + (:discard ast))) + (:block ast))))) + +;;; Like `convert', but preserves the current `*multiple-value-p*'. +;;; Use this when compiling a subform that is in tail position with +;;; respect to the enclosing form (e.g. branches of IF, last form +;;; of PROGN). +(defun convert-tail (sexp &key (target :expression)) + (convert sexp :multiple-value-p *multiple-value-p* :target target)) + +;;; Compile SEXP and return (values preceding-stmts js-expression). +;;; If the handler produces an expression, preceding-stmts is NIL. +;;; If it produces a block, a temporary variable is introduced and +;;; the block assigns to it. +(defun convert-for-value (sexp &optional multiple-value-p) + (let ((tmp (gvarname 'tmp))) + (multiple-value-bind (ast kind) + (convert-1 sexp multiple-value-p `(:assign ,tmp)) + (if (eq kind :expression) + (values nil ast) + (values `(progn (var ,tmp) ,ast) tmp))))) (defun convert-block (sexps &optional return-last-p decls-allowed-p) @@ -1840,11 +1931,12 @@ (declare (ignore decls)) (if return-last-p `(progn - ,@(mapcar #'convert (butlast sexps)) - (return ,(convert (car (last sexps)) *multiple-value-p*))) + ,@(mapcar (lambda (form) (convert form :target :discard)) + (butlast sexps)) + ,(convert-tail (car (last sexps)) :target :return)) `(progn - ,@(append (mapcar #'convert (butlast sexps)) - (list (convert (car (last sexps)) *multiple-value-p*))))))) + ,@(mapcar #'convert (butlast sexps)) + ,@(list (convert-tail (car (last sexps)))))))) ;;; Process a list of toplevel forms. The last form inherits LAST-P; @@ -1950,12 +2042,14 @@ (process-toplevel-form sexp (lambda (form last-p) (let* ((*toplevel-compilations* nil) - (code (convert form (and last-p multiple-value-p))) + (code (if (and last-p return-p) + (convert form :target :return + :multiple-value-p (and last-p multiple-value-p)) + (convert form :multiple-value-p + (and last-p multiple-value-p)))) (ast `(progn ,@(get-toplevel-compilations) - ,(if (and last-p return-p) - `(return ,code) - code)))) + ,code))) (js ast))) t))))) @@ -2001,20 +2095,21 @@ compiler.lisp for details." (with-compilation-environment (%with-compilation-unit () (let* ((*toplevel-compilations* nil) - (code (convert form last-p)) - (ast `(progn - ,@(get-toplevel-compilations) - (return ,code))) - (jscode (with-output-to-string (*js-output*) - (js ast))) - (literals (let ((vec (make-array *literal-counter*))) - (maphash (lambda (sexp entry) - (setf (aref vec (car entry)) sexp)) - *literal-table*) - vec))) - #+jscl-target (setq result-mv - (multiple-value-list (js-eval jscode literals))) - #-jscl-target (error "eval-toplevel: cannot execute in cross-compiler"))))) + (code (convert form :target :return + :multiple-value-p last-p)) + (ast `(progn + ,@(get-toplevel-compilations) + ,code)) + (jscode (with-output-to-string (*js-output*) + (js ast))) + (literals (let ((vec (make-array *literal-counter*))) + (maphash (lambda (sexp entry) + (setf (aref vec (car entry)) sexp)) + *literal-table*) + vec))) + #+jscl-target (setq result-mv + (multiple-value-list (js-eval jscode literals))) + #-jscl-target (error "eval-toplevel: cannot execute in cross-compiler"))))) t) (values-list result-mv))) From ae57de06a6da5860f892a749cdea1b88d0ded1fd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?David=20V=C3=A1zquez=20P=C3=BAa?= Date: Wed, 18 Feb 2026 08:56:37 +0100 Subject: [PATCH 2/3] Add js-expression-p and update compiler infrastructure for statement support Add js-expression-p to codegen to classify AST nodes as expressions or statements, replacing the explicit :expression/:block kind return from convert-1. Update convert, convert-tail, convert-for-value, and convert-block to use the new classification. Add emit-for-target helper and JS let statement support. Use ? instead of if for ternary expressions in convert-to-bool and jsbool to maintain expression semantics. --- docs/compiler.md | 37 ++++++--- src/compiler/codegen.lisp | 17 +++- src/compiler/compiler.lisp | 162 ++++++++++++++++++++----------------- 3 files changed, 129 insertions(+), 87 deletions(-) diff --git a/docs/compiler.md b/docs/compiler.md index 5831520c..f099bfbc 100644 --- a/docs/compiler.md +++ b/docs/compiler.md @@ -129,32 +129,49 @@ but `convert` translates this to `(:assign tmp)` before calling - **`(convert sexp &key multiple-value-p target)`** — compile a subform whose value is needed in the given target. - **`(convert-tail sexp &key target)`** — compile a subform in tail - position, preserving the current `*multiple-value-p*`. + position, preserving the current `*multiple-value-p*` and + defaulting to the current `*target*`. - **`(convert-for-value sexp &optional multiple-value-p)`** — compile a subform and return `(values preceding-stmts js-expression)`, introducing a temporary variable if needed. +### Expression vs statement detection + +`convert` determines whether a handler's result is a JS expression or +a JS statement by calling `js-expression-p` (in codegen.lisp) on the +returned AST. Statement-only operators (`return`, `var`, `group`, +`if`, `while`, `try`, `throw`, etc.) are classified as statements; +everything else is an expression. + +To keep this unambiguous: +- Use `?` for ternary expressions, `if` for if-statements. +- Use `progn` for expression sequences (comma operator), `group` for + statement blocks. + ### Writing compilation handlers Handlers fall into two categories: -**Leaf compilations** Some compilation are very simple, like symbol -variables, constants, etc. They do not have subforms, or they will -most likely be constants. For these, it makes sense to return -expression: +**Leaf handlers** compute their result directly. Sub-forms (if any) +are compiled via `convert` or `convert-for-value`. The handler +returns a JS expression AST and `convert` adapts it to the target +automatically. ```lisp (define-builtin car (x) `(get ,x "$$jscl_car")) ``` -**Propagator compilations** have a subforms that are likely to compile -to statements. In this case, it is better to compose them and continue -returning statements. +**Propagator handlers** delegate to a sub-form in result (tail) +position by passing `*target*` through via `convert-tail`. They +produce JS statements and `convert` uses them as-is. -For example, `if`, +For example, `if` propagates the target to both branches via +`convert-tail` (which defaults to `*target*`): ```lisp (define-compilation if (condition true &optional false) - ...) + `(if (!== ,(convert condition) ,(convert nil)) + ,(convert-tail true) + ,(convert-tail false))) ``` diff --git a/src/compiler/codegen.lisp b/src/compiler/codegen.lisp index 63cee20e..aec08f63 100644 --- a/src/compiler/codegen.lisp +++ b/src/compiler/codegen.lisp @@ -437,6 +437,19 @@ +;;; Returns T if FORM is a JS expression AST node, NIL if it is a +;;; statement. `if' is always a statement (use `?' for ternary). +;;; `progn' is always an expression (comma operator); use `group' for +;;; statement sequences. +(defun js-expression-p (form) + (cond + ((atom form) t) + ((vectorp form) t) + (t (not (member (car form) + '(return var let group if while switch for for-in + try catch finally throw label break)))))) + + ;;; Statements generators ;;; ;;; `js-stmt' generates code for Javascript statements. A form is @@ -494,7 +507,7 @@ (js-format "return ") (js-expr value) (js-end-stmt))) - (var + ((var let) (flet ((js-var (spec) (destructuring-bind (variable &optional initial) (ensure-list spec) @@ -503,7 +516,7 @@ (js-format "=") (js-expr initial no-comma))))) (destructuring-bind (var &rest vars) (cdr form) - (js-format "var ") + (js-format (if (eq (car form) 'let) "let " "var ")) (js-var var) (dolist (var vars) (js-format ",") diff --git a/src/compiler/compiler.lisp b/src/compiler/compiler.lisp index a7859325..1ed81a25 100644 --- a/src/compiler/compiler.lisp +++ b/src/compiler/compiler.lisp @@ -44,7 +44,7 @@ (defun convert-to-bool (expr) - `(if ,expr ,(convert t) ,(convert nil))) + `(? ,expr ,(convert t) ,(convert nil))) ;;; A Form can return a multiple values object calling VALUES, like @@ -66,12 +66,19 @@ ;;; The :expression target is never passed to handlers; `convert' ;;; translates it to (:assign tmp) before calling `convert-1'. ;;; -;;; Legacy handlers ignore *target* and always produce an expression. +;;; Legacy handlers ignore *target* and always produce a JS expression. ;;; `convert' adapts it to the target automatically. Migrated -;;; handlers may read *target* and return (values ast :block) to -;;; emit statements directly. +;;; handlers read *target* and produce a JS statement (detected by +;;; `js-expression-p' in codegen). (defvar *target* :expression) +;;; Deliver a JS expression via the current *target*. +(defun emit-for-target (expr) + (ecase (if (consp *target*) :assign *target*) + (:return `(return ,expr)) + (:assign `(= ,(cadr *target*) ,expr)) + (:discard expr))) + ;;; When in multiple-value position, wrap JSEXPR in a values1() call ;;; to clear _mv signaling a single return value. In non-MV position, ;;; return JSEXPR unchanged. @@ -571,8 +578,8 @@ ,(bind-this) ,(let ((*multiple-value-p* t)) (if block - (convert-block `((block ,block ,@body)) t) - (convert-block body t))))))))) + (convert-block `((block ,block ,@body)) :return) + (convert-block body :return))))))))) (defun setq-pair (var val) @@ -779,7 +786,7 @@ *environment* 'function))) `(call (function ,(mapcar #'translate-function fnames) - ,(convert-block body t t)) + ,(convert-block body :return t)) ,@cfuncs))) (define-compilation labels (definitions &rest body) @@ -794,34 +801,34 @@ ,(compile-lambda (cadr func) `((block ,(car func) ,@(cddr func))))))) definitions) - ,(convert-block body t t)))) + ,(convert-block body :return t)))) (define-compilation progn (&rest body) ;; Note that this is only called for non toplevel forms. - (convert-block body nil nil)) + (convert-block body)) (define-compilation locally (&rest body) ;; Note that this is only called for non toplevel forms. (let ((*environment* (copy-lexenv *environment*))) - (convert-block body nil t))) + (convert-block body :expression t))) (define-compilation macrolet (definitions &rest body) ;; Note that this is only called for non toplevel forms. (let ((*environment* (extend-macrolet-env definitions))) - (convert-block body nil t))) + (convert-block body :expression t))) (define-compilation symbol-macrolet (macrobindings &rest body) ;; Note that this is only called for non toplevel forms. (let ((*environment* (extend-symbol-macrolet-env macrobindings))) - `(progn ,(convert-block body nil t)))) + (convert-block body :expression t))) (define-compilation eval-when (situations &rest body) ;; Note that this is only called for non toplevel forms. ;; So only :execute matters (CLHS 3.2.3.1) (if (or (find :execute situations) (find 'eval situations)) - (convert-block body nil t) + (convert-block body :expression t) (convert nil))) @@ -867,14 +874,14 @@ ;;; the old value. (defun let-bind-dynamic-vars (special-bindings body) (if (null special-bindings) - (convert-block body t t) + (convert-block body :return t) (let ((special-variables (mapcar #'car special-bindings)) (lexical-variables (mapcar #'cdr special-bindings))) `(return (call-internal |bindSpecialBindings| ,(list-to-vector (mapcar #'literal special-variables)) ,(list-to-vector (mapcar #'translate-variable lexical-variables)) - (function () ,(convert-block body t t))))))) + (function () ,(convert-block body :return t))))))) (define-compilation let (bindings &rest body) @@ -967,7 +974,7 @@ (let ((body `(progn ,@(reverse prelude-target) - ,(convert-block body t t)))) + ,(convert-block body :return t)))) (if (find-if #'special-variable-p bindings :key #'first) `(selfcall @@ -990,7 +997,7 @@ (when *multiple-value-p* (push 'multiple-value (binding-declarations b))) (let* ((*environment* (extend-lexenv (list b) *environment* 'block)) - (cbody (convert-block body t))) + (cbody (convert-block body :return))) (if (member 'used (binding-declarations b)) `(selfcall (try @@ -1035,7 +1042,7 @@ `(selfcall (var (id ,(convert id))) (try - ,(convert-block body t)) + ,(convert-block body :return)) (catch (cf) (if (and (instanceof cf (internal |CatchNLX|)) (== (get cf "id") id)) ,(if *multiple-value-p* @@ -1569,9 +1576,9 @@ (multiple-value-bind (value constantp) (constant-value x *environment*) (if constantp (if value 'true 'false) - `(if (!== ,(convert x) ,(convert nil)) - true - false)))) + `(? (!== ,(convert x) ,(convert nil)) + true + false)))) (define-builtin jsnull () 'null) @@ -1677,7 +1684,7 @@ (let* ((*environment* (extend-local-env (list var))) (tvar (translate-variable var))) `(catch (,tvar) - ,(convert-block body t)))))) + ,(convert-block body :return)))))) (finally-compilation (and finally-form @@ -1826,35 +1833,29 @@ (cond ((symbolp sexp) (let ((b (lookup-in-lexenv sexp *environment* 'variable))) - (values - (cond - ((and b (not (member 'special (binding-declarations b)))) - (value1 (binding-value b))) - ((or (keywordp sexp) - (and b (member 'constant (binding-declarations b)))) - (value1 `(get ,(convert `',sexp) "value"))) - (t - (convert `(symbol-value ',sexp)))) - :expression))) + (cond + ((and b (not (member 'special (binding-declarations b)))) + (value1 (binding-value b))) + ((or (keywordp sexp) + (and b (member 'constant (binding-declarations b)))) + (value1 `(get ,(convert `',sexp) "value"))) + (t + (convert `(symbol-value ',sexp)))))) ((listp sexp) (let* ((name (car sexp)) (args (cdr sexp))) (cond ;; Special forms ((gethash name *compilations*) - (let ((comp (gethash name *compilations*))) - ;; Migrated handlers return (values ast :block). - ;; Legacy handlers return just ast; kind defaults to nil. - (multiple-value-bind (ast kind) (apply comp args) - (values ast (or kind :expression))))) + (apply (gethash name *compilations*) args)) ;; Built-in functions ((and (gethash name *builtins*) (not (claimp name 'function 'notinline))) - (values (apply (gethash name *builtins*) args) :expression)) + (apply (gethash name *builtins*) args)) (t - (values (compile-funcall name args) :expression))))) + (compile-funcall name args))))) (t - (values (value1 (literal sexp)) :expression)))))) + (value1 (literal sexp))))))) ;;; Compile SEXP to JavaScript AST. ;;; @@ -1885,58 +1886,69 @@ ;; always produce an assignment statement, forcing every ;; expression into a selfcall IIFE — even simple ones like ;; variable references or (car x). By calling convert-1, we - ;; can inspect the kind: legacy handlers ignore the target and - ;; return :expression, letting us use the expression directly - ;; without an IIFE. Migrated handlers honor the (:assign tmp) - ;; target and return :block, which we wrap in a selfcall. + ;; let js-expression-p inspect the result: legacy handlers + ;; ignore the target and return a JS expression, which we use + ;; directly without an IIFE. Migrated handlers honor the + ;; (:assign tmp) target and return a JS statement, which we + ;; wrap in a selfcall. (let ((tmp (gvarname 'tmp))) - (multiple-value-bind (ast kind) - (convert-1 sexp multiple-value-p `(:assign ,tmp)) - (ecase kind - (:expression ast) - (:block `(selfcall (var ,tmp) ,ast (return ,tmp)))))) + (let ((ast (convert-1 sexp multiple-value-p `(:assign ,tmp)))) + (cond + ;; Handler produced (= tmp expr) — the target propagated + ;; through a simple delegation (e.g. convert-tail) and the + ;; sub-form was a plain expression. Extract the value. + ;; Unwrap multiple layers for cascaded delegation (e.g. + ;; nested constant-folded IF). + ((and (consp ast) (eq (car ast) '=) (eq (cadr ast) tmp)) + (do ((expr (caddr ast) (caddr expr))) + ((not (and (consp expr) (eq (car expr) '=) (eq (cadr expr) tmp))) + expr))) + ;; Legacy handler ignored the target — plain expression. + ((js-expression-p ast) ast) + ;; Migrated handler honored the target — wrap in selfcall. + (t `(selfcall (let ,tmp) ,ast (return ,tmp)))))) ;; Statement targets: pass through directly. - (multiple-value-bind (ast kind) (convert-1 sexp multiple-value-p target) - (ecase kind - (:expression - (ecase (if (consp target) :assign target) - (:return `(return ,ast)) - (:assign `(= ,(cadr target) ,ast)) - (:discard ast))) - (:block ast))))) - -;;; Like `convert', but preserves the current `*multiple-value-p*'. -;;; Use this when compiling a subform that is in tail position with -;;; respect to the enclosing form (e.g. branches of IF, last form -;;; of PROGN). -(defun convert-tail (sexp &key (target :expression)) + (let ((ast (convert-1 sexp multiple-value-p target))) + (if (js-expression-p ast) + ;; Legacy handler ignored the target — adapt the expression. + (ecase (if (consp target) :assign target) + (:return `(return ,ast)) + (:assign `(= ,(cadr target) ,ast)) + (:discard ast)) + ;; Migrated handler honored the target — use as-is. + ast)))) + +;;; Like `convert', but preserves the current `*multiple-value-p*' +;;; and defaults to the current `*target*'. Use this when compiling +;;; a subform in tail position (e.g. branches of IF, last form of +;;; PROGN). +(defun convert-tail (sexp &key (target *target*)) (convert sexp :multiple-value-p *multiple-value-p* :target target)) ;;; Compile SEXP and return (values preceding-stmts js-expression). ;;; If the handler produces an expression, preceding-stmts is NIL. -;;; If it produces a block, a temporary variable is introduced and -;;; the block assigns to it. +;;; If it produces a statement block, a temporary variable is +;;; introduced and the block assigns to it. (defun convert-for-value (sexp &optional multiple-value-p) (let ((tmp (gvarname 'tmp))) - (multiple-value-bind (ast kind) - (convert-1 sexp multiple-value-p `(:assign ,tmp)) - (if (eq kind :expression) + (let ((ast (convert-1 sexp multiple-value-p `(:assign ,tmp)))) + (if (js-expression-p ast) (values nil ast) - (values `(progn (var ,tmp) ,ast) tmp))))) + (values `(group (let ,tmp) ,ast) tmp))))) -(defun convert-block (sexps &optional return-last-p decls-allowed-p) +(defun convert-block (sexps &optional (last-target :expression) decls-allowed-p) (multiple-value-bind (sexps decls) (parse-body sexps :declarations decls-allowed-p) (declare (ignore decls)) - (if return-last-p + (if (eq last-target :expression) `(progn + ,@(mapcar #'convert (butlast sexps)) + ,@(list (convert-tail (car (last sexps)) :target :expression))) + `(group ,@(mapcar (lambda (form) (convert form :target :discard)) (butlast sexps)) - ,(convert-tail (car (last sexps)) :target :return)) - `(progn - ,@(mapcar #'convert (butlast sexps)) - ,@(list (convert-tail (car (last sexps)))))))) + ,(convert-tail (car (last sexps)) :target last-target))))) ;;; Process a list of toplevel forms. The last form inherits LAST-P; From 93f7dff8286d660758fdbeb8ebbc2a026b4e1832 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?David=20V=C3=A1zquez=20P=C3=BAa?= Date: Wed, 18 Feb 2026 09:18:54 +0100 Subject: [PATCH 3/3] Simplifications --- src/compiler/compiler.lisp | 20 ++++---------------- 1 file changed, 4 insertions(+), 16 deletions(-) diff --git a/src/compiler/compiler.lisp b/src/compiler/compiler.lisp index 1ed81a25..bff99777 100644 --- a/src/compiler/compiler.lisp +++ b/src/compiler/compiler.lisp @@ -1875,8 +1875,7 @@ ;;; ;;; Most internal call sites use plain (convert subform) for subforms ;;; whose value is consumed as an expression. Use `convert-tail' for -;;; subforms in tail position, and `convert-for-value' when you need -;;; to separate preceding statements from a value expression. +;;; subforms in tail position. (defun convert (sexp &key multiple-value-p (target :expression)) (if (eq target :expression) ;; Expression target: we call convert-1 with (:assign tmp) so @@ -1925,30 +1924,19 @@ (defun convert-tail (sexp &key (target *target*)) (convert sexp :multiple-value-p *multiple-value-p* :target target)) -;;; Compile SEXP and return (values preceding-stmts js-expression). -;;; If the handler produces an expression, preceding-stmts is NIL. -;;; If it produces a statement block, a temporary variable is -;;; introduced and the block assigns to it. -(defun convert-for-value (sexp &optional multiple-value-p) - (let ((tmp (gvarname 'tmp))) - (let ((ast (convert-1 sexp multiple-value-p `(:assign ,tmp)))) - (if (js-expression-p ast) - (values nil ast) - (values `(group (let ,tmp) ,ast) tmp))))) - -(defun convert-block (sexps &optional (last-target :expression) decls-allowed-p) +(defun convert-block (sexps &optional (target :expression) decls-allowed-p) (multiple-value-bind (sexps decls) (parse-body sexps :declarations decls-allowed-p) (declare (ignore decls)) - (if (eq last-target :expression) + (if (eq target :expression) `(progn ,@(mapcar #'convert (butlast sexps)) ,@(list (convert-tail (car (last sexps)) :target :expression))) `(group ,@(mapcar (lambda (form) (convert form :target :discard)) (butlast sexps)) - ,(convert-tail (car (last sexps)) :target last-target))))) + ,(convert-tail (car (last sexps)) :target target))))) ;;; Process a list of toplevel forms. The last form inherits LAST-P;