flan/test/programs/edn.flan

;;;; The EDN tokenizer, and a struct reader written by hand against it.
;;;;
;;;; The second half is the point. `(read-edn Enemy bytes)` — the compiler
;;;; emitting a parser from a walk over Enemy's fields — is not built yet, so
;;;; what this file proves is that the cursor is usable *without* it: read-enemy
;;;; below is what that emitted code will look like, written out by hand. An API
;;;; that only a compiler could call would be present rather than usable.
;;;;
;;;; Every case here is one a plausible wrong version fails. Named where it is
;;;; not obvious.

(import edn "vendor:edn")

;; ── A dump of the token stream ──────────────────────────────────────
;;
;; One letter per kind, then the text in brackets, so both halves of every
;; token are asserted. A tokenizer that got the kinds right and the slices
;; wrong — off by the quote, off by the colon — would pass on the letters
;; alone.

(defn kind-letter [k i32] string
  (cond
    (= k edn/tok-eof)        "."
    (= k edn/tok-error)      "!"
    (= k edn/tok-nil)        "n"
    (= k edn/tok-bool)       "b"
    (= k edn/tok-int)        "i"
    (= k edn/tok-float)      "f"
    (= k edn/tok-string)     "s"
    (= k edn/tok-keyword)    "k"
    (= k edn/tok-symbol)     "y"
    (= k edn/tok-vec-open)   "["
    (= k edn/tok-vec-close)  "]"
    (= k edn/tok-map-open)   "{"
    (= k edn/tok-map-close)  "}"
    (= k edn/tok-list-open)  "("
    (= k edn/tok-list-close) ")"
    :else                    "?"))

(defn dump [src string]
  (let [b (bytes src)
        c (edn/cursor b)
        t (edn/next (addr c))]
    (while (and (edn/ok? (addr c)) (!= (.kind t) edn/tok-eof))
      (print-str (kind-letter (.kind t)))
      (print-str "<")
      (print-bytes (.text t))
      (print-str ">")
      (set t (edn/next (addr c))))
    (when (not (edn/ok? (addr c)))
      (print-str "ERR@")
      (print-i64 (i64 (edn/error-pos (addr c)))))
    (newline)))

;; The refusals. Asserted on the *reason*, not on the fact of failing: a
;; tokenizer that answered err-unexpected-byte for every one of these would
;; pass a test that only checked that it failed.
(defn refusal [src string]
  (let [b (bytes src)
        c (edn/cursor b)]
    (while (and (edn/ok? (addr c))
                (!= (.kind (edn/next (addr c))) edn/tok-eof)))
    (print-i64 (i64 (edn/error-pos (addr c))))
    (print-str " ")
    (print-str (edn/error-message (edn/error (addr c))))
    (newline)))

;; ── The worked example: a struct read by hand ───────────────────────

;; `name` is a [u8] and not a copy of one, so an Enemy is only valid while the
;; buffer it was read out of is. That is the lifetime contract from the package
;; header, and it is what a struct reader inherits by using slices.
(defstruct Enemy
  [name  [u8]
   hp    i32
   speed f32
   boss? bool])

;; The shape the compiler-emitted version will have: open the map, loop on the
;; keys, dispatch each known one onto its field, and skip whatever is left over
;; so an extra key in a data file is not fatal. Errors accumulate on the cursor
;; rather than being returned, which is why this can be a straight line of
;; assignments with one test at the end.
(defn read-enemy [c (Ptr edn/Cursor)] Enemy
  (let [e (Enemy {:hp 0 :speed 0.0 :boss? false})]
    (edn/expect c edn/tok-map-open)
    (while (edn/ok? c)
      (let [k (edn/next c)]
        (when (or (not (edn/ok? c)) (= (.kind k) edn/tok-map-close))
          (return e))
        (when (!= (.kind k) edn/tok-keyword)
          (edn/fail c edn/err-unexpected-token (.pos k))
          (return e))
        (cond
          (edn/keyword=? k "name")
          (set (.name e) (.text (edn/expect c edn/tok-string)))

          (edn/keyword=? k "hp")
          (set (.hp e) (i32 (match (edn/int-of (edn/expect c edn/tok-int))
                              (Some v) v None 0)))

          ;; The one field read with `next` rather than `expect`, because two
          ;; kinds are acceptable for it. The None arm is what keeps that from
          ;; being a hole: a string here fails rather than defaulting to 0.0.
          (edn/keyword=? k "speed")
          (let [v (edn/next c)]
            (match (edn/float-of v)
              (Some x) (set (.speed e) (f32 x))
              None     (edn/fail c edn/err-unexpected-token (.pos v))))

          (edn/keyword=? k "boss?")
          (set (.boss? e) (match (edn/bool-of (edn/expect c edn/tok-bool))
                            (Some v) v None false))

          ;; An unknown key: read past its value, however big it is.
          :else
          (when (not (edn/skip-value c))
            (return e)))))
    e))

