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-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-eval-call
  ;; Apply a callable VAL to ARG-EXPRS in CALLER-ENV. Result is the
  ;; function's return value or a (:eval-error ...).
  ;;
  ;; 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
      (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)))
        (cond
          (and (list? lhs) (= (first lhs) :var))
          (go-eval-assign-pairs
            (go-env-extend env (nth lhs 1) (first vals))
            (rest lhs-list) (rest vals))
          :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) :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))))