;;;; An EDN tokenizer, in Flan, over a [u8].
;;;;
;;;; This is half of a reader. It answers one question — "what is the next
;;;; token, and where" — and it answers it without allocating anything: every
;;;; token's text is a `slice` of the input buffer, not a copy of it. The other
;;;; half, `(read-edn Enemy bytes)` emitting a parser from a compile-time walk
;;;; over a struct's fields, belongs to the compiler and is not here. Until it
;;;; exists a caller writes the struct reader by hand against this cursor;
;;;; test/programs/edn.flan is a worked example of doing exactly that.
;;;;
;;;; ── The lifetime contract, which the type system does not state ─────
;;;;
;;;; A Token's `text` is a slice INTO the buffer the Cursor was built over.
;;;; It is ptr+len and it owns nothing. Therefore:
;;;;
;;;;   * the input buffer must outlive every Token taken from it, and every
;;;;     Cursor over it;
;;;;   * mutating the input while tokens are live changes their text under
;;;;     them, because they are views and not copies;
;;;;   * a Token returned out of the function that owns the buffer is a
;;;;     dangling pointer, and nothing in the language will say so.
;;;;
;;;; That is the price of not allocating, and it is written here because it is
;;;; the kind of contract that otherwise gets discovered from a corrupted
;;;; string three frames later.
;;;;
;;;; ── What is refused, and why ────────────────────────────────────────
;;;;
;;;; Every refusal below is a *named* one with a reason attached, reachable as
;;;; (edn/error-message code). A tokenizer that quietly skipped what it did not
;;;; understand would hand a caller a value that is not the one in the file.
;;;;
;;;;   escaped strings   "a\nb", "a\"b"   — the important one. Unescaping needs
;;;;                     somewhere to put the unescaped copy, and there is no
;;;;                     allocator, so there is nowhere. Returning the raw
;;;;                     bytes including the backslash would be quietly wrong:
;;;;                     a caller comparing against "a\nb" would get a 4-byte
;;;;                     answer where it expected 3, and a caller printing it
;;;;                     would print a backslash. So a backslash inside a
;;;;                     string is an error at the byte it appears on.
;;;;   sets              #{1 2}  — needs a hash set to even represent.
;;;;   tagged literals   #foo {} — the tag decides the type, and dispatching on
;;;;                     a tag at run time is what a type-directed reader
;;;;                     exists to avoid.
;;;;   #inst, #uuid      named separately from tagged literals because they are
;;;;                     the two a real file is most likely to contain, and
;;;;                     "tagged literals are refused" would not tell a caller
;;;;                     that a timestamp is the thing to remove.
;;;;   ratios            22/7    — there is no rational type.
;;;;   metadata          ^{:a 1} — it attaches to the value after it, and a
;;;;                     flat token stream has nowhere to attach anything.
;;;;   characters        \a      — outside the requested subset; a char is not
;;;;                     a byte once anything is non-ASCII, and there is no
;;;;                     code point type.
;;;;
;;;; ── One place this is not EDN, on the record ────────────────────────
;;;;
;;;; `.5` is a float here. In EDN a number must begin with a digit and `.` is
;;;; a legal symbol-start byte, so strictly `.5` is the *symbol* `.5` — which
;;;; makes this a reinterpretation of a legal token and not an extension, and
;;;; therefore the kind of thing that gets written down rather than discovered.
;;;; It is this way because number-start? runs before the symbol case and
;;;; parse-f64 accepts a leading dot; a caller who needs the symbol reading
;;;; should not be writing `.5` at all. `-`, by contrast, is a symbol, because
;;;; number-start? requires a digit after the sign.
;;;;
;;;; ── Errors ──────────────────────────────────────────────────────────
;;;;
;;;; On the cursor, not in the return type. `next` answers a Token whose kind
;;;; is tok-error, and the cursor carries the code and the byte offset it was
;;;; found at; (edn/error-message code) turns the code into the sentence. The
;;;; offset is the point: an editor underlines a byte range, and an Option with
;;;; no position could not tell it where. An (Option Token) was the alternative
;;;; and it loses exactly that — None says something went wrong, and a second
;;;; out-parameter for the position is the same two fields with a worse shape.
;;;;
;;;; A failed cursor is poisoned: every later `next` answers the same error
;;;; token without advancing. That is what stops a caller's `while` loop from
;;;; spinning on a malformed file forever.

