189 lines
7.3 KiB
OCaml
189 lines
7.3 KiB
OCaml
(** 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, and a defn's
|
|
{:where ...} clause. Braces are not a type: the
|
|
{K V} spelling was withdrawn for (Map K V). 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
|