;; 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. (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)) (= 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) (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 :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)) (let ((v (go-eval env (nth stmt 1)))) (cond (go-eval-error? 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) :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))))