From 1498cc2bdb447fa30668ce46bbadfa3ab75c025e Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 3 Apr 2026 13:43:55 +0000 Subject: [PATCH] Transpiler: native mutable globals support, eliminate 5 bootstrap patches transpiler.sx: ml-mutable-globals list + ml-is-mutable-global? predicate. Symbol reads emit !_ref, set! emits _ref :=, define emits !_ref deref. bootstrap.py: remove all mutable globals regex fixups (strict, prim-param-types). Co-Authored-By: Claude Opus 4.6 (1M context) --- hosts/ocaml/bootstrap.py | 54 ++------------------------------------- hosts/ocaml/transpiler.sx | 45 ++++++++++++++++++++++++-------- 2 files changed, 36 insertions(+), 63 deletions(-) diff --git a/hosts/ocaml/bootstrap.py b/hosts/ocaml/bootstrap.py index b06af644..0435e085 100644 --- a/hosts/ocaml/bootstrap.py +++ b/hosts/ocaml/bootstrap.py @@ -211,60 +211,10 @@ def compile_spec_to_ml(spec_dir: str | None = None) -> str: parts.append(FIXUPS) output = "\n".join(parts) - # Post-process: fix mutable globals that the transpiler can't handle. - # The transpiler emits local refs for set! targets within functions, - # but top-level globals (*strict*, *prim-param-types*) need to use - # the pre-declared refs from the preamble. + # Mutable globals (*strict*, *prim-param-types*) are now handled by + # the transpiler directly — it emits !_ref for reads, _ref := for writes. import re - # Fix *strict*: use _strict_ref instead of immutable let rec binding - output = re.sub( - r'and _strict_ =\n \(Bool false\)', - 'and _strict_ = !_strict_ref', - output, - ) - # Fix set-strict!: use _strict_ref instead of local ref - output = re.sub( - r'and set_strict_b val\' =\n let _strict_ = ref Nil in \(_strict_ := val\'; Nil\)', - "and set_strict_b val' =\n _strict_ref := val'; Nil", - output, - ) - # Fix *prim-param-types*: use _prim_param_types_ref - output = re.sub( - r'and _prim_param_types_ =\n Nil', - 'and _prim_param_types_ = !_prim_param_types_ref', - output, - ) - # Fix set-prim-param-types!: use _prim_param_types_ref - output = re.sub( - r'and set_prim_param_types_b types =\n let _prim_param_types_ = ref Nil in \(_prim_param_types_ := types; Nil\)', - "and set_prim_param_types_b types =\n _prim_param_types_ref := types; Nil", - output, - ) - - # Fix all runtime reads of _strict_ and _prim_param_types_ to deref - # the mutable refs instead of using the stale let-rec bindings. - # This is needed because let-rec value bindings capture initial values. - # Use regex with word boundary to avoid replacing _strict_ref with - # !_strict_refref. - def fix_mutable_reads(text): - lines = text.split('\n') - fixed = [] - for line in lines: - # Skip the definition lines - stripped = line.strip() - if stripped.startswith('and _strict_ =') or stripped.startswith('and _prim_param_types_ ='): - fixed.append(line) - continue - # Replace _strict_ as a standalone identifier only (not inside - # other names like set_strict_b). Match when preceded by space, - # paren, or start-of-line, and followed by space, paren, or ;. - line = re.sub(r'(?<=[ (])_strict_(?=[ );])', '!_strict_ref', line) - line = re.sub(r'(?<=[ (])_prim_param_types_(?=[ );])', '!_prim_param_types_ref', line) - fixed.append(line) - return '\n'.join(fixed) - output = fix_mutable_reads(output) - # Fix cek_call: the spec passes (make-env) as the env arg to # continue_with_call, but the transpiler evaluates make-env at # transpile time (it's a primitive), producing Dict instead of Env. diff --git a/hosts/ocaml/transpiler.sx b/hosts/ocaml/transpiler.sx index 4837b393..a98089cc 100644 --- a/hosts/ocaml/transpiler.sx +++ b/hosts/ocaml/transpiler.sx @@ -268,6 +268,12 @@ (define ml-dynamic-globals (list "*render-check*" "*render-fn*")) +(define ml-mutable-globals (list "*strict*" "*prim-param-types*")) + +(define + ml-is-mutable-global? + (fn (name) (some (fn (g) (= g name)) ml-mutable-globals))) + (define ml-is-dyn-global? (fn ((name :as string)) (some (fn (g) (= g name)) ml-dynamic-globals))) @@ -431,9 +437,12 @@ (let ((mangled (ml-mangle (symbol-name expr)))) (if - (some (fn (c) (= c mangled)) set-vars) - (str "!" mangled) - mangled)) + (ml-is-mutable-global? (symbol-name expr)) + (str "!" mangled "ref") + (if + (some (fn (c) (= c mangled)) set-vars) + (str "!" mangled) + mangled))) (= (type-of expr) "keyword") (str "(String " (ml-quote-string (keyword-name expr)) ")") (= (type-of expr) "dict") @@ -636,15 +645,23 @@ (ml-emit-quote (first args)) (= op "set!") (let - ((var-name (if (= (type-of (first args)) "symbol") (symbol-name (first args)) (str (first args))))) - (let - ((mangled (ml-mangle var-name))) + ((var-name (symbol-name (first args)))) + (if + (ml-is-mutable-global? var-name) (str "(" - mangled - " := " + (ml-mangle var-name) + "ref := " (ml-expr-inner (nth args 1) set-vars) - "; Nil)"))) + "; Nil)") + (let + ((mangled (ml-mangle var-name))) + (str + "(" + mangled + " := " + (ml-expr-inner (nth args 1) set-vars) + "; Nil)")))) (= op "str") (str "(String (sx_str [" @@ -1751,7 +1768,10 @@ ref-decls body-str "\n"))))) - (str "let " ml-name " =\n " (ml-expr val-expr) "\n"))))))) + (if + (ml-is-mutable-global? name) + (str "let " ml-name " =\n !" ml-name "ref\n") + (str "let " ml-name " =\n " (ml-expr val-expr) "\n")))))))) (define ml-translate-file @@ -1854,4 +1874,7 @@ ref-decls body-str "\n"))))) - (str "let rec " ml-name " =\n " (ml-expr val-expr) "\n")))))) + (if + (ml-is-mutable-global? name) + (str "let rec " ml-name " =\n !" ml-name "ref\n") + (str "let rec " ml-name " =\n " (ml-expr val-expr) "\n")))))))