Files
rose-ash/lib/go/eval.sx
giles 8c91b34264
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
go: Phase 8 first slice — stdlib strings/strconv, 41 tests, +40 cleared [shapes-static-types-bidirectional]
New :go-package NAME ENTRIES value type with field lookup via
extended go-eval-select. New :go-builtin-fn callable for closure-
based stdlib functions. lib/go/std/strings.sx ships 12 functions
(Contains, HasPrefix, HasSuffix, Index, Count, Repeat, Join,
ToUpper, ToLower, TrimSpace, Split, Replace) + lib/go/std/strconv.sx
ships Itoa/Atoi.

Pre-existing bug fixed: parser was emitting (:literal V) for both
`42` and `"42"`, relying on first-char heuristic in eval/types.
Now emits :literal-string for string/rune literals so Atoi("42")
correctly receives the string. 3 parse tests + 2 in-composite-key
tests updated to new shape.

Total 597/597. Stdlib 41/41 — +40 acceptance bar cleared. Sister
diary documents the 11 value-type kinds (struct/slice/map/chan/
fn/method/builtin/builtin-fn/package/panic/defer) all sharing the
"(:KIND PAYLOAD...)" shape, alongside AST nodes and sentinel signals
as the kit's three orthogonal first-class-tag axes.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-28 02:14:55 +00:00

