flan/lib/form.ml

(** The reader's output: syntax, before any typing or macro expansion.

    Deliberately dumb. [true], [false] and [nil] are ordinary symbols here and
    are resolved later; the reader knows nothing about special forms. *)

type t = {
  v   : value;
  loc : Loc.t;
}

and value =
  | Sym   of string        (* foo  rl/draw-fps  .pos  + *)
  | Kw    of string        (* :space  :else                    (leading : dropped) *)
  | Int   of int64         (* 42  -1  0xE6B800FF *)
  | Float of float         (* 0.05 *)
  | Str   of string        (* "SAND" *)
  | Byte  of int           (* \space  \0  \(                   (0..255) *)
  | List  of t list        (* (f x) *)
  | Vec   of t list        (* [1 2 3]  and every binding/type bracket *)
  | Map   of t list        (* {.field v} a struct value, {K V} a type. The
                              colon spelling is left for map literals. *)

let make v loc = { v; loc }

let rec to_string f =
  let seq l = String.concat " " (List.map to_string l) in
  match f.v with
  | Sym s   -> s
  | Kw s    -> ":" ^ s
  | Int i   -> Int64.to_string i
  | Float x -> Printf.sprintf "%g" x
  | Str s   -> Printf.sprintf "%S" s
  | Byte b  ->
    (match Char.chr b with
     | ' '  -> "\\space"
     | '\t' -> "\\tab"
     | '\n' -> "\\newline"
     | c    -> Printf.sprintf "\\%c" c)
  | List l  -> "(" ^ seq l ^ ")"
  | Vec l   -> "[" ^ seq l ^ "]"
  | Map l   -> "{" ^ seq l ^ "}"

(* ── Printing a Form back as source ─────────────────────────────────

   [to_string] above is an error-message renderer: one line, no width, and
   [%S] and [%g] where a reader's own spelling was never needed to say
   "expected a name, found this". It is also what [Macro.key] digests, so it
   is left exactly as it is — every cached macro module on disk is keyed by
   what it prints today.

   What follows is the other job, and it arrived with [C-c C-m]: text a person
   reads and a reader reads back. An expansion is *only* text. A macro answers
   a [Form] and nothing in the language ever wrote it down, so unlike every
   other thing the editor shows there is no file to point at and no source to
   fall back on — whatever this prints is the whole of what anybody sees.

   Three places where [to_string] is not a round trip, all of them reachable
   from an expansion because a macro may build any literal at all:

   - [%g] prints 1.0 as "1", which reads back as an [Int], and it truncates at
     six significant digits. Shortest-round-trip here, then a ".0" when
     nothing in the text says "float".
   - [%S] is OCaml's escaping. The reader takes exactly six escapes — newline,
     tab, return, backslash, quote and nul — and every other byte literally,
     so the three-digit decimal escape [%S] writes would not read back.
   - [Byte] falls through to \<char>, which spells 0 and 13 as a NUL and a
     carriage return sitting in the middle of the source. The reader has names
     for those and this uses them. *)

let escape s =
  let b = Buffer.create (String.length s + 2) in
  String.iter
    (fun c ->
       match c with
       | '\n' -> Buffer.add_string b "\\n"
       | '\t' -> Buffer.add_string b "\\t"
       | '\r' -> Buffer.add_string b "\\r"
       | '\\' -> Buffer.add_string b "\\\\"
       | '"' -> Buffer.add_string b "\\\""
       | '\000' -> Buffer.add_string b "\\0"
       | c -> Buffer.add_char b c)
    s;
  Buffer.contents b

let float_repr x =
  (* The shortest of the three precisions that survives [float_of_string] is
     the one the reader parses back to the same bits. 15 covers almost every
     literal anyone writes; 17 covers every double there is. *)
  let rec shortest = function
    | [] -> Printf.sprintf "%.17g" x
    | p :: ps ->
      let s = Printf.sprintf "%.*g" p x in
      if float_of_string s = x then s else shortest ps
  in
  let s = shortest [ 15; 16; 17 ] in
  (* "1" is an integer to the reader, so a float whose text has no point and
     no exponent needs one. Guarded on the text and not on the value: nan and
     the infinities print as words, and "nan.0" is no improvement on a literal
     no reader accepts either way. *)
  let plain =
    s <> ""
    && String.for_all (fun c -> (c >= '0' && c <= '9') || c = '-' || c = '+') s
  in
  if plain then s ^ ".0" else s

let byte_repr b =
  match b with
  | 32 -> "\\space"
  | 9 -> "\\tab"
  | 10 -> "\\newline"
  | 13 -> "\\return"
  | 0 -> "\\nul"
  (* Printable ASCII is written as itself. Anything else has no spelling in
     the reader at all — [read_byte] takes a name or a single character — so
     it is written as the decimal the reader would have to grow, rather than
     as a byte that would corrupt the line it is on. *)
  | b when b > 32 && b < 127 -> Printf.sprintf "\\%c" (Char.chr b)
  | b -> Printf.sprintf "\\%d" b

(** One line, and a reader reads it back. *)
let rec to_source f =
  let seq l = String.concat " " (List.map to_source l) in
  match f.v with
  | Sym s -> s
  | Kw s -> ":" ^ s
  | Int i -> Int64.to_string i
  | Float x -> float_repr x
  | Str s -> "\"" ^ escape s ^ "\""
  | Byte b -> byte_repr b
  | List l -> "(" ^ seq l ^ ")"
  | Vec l -> "[" ^ seq l ^ "]"
  | Map l -> "{" ^ seq l ^ "}"

(** The same text with line breaks in it, for a form too wide to read on one.

    Where the breaks go, and deliberately not where the columns do. A list
    that fits is written flat; one that does not keeps its head on the opening
    line and puts each remaining element on its own, two columns in. That is
    the structural half, which a printer has to decide. The indentation is the
    editor's: [flan-mode] re-indents what it is shown, and that is where this
    project's indentation rules already live, so nothing here tries to know
    that a [let] aligns its bindings under the bracket. A client with no Emacs
    still gets something readable rather than one very long line. *)
let pretty ?(width = 72) (f : t) : string =
  let b = Buffer.create 256 in
  let rec go col f =
    let flat = to_source f in
    if col + String.length flat <= width then Buffer.add_string b flat
    else
      let elements ind rest =
        List.iter
          (fun e ->
             Buffer.add_char b '\n';
             Buffer.add_string b (String.make ind ' ');
             go ind e)
          rest
      in
      match f.v with
      (* A call or a special form: the head names what this is, so it stays on
         the opening line whatever the rest of it costs. *)
      | List (({ v = Sym _; _ } as h) :: rest) ->
        Buffer.add_char b '(';
        Buffer.add_string b (to_source h);
        elements (col + 2) rest;
        Buffer.add_char b ')'
      | List (x :: rest) ->
        Buffer.add_char b '(';
        go (col + 1) x;
        elements (col + 1) rest;
        Buffer.add_char b ')'
      | Vec (x :: rest) ->
        Buffer.add_char b '[';
        go (col + 1) x;
        elements (col + 1) rest;
        Buffer.add_char b ']'
      | Map (x :: rest) ->
        Buffer.add_char b '{';
        go (col + 1) x;
        elements (col + 1) rest;
        Buffer.add_char b '}'
      (* An empty bracket, or a single atom longer than the width. Neither has
         a break in it to take. *)
      | _ -> Buffer.add_string b flat
  in
  go 0 f;
  Buffer.contents b