giles
b693854dc4
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
Phase 5 (goroutines + channels) opens.
lib/go/sched.sx is the **independent implementation** referenced by
plans/lib-guest-scheduler.md — the first-consumer cut whose realised
shape will inform the eventual sister kit.
Channel representation:
(list :go-chan SEND-FN RECV-FN CLOSED?-FN CLOSE!-FN)
Each closure shares a mutable `buf` (a list mutated via append! and
set!) and a `closed` flag. Channel identity is closure-instance —
two `make()` calls produce distinct values per Go spec § Channel types.
Primitive API in sched.sx:
go-make-chan / go-chan? / go-chan-send! / go-chan-recv! /
go-chan-closed? / go-chan-close!
Eval integration in eval.sx:
* `make` and `close` added as builtins. v0 `make()` takes no args
and returns an unbounded-buffer channel.
* `:send` stmt → go-chan-send! on the channel.
* Unary `<-` recv on channel values → go-chan-recv!. `:empty`
sentinel converted to nil (stand-in for blocking semantics).
* `:go expr` → synchronous eval (v0 limitation, see sched.sx
header).
**v0 concurrency model — synchronous goroutines.** SX doesn't expose
first-class continuations to guest code, so v0 runs `go f()`
immediately and depends on the spawned goroutine running to
completion before the main goroutine receives. This is the right
semantics for the simple producer/consumer patterns covered here.
True preemption with blocking send/recv is Phase 5b — requires either
a CEK-style trampolining eval rewrite or kit-level continuation
support. Logged in sched.sx header and in the sister-plan diary.
Runtime suite (12 tests):
* 6 direct API tests: identity, FIFO order, closed-flag
* 6 source-level: make + send + recv, go ping-pong, close,
multi-goroutine fan-in, worker-with-result
Sister-plan scheduler diary updated with the channel-as-closure-
bundle insight and the v0 synchronous-spawn caveat.
runtime 12/12, total 469/469.
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
998 lines
32 KiB
Plaintext
998 lines
32 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"))))
|
|
|
|
(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.
|
|
(= 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))
|
|
: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)
|
|
(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) :go))
|
|
;; v0: synchronous evaluation — no real preemption. The spawned
|
|
;; expression's value is dropped. See sched.sx header for
|
|
;; semantic notes.
|
|
(let ((v (go-eval env (nth stmt 1))))
|
|
(cond
|
|
(go-eval-error? v) v
|
|
:else env))
|
|
: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)
|
|
(= op "<-")
|
|
(cond
|
|
(not (go-chan? v)) (list :eval-error :recv-not-chan v)
|
|
:else
|
|
(let ((r (go-chan-recv! v)))
|
|
;; :empty in v0 means "no value yet" — Go would block.
|
|
;; We return nil as a stand-in for the zero value.
|
|
(cond (= r :empty) nil :else r)))
|
|
: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))))
|