rose-ash/lib/go/eval.sx

;; 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"))))

(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))
        (= 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)
        :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 for this call frame.
                  ;; Mutated by go-eval-defer-stmt via append!; drained
                  ;; LIFO before the call returns. Replaces any outer
                  ;; frame's stack (defers are frame-local).
                  (let ((defer-stack (list)))
                    (let ((frame-env
                            (go-env-extend
                              call-env "__go-defer-stack" defer-stack)))
                      (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
                            (go-run-defers! frame-env defer-stack)
                            (cond
                              (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 :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
          :else (go-eval-block r (rest stmts)))))))

(define
  go-eval-program
  ;; Top-level driver. The "implicit main frame" gets its own defer
  ;; stack so `defer` at top level (which is what most runtime tests
  ;; use) behaves like deferring in main. The stack is drained after
  ;; all forms run.
  (fn (env forms)
    (let ((defer-stack (list)))
      (let ((env (go-env-extend env "__go-defer-stack" defer-stack)))
        (let ((r (go-eval-program-loop env forms)))
          (do
            (go-run-defers! env defer-stack)
            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
          :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))))