;; ── Token kinds ─────────────────────────────────────────────────────
;;
;; Plain i32 constants and not a `defenum`, which is the shape that wants
;; explaining. An enum here is FFI-only: `=` on an Enum value fails in emit,
;; and a keyword is not a pattern, so `match` cannot see one either. Both fixes
;; live in check.ml and emit.ml, which this lane does not touch. An i32 loses
;; the compile-time typo check on a keyword and gains a token kind a caller can
;; actually branch on, which is the whole job.

(defconst tok-eof        0)   ; the input is exhausted; text is empty
(defconst tok-error      1)   ; see (edn/error c) and (edn/error-message ...)
(defconst tok-nil        2)   ; nil
(defconst tok-bool       3)   ; true / false   — text is the word
(defconst tok-int        4)   ; text parses as i64
(defconst tok-float      5)   ; text parses as f64
(defconst tok-string     6)   ; text is the CONTENTS, without the quotes
(defconst tok-keyword    7)   ; text is WITHOUT the leading colon
(defconst tok-symbol     8)   ; text is the symbol, namespace and all
(defconst tok-vec-open   9)   ; [
(defconst tok-vec-close  10)  ; ]
(defconst tok-map-open   11)  ; {
(defconst tok-map-close  12)  ; }
(defconst tok-list-open  13)  ; (
(defconst tok-list-close 14)  ; )

;; ── Error codes ─────────────────────────────────────────────────────

(defconst err-none             0)
(defconst err-unexpected-byte  1)
(defconst err-unterminated     2)
(defconst err-string-escape    3)   ; refusal
(defconst err-set              4)   ; refusal
(defconst err-tagged           5)   ; refusal
(defconst err-inst             6)   ; refusal
(defconst err-uuid             7)   ; refusal
(defconst err-metadata         8)   ; refusal
(defconst err-ratio            9)   ; refusal
(defconst err-char             10)  ; refusal
(defconst err-bad-number       11)
(defconst err-empty-keyword    12)
(defconst err-unbalanced       13)  ; a closer that does not match what is open
(defconst err-too-deep         14)
(defconst err-unexpected-token 15)  ; raised by a caller, not by the tokenizer

;; How deep a nesting the balance check can follow. A fixed array in the
;; Cursor and not a growable stack, because there is no allocator; 32 is far
;; past anything a hand-written config file contains, and past it the answer is
;; err-too-deep rather than a silently unchecked closer.
(defconst max-depth 32)

;; ── The types ───────────────────────────────────────────────────────

;; `text` is a slice of the Cursor's `src`. Read the lifetime contract at the
;; top of this file before storing one anywhere.
;;
;; `pos` is the offset of the token's first byte in the ORIGINAL buffer — of
;; the opening quote for a string, of the colon for a keyword — so it stays a
;; usable underline position even though `text` is narrower than the token.
(defstruct Token
  [kind i32
   text [u8]
   pos  i32])

;; The cursor owns no storage either: `src` is the caller's buffer.
;;
;; `open` is the stack of delimiters still open, holding the tok-*-close kind
;; each one is waiting for. Balance is checked in `next` itself rather than
;; left to a parser, because `[1 2}` is malformed in a way only the tokenizer
;; has the position for.
(defstruct Cursor
  [src     [u8]
   pos     i32
   err     i32
   err-pos i32
   open    [max-depth i32]
   depth   i32])

;; ── Construction ────────────────────────────────────────────────────

(defn cursor [src [u8]] Cursor
  (Cursor {:src src :pos 0 :err err-none :err-pos 0 :depth 0}))

(defn ok? [c (Ptr Cursor)] bool
  (= (.err c) err-none))

(defn error [c (Ptr Cursor)] i32
  (.err c))

(defn error-pos [c (Ptr Cursor)] i32
  (.err-pos c))

