Files
rose-ash/lib/go/eval.sx
giles 674d8115b8
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
go: eval.sx — method dispatch + unary + e2e programs + 14 tests; Phase 4 bar crossed [nothing]
Phase 4 cont. The crossings:

  * Method dispatch — Methods record under #method/TYPE/NAME (same
    mangled-key scheme the type checker uses, intentionally so eval
    and type checker can converge on a shared method-table protocol
    later). go-eval-method-call: lookup the receiver type's method,
    bind receiver param to the struct value, evaluate body. Value and
    pointer receivers treated the same in v0 (pointer semantics not
    modelled yet).
  * Method-call dispatch — In go-eval's :app branch, head=:select
    routes to go-eval-method-call. If the receiver is not a struct,
    falls back to the field-as-callable path.
  * Unary prefix ops — go-eval's :app branch checks for 1-arg :var
    head with op name "-" / "+" / "!". (Other unary ops like
    *p / &v / <-ch / ^x deferred until pointer / channel / bitwise
    semantics arrive.)

End-to-end programs verified:
  * recursive fib(10) = 55
  * struct + method + iterative loop (counter bump 7 times)
  * linear search (returns index or -1)
  * factorial via method on Counter (= 120)
  * count odd numbers in 1..10 = 5

**Phase 4 acceptance bar (80+) crossed: eval 80/80, total 457/457.**

Remaining Phase 4 work (closures, multi-return, full slice triple,
pointer semantics) refines but doesn't gate Phase 5 (goroutines).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-27 21:47:07 +00:00

960 lines
31 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.
(list
(list "len" (list :go-builtin "len"))
(list "append" (list :go-builtin "append"))
(list "print" (list :go-builtin "print"))))
(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-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.
(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))
: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.
: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)
(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)) (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))
;; (:index OBJ IDX) — slice or map element assignment
(and (list? lhs) (= (first lhs) :index))
(let ((obj-expr (nth lhs 1)) (idx-expr (nth lhs 2)))
(cond
;; only support var-rooted indexing for now
(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)))))
;; (:select OBJ FIELD) — struct field assignment
(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
;; (:inc-dec OP EXPR) where OP is "++" or "--". EXPR should be (:var NAME).
(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
;; (:for INIT COND POST BODY). Any may be nil.
(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
: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)
:else
(let ((v (go-eval env stmt)))
(cond
(go-eval-error? v) v
:else env)))))
(define
go-eval-method-decl
;; (:method-decl RECV NAME PARAMS RESULTS BODY) — register the method
;; under #method/RECV-TYPE-NAME/METHOD-NAME, value is a :go-method.
(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
;; Method dispatch: lookup #method/TYPE/NAME in env, bind receiver
;; to OBJ-value and params to ARGS, run body.
(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)))
;; Not a struct: maybe it's a callable field access? Try the
;; normal select-then-call path.
(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
;; (:type-decl NAME TYPE). For struct types we register the field-name
;; list so positional composite literals like Point{1, 2} can map
;; positions to field names. Other type aliases are silent no-ops in v0.
(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
: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) :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))))
;; Unary prefix op: head is :var with op name + 1 arg.
(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)
:else (list :eval-error :unsupported-unary op)))
;; Method-call shape: head is (:select OBJ METHOD-NAME).
(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))))