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.
  (list
    (list "len"    (list :go-builtin "len"))
    (list "append" (list :go-builtin "append"))
    (list "print"  (list :go-builtin "print"))))

(define
  go-env-lookup
  (fn
    (env name)
    (cond
      (= (len env) 0)
      nil
      (= (first (first env)) name)
      (nth (first env) 1)
      :else (go-env-lookup (rest env) name))))

(define go-env-extend (fn (env name value) (cons (list name value) env)))

(define
  go-eval-error?
  (fn
    (x)
    (and
      (list? x)
      (not (= (len x) 0))
      (= (first x) :eval-error))))

;; ── literal parsing ──────────────────────────────────────────────

(define
  go-hex-digit-value
  (fn
    (c)
    (cond
      (= c "0")
      0
      (= c "1")
      1
      (= c "2")
      2
      (= c "3")
      3
      (= c "4")
      4
      (= c "5")
      5
      (= c "6")
      6
      (= c "7")
      7
      (= c "8")
      8
      (= c "9")
      9
      (= c "a")
      10
      (= c "b")
      11
      (= c "c")
      12
      (= c "d")
      13
      (= c "e")
      14
      (= c "f")
      15
      (= c "A")
      10
      (= c "B")
      11
      (= c "C")
      12
      (= c "D")
      13
      (= c "E")
      14
      (= c "F")
      15
      :else -1)))

(define
  go-parse-radix-from
  (fn
    (v start radix)
    (define
      grf-loop
      (fn
        (i acc)
        (cond
          (>= i (len v))
          acc
          (= (nth v i) "_")
          (grf-loop (+ i 1) acc)
          :else (let
            ((d (go-hex-digit-value (nth v i))))
            (cond
              (or (< d 0) (>= d radix))
              acc
              :else (grf-loop (+ i 1) (+ (* acc radix) d)))))))
    (grf-loop start 0)))

(define
  go-parse-int-literal
  (fn
    (v)
    (cond
      (and
        (>= (len v) 2)
        (= (nth v 0) "0")
        (or (= (nth v 1) "x") (= (nth v 1) "X")))
      (go-parse-radix-from v 2 16)
      (and
        (>= (len v) 2)
        (= (nth v 0) "0")
        (or (= (nth v 1) "b") (= (nth v 1) "B")))
      (go-parse-radix-from v 2 2)
      (and
        (>= (len v) 2)
        (= (nth v 0) "0")
        (or (= (nth v 1) "o") (= (nth v 1) "O")))
      (go-parse-radix-from v 2 8)
      :else (go-parse-radix-from v 0 10))))

(define
  go-eval-literal
  (fn
    (v)
    (let
      ((k (go-classify-literal-string v)))
      (cond (= k :int) (go-parse-int-literal v) (= k :string) v :else v))))

;; ── binary ops ───────────────────────────────────────────────────

(define
  go-eval-binop
  (fn
    (op l r)
    (cond
      (= op "+")
      (+ l r)
      (= op "-")
      (- l r)
      (= op "*")
      (* l r)
      (= op "/")
      (/ l r)
      (= op "==")
      (= l r)
      (= op "!=")
      (not (= l r))
      (= op "<")
      (< l r)
      (= op "<=")
      (<= l r)
      (= op ">")
      (> l r)
      (= op ">=")
      (>= l r)
      (= op "&&")
      (and l r)
      (= op "||")
      (or l r)
      :else (list :eval-error :unsupported-binop op))))

;; ── main eval ────────────────────────────────────────────────────

(define
  go-eval-binop-ops
  (list "+" "-" "*" "/" "==" "!=" "<" "<=" ">" ">=" "&&" "||"))

(define
  go-is-eval-binop?
  (fn (head args)
    (and (list? head) (= (first head) :var)
         (= (len args) 2)
         (some (fn (op) (= op (nth head 1))) go-eval-binop-ops))))

(define
  go-eval-args
  ;; Returns a list of arg values or a (:eval-error ...).
  (fn (env args)
    (cond
      (or (= args nil) (= (len args) 0)) (list)
      :else
      (let ((v (go-eval env (first args))))
        (cond
          (go-eval-error? v) v
          :else
          (let ((rest-vs (go-eval-args env (rest args))))
            (cond
              (go-eval-error? rest-vs) rest-vs
              :else (cons v rest-vs))))))))

(define
  go-flatten-param-names
  ;; PARAMS is a list of (:field NAMES TYPE) groups; return a flat name list.
  (fn (params)
    (cond
      (or (= params nil) (= (len params) 0)) (list)
      :else
      (let ((field (first params)))
        (let ((names (nth field 1)))
          (go-name-concat names (go-flatten-param-names (rest params))))))))

