giles
1340c2626b
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
Phase 4 cont. go-eval-stmt dispatches on: :return → wraps value in (:return-value V) sentinel :var-decl → bind each NAME via go-eval-var-decl :short-decl → bind each (:var NAME) lhs to corresponding expr value :assign → immutable-env shadowing (true mutation deferred) :block → run stmts via go-eval-block, propagating :return-value :if / :else → cond-driven dispatch :func-decl → bind name to (list :go-fn PARAMS BODY) else → expression statement, evaluate for side effects go-eval-call extends the CALLER's env with param-names → arg-values (dynamic-scope-ish — closures don't capture lexical env yet), runs the body block, catches :return-value and unwraps. **Recursive fib(5) = 5 evaluates correctly.** Recursion works because top-level func bindings are in the calling env before the recursive call happens. True lexical closures (let bind sees outer var; assignments visible to nested funcs) need an env-cell model with mutation; deferred to a later slice. eval 33/33, total 410/410. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
443 lines
12 KiB
Plaintext
443 lines
12 KiB
Plaintext
;; lib/go/eval.sx — Go tree-walk evaluator.
|
|
;;
|
|
;; (go-eval ENV EXPR) → VALUE | (list :eval-error TAG ...)
|
|
;;
|
|
;; ENV is an association list of (NAME VALUE) bindings. Per-block scope
|
|
;; via fresh extension. Values:
|
|
;; integers → SX numbers (decimal/hex/oct/bin literals all decoded)
|
|
;; strings → SX strings
|
|
;; booleans → SX true/false
|
|
;; nil → SX nil
|
|
;; Composite Go values (slices, maps, structs, pointers, channels)
|
|
;; arrive in later slices.
|
|
|
|
(define go-env-empty (list))
|
|
|
|
(define
|
|
go-env-lookup
|
|
(fn
|
|
(env name)
|
|
(cond
|
|
(= (len env) 0)
|
|
nil
|
|
(= (first (first env)) name)
|
|
(nth (first env) 1)
|
|
:else (go-env-lookup (rest env) name))))
|
|
|
|
(define go-env-extend (fn (env name value) (cons (list name value) env)))
|
|
|
|
(define
|
|
go-eval-error?
|
|
(fn
|
|
(x)
|
|
(and
|
|
(list? x)
|
|
(not (= (len x) 0))
|
|
(= (first x) :eval-error))))
|
|
|
|
;; ── literal parsing ──────────────────────────────────────────────
|
|
|
|
(define
|
|
go-hex-digit-value
|
|
(fn
|
|
(c)
|
|
(cond
|
|
(= c "0")
|
|
0
|
|
(= c "1")
|
|
1
|
|
(= c "2")
|
|
2
|
|
(= c "3")
|
|
3
|
|
(= c "4")
|
|
4
|
|
(= c "5")
|
|
5
|
|
(= c "6")
|
|
6
|
|
(= c "7")
|
|
7
|
|
(= c "8")
|
|
8
|
|
(= c "9")
|
|
9
|
|
(= c "a")
|
|
10
|
|
(= c "b")
|
|
11
|
|
(= c "c")
|
|
12
|
|
(= c "d")
|
|
13
|
|
(= c "e")
|
|
14
|
|
(= c "f")
|
|
15
|
|
(= c "A")
|
|
10
|
|
(= c "B")
|
|
11
|
|
(= c "C")
|
|
12
|
|
(= c "D")
|
|
13
|
|
(= c "E")
|
|
14
|
|
(= c "F")
|
|
15
|
|
:else -1)))
|
|
|
|
(define
|
|
go-parse-radix-from
|
|
(fn
|
|
(v start radix)
|
|
(define
|
|
grf-loop
|
|
(fn
|
|
(i acc)
|
|
(cond
|
|
(>= i (len v))
|
|
acc
|
|
(= (nth v i) "_")
|
|
(grf-loop (+ i 1) acc)
|
|
:else (let
|
|
((d (go-hex-digit-value (nth v i))))
|
|
(cond
|
|
(or (< d 0) (>= d radix))
|
|
acc
|
|
:else (grf-loop (+ i 1) (+ (* acc radix) d)))))))
|
|
(grf-loop start 0)))
|
|
|
|
(define
|
|
go-parse-int-literal
|
|
(fn
|
|
(v)
|
|
(cond
|
|
(and
|
|
(>= (len v) 2)
|
|
(= (nth v 0) "0")
|
|
(or (= (nth v 1) "x") (= (nth v 1) "X")))
|
|
(go-parse-radix-from v 2 16)
|
|
(and
|
|
(>= (len v) 2)
|
|
(= (nth v 0) "0")
|
|
(or (= (nth v 1) "b") (= (nth v 1) "B")))
|
|
(go-parse-radix-from v 2 2)
|
|
(and
|
|
(>= (len v) 2)
|
|
(= (nth v 0) "0")
|
|
(or (= (nth v 1) "o") (= (nth v 1) "O")))
|
|
(go-parse-radix-from v 2 8)
|
|
:else (go-parse-radix-from v 0 10))))
|
|
|
|
(define
|
|
go-eval-literal
|
|
(fn
|
|
(v)
|
|
(let
|
|
((k (go-classify-literal-string v)))
|
|
(cond (= k :int) (go-parse-int-literal v) (= k :string) v :else v))))
|
|
|
|
;; ── binary ops ───────────────────────────────────────────────────
|
|
|
|
(define
|
|
go-eval-binop
|
|
(fn
|
|
(op l r)
|
|
(cond
|
|
(= op "+")
|
|
(+ l r)
|
|
(= op "-")
|
|
(- l r)
|
|
(= op "*")
|
|
(* l r)
|
|
(= op "/")
|
|
(/ l r)
|
|
(= op "==")
|
|
(= l r)
|
|
(= op "!=")
|
|
(not (= l r))
|
|
(= op "<")
|
|
(< l r)
|
|
(= op "<=")
|
|
(<= l r)
|
|
(= op ">")
|
|
(> l r)
|
|
(= op ">=")
|
|
(>= l r)
|
|
(= op "&&")
|
|
(and l r)
|
|
(= op "||")
|
|
(or l r)
|
|
:else (list :eval-error :unsupported-binop op))))
|
|
|
|
;; ── main eval ────────────────────────────────────────────────────
|
|
|
|
(define
|
|
go-eval-binop-ops
|
|
(list "+" "-" "*" "/" "==" "!=" "<" "<=" ">" ">=" "&&" "||"))
|
|
|
|
(define
|
|
go-is-eval-binop?
|
|
(fn (head args)
|
|
(and (list? head) (= (first head) :var)
|
|
(= (len args) 2)
|
|
(some (fn (op) (= op (nth head 1))) go-eval-binop-ops))))
|
|
|
|
(define
|
|
go-eval-args
|
|
;; Returns a list of arg values or a (:eval-error ...).
|
|
(fn (env args)
|
|
(cond
|
|
(or (= args nil) (= (len args) 0)) (list)
|
|
:else
|
|
(let ((v (go-eval env (first args))))
|
|
(cond
|
|
(go-eval-error? v) v
|
|
:else
|
|
(let ((rest-vs (go-eval-args env (rest args))))
|
|
(cond
|
|
(go-eval-error? rest-vs) rest-vs
|
|
:else (cons v rest-vs))))))))
|
|
|
|
(define
|
|
go-flatten-param-names
|
|
;; PARAMS is a list of (:field NAMES TYPE) groups; return a flat name list.
|
|
(fn (params)
|
|
(cond
|
|
(or (= params nil) (= (len params) 0)) (list)
|
|
:else
|
|
(let ((field (first params)))
|
|
(let ((names (nth field 1)))
|
|
(go-name-concat names (go-flatten-param-names (rest params))))))))
|
|
|
|
(define
|
|
go-name-concat
|
|
(fn (a b)
|
|
(cond
|
|
(= (len a) 0) b
|
|
:else (cons (first a) (go-name-concat (rest a) b)))))
|
|
|
|
(define
|
|
go-bind-names
|
|
(fn (env names vals)
|
|
(cond
|
|
(= (len names) 0) env
|
|
:else
|
|
(go-bind-names
|
|
(go-env-extend env (first names) (first vals))
|
|
(rest names) (rest vals)))))
|
|
|
|
(define
|
|
go-eval-call
|
|
;; Apply a callable VAL to ARG-EXPRS in CALLER-ENV. Result is the
|
|
;; function's return value or a (:eval-error ...).
|
|
;;
|
|
;; Closure semantics: the function value carries no captured env in v0
|
|
;; (dynamic scope wrt outer bindings). Recursion at top level works
|
|
;; because the calling env already has the function bound. Nested
|
|
;; lexical closures arrive in a later slice.
|
|
(fn (caller-env callee-val args)
|
|
(cond
|
|
(not (and (list? callee-val) (= (first callee-val) :go-fn)))
|
|
(list :eval-error :not-callable callee-val)
|
|
:else
|
|
(let ((params (nth callee-val 1)) (body (nth callee-val 2)))
|
|
(let ((arg-vals (go-eval-args caller-env args)))
|
|
(cond
|
|
(go-eval-error? arg-vals) arg-vals
|
|
:else
|
|
(let ((param-names (go-flatten-param-names params)))
|
|
(cond
|
|
(not (= (len param-names) (len arg-vals)))
|
|
(list :eval-error :arity-mismatch
|
|
(len param-names) (len arg-vals))
|
|
:else
|
|
(let ((call-env
|
|
(go-bind-names caller-env param-names arg-vals)))
|
|
(cond
|
|
(= body nil) nil
|
|
(and (list? body) (= (first body) :block))
|
|
(let ((r (go-eval-block call-env (nth body 1))))
|
|
(cond
|
|
(and (list? r) (= (first r) :return-value))
|
|
(nth r 1)
|
|
(go-eval-error? r) r
|
|
:else nil))
|
|
:else nil))))))))))
|
|
|
|
(define
|
|
go-eval-var-decl
|
|
;; (:var-decl (:field NAMES TYPE) EXPRS) — bind each NAME to either
|
|
;; the corresponding EXPR's value or nil (zero-init when no EXPRS).
|
|
(fn (env stmt)
|
|
(let ((field (nth stmt 1)) (exprs (nth stmt 2)))
|
|
(let ((names (nth field 1)))
|
|
(cond
|
|
(or (= exprs nil) (= (len exprs) 0))
|
|
(go-bind-names env names
|
|
(go-zeros (len names)))
|
|
:else
|
|
(let ((vals (go-eval-args env exprs)))
|
|
(cond
|
|
(go-eval-error? vals) vals
|
|
:else (go-bind-names env names vals))))))))
|
|
|
|
(define
|
|
go-zeros (fn (n) (cond (<= n 0) (list) :else (cons nil (go-zeros (- n 1))))))
|
|
|
|
(define
|
|
go-eval-short-decl
|
|
;; (:short-decl LHS-LIST EXPRS) — LHS list of (:var NAME) nodes.
|
|
(fn (env stmt)
|
|
(let ((lhs-list (nth stmt 1)) (exprs (nth stmt 2)))
|
|
(let ((names
|
|
(map (fn (lhs)
|
|
(cond
|
|
(and (list? lhs) (= (first lhs) :var))
|
|
(nth lhs 1)
|
|
:else :unknown))
|
|
lhs-list)))
|
|
(let ((vals (go-eval-args env exprs)))
|
|
(cond
|
|
(go-eval-error? vals) vals
|
|
:else (go-bind-names env names vals)))))))
|
|
|
|
(define
|
|
go-eval-assign
|
|
;; v0: assignment shadows via env extension (immutable env model).
|
|
;; Mutation through closures deferred.
|
|
(fn (env stmt)
|
|
(let ((lhs-list (nth stmt 1)) (rhs-list (nth stmt 2)))
|
|
(let ((vals (go-eval-args env rhs-list)))
|
|
(cond
|
|
(go-eval-error? vals) vals
|
|
:else
|
|
(go-eval-assign-pairs env lhs-list vals))))))
|
|
|
|
(define
|
|
go-eval-assign-pairs
|
|
(fn (env lhs-list vals)
|
|
(cond
|
|
(= (len lhs-list) 0) env
|
|
:else
|
|
(let ((lhs (first lhs-list)))
|
|
(cond
|
|
(and (list? lhs) (= (first lhs) :var))
|
|
(go-eval-assign-pairs
|
|
(go-env-extend env (nth lhs 1) (first vals))
|
|
(rest lhs-list) (rest vals))
|
|
:else (list :eval-error :unsupported-lhs lhs))))))
|
|
|
|
(define
|
|
go-eval-if
|
|
(fn (env stmt)
|
|
(let ((cnd (nth stmt 1)) (then (nth stmt 2)) (els (nth stmt 3)))
|
|
(let ((c (go-eval env cnd)))
|
|
(cond
|
|
(go-eval-error? c) c
|
|
c (go-eval-stmt env then)
|
|
(not (= els nil)) (go-eval-stmt env els)
|
|
:else env)))))
|
|
|
|
(define
|
|
go-eval-func-decl
|
|
(fn (env stmt)
|
|
(let ((name (nth stmt 1)) (params (nth stmt 2))
|
|
(body (nth stmt 4)))
|
|
(go-env-extend env name (list :go-fn params body)))))
|
|
|
|
(define
|
|
go-eval-stmt
|
|
(fn (env stmt)
|
|
(cond
|
|
(and (list? stmt) (= (first stmt) :return))
|
|
(let ((exprs (nth stmt 1)))
|
|
(cond
|
|
(or (= exprs nil) (= (len exprs) 0))
|
|
(list :return-value nil)
|
|
:else
|
|
(let ((v (go-eval env (first exprs))))
|
|
(cond
|
|
(go-eval-error? v) v
|
|
:else (list :return-value v)))))
|
|
(and (list? stmt) (= (first stmt) :var-decl))
|
|
(go-eval-var-decl env stmt)
|
|
(and (list? stmt) (= (first stmt) :short-decl))
|
|
(go-eval-short-decl env stmt)
|
|
(and (list? stmt) (= (first stmt) :assign))
|
|
(go-eval-assign env stmt)
|
|
(and (list? stmt) (= (first stmt) :block))
|
|
(go-eval-block env (nth stmt 1))
|
|
(and (list? stmt) (= (first stmt) :if))
|
|
(go-eval-if env stmt)
|
|
(and (list? stmt) (= (first stmt) :func-decl))
|
|
(go-eval-func-decl env stmt)
|
|
:else
|
|
(let ((v (go-eval env stmt)))
|
|
(cond
|
|
(go-eval-error? v) v
|
|
:else env)))))
|
|
|
|
(define
|
|
go-eval-block
|
|
(fn (env stmts)
|
|
(cond
|
|
(or (= stmts nil) (= (len stmts) 0)) env
|
|
:else
|
|
(let ((r (go-eval-stmt env (first stmts))))
|
|
(cond
|
|
(and (list? r) (= (first r) :return-value)) r
|
|
(go-eval-error? r) r
|
|
:else (go-eval-block r (rest stmts)))))))
|
|
|
|
(define
|
|
go-eval-program
|
|
;; Evaluate a sequence of top-level forms in ENV. Returns the final
|
|
;; env (or :eval-error / :return-value if either propagates).
|
|
(fn (env forms)
|
|
(cond
|
|
(or (= forms nil) (= (len forms) 0)) env
|
|
:else
|
|
(let ((r (go-eval-stmt env (first forms))))
|
|
(cond
|
|
(and (list? r) (= (first r) :return-value)) r
|
|
(go-eval-error? r) r
|
|
:else (go-eval-program r (rest forms)))))))
|
|
|
|
(define
|
|
go-eval
|
|
(fn
|
|
(env expr)
|
|
(cond
|
|
(and (list? expr) (= (first expr) :literal))
|
|
(go-eval-literal (nth expr 1))
|
|
(and (list? expr) (= (first expr) :var))
|
|
(let
|
|
((name (nth expr 1)))
|
|
(cond
|
|
(= name "true") true
|
|
(= name "false") false
|
|
(= name "nil") nil
|
|
:else (let
|
|
((v (go-env-lookup env name)))
|
|
(cond (= v nil) (list :eval-error :unbound name) :else v))))
|
|
(and (list? expr) (= (first expr) :app))
|
|
(let ((head (nth expr 1)) (args (nth expr 2)))
|
|
(cond
|
|
(go-is-eval-binop? head args)
|
|
(let ((op (nth head 1)))
|
|
(let ((lv (go-eval env (first args)))
|
|
(rv (go-eval env (nth args 1))))
|
|
(cond
|
|
(go-eval-error? lv) lv
|
|
(go-eval-error? rv) rv
|
|
:else (go-eval-binop op lv rv))))
|
|
:else
|
|
(let ((callee (go-eval env head)))
|
|
(cond
|
|
(go-eval-error? callee) callee
|
|
:else (go-eval-call env callee args)))))
|
|
:else (list :eval-error :unsupported-eval expr))))
|