(defn show-enemy [src string]
  (let [b (bytes src)
        c (edn/cursor b)
        e (read-enemy (addr c))]
    (if (edn/ok? (addr c))
      (do
        (print-str "[")
        (print-bytes (.name e))
        (print-str "] hp=")
        (print-i64 (i64 (.hp e)))
        (print-str " speed=")
        (print-f64 (f64 (.speed e)))
        (print-str " boss=")
        (print-str (if (.boss? e) "yes" "no")))
      (do
        (print-str "ERR@")
        (print-i64 (i64 (edn/error-pos (addr c))))
        (print-str " ")
        (print-str (edn/error-message (edn/error (addr c))))))
    (newline)))

(defn main [] i32
  ;; ── Scalars, and the boundaries between them ──────────────────────
  (dump "1")                     ; i<1>
  (dump "-1 +2 0")               ; the signs are part of the number
  (dump "1.5 -2.5e3 .5")         ; f, and a leading dot is a float
  (dump "true false nil")        ; b b n — and not three symbols
  ;; `-` alone is a symbol, `foo/bar` is NOT a ratio, and the uppercase half
  ;; of the alphabet test is only exercised by a name that has one in it.
  (dump "foo Enemy/Goblin -")
  (dump ":a :foo/bar")           ; k, text without the colon
  (newline)

  ;; A number followed immediately by a delimiter, with no space. A scanner
  ;; that only stopped on whitespace reads "1]" or "1;x" as one atom and then
  ;; fails to parse it.
  (dump "[1]")
  (dump "[1 2][3]")              ; two tokens with no space between them
  (dump "{:a 1}")
  (dump "1;c")                   ; a comment starting against the number
  (dump ":a;c")                  ; a keyword ending at a comment
  (newline)

  ;; Empty collections, and nesting. An empty map is the case a reader that
  ;; assumes at least one key-value pair gets wrong.
  (dump "{}")
  (dump "[]")
  (dump "()")
  (dump "[[1] [2 [3]]]")
  (dump "{:a {:b []}}")
  (newline)

  ;; A keyword at the very end of input — the loop has to test the length
  ;; before reading the byte, or this walks off the end.
  (dump ":a")
  (dump "1")
  (dump "\"x\"")
  (newline)

  ;; Comments. The last one has no trailing newline, which is the case that
  ;; separates a scan-to-newline from a scan-to-newline-or-end.
  (dump "; only a comment\n1")
  (dump "1 ; trailing\n2")
  (dump "1 ; no newline at the end")
  (dump ";")                     ; a bare comment marker, nothing after it
  (newline)

  ;; Commas are whitespace in EDN, and are not tokens.
  (dump "[1, 2 ,3]")
  (newline)

  ;; Strings. The second is the one that matters: a `[` and a `;` inside a
  ;; string must not open a vector or start a comment.
  (dump "\"hi\"")
  (dump "\"a[b;c\" 1")
  (dump "\"\" 1")                ; the empty string is a token with empty text
  (dump "\"a b\"")
  (newline)

  ;; ── The refusals, each asserted on its own reason ─────────────────
  (refusal "\"a\\nb\"")          ; an escape inside a string
  (refusal "\"a\\\"b\"")         ; an escaped quote — the case where a wrong
                                 ; version returns `a\` and leaves `b"` behind
  (refusal "\"unterminated")     ; not a refusal, but the other string failure
  (refusal "#{1 2}")             ; a set
  (refusal "#foo {}")            ; a tagged literal
  (refusal "#inst \"2024\"")     ; named separately
  (refusal "#uuid \"x\"")
  (refusal "^{:a 1} [1]")        ; metadata
  (refusal "22/7")               ; a ratio
  (refusal "\\a")                ; a character literal
  (refusal "12x")                ; starts like a number, is not one
  (refusal "[1 :]")              ; a colon with no name
  (refusal "@")                  ; not the start of any value — and the case a
                                 ; scan-to-delimiter reads as a one-byte symbol
  (refusal "`x")                 ; a Clojure reader macro, not EDN
  (refusal "[1 2}")              ; the wrong closer
  (refusal "]")                  ; a closer with nothing open
  (refusal "[1 2")               ; end of input with something still open
  ;; 33 opening brackets against a 32-deep stack. The error message is the
  ;; least of what this checks: a `>` where the guard needs `>=` writes one
  ;; past the end of a fixed array, and the answer is a bounds trap rather
  ;; than a wrong message. The offset is the 33rd bracket.
  (refusal "[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[")
  (newline)

  ;; ── The struct reader ─────────────────────────────────────────────
  (show-enemy "{:name \"goblin\" :hp 12 :speed 1.5 :boss? false}")
  ;; Fields in a different order, one missing (zeroed), one unknown key whose
  ;; value is a whole nested collection that skip-value has to walk past.
  (show-enemy "{:boss? true :loot [:gold {:n 3} [[]]] :hp 40 :name \"dragon\"}")
  ;; :speed given as an integer — 2 and 2.0 are the same number.
  (show-enemy "{:name \"imp\" :hp 1 :speed 2}")
  (show-enemy "{}")
  ;; Wrong type for a field: the reader stops and names the position.
  (show-enemy "{:name 7}")
  ;; A comment inside the map, and commas.
  (show-enemy "{:name \"orc\", ; a note\n :hp 9}")
  0)