(define
  go-name-concat
  (fn (a b)
    (cond
      (= (len a) 0) b
      :else (cons (first a) (go-name-concat (rest a) b)))))

(define
  go-bind-names
  (fn (env names vals)
    (cond
      (= (len names) 0) env
      :else
      (go-bind-names
        (go-env-extend env (first names) (first vals))
        (rest names) (rest vals)))))

(define
  go-map-get
  (fn (entries key)
    (cond
      (= (len entries) 0) nil
      (= (first (first entries)) key) (nth (first entries) 1)
      :else (go-map-get (rest entries) key))))

(define
  go-map-set
  ;; Update the key's value if present, else append. Returns a new entry list.
  (fn (entries key value)
    (cond
      (= (len entries) 0) (list (list key value))
      (= (first (first entries)) key)
      (cons (list key value) (rest entries))
      :else (cons (first entries) (go-map-set (rest entries) key value)))))

(define
  go-slice-set
  ;; Functional update on a list at index IDX. Out-of-range no-ops in v0.
  (fn (elems idx value)
    (cond
      (>= idx (len elems)) elems
      (< idx 0) elems
      (= idx 0) (cons value (rest elems))
      :else (cons (first elems) (go-slice-set (rest elems) (- idx 1) value)))))

(define
  go-eval-builtin
  ;; Run Go's predeclared builtins (len, append, print). args are
  ;; expressions; we eval them in the caller env then dispatch on NAME.
  (fn (caller-env name args)
    (let ((vals (go-eval-args caller-env args)))
      (cond
        (go-eval-error? vals) vals
        (= name "len")
        (cond
          (not (= (len vals) 1))
          (list :eval-error :builtin-arity name 1 (len vals))
          :else
          (let ((arg (first vals)))
            (cond
              (and (list? arg) (= (first arg) :go-slice)) (len (nth arg 1))
              (and (list? arg) (= (first arg) :go-map))   (len (nth arg 1))
              (string? arg) (len arg)
              :else (list :eval-error :len-not-applicable arg))))
        (= name "append")
        (cond
          (< (len vals) 1)
          (list :eval-error :builtin-arity name 1 (len vals))
          :else
          (let ((slc (first vals)) (extra (rest vals)))
            (cond
              (and (list? slc) (= (first slc) :go-slice))
              (list :go-slice (go-name-concat (nth slc 1) extra))
              :else (list :eval-error :append-not-slice slc))))
        (= name "print")
        nil  ;; v0: silent. Real impl would write to stdout.
        :else (list :eval-error :unknown-builtin name)))))

(define
  go-extract-composite-vals
  ;; For slice/array composite literals: read each element's value
  ;; (skipping :kv keys, only using values for Go's index-keyed shorthand).
  (fn (env elems)
    (cond
      (or (= elems nil) (= (len elems) 0)) (list)
      :else
      (let ((e (first elems)))
        (let ((v
                (cond
                  (and (list? e) (= (first e) :kv))
                  (go-eval env (nth e 2))
                  :else (go-eval env e))))
          (cond
            (go-eval-error? v) v
            :else
            (let ((rest-vs (go-extract-composite-vals env (rest elems))))
              (cond
                (go-eval-error? rest-vs) rest-vs
                :else (cons v rest-vs)))))))))

(define
  go-extract-map-entries
  (fn (env elems)
    (cond
      (or (= elems nil) (= (len elems) 0)) (list)
      :else
      (let ((e (first elems)))
        (cond
          (not (and (list? e) (= (first e) :kv)))
          (list :eval-error :map-elem-missing-key e)
          :else
          (let ((k (go-eval env (nth e 1))) (v (go-eval env (nth e 2))))
            (cond
              (go-eval-error? k) k
              (go-eval-error? v) v
              :else
              (let ((rest-es (go-extract-map-entries env (rest elems))))
                (cond
                  (go-eval-error? rest-es) rest-es
                  :else (cons (list k v) rest-es))))))))))

(define
  go-eval-composite
  ;; (:composite TYPE-OR-EXPR ELEMS). v0 supports slice/array/map; struct
  ;; later.
  (fn (env expr)
    (let ((ty (nth expr 1)) (elems (nth expr 2)))
      (cond
        (and (list? ty)
             (or (= (first ty) :ty-slice) (= (first ty) :ty-array)))
        (let ((vals (go-extract-composite-vals env elems)))
          (cond
            (go-eval-error? vals) vals
            :else (list :go-slice vals)))
        (and (list? ty) (= (first ty) :ty-map))
        (let ((entries (go-extract-map-entries env elems)))
          (cond
            (go-eval-error? entries) entries
            :else (list :go-map entries)))
        :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)))))
          :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)
      :else
      (let ((v (go-eval env stmt)))
        (cond
          (go-eval-error? v) v
          :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) :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))))
          :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))))