apl: tradfn ∇ header — line-numbered stmts + :branch goto (+10 tests, 245/245)

2026-05-07 02:13:00 +00:00
parent 16167c5d9b
commit 1900726fc9
4 changed files with 115 additions and 1 deletions
--- a/lib/apl/transpile.sx
+++ b/lib/apl/transpile.sx
@@ -188,3 +188,50 @@
    (let
      ((stmts (rest dfn-ast)) (env {:omega omega :nabla dfn-ast :alpha nil}))
      (apl-eval-stmts stmts env))))
+
+(define
+  apl-tradfn-loop
+  (fn
+    (stmts line env result-name)
+    (cond
+      ((= line 0) (get env result-name))
+      ((> line (len stmts)) (get env result-name))
+      (else
+        (let
+          ((stmt (nth stmts (- line 1))))
+          (let
+            ((tag (first stmt)))
+            (cond
+              ((= tag :branch)
+                (let
+                  ((target (apl-eval-ast (nth stmt 1) env)))
+                  (let
+                    ((target-num (first (get target :ravel))))
+                    (apl-tradfn-loop stmts target-num env result-name))))
+              ((= tag :assign)
+                (let
+                  ((v (apl-eval-ast (nth stmt 2) env)))
+                  (apl-tradfn-loop
+                    stmts
+                    (+ line 1)
+                    (assoc env (nth stmt 1) v)
+                    result-name)))
+              (else
+                (begin
+                  (apl-eval-ast stmt env)
+                  (apl-tradfn-loop stmts (+ line 1) env result-name))))))))))
+
+(define
+  apl-call-tradfn
+  (fn
+    (tradfn alpha omega)
+    (let
+      ((stmts (get tradfn :stmts))
+        (result-name (get tradfn :result))
+        (alpha-name (get tradfn :alpha))
+        (omega-name (get tradfn :omega)))
+      (let
+        ((env-a (if alpha-name (assoc {} alpha-name alpha) {})))
+        (let
+          ((env-ao (if omega-name (assoc env-a omega-name omega) env-a)))
+          (apl-tradfn-loop stmts 1 env-ao result-name))))))