1540 lines
47 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-builtins
;; A starter env containing the Go builtins eval understands.
;; Tests can call (go-env-builtins) instead of go-env-empty when they
;; need len/append/print/make/close.
(list
(list "len" (list :go-builtin "len"))
(list "append" (list :go-builtin "append"))
(list "print" (list :go-builtin "print"))
(list "make" (list :go-builtin "make"))
(list "close" (list :go-builtin "close"))
(list "after" (list :go-builtin "after"))
(list "panic" (list :go-builtin "panic"))
(list "recover" (list :go-builtin "recover"))))
(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))))
(define
go-panic?
(fn (x)
(and (list? x) (not (= (len x) 0)) (= (first x) :go-panic))))
(define
go-find-raised-panic-cell
;; Env is a list of (NAME VALUE) pairs. Find the first one whose
;; name is "__go-panic-cell" AND whose state slot is :raised.
;; Returns the cell (so recover() can mutate it) or nil.
(fn (env)
(cond
(or (= env nil) (= (len env) 0)) nil
:else
(let ((b (first env)))
(cond
(and (= (first b) "__go-panic-cell")
(= (nth (nth b 1) 0) :raised))
(nth b 1)
:else (go-find-raised-panic-cell (rest env)))))))
;; ── 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-map-get
(fn (entries key)
(cond
(= (len entries) 0) nil
(= (first (first entries)) key) (nth (first entries) 1)
:else (go-map-get (rest entries) key))))
(define
go-map-set
;; Update the key's value if present, else append. Returns a new entry list.
(fn (entries key value)
(cond
(= (len entries) 0) (list (list key value))
(= (first (first entries)) key)
(cons (list key value) (rest entries))
:else (cons (first entries) (go-map-set (rest entries) key value)))))
(define
go-slice-set
;; Functional update on a list at index IDX. Out-of-range no-ops in v0.
(fn (elems idx value)
(cond
(>= idx (len elems)) elems
(< idx 0) elems
(= idx 0) (cons value (rest elems))
:else (cons (first elems) (go-slice-set (rest elems) (- idx 1) value)))))
(define
go-struct-field-names
;; FIELDS is a list of (:field NAMES TYPE) groups; flatten to names.
(fn (fields)
(cond
(or (= fields nil) (= (len fields) 0)) (list)
:else
(let ((f (first fields)))
(let ((names (nth f 1)))
(go-name-concat names (go-struct-field-names (rest fields))))))))
(define
go-zip-fields
(fn (names vals)
(cond
(= (len names) 0) (list)
:else
(cons (list (first names) (first vals))
(go-zip-fields (rest names) (rest vals))))))
(define
go-eval-keyed-fields
;; Each elem is (:kv (:var FIELD-NAME) VALUE-EXPR).
(fn (env elems)
(cond
(or (= elems nil) (= (len elems) 0)) (list)
:else
(let ((e (first elems)))
(cond
(not (and (list? e) (= (first e) :kv)))
(list :eval-error :struct-elem-missing-key e)
:else
(let ((k (nth e 1)) (v (go-eval env (nth e 2))))
(cond
(go-eval-error? v) v
(not (and (list? k) (= (first k) :var)))
(list :eval-error :struct-key-not-ident k)
:else
(let ((rest-fields
(go-eval-keyed-fields env (rest elems))))
(cond
(go-eval-error? rest-fields) rest-fields
:else
(cons (list (nth k 1) v) rest-fields))))))))))
(define
go-eval-struct-lit
(fn (env type-name field-names elems)
(cond
(or (= elems nil) (= (len elems) 0))
(list :go-struct type-name (list))
(and (list? (first elems)) (= (first (first elems)) :kv))
(let ((fields (go-eval-keyed-fields env elems)))
(cond
(go-eval-error? fields) fields
:else (list :go-struct type-name fields)))
:else
(cond
(not (= (len elems) (len field-names)))
(list :eval-error :struct-arity-mismatch type-name
(len field-names) (len elems))
:else
(let ((vals (go-eval-args env elems)))
(cond
(go-eval-error? vals) vals
:else
(list :go-struct type-name
(go-zip-fields field-names vals))))))))
(define
go-eval-select
;; (:select OBJ FIELD-NAME) — struct field access OR package member
;; lookup. Packages are values of shape (:go-package NAME ENTRIES)
;; where ENTRIES is an assoc list of (FIELD-NAME VALUE). Used by
;; lib/go/std/*.sx to expose `strings.Contains`-style call sites.
(fn (env expr)
(let ((obj (go-eval env (nth expr 1))) (field-name (nth expr 2)))
(cond
(go-eval-error? obj) obj
(and (list? obj) (= (first obj) :go-struct))
(let ((v (go-map-get (nth obj 2) field-name)))
(cond
(= v nil) (list :eval-error :unknown-field field-name)
:else v))
(and (list? obj) (= (first obj) :go-package))
(let ((v (go-map-get (nth obj 2) field-name)))
(cond
(= v nil)
(list :eval-error :unknown-package-member (nth obj 1) field-name)
:else v))
:else (list :eval-error :not-selectable obj)))))
(define
go-eval-builtin
;; Run Go's predeclared builtins (len, append, print). args are
;; expressions; we eval them in the caller env then dispatch on NAME.
(fn (caller-env name args)
(let ((vals (go-eval-args caller-env args)))
(cond
(go-eval-error? vals) vals
(= name "len")
(cond
(not (= (len vals) 1))
(list :eval-error :builtin-arity name 1 (len vals))
:else
(let ((arg (first vals)))
(cond
(and (list? arg) (= (first arg) :go-slice)) (len (nth arg 1))
(and (list? arg) (= (first arg) :go-map)) (len (nth arg 1))
(string? arg) (len arg)
:else (list :eval-error :len-not-applicable arg))))
(= name "append")
(cond
(< (len vals) 1)
(list :eval-error :builtin-arity name 1 (len vals))
:else
(let ((slc (first vals)) (extra (rest vals)))
(cond
(and (list? slc) (= (first slc) :go-slice))
(list :go-slice (go-name-concat (nth slc 1) extra))
:else (list :eval-error :append-not-slice slc))))
(= name "print")
nil ;; v0: silent. Real impl would write to stdout.
(= name "make")
;; v0: ignore args, always return a fresh channel. Real Go is
;; make(chan T) / make(chan T, n) / make([]T, n) / make(map[K]V) —
;; v0 channel-buffer is unbounded so cap arg is a no-op.
(go-make-chan)
(= name "close")
(cond
(not (= (len vals) 1))
(list :eval-error :builtin-arity name 1 (len vals))
(not (go-chan? (first vals)))
(list :eval-error :close-not-chan (first vals))
:else (do (go-chan-close! (first vals)) nil))
(= name "after")
;; v0 stub for time.After: returns a channel already holding a
;; ready value (the duration arg is ignored). Lets `select`
;; with-timeout patterns express the intent even though we
;; don't model real time yet.
(let ((ch (go-make-chan))) (go-chan-send! ch :tick) ch)
(= name "panic")
;; Returns a panic sentinel — propagated like :return-value
;; through statements/blocks; trapped by the enclosing frame
;; to drain defers, then either consumed by recover() or
;; re-raised. nil panic value is the implicit "nil panic".
(cond
(not (= (len vals) 1))
(list :eval-error :builtin-arity name 1 (len vals))
:else (list :go-panic (first vals)))
(= name "recover")
;; Walks env chain for the *outermost* panic cell currently
;; in :raised state — this is the panicking frame's cell,
;; reached through the deferred-call invocation chain.
;; Flips it to :recovered, returns V. Returns nil if no
;; panic is in flight.
(let ((cell (go-find-raised-panic-cell caller-env)))
(cond
(= cell nil) nil
:else
(let ((v (nth cell 1)))
(do (set-nth! cell 0 :recovered) v))))
:else (list :eval-error :unknown-builtin name)))))
(define
go-extract-composite-vals
;; For slice/array composite literals: read each element's value
;; (skipping :kv keys, only using values for Go's index-keyed shorthand).
(fn (env elems)
(cond
(or (= elems nil) (= (len elems) 0)) (list)
:else
(let ((e (first elems)))
(let ((v
(cond
(and (list? e) (= (first e) :kv))
(go-eval env (nth e 2))
:else (go-eval env e))))
(cond
(go-eval-error? v) v
:else
(let ((rest-vs (go-extract-composite-vals env (rest elems))))
(cond
(go-eval-error? rest-vs) rest-vs
:else (cons v rest-vs)))))))))
(define
go-extract-map-entries
(fn (env elems)
(cond
(or (= elems nil) (= (len elems) 0)) (list)
:else
(let ((e (first elems)))
(cond
(not (and (list? e) (= (first e) :kv)))
(list :eval-error :map-elem-missing-key e)
:else
(let ((k (go-eval env (nth e 1))) (v (go-eval env (nth e 2))))
(cond
(go-eval-error? k) k
(go-eval-error? v) v
:else
(let ((rest-es (go-extract-map-entries env (rest elems))))
(cond
(go-eval-error? rest-es) rest-es
:else (cons (list k v) rest-es))))))))))
(define
go-eval-composite
;; (:composite TYPE-OR-EXPR ELEMS). v0 supports slice/array/map; struct
;; later.
(fn (env expr)
(let ((ty (nth expr 1)) (elems (nth expr 2)))
(cond
(and (list? ty)
(or (= (first ty) :ty-slice) (= (first ty) :ty-array)))
(let ((vals (go-extract-composite-vals env elems)))
(cond
(go-eval-error? vals) vals
:else (list :go-slice vals)))
(and (list? ty) (= (first ty) :ty-map))
(let ((entries (go-extract-map-entries env elems)))
(cond
(go-eval-error? entries) entries
:else (list :go-map entries)))
;; Named struct type (Point{1, 2}). Lookup the type info.
(and (list? ty) (= (first ty) :var))
(let ((type-info (go-env-lookup env (nth ty 1))))
(cond
(= type-info nil)
(list :eval-error :unknown-struct-type (nth ty 1))
(not (and (list? type-info)
(= (first type-info) :go-struct-type)))
(list :eval-error :not-struct-type (nth ty 1) type-info)
:else
(go-eval-struct-lit env (nth ty 1)
(nth type-info 1) elems)))
:else (list :eval-error :unsupported-composite ty)))))
(define
go-eval-index
;; (:index OBJ IDX-EXPR). v0: slice or map.
(fn (env expr)
(let ((obj (go-eval env (nth expr 1)))
(idx (go-eval env (nth expr 2))))
(cond
(go-eval-error? obj) obj
(go-eval-error? idx) idx
(and (list? obj) (= (first obj) :go-slice))
(let ((elems (nth obj 1)))
(cond
(or (< idx 0) (>= idx (len elems)))
(list :eval-error :index-out-of-range idx (len elems))
:else (nth elems idx)))
(and (list? obj) (= (first obj) :go-map))
;; v0: returns nil for missing keys. Go's real semantics is the
;; zero value of the value type — needs runtime type info.
(go-map-get (nth obj 1) idx)
:else (list :eval-error :not-indexable obj)))))
(define
go-eval-slice
;; (:slice OBJ LOW HIGH MAX). v0: two-index slice on go-slice values.
(fn (env expr)
(let ((obj (go-eval env (nth expr 1)))
(low (cond
(= (nth expr 2) nil) 0
:else (go-eval env (nth expr 2))))
(high-expr (nth expr 3)))
(cond
(go-eval-error? obj) obj
(go-eval-error? low) low
(not (and (list? obj) (= (first obj) :go-slice)))
(list :eval-error :not-sliceable obj)
:else
(let ((elems (nth obj 1)))
(let ((high
(cond
(= high-expr nil) (len elems)
:else (go-eval env high-expr))))
(cond
(go-eval-error? high) high
:else
(list :go-slice (go-list-slice elems low high)))))))))
(define
go-list-slice
(fn (lst low high)
(cond
(>= low high) (list)
(>= low (len lst)) (list)
:else
(cons (nth lst low)
(go-list-slice lst (+ low 1) high)))))
(define
go-eval-call
;;
;; 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
(and (list? callee-val) (= (first callee-val) :go-builtin))
(go-eval-builtin caller-env (nth callee-val 1) args)
;; :go-builtin-fn FN — closure-based builtin (used by stdlib).
;; FN takes a list of pre-evaluated arg values and returns a
;; result value. Distinct from :go-builtin which is name-based
;; dispatch through go-eval-builtin's cond.
(and (list? callee-val) (= (first callee-val) :go-builtin-fn))
(let ((arg-vals (go-eval-args caller-env args)))
(cond
(go-eval-error? arg-vals) arg-vals
:else ((nth callee-val 1) arg-vals)))
(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)))
;; Install a fresh defer stack + panic cell for this
;; frame. Panic cell is (list STATE VALUE): :none if
;; nothing happened, :raised V if body panicked,
;; :recovered if a defer called recover() to swallow.
(let ((defer-stack (list))
(panic-cell (list :none nil)))
(let ((frame-env
(go-env-extend
(go-env-extend
call-env "__go-defer-stack" defer-stack)
"__go-panic-cell" panic-cell)))
(cond
(= body nil)
(do (go-run-defers! frame-env defer-stack) nil)
(and (list? body) (= (first body) :block))
(let ((r (go-eval-block frame-env (nth body 1))))
(do
;; If body panicked, stash value before
;; defers run so recover() can see it.
(cond
(go-panic? r)
(do (set-nth! panic-cell 0 :raised)
(set-nth! panic-cell 1 (nth r 1)))
:else nil)
(go-run-defers! frame-env defer-stack)
(cond
;; Recover called during defers — swallow.
(= (nth panic-cell 0) :recovered) nil
;; Still raised after defers — propagate.
(= (nth panic-cell 0) :raised)
(list :go-panic (nth panic-cell 1))
(and (list? r) (= (first r) :return-value))
(nth r 1)
(go-eval-error? r) r
:else nil)))
:else
(do (go-run-defers! frame-env defer-stack)
nil)))))))))))))
(define
go-eval-defer-stmt
(fn
(env stmt)
(let
((expr (nth stmt 1)))
(cond
(not (and (list? expr) (= (first expr) :app)))
(list :eval-error :defer-not-call expr)
:else (let
((head (nth expr 1)) (args (nth expr 2)))
(let
((callee-val (go-eval env head)))
(cond
(go-eval-error? callee-val)
callee-val
:else (let
((arg-vals (go-eval-args env args)))
(cond
(go-eval-error? arg-vals)
arg-vals
:else (let
((stack (go-env-lookup env "__go-defer-stack")))
(cond
(= stack nil)
(list :eval-error :defer-outside-fn)
:else (do
(append! stack (list :go-defer callee-val arg-vals))
env))))))))))))
(define
go-run-defers!
;; Drain a defer stack LIFO. SX has no in-place list-shrink, so we
;; walk by index from top down.
(fn (env stack)
(go-run-defers-prefix! env stack (len stack))))
(define
go-run-defers-prefix!
(fn (env stack idx)
(cond
(<= idx 0) nil
:else
(let ((d (nth stack (- idx 1))))
(let ((callee-val (nth d 1)) (arg-vals (nth d 2)))
(let ((wrapped-args
(map (fn (v) (list :quoted-value v)) arg-vals)))
(do
(go-eval-call env callee-val wrapped-args)
(go-run-defers-prefix! env stack (- idx 1)))))))))
(define
go-eval-var-decl
(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
(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
(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)) (rhs-val (first vals)))
(cond
(and (list? lhs) (= (first lhs) :var))
(go-eval-assign-pairs
(go-env-extend env (nth lhs 1) rhs-val)
(rest lhs-list)
(rest vals))
(and (list? lhs) (= (first lhs) :index))
(let
((obj-expr (nth lhs 1))
(idx-expr (nth lhs 2)))
(cond
(not (and (list? obj-expr) (= (first obj-expr) :var)))
(list :eval-error :unsupported-lhs lhs)
:else (let
((obj (go-eval env obj-expr)) (idx (go-eval env idx-expr)))
(cond
(go-eval-error? obj)
obj
(go-eval-error? idx)
idx
(and (list? obj) (= (first obj) :go-slice))
(go-eval-assign-pairs
(go-env-extend
env
(nth obj-expr 1)
(list
:go-slice (go-slice-set (nth obj 1) idx rhs-val)))
(rest lhs-list)
(rest vals))
(and (list? obj) (= (first obj) :go-map))
(go-eval-assign-pairs
(go-env-extend
env
(nth obj-expr 1)
(list
:go-map (go-map-set (nth obj 1) idx rhs-val)))
(rest lhs-list)
(rest vals))
:else (list :eval-error :unsupported-lhs lhs)))))
(and (list? lhs) (= (first lhs) :select))
(let
((obj-expr (nth lhs 1))
(field-name (nth lhs 2)))
(cond
(not (and (list? obj-expr) (= (first obj-expr) :var)))
(list :eval-error :unsupported-lhs lhs)
:else (let
((obj (go-eval env obj-expr)))
(cond
(go-eval-error? obj)
obj
(and (list? obj) (= (first obj) :go-struct))
(go-eval-assign-pairs
(go-env-extend
env
(nth obj-expr 1)
(list
:go-struct (nth obj 1)
(go-map-set (nth obj 2) field-name rhs-val)))
(rest lhs-list)
(rest vals))
:else (list :eval-error :unsupported-lhs lhs)))))
: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-inc-dec
(fn
(env stmt)
(let
((op (nth stmt 1)) (operand (nth stmt 2)))
(cond
(not (and (list? operand) (= (first operand) :var)))
(list :eval-error :unsupported-lhs operand)
:else (let
((current (go-eval env operand)))
(cond
(go-eval-error? current)
current
:else (let
((new-val (cond (= op "++") (+ current 1) (= op "--") (- current 1) :else current)))
(go-env-extend env (nth operand 1) new-val))))))))
(define
go-eval-for
(fn
(env stmt)
(let
((init (nth stmt 1))
(cnd (nth stmt 2))
(post (nth stmt 3))
(body (nth stmt 4)))
(let
((env0 (cond (= init nil) env :else (go-eval-stmt env init))))
(cond
(go-eval-error? env0)
env0
:else (go-for-loop env0 cnd post body))))))
(define
go-for-loop
(fn
(env cnd post body)
(let
((c (cond (= cnd nil) true :else (go-eval env cnd))))
(cond
(go-eval-error? c)
c
(not c)
env
:else (let
((r (cond (= body nil) env (and (list? body) (= (first body) :block)) (go-eval-block env (nth body 1)) :else env)))
(cond
(and (list? r) (= (first r) :return-value))
r
(= r :break)
env
(= r :continue)
(let
((env1 (cond (= post nil) env :else (go-eval-stmt env post))))
(cond
(go-eval-error? env1)
env1
:else (go-for-loop env1 cnd post body)))
(go-eval-error? r)
r
(go-panic? r)
r
:else (let
((env1 (cond (= post nil) r :else (go-eval-stmt r post))))
(cond
(go-eval-error? env1)
env1
:else (go-for-loop env1 cnd post 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) :for))
(go-eval-for env stmt)
(and (list? stmt) (= (first stmt) :break))
:break (and (list? stmt) (= (first stmt) :continue))
:continue (and (list? stmt) (= (first stmt) :inc-dec))
(go-eval-inc-dec env stmt)
(and (list? stmt) (= (first stmt) :func-decl))
(go-eval-func-decl env stmt)
(and (list? stmt) (= (first stmt) :method-decl))
(go-eval-method-decl env stmt)
(and (list? stmt) (= (first stmt) :type-decl))
(go-eval-type-decl env stmt)
(and (list? stmt) (= (first stmt) :send))
(let
((ch (go-eval env (nth stmt 1)))
(v (go-eval env (nth stmt 2))))
(cond
(go-eval-error? ch)
ch
(go-eval-error? v)
v
(not (go-chan? ch))
(list :eval-error :send-not-chan ch)
:else (do (go-chan-send! ch v) env)))
(and (list? stmt) (= (first stmt) :defer))
(go-eval-defer-stmt env stmt)
(and (list? stmt) (= (first stmt) :go))
;; v0: synchronous spawn. A panic from the spawned expression
;; that the goroutine didn't recover propagates here — real
;; Go would crash the whole program; the sync model surfaces
;; it back to the spawner which has the same end-effect.
(let
((v (go-eval env (nth stmt 1))))
(cond
(go-eval-error? v) v
(go-panic? v) v
:else env))
(and (list? stmt) (= (first stmt) :select))
(let
((r (go-eval-select-stmt env stmt)))
(cond
(go-eval-error? r)
r
(and (list? r) (= (first r) :return-value))
r
(= r :break)
r
(= r :continue)
r
:else r))
(and (list? stmt) (= (first stmt) :range-for))
(go-eval-range-for env stmt)
:else (let ((v (go-eval env stmt))) (cond (go-eval-error? v) v (go-panic? v) v :else env)))))
(define
go-select-try-case
(fn
(env comm)
(cond
(and (list? comm) (= (first comm) :send))
(let
((ch (go-eval env (nth comm 1)))
(v (go-eval env (nth comm 2))))
(cond
(go-eval-error? ch)
ch
(go-eval-error? v)
v
(not (go-chan? ch))
(list :eval-error :send-not-chan ch)
:else (do (go-chan-send! ch v) env)))
(and
(list? comm)
(or (= (first comm) :short-decl) (= (first comm) :assign)))
(let
((lhs-list (nth comm 1)) (exprs (nth comm 2)))
(cond
(not (= (len exprs) 1))
:not-ready :else
(let
((rhs (first exprs)))
(cond
(not
(and
(list? rhs)
(= (first rhs) :app)
(list? (nth rhs 1))
(= (first (nth rhs 1)) :var)
(= (nth (nth rhs 1) 1) "<-")
(= (len (nth rhs 2)) 1)))
:not-ready :else
(let
((ch (go-eval env (first (nth rhs 2)))))
(cond
(go-eval-error? ch)
ch
(not (go-chan? ch))
(list :eval-error :recv-not-chan ch)
(= (go-chan-len ch) 0)
:not-ready :else
(let
((v (go-chan-recv! ch)))
(cond
(= v :empty)
:not-ready :else
(let
((names (map (fn (lhs) (cond (and (list? lhs) (= (first lhs) :var)) (nth lhs 1) :else :unknown)) lhs-list)))
(cond
(= (len names) 0)
env
:else (go-env-extend env (first names) v)))))))))))
(and
(list? comm)
(= (first comm) :app)
(list? (nth comm 1))
(= (first (nth comm 1)) :var)
(= (nth (nth comm 1) 1) "<-")
(= (len (nth comm 2)) 1))
(let
((ch (go-eval env (first (nth comm 2)))))
(cond
(go-eval-error? ch)
ch
(not (go-chan? ch))
(list :eval-error :recv-not-chan ch)
(= (go-chan-len ch) 0)
:not-ready :else
(do (go-chan-recv! ch) env)))
:else :not-ready)))
(define
go-select-pick
(fn
(env cases default-case)
(cond
(or (= cases nil) (= (len cases) 0))
(cond
(= default-case nil)
(list :eval-error :select-blocked-no-default)
:else (go-eval-block env (nth default-case 1)))
:else (let
((c (first cases)))
(cond
(and (list? c) (= (first c) :default))
(go-select-pick env (rest cases) c)
(and (list? c) (= (first c) :select-case))
(let
((maybe-env (go-select-try-case env (nth c 1))))
(cond
(= maybe-env :not-ready)
(go-select-pick env (rest cases) default-case)
(go-eval-error? maybe-env)
maybe-env
:else (go-eval-block maybe-env (nth c 2))))
:else (go-select-pick env (rest cases) default-case))))))
(define
go-eval-select-stmt
(fn (env stmt) (go-select-pick env (nth stmt 1) nil)))
(define
go-ast-name
(fn
(ast)
(cond
(and (list? ast) (= (first ast) :var))
(nth ast 1)
:else nil)))
(define
go-range-extend
(fn
(env key-name value-name k v)
(cond
(and (not (= key-name nil)) (not (= value-name nil)))
(go-env-extend (go-env-extend env key-name k) value-name v)
(not (= key-name nil))
(go-env-extend env key-name k)
:else env)))
(define
go-range-body
(fn
(env body)
(cond
(and (list? body) (= (first body) :block))
(go-eval-block env (nth body 1))
:else env)))
(define
go-range-slice-loop
(fn
(env elems i key-name value-name body original-env)
(cond
(>= i (len elems))
env
:else (let
((env2 (go-range-extend env key-name value-name i (nth elems i))))
(let
((r (go-range-body env2 body)))
(cond
(and (list? r) (= (first r) :return-value))
r
(= r :break)
env
(= r :continue)
(go-range-slice-loop
env
elems
(+ i 1)
key-name
value-name
body
original-env)
(go-eval-error? r)
r
:else (go-range-slice-loop
r
elems
(+ i 1)
key-name
value-name
body
original-env)))))))
(define
go-range-map-loop
(fn
(env entries key-name value-name body original-env)
(cond
(or (= entries nil) (= (len entries) 0))
env
:else (let
((entry (first entries)))
(let
((k (first entry)) (v (nth entry 1)))
(let
((env2 (go-range-extend env key-name value-name k v)))
(let
((r (go-range-body env2 body)))
(cond
(and (list? r) (= (first r) :return-value))
r
(= r :break)
env
(= r :continue)
(go-range-map-loop
env
(rest entries)
key-name
value-name
body
original-env)
(go-eval-error? r)
r
:else (go-range-map-loop
r
(rest entries)
key-name
value-name
body
original-env)))))))))
(define
go-range-chan-loop
(fn
(env coll key-name body original-env)
(cond
(= (go-chan-len coll) 0)
env
:else (let
((v (go-chan-recv! coll)))
(let
((env2 (cond (not (= key-name nil)) (go-env-extend env key-name v) :else env)))
(let
((r (go-range-body env2 body)))
(cond
(and (list? r) (= (first r) :return-value))
r
(= r :break)
env
(= r :continue)
(go-range-chan-loop env coll key-name body original-env)
(go-eval-error? r)
r
:else (go-range-chan-loop r coll key-name body original-env))))))))
(define
go-eval-range-for
(fn
(env stmt)
(let
((key-name (go-ast-name (nth stmt 2)))
(value-name (go-ast-name (nth stmt 3)))
(coll-expr (nth stmt 4))
(body (nth stmt 5)))
(let
((coll (go-eval env coll-expr)))
(cond
(go-eval-error? coll)
coll
(and (list? coll) (= (first coll) :go-slice))
(go-range-slice-loop
env
(nth coll 1)
0
key-name
value-name
body
env)
(and (list? coll) (= (first coll) :go-map))
(go-range-map-loop
env
(nth coll 1)
key-name
value-name
body
env)
(and (list? coll) (= (first coll) :go-chan))
(go-range-chan-loop env coll key-name body env)
:else (list :eval-error :not-rangeable coll))))))
(define
go-eval-method-decl
(fn
(env stmt)
(let
((recv (nth stmt 1))
(name (nth stmt 2))
(params (nth stmt 3))
(body (nth stmt 5)))
(let
((recv-names (nth recv 1))
(recv-ty (nth recv 2)))
(let
((recv-name (cond (= (len recv-names) 0) "_" :else (first recv-names))))
(let
((type-name (go-extract-recv-ty-name recv-ty)))
(cond
(= type-name nil)
env
:else (go-env-extend
env
(str "#method/" type-name "/" name)
(list :go-method recv-name params body)))))))))
(define
go-eval-method-call
(fn
(env obj-expr method-name args)
(let
((obj (go-eval env obj-expr)))
(cond
(go-eval-error? obj)
obj
(not (and (list? obj) (= (first obj) :go-struct)))
(let
((callee (go-eval env (list :select obj-expr method-name))))
(cond
(go-eval-error? callee)
callee
:else (go-eval-call env callee args)))
:else (let
((type-name (nth obj 1)))
(let
((method-val (go-env-lookup env (str "#method/" type-name "/" method-name))))
(cond
(= method-val nil)
(list :eval-error :no-such-method type-name method-name)
:else (let
((recv-name (nth method-val 1))
(params (nth method-val 2))
(body (nth method-val 3)))
(let
((arg-vals (go-eval-args 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-env-extend (go-bind-names env param-names arg-vals) recv-name obj)))
(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-type-decl
(fn
(env stmt)
(let
((name (nth stmt 1)) (ty (nth stmt 2)))
(cond
(and (list? ty) (= (first ty) :ty-struct))
(go-env-extend
env
name
(list :go-struct-type (go-struct-field-names (nth ty 1))))
: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
(= r :break)
r
(= r :continue)
r
(go-eval-error? r)
r
(go-panic? r)
r
:else (go-eval-block r (rest stmts)))))))
(define
go-eval-program
;; Top-level driver = implicit main frame. Gets its own defer stack
;; and panic cell so `defer` and `recover()` at top level behave
;; like inside main(). Panic that escapes top-level surfaces as
;; the program's return value (tests use this to assert uncaught
;; panics).
(fn (env forms)
(let ((defer-stack (list))
(panic-cell (list :none nil)))
(let ((env (go-env-extend
(go-env-extend env "__go-defer-stack" defer-stack)
"__go-panic-cell" panic-cell)))
(let ((r (go-eval-program-loop env forms)))
(do
(cond
(go-panic? r)
(do (set-nth! panic-cell 0 :raised)
(set-nth! panic-cell 1 (nth r 1)))
:else nil)
(go-run-defers! env defer-stack)
(cond
(= (nth panic-cell 0) :recovered) env
(= (nth panic-cell 0) :raised)
(list :go-panic (nth panic-cell 1))
:else r)))))))
(define
go-eval-program-loop
(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
(go-panic? r)
r
:else (go-eval-program-loop 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) :literal-string))
;; Parser-tagged string/rune literal — pass through verbatim,
;; bypassing first-char-based reclassification.
(nth expr 1)
(and (list? expr) (= (first expr) :quoted-value))
(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) :composite))
(go-eval-composite env expr)
(and (list? expr) (= (first expr) :index))
(go-eval-index env expr)
(and (list? expr) (= (first expr) :slice))
(go-eval-slice env expr)
(and (list? expr) (= (first expr) :select))
(go-eval-select env expr)
(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))))
(and
(list? head)
(= (first head) :var)
(= (len args) 1)
(some
(fn (o) (= o (nth head 1)))
(list "-" "+" "!" "<-")))
(let
((op (nth head 1)) (v (go-eval env (first args))))
(cond
(go-eval-error? v)
v
(= op "-")
(- 0 v)
(= op "+")
v
(= op "!")
(not v)
(= op "<-")
(cond
(not (go-chan? v))
(list :eval-error :recv-not-chan v)
:else (let
((r (go-chan-recv! v)))
(cond (= r :empty) nil :else r)))
:else (list :eval-error :unsupported-unary op)))
(and (list? head) (= (first head) :select))
(go-eval-method-call
env
(nth head 1)
(nth head 2)
args)
: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))))