flan/lib/cjson.ml

(** Just enough JSON to read clang's AST dump.

    Not a general JSON library and not a dependency. The compiler's build
    inputs are a [clang] on PATH and nothing else — that is plan.org's "Why
    LLVM IR as text" applied a second time — so reading clang's
    [-ast-dump=json] must not drag in an opam package to parse it. What the
    dump actually contains is a narrow subset: objects, arrays, strings,
    integers, [true]/[false]/[null]. No floats appear in a declaration dump,
    but one is accepted anyway rather than being a lurking parse error.

    The reader is strict about structure and lax about what it keeps: a dump of
    raylib.h is 1.8 MB and roughly fifty thousand objects, almost all of it
    source ranges nobody asks for. Parsing it whole and then selecting is still
    well under the cost of the [clang] process that produced it, so there is no
    streaming filter here and no reason for one. *)

type t =
  | Null
  | Bool of bool
  | Num  of float
  | Str  of string
  | Arr  of t list
  | Obj  of (string * t) list

exception Bad of string

let bad fmt = Printf.ksprintf (fun m -> raise (Bad m)) fmt

let parse (s : string) : t =
  let n = String.length s in
  let i = ref 0 in
  let peek () = if !i < n then s.[!i] else '\000' in
  let rec skip_ws () =
    if !i < n then
      match s.[!i] with
      | ' ' | '\t' | '\n' | '\r' -> incr i; skip_ws ()
      | _ -> ()
  in
  let expect c =
    if !i >= n || s.[!i] <> c then
      bad "expected %c at byte %d" c !i
    else incr i
  in
  let lit word v =
    let l = String.length word in
    if !i + l <= n && String.sub s !i l = word then (i := !i + l; v)
    else bad "bad literal at byte %d" !i
  in
  (* Strings are the hot path — every node has several — so the common case of
     no escape at all is copied out in one [String.sub] rather than a character
     at a time through a Buffer. *)
  let string_ () =
    expect '"';
    let start = !i in
    let rec scan plain =
      if !i >= n then bad "unterminated string at byte %d" start
      else
        match s.[!i] with
        | '"' -> plain
        | '\\' -> i := !i + 2; scan false
        | _ -> incr i; scan plain
    in
    let plain = scan true in
    if plain then begin
      let r = String.sub s start (!i - start) in
      incr i; r
    end
    else begin
      let b = Buffer.create (!i - start) in
      let j = ref start in
      while !j < !i do
        (match s.[!j] with
         | '\\' ->
           incr j;
           (match s.[!j] with
            | 'n' -> Buffer.add_char b '\n'
            | 't' -> Buffer.add_char b '\t'
            | 'r' -> Buffer.add_char b '\r'
            | 'b' -> Buffer.add_char b '\b'
            | 'f' -> Buffer.add_char b '\012'
            | '/' -> Buffer.add_char b '/'
            | '"' -> Buffer.add_char b '"'
            | '\\' -> Buffer.add_char b '\\'
            | 'u' ->
              (* clang escapes a non-ASCII identifier or a comment this way.
                 Encoded as UTF-8; a surrogate pair is not joined, which is
                 acceptable because nothing this reads is ever a name Flan
                 could use anyway. *)
              let hex = String.sub s (!j + 1) 4 in
              j := !j + 4;
              let c = int_of_string ("0x" ^ hex) in
              if c < 0x80 then Buffer.add_char b (Char.chr c)
              else if c < 0x800 then begin
                Buffer.add_char b (Char.chr (0xC0 lor (c lsr 6)));
                Buffer.add_char b (Char.chr (0x80 lor (c land 0x3F)))
              end
              else begin
                Buffer.add_char b (Char.chr (0xE0 lor (c lsr 12)));
                Buffer.add_char b (Char.chr (0x80 lor ((c lsr 6) land 0x3F)));
                Buffer.add_char b (Char.chr (0x80 lor (c land 0x3F)))
              end
            | c -> bad "unknown escape \\%c at byte %d" c !j)
         | c -> Buffer.add_char b c);
        incr j
      done;
      incr i;
      Buffer.contents b
    end
  in
  let number () =
    let start = !i in
    if peek () = '-' then incr i;
    let digits () = while !i < n && s.[!i] >= '0' && s.[!i] <= '9' do incr i done in
    digits ();
    if peek () = '.' then (incr i; digits ());
    if peek () = 'e' || peek () = 'E' then begin
      incr i;
      if peek () = '+' || peek () = '-' then incr i;
      digits ()
    end;
    if !i = start then bad "expected a number at byte %d" start;
    Num (float_of_string (String.sub s start (!i - start)))
  in
  let rec value () =
    skip_ws ();
    match peek () with
    | '{' ->
      incr i; skip_ws ();
      if peek () = '}' then (incr i; Obj [])
      else begin
        let acc = ref [] in
        let rec members () =
          skip_ws ();
          let k = string_ () in
          skip_ws (); expect ':';
          let v = value () in
          acc := (k, v) :: !acc;
          skip_ws ();
          if peek () = ',' then (incr i; members ()) else expect '}'
        in
        members ();
        Obj (List.rev !acc)
      end
    | '[' ->
      incr i; skip_ws ();
      if peek () = ']' then (incr i; Arr [])
      else begin
        let acc = ref [] in
        let rec items () =
          let v = value () in
          acc := v :: !acc;
          skip_ws ();
          if peek () = ',' then (incr i; items ()) else expect ']'
        in
        items ();
        Arr (List.rev !acc)
      end
    | '"' -> Str (string_ ())
    | 't' -> lit "true" (Bool true)
    | 'f' -> lit "false" (Bool false)
    | 'n' -> lit "null" Null
    | _ -> number ()
  in
  let v = value () in
  skip_ws ();
  if !i <> n then bad "trailing bytes at %d" !i;
  v

(* ── Getters ───────────────────────────────────────────────────────── *)

let mem k = function Obj kvs -> List.assoc_opt k kvs | _ -> None
let str k j = match mem k j with Some (Str s) -> Some s | _ -> None
let bool k j = match mem k j with Some (Bool b) -> b | _ -> false
let arr k j = match mem k j with Some (Arr l) -> l | _ -> []