;; Each refusal names itself and says why, so a file that uses one fails with
;; the sentence explaining what to do about it rather than with a code.
(defn error-message [code i32] string
  (cond
    (= code err-none)             "no error"
    (= code err-unexpected-byte)  "unexpected byte: not the start of any EDN value"
    (= code err-unterminated)     "unterminated string: end of input before the closing quote"
    (= code err-string-escape)    "escaped strings are refused: unescaping needs a copy of the bytes, and there is no allocator to put one in"
    (= code err-set)              "sets #{} are refused: there is no hash set, and no allocator to build one in"
    (= code err-tagged)           "tagged literals #tag are refused: the tag would pick the type at run time, which is what a type-directed reader exists to avoid"
    (= code err-inst)             "#inst is refused: it is a tagged literal, and there is no timestamp type to read it into"
    (= code err-uuid)             "#uuid is refused: it is a tagged literal, and there is no uuid type to read it into"
    (= code err-metadata)         "metadata ^ is refused: it attaches to the value after it, and a flat token stream has nowhere to attach it"
    (= code err-ratio)            "ratios are refused: there is no rational type, and rounding one to a float would change the value"
    (= code err-char)             "character literals are refused: a character is not a byte once it is not ASCII, and there is no code point type"
    (= code err-bad-number)       "not a number: the token starts like one but does not parse as an integer or a float"
    (= code err-empty-keyword)    "empty keyword: a colon with no name after it"
    (= code err-unbalanced)       "unbalanced: this closing delimiter does not match the one that is open"
    (= code err-too-deep)         "nesting is too deep: the balance stack is a fixed array and it is full"
    (= code err-unexpected-token) "unexpected token: not the kind the caller was reading"
    :else                         "unknown error code"))

;; Marks the cursor failed. Public, because a caller's own reader needs to
;; report "expected an integer here" with a position the same way this file
;; does, and there is nowhere else the position would come from.
;;
;; The first failure wins: a later one would overwrite the offset that
;; explains the file, with an offset that is merely downstream of it.
(defn fail [c (Ptr Cursor)  code i32  pos i32]
  (when (= (.err c) err-none)
    (set (.err c) code)
    (set (.err-pos c) pos)))

;; ── Byte classes ────────────────────────────────────────────────────

;; A comma is whitespace in EDN, which is the rule most hand-written readers
;; get wrong: {:a 1, :b 2} is one map and the comma is not a token.
(defn ws? [b u8] bool
  (or (space? b) (= b \,)))

