;;;; An EDN document read into a dynamic value, against an arena.
;;;;
;;;; This is the other half of programs/edn.flan. That one reads a document
;;;; whose shape is known into a struct, by hand, which is what the compiler's
;;;; (read-edn Enemy bytes) will emit. This one is what a reader handed *no*
;;;; target type has to answer with: a data type naming itself through a
;;;; (Vec Value) and a (Map string Value), holding whatever was in the file.
;;;;
;;;; ── The allocator story, which is the point of the program ───────────
;;;;
;;;; read-value below takes no allocator and names none. It does not need to:
;;;; spec-memory.md puts the allocator in the calling convention, so every
;;;; (vec-new) and (map-new) inside it takes the *context*, and the caller
;;;; chooses the tier with (with-allocator ...) around the call. An explicit
;;;; allocator at a construction site overrides that, which is how a reader
;;;; would take one as a parameter if it wanted to — but the existing idiom
;;;; already does the job, so there is no new machinery here and none needed.
;;;;
;;;; The tier has to be a region and not the heap, and that is enforced rather
;;;; than documented: a (Vec Value) whose elements own storage traps at its
;;;; construction against any allocator that can free one block. See
;;;; programs/arena-region.flan.
;;;;
;;;; ── What the region buys, said plainly ───────────────────────────────
;;;;
;;;; The document below is four levels deep and every level allocates. There is
;;;; no teardown anywhere in this file: no drop, no destructor, no recursive
;;;; free, not even a (free) call. One (free-all frame) at the bottom of main
;;;; releases every Vec block, every Map block and every entry in them, because
;;;; they all came out of the same region.
;;;;
;;;; Odin's core:encoding/json ships a hand-written recursive destroy_value in
;;;; the *library* for the heap case, and names parsing against temp_allocator
;;;; and calling free_all as the idiomatic alternative. This is that
;;;; alternative, and it needs nothing from the language that was not already
;;;; there.
;;;;
;;;; ── One lifetime that is not the region's ────────────────────────────
;;;;
;;;; A Token's text is a slice INTO the source buffer, and (string ...) over it
;;;; is a view and not a copy — so every Text, every Key and every map key here
;;;; points at `src`, not at the arena. The document outlives free-all in that
;;;; one respect and dies with the buffer instead. That is edn.flan's stated
;;;; contract and not a new one; it is repeated because a reader looking at a
;;;; value that survived a free-all would otherwise think the region had
;;;; leaked.

(import edn "vendor:edn")

(defvar frame Allocator)

(defdata Value
  [(Nil   [])
   (Bool  [b bool])
   (Int   [n i64])
   (Float [x f64])
   (Text  [s string])
   (Key   [s string])
   (List  [items (Vec Value)])
   (Table [entries (Map string Value)])])

;; One token in hand, and the cursor for whatever the token opens. A vector and
;; a map recurse; everything else is a leaf.
(defn read-value [c (Ptr edn/Cursor)  t edn/Token] Value
  (cond
    (= (.kind t) edn/tok-bool)
      (Value.Bool {.b (match (edn/bool-of t) (Some v) v None false)})
    (= (.kind t) edn/tok-int)
      (Value.Int {.n (match (edn/int-of t) (Some v) v None (i64 0))})
    (= (.kind t) edn/tok-float)
      (Value.Float {.x (match (edn/float-of t) (Some v) v None 0.0)})
    (= (.kind t) edn/tok-string)  (Value.Text {.s (string (.text t))})
    (= (.kind t) edn/tok-keyword) (Value.Key  {.s (string (.text t))})
    (= (.kind t) edn/tok-symbol)  (Value.Key  {.s (string (.text t))})

    (= (.kind t) edn/tok-vec-open)
      (let [items (vec-new Value)
            u (edn/next c)]
        (while (and (edn/ok? c)
                    (!= (.kind u) edn/tok-vec-close)
                    (!= (.kind u) edn/tok-eof))
          (push items (read-value c u))
          (set u (edn/next c)))
        (Value.List {.items items}))

    ;; A map's key is whatever token is there — a keyword here, and its text
    ;; slice is the key. The value is read by the same recursion, so a map of
    ;; vectors of maps is one call per level and no special case.
    (= (.kind t) edn/tok-map-open)
      (let [entries (map-new string Value)
            k (edn/next c)]
        (while (and (edn/ok? c)
                    (!= (.kind k) edn/tok-map-close)
                    (!= (.kind k) edn/tok-eof))
          (let [v (edn/next c)]
            (put entries (string (.text k)) (read-value c v)))
          (set k (edn/next c)))
        (Value.Table {.entries entries}))

    :else Value.Nil))

;; Walking it back. (at v i) addresses an element in place and (get m k)
;; answers a copy of the value's bytes; in a region the two are the same thing,
;; an alias into storage nobody individually owns, so a document is read back
;; with the operations that were already there.
(defn count-leaves [v Value] i32
  (match v
    (List items)
      (let [n 0]
        (dotimes [i (len items)]
          (set n (+ n (count-leaves (at items i)))))
        n)
    ;; map-next! fills an out-parameter with a copy of the value's bytes,
    ;; which for a Value holding a container is a second header over the same
    ;; block. In a region that is an alias and not a second owner — nothing
    ;; here owns anything, the arena does — so walking a map is the ordinary
    ;; iteration and needs no accessor of its own.
    (Table entries)
      (let [n 0
            cur (i64 0)
            k ""
            v Value.Nil]
        (while (map-next! entries (addr cur) (addr k) (addr v))
          (set n (+ n (count-leaves v))))
        n)
    _ 1))

(defn sum-ints [v Value] i64
  (match v
    (Int n) n
    (List items)
      (let [t (i64 0)]
        (dotimes [i (len items)]
          (set t (+ t (sum-ints (at items i)))))
        t)
    (Table entries)
      (match (get entries "xs") (Some x) (sum-ints x) None (i64 0))
    _ (i64 0)))

(defn describe [v Value] string
  (match v
    Nil "nil" (Bool _b) "bool" (Int _n) "int" (Float _x) "float"
    (Text _s) "string" (Key _s) "keyword" (List _i) "vector" (Table _e) "map"))

(defn read-doc [src string] Value
  (let [b (bytes src)
        c (edn/cursor b)
        t (edn/next (addr c))]
    (read-value (addr c) t)))

(defconst doc
  "{:name \"level-1\"
    :xs [1 2 3]
    :spawns [{:kind :grunt :at [10 20]}
             {:kind :boss  :at [30 40]}]
    :gravity 9.8
    :looping true}")

(defn main [] i32
  (set frame (arena-new 65536))
  (with-allocator frame
    (let [v (read-doc doc)]
      (println (describe v))
      (println (count-leaves v))
      (println (sum-ints v))
      (match v
        (Table entries)
          (match (get entries "name")
            (Some n) (println (describe n))
            None (println "missing"))
        _ (println "not a map"))))
  ;; The whole document, in one operation and with no per-element teardown.
  (free-all frame)
  (arena-destroy frame)
  0)