;; Everything that ends an unquoted token. Note `;` is here: `[1;c` has the
;; comment start immediately after the 1, with no space, and a scanner that
;; only stopped on whitespace and brackets would read "1;c" as one number.
(defn delim? [b u8] bool
  (or (ws? b)
      (= b \() (= b \)) (= b \[) (= b \]) (= b \{) (= b \})
      (= b \") (= b \;)))

(defn alpha? [b u8] bool
  (or (and (>= b \a) (<= b \z))
      (and (>= b \A) (<= b \Z))))

;; What EDN lets a symbol begin with. It matters that this is a list and not
;; "anything that is not a delimiter": without it every stray byte becomes a
;; one-character symbol, and `@` or a backtick — a Clojure reader macro, not
;; EDN — reads as a name instead of being reported at the byte it is on.
(defn sym-start? [b u8] bool
  (or (alpha? b)
      (= b \.) (= b \*) (= b \+) (= b \!) (= b \-) (= b \_)
      (= b \?) (= b \$) (= b \%) (= b \&) (= b \=) (= b \<) (= b \>)
      (= b \/)))

;; ── Internal helpers ────────────────────────────────────────────────
;;
;; "Internal" by intent and not by enforcement: a package has no visibility
;; yet, so edn/scan-atom and edn/push-open are as callable as edn/next is.
;; Nothing below is part of the API and none of it will keep its shape.

(defn at-end? [c (Ptr Cursor)] bool
  (>= (.pos c) (len (.src c))))

;; An empty slice of src, positioned at p. Used for the tokens that have no
;; text of their own — eof, error, and every delimiter. It is still a slice of
;; the input rather than a slice of nothing, so `text` has one meaning for all
;; token kinds.
(defn empty-at [c (Ptr Cursor)  p i32] [u8]
  (slice (.src c) p p))

(defn token [c (Ptr Cursor)  kind i32  lo i32  hi i32  p i32] Token
  (Token {:kind kind :text (slice (.src c) lo hi) :pos p}))

(defn error-token [c (Ptr Cursor)] Token
  (Token {:kind tok-error :text (empty-at c (.err-pos c)) :pos (.err-pos c)}))

;; Whitespace, commas, and `;` comments, which run to the newline or to the end
;; of input — a comment on the last line of a file with no trailing newline is
;; the case that decides whether the loop tests the length before the byte.
(defn skip-trivia [c (Ptr Cursor)]
  (while (not (at-end? c))
    (let [b (at (.src c) (.pos c))]
      (cond
        (ws? b)
        (set (.pos c) (+ (.pos c) 1))

        (= b \;)
        (do
          (while (and (not (at-end? c)) (!= (at (.src c) (.pos c)) \newline))
            (set (.pos c) (+ (.pos c) 1)))
          ;; The newline itself, if there is one. If there is not, at-end? is
          ;; already true and the outer loop stops.
          (when (not (at-end? c))
            (set (.pos c) (+ (.pos c) 1))))

        :else
        (return)))))

;; The end of the unquoted token starting at lo: the first delimiter, or the
;; end of input.
(defn scan-atom [c (Ptr Cursor)  lo i32] i32
  (let [i lo]
    (while (and (< i (len (.src c))) (not (delim? (at (.src c) i))))
      (set i (+ i 1)))
    i))

(defn push-open [c (Ptr Cursor)  closer i32  p i32] bool
  (when (>= (.depth c) max-depth)
    (fail c err-too-deep p)
    (return false))
  (set (at (.open c) (.depth c)) closer)
  (set (.depth c) (+ (.depth c) 1))
  true)

(defn pop-close [c (Ptr Cursor)  closer i32  p i32] bool
  (when (or (= (.depth c) 0)
            (!= (at (.open c) (- (.depth c) 1)) closer))
    (fail c err-unbalanced p)
    (return false))
  (set (.depth c) (- (.depth c) 1))
  true)

;; ── Numbers ─────────────────────────────────────────────────────────

;; A token starting with a digit, or with a sign or a dot followed by one.
;; `-` alone is a symbol in EDN and stays one here.
(defn number-start? [c (Ptr Cursor)  i i32] bool
  (let [s (.src c)]
    (when (>= i (len s))
      (return false))
    (when (digit? (at s i))
      (return true))
    (and (or (= (at s i) \-) (= (at s i) \+) (= (at s i) \.))
         (< (+ i 1) (len s))
         (digit? (at s (+ i 1))))))

(defn read-number [c (Ptr Cursor)  lo i32] Token
  (let [hi (scan-atom c lo)]
    (set (.pos c) hi)
    (let [text (slice (.src c) lo hi)]
      ;; A ratio is caught here and not by a "contains a slash" rule over every
      ;; token, because a slash is perfectly ordinary in a symbol: foo/bar is a
      ;; namespaced name and must stay one.
      (when (match (index-of-byte text \/) (Some _) true None false)
        (fail c err-ratio lo)
        (return (error-token c)))
      (when (match (parse-i64 text) (Some _) true None false)
        (return (token c tok-int lo hi lo)))
      (when (match (parse-f64 text) (Some _) true None false)
        (return (token c tok-float lo hi lo)))
      ;; "12x", and also EDN's own 1N and 1M, which have no type here.
      (fail c err-bad-number lo)
      (error-token c))))

;; ── Strings ─────────────────────────────────────────────────────────

;; The whole reason this is not three lines. `text` is the interior, between
;; the quotes — so the bytes are usable directly — but `pos` is the opening
;; quote, so an editor underlines the literal and not its contents.
;;
;; A backslash anywhere inside is the refusal, reported at the backslash
;; rather than at the start of the string, because the backslash is what has
;; to be removed.
(defn read-string [c (Ptr Cursor)  lo i32] Token
  (let [i (+ lo 1)
        s (.src c)]
    (while (< i (len s))
      (let [b (at s i)]
        (when (= b \\)
          (set (.pos c) i)
          (fail c err-string-escape i)
          (return (error-token c)))
        (when (= b \")
          (set (.pos c) (+ i 1))
          (return (token c tok-string (+ lo 1) i lo)))
        (set i (+ i 1))))
    ;; Ran off the end with the string still open. Reported at the opening
    ;; quote: that is the byte a caller has to look at, not the end of the file.
    (set (.pos c) i)
    (fail c err-unterminated lo)
    (error-token c)))

;; ── The dispatch ────────────────────────────────────────────────────

;; The one call a caller makes. Advances the cursor past the token it returns.
;;
;; A cursor that has already failed keeps answering the same error token and
;; does not advance, so `(while (!= (.kind t) tok-eof) ...)` terminates on a
;; malformed file instead of spinning.
(defn next [c (Ptr Cursor)] Token
  (when (not (ok? c))
    (return (error-token c)))
  (skip-trivia c)
  (when (at-end? c)
    ;; Something still open at the end of input is malformed, and the position
    ;; that helps is the end — the file stopped, not the value.
    (when (> (.depth c) 0)
      (fail c err-unbalanced (.pos c))
      (return (error-token c)))
    (return (Token {:kind tok-eof :text (empty-at c (.pos c)) :pos (.pos c)})))

  (let [s (.src c)
        lo (.pos c)
        b (at s lo)]
    (cond
      ;; ── Delimiters, each of which moves the balance stack ──────────
      (= b \[)
      (do (set (.pos c) (+ lo 1))
          (if (push-open c tok-vec-close lo)
            (token c tok-vec-open lo lo lo)
            (error-token c)))

      (= b \])
      (do (set (.pos c) (+ lo 1))
          (if (pop-close c tok-vec-close lo)
            (token c tok-vec-close lo lo lo)
            (error-token c)))

      (= b \{)
      (do (set (.pos c) (+ lo 1))
          (if (push-open c tok-map-close lo)
            (token c tok-map-open lo lo lo)
            (error-token c)))

      (= b \})
      (do (set (.pos c) (+ lo 1))
          (if (pop-close c tok-map-close lo)
            (token c tok-map-close lo lo lo)
            (error-token c)))

      (= b \()
      (do (set (.pos c) (+ lo 1))
          (if (push-open c tok-list-close lo)
            (token c tok-list-open lo lo lo)
            (error-token c)))

      (= b \))
      (do (set (.pos c) (+ lo 1))
          (if (pop-close c tok-list-close lo)
            (token c tok-list-close lo lo lo)
            (error-token c)))

      (= b \")
      (read-string c lo)

      ;; ── Keywords ───────────────────────────────────────────────────
      (= b \:)
      (let [hi (scan-atom c (+ lo 1))]
        (set (.pos c) hi)
        (if (= hi (+ lo 1))
          (do (fail c err-empty-keyword lo) (error-token c))
          ;; text drops the colon: a caller comparing against "name" should not
          ;; have to write ":name", and the compiler-side reader will want the
          ;; bare name to match a field against.
          (token c tok-keyword (+ lo 1) hi lo)))

      ;; ── The refusals that have their own byte ──────────────────────
      (= b \^)
      (do (set (.pos c) (+ lo 1))
          (fail c err-metadata lo)
          (error-token c))

      (= b \\)
      (do (set (.pos c) (+ lo 1))
          (fail c err-char lo)
          (error-token c))

      (= b \#)
      (let [hi (scan-atom c (+ lo 1))]
        (set (.pos c) hi)
        (cond
          ;; #{ — the brace is a delimiter, so scan-atom stopped before it and
          ;; hi is lo+1. Nothing is pushed on the balance stack: the cursor is
          ;; failing here and will not report a second thing about this file.
          (and (< (+ lo 1) (len s)) (= (at s (+ lo 1)) \{))
          (do (fail c err-set lo) (error-token c))

          (bytes=? (slice s (+ lo 1) hi) (bytes "inst"))
          (do (fail c err-inst lo) (error-token c))

          (bytes=? (slice s (+ lo 1) hi) (bytes "uuid"))
          (do (fail c err-uuid lo) (error-token c))

          :else
          (do (fail c err-tagged lo) (error-token c))))

      ;; ── Numbers, then everything else as a symbol ──────────────────
      (number-start? c lo)
      (read-number c lo)

      :else
      (let [hi (scan-atom c lo)]
        ;; Two ways to get here without a symbol. `hi = lo` would be a
        ;; zero-length atom and an infinite loop; a byte that is not a symbol
        ;; start is `@` or a backtick, which are Clojure and not EDN. Both
        ;; advance one byte before failing, so the position is the offending
        ;; byte and the loop cannot spin on it.
        (when (or (= hi lo) (not (sym-start? b)))
          (set (.pos c) (+ lo 1))
          (fail c err-unexpected-byte lo)
          (return (error-token c)))
        (set (.pos c) hi)
        (let [text (slice s lo hi)]
          (cond
            (bytes=? text (bytes "nil"))   (token c tok-nil lo hi lo)
            (bytes=? text (bytes "true"))  (token c tok-bool lo hi lo)
            (bytes=? text (bytes "false")) (token c tok-bool lo hi lo)
            :else                          (token c tok-symbol lo hi lo)))))))

;; ── Reading values out of a token ───────────────────────────────────
;;
;; Each checks the kind first. None for the wrong kind rather than a parse of
;; whatever bytes happened to be there, which is the same reason parse-i64 is
;; Flan and not strtoll.

(defn int-of [t Token] (Option i64)
  (if (= (.kind t) tok-int) (parse-i64 (.text t)) None))

;; Accepts an integer token too: 1 and 1.0 are the same number, and a config
;; file that writes `:speed 2` for an f32 field is not making a mistake.
(defn float-of [t Token] (Option f64)
  (if (or (= (.kind t) tok-float) (= (.kind t) tok-int))
    (parse-f64 (.text t))
    None))

(defn bool-of [t Token] (Option bool)
  (if (= (.kind t) tok-bool)
    (Some (bytes=? (.text t) (bytes "true")))
    None))

(defn text=? [t Token  s string] bool
  (bytes=? (.text t) (bytes s)))

;; A keyword whose name is s. The leading colon is not part of `text`, so this
;; is written (keyword=? t "hp") and not (keyword=? t ":hp").
(defn keyword=? [t Token  s string] bool
  (and (= (.kind t) tok-keyword) (bytes=? (.text t) (bytes s))))

;; ── Reading past a value ────────────────────────────────────────────

;; Consumes exactly one value — a scalar, or a whole collection with everything
;; nested inside it. This is what a struct reader calls on a map key it does
;; not know, so an extra field in a data file is ignored rather than fatal.
;;
;; Iterative on the cursor's own balance depth and not recursive: the depth is
;; already tracked, and a recursive skip would put the nesting on the C stack
;; where a deep file is a crash rather than err-too-deep.
(defn skip-value [c (Ptr Cursor)] bool
  (let [start (.depth c)
        t (next c)]
    (when (not (ok? c))
      (return false))
    (when (= (.kind t) tok-eof)
      (fail c err-unexpected-token (.pos t))
      (return false))
    ;; A scalar is one token and we are done. A closer here is a value ending
    ;; that never began, which pop-close has already reported.
    (when (<= (.depth c) start)
      (return true))
    (while (> (.depth c) start)
      (let [u (next c)]
        (when (not (ok? c))
          (return false))
        (when (= (.kind u) tok-eof)
          ;; next already failed on the open depth; this is belt and braces.
          (fail c err-unbalanced (.pos u))
          (return false))))
    true))

;; ── Expecting a kind ────────────────────────────────────────────────

;; The shape a hand-written reader is built out of: take the next token, and if
;; it is not the kind wanted, fail the cursor at that token's position with a
;; reason. The returned token is the error token in that case, so a caller that
;; forgets to test ok? still does not read a value out of the wrong kind —
;; int-of and friends answer None for tok-error.
(defn expect [c (Ptr Cursor)  kind i32] Token
  (let [t (next c)]
    (when (and (ok? c) (!= (.kind t) kind))
      (fail c err-unexpected-token (.pos t))
      (return (error-token c)))
    t))