flan convert keeps comments and number spellings in both directions, and a .fln message quotes the text as written, with let-bound match, if and block calls read as values
This commit is contained in:
parent
17f0358e92
commit
8200120bf3
10
bin/main.ml
10
bin/main.ml
@ -328,17 +328,15 @@ let () =
|
||||
|> List.iter (fun f -> print_endline (Flan.Form.to_string f))))
|
||||
files
|
||||
(* The other syntax, on stdout: a .flan file printed indented, a .fln file
|
||||
printed with parentheses. Comments are not forms, so they do not carry
|
||||
over. *)
|
||||
printed with parentheses, comments and number spellings kept both
|
||||
ways. *)
|
||||
| [ _; "convert"; path ] ->
|
||||
with_errors path (fun () ->
|
||||
let forms = Flan.Source.read_file path in
|
||||
let source = In_channel.with_open_bin path In_channel.input_all in
|
||||
if Flan.Source.is_indented path then
|
||||
print_string
|
||||
(String.concat "\n\n" (List.map (fun f -> Flan.Form.pretty f) forms)
|
||||
^ "\n")
|
||||
print_string (Flan.Paren_printer.program ~source forms)
|
||||
else
|
||||
let source = In_channel.with_open_bin path In_channel.input_all in
|
||||
match Flan.Indent_printer.program ~source forms with
|
||||
| text -> print_string text
|
||||
| exception Flan.Indent_printer.Unprintable (f, why) ->
|
||||
|
||||
@ -55,6 +55,11 @@ let paren s = "(" ^ s ^ ")"
|
||||
as 4293922815. Set by [program ~source]. *)
|
||||
let spelling : (Form.t -> string option) ref = ref (fun _ -> None)
|
||||
|
||||
(* Whether a comment sits inside a form, on a line before its last: such a
|
||||
form is not squeezed onto one line, or the comment would have no line of
|
||||
its own to go to. Set by [program ~source]. *)
|
||||
let inside : (Form.t -> bool) ref = ref (fun _ -> false)
|
||||
|
||||
(* The same form, locations aside. *)
|
||||
let rec same (a : Form.t) (b : Form.t) =
|
||||
match a.v, b.v with
|
||||
@ -331,9 +336,12 @@ let rec block n (fs : Form.t list) : string list =
|
||||
go fs
|
||||
|
||||
and stmt n ~last (f : Form.t) : string list =
|
||||
match sugar n ~last f with
|
||||
| Some ls -> ls
|
||||
| None -> plain n f
|
||||
let ls = match sugar n ~last f with Some ls -> ls | None -> plain n f in
|
||||
(* The first line carries the line the form came from, for
|
||||
[Source_text.weave] to put the comments back by. *)
|
||||
match ls with
|
||||
| first :: rest -> Source_text.tag f.loc.Loc.line first :: rest
|
||||
| [] -> []
|
||||
|
||||
and plain n (f : Form.t) : string list =
|
||||
let text =
|
||||
@ -445,7 +453,8 @@ and sugar n ~last (f : Form.t) : string list option =
|
||||
| _ -> true
|
||||
in
|
||||
let line = i ^ fst (expr f) in
|
||||
if simple a && simple b && String.length line <= width then Some [ line ]
|
||||
if simple a && simple b && String.length line <= width && not (!inside f)
|
||||
then Some [ line ]
|
||||
else
|
||||
Some
|
||||
([ i ^ "if " ^ at 1 c ] @ slot (n + 2) a @ [ i ^ "else" ] @ slot (n + 2) b)
|
||||
@ -503,7 +512,8 @@ and sugar n ~last (f : Form.t) : string list option =
|
||||
Some
|
||||
((i ^ "match " ^ at 0 s)
|
||||
:: List.concat_map
|
||||
(fun (pat, body) ->
|
||||
(fun ((pat : Form.t), body) ->
|
||||
List.mapi (fun k l -> if k = 0 then Source_text.tag pat.loc.Loc.line l else l) @@
|
||||
let pt = at 8 pat in
|
||||
let line = ind (n + 2) ^ pt ^ " -> " ^ inline_text body in
|
||||
match body.v with
|
||||
@ -569,7 +579,8 @@ and sugar n ~last (f : Form.t) : string list option =
|
||||
| [ x ] when (match x.v with
|
||||
| Form.List ({ v = Form.Sym h; _ } :: _) -> not (List.mem h sugar_heads)
|
||||
| _ -> true)
|
||||
&& String.length head + 3 + String.length (at 0 x) <= width ->
|
||||
&& String.length head + 3 + String.length (at 0 x) <= width
|
||||
&& not (!inside f) ->
|
||||
Some [ head ^ " = " ^ at 0 x ]
|
||||
| _ -> Some (head :: block (n + 2) body)))
|
||||
| Form.List ({ v = Form.Sym (("def" | "defonce" | "defconst") as d); _ }
|
||||
@ -596,7 +607,8 @@ and sugar n ~last (f : Form.t) : string list option =
|
||||
:: List.map
|
||||
(fun ((f : Form.t), t) ->
|
||||
let fname = fst (expr f) in
|
||||
ind (n + 2) ^ if is_sym "dyn" t then fname else fname ^ ": " ^ ty t)
|
||||
Source_text.tag f.loc.Loc.line
|
||||
(ind (n + 2) ^ if is_sym "dyn" t then fname else fname ^ ": " ^ ty t))
|
||||
prs)
|
||||
| _ -> None)
|
||||
| Form.List [ { v = Form.Sym "defdata"; _ }; { v = Form.Sym name; _ }; { v = Form.Vec cs; _ } ]
|
||||
@ -667,33 +679,15 @@ and let_lines n ~last prs body =
|
||||
|
||||
(** A whole file: top-level forms with a blank line between them. *)
|
||||
let program ?source (fs : Form.t list) : string =
|
||||
(* With the text the forms were read from, a number keeps its spelling:
|
||||
the text under its span, when that reads back to the same value. *)
|
||||
let lines =
|
||||
match source with
|
||||
| Some src -> Array.of_list (String.split_on_char '\n' src)
|
||||
| None -> [||]
|
||||
in
|
||||
spelling :=
|
||||
(fun (f : Form.t) ->
|
||||
let l = f.loc in
|
||||
if l.Loc.line < 1 || l.Loc.line > Array.length lines || l.Loc.eline <> l.Loc.line
|
||||
then None
|
||||
else
|
||||
let text = lines.(l.Loc.line - 1) in
|
||||
let a = l.Loc.col - 1 and b = l.Loc.ecol - 1 in
|
||||
if a < 0 || b > String.length text || b <= a then None
|
||||
else
|
||||
let t = String.sub text a (b - a) in
|
||||
match f.v with
|
||||
| Form.Int i when Int64.of_string_opt t = Some i -> Some t
|
||||
| Form.Float x
|
||||
when String.exists (fun c -> c = '.' || c = 'e' || c = 'E') t
|
||||
&& (match float_of_string_opt t with
|
||||
| Some y -> Int64.equal (Int64.bits_of_float x) (Int64.bits_of_float y)
|
||||
| None -> false) ->
|
||||
Some t
|
||||
| _ -> None);
|
||||
(match source with Some src -> Source_text.spelling src | None -> fun _ -> None);
|
||||
let cs = match source with Some src -> Source_text.comments src | None -> [] in
|
||||
(inside :=
|
||||
fun (f : Form.t) ->
|
||||
List.exists
|
||||
(fun (c : Source_text.comment) ->
|
||||
f.loc.Loc.line <= c.line && c.line < f.loc.Loc.eline)
|
||||
cs);
|
||||
let rec go = function
|
||||
| [] -> []
|
||||
| [ x ] -> [ String.concat "\n" (stmt 0 ~last:true x) ]
|
||||
@ -701,7 +695,12 @@ let program ?source (fs : Form.t list) : string =
|
||||
in
|
||||
let text =
|
||||
try String.concat "\n\n" (go fs) ^ "\n"
|
||||
with e -> spelling := (fun _ -> None); raise e
|
||||
with e -> spelling := (fun _ -> None); inside := (fun _ -> false); raise e
|
||||
in
|
||||
spelling := (fun _ -> None);
|
||||
text
|
||||
inside := (fun _ -> false);
|
||||
(* With the source, its comments go back where they were; without it the
|
||||
tags come out and nothing goes in. *)
|
||||
Source_text.weave
|
||||
(match source with Some src -> Source_text.comments src | None -> [])
|
||||
text
|
||||
|
||||
@ -380,9 +380,9 @@ let stray p ~after =
|
||||
finished here" after
|
||||
| NAME "=" ->
|
||||
failk "assign-in-test" t.loc
|
||||
"= assigns, and here it follows %s where a value is being read. To \
|
||||
compare, write ==: %s == ..."
|
||||
after after
|
||||
"this = follows %s, where it cannot assign: an assignment is a line \
|
||||
of its own, with one =. To compare two values, write == instead"
|
||||
after
|
||||
| COLON ->
|
||||
failk "header-colon" t.loc
|
||||
"this line ends in a colon after %s. A header (if, elif, else, while, \
|
||||
@ -432,8 +432,25 @@ let check_name (t : token) s =
|
||||
| None -> s)
|
||||
|
||||
(* A form's own text, for the "after" half of a message. *)
|
||||
(* The text being read, so that a message quotes what the user wrote rather
|
||||
than the paren form it became. Set for the length of one [read_all]. *)
|
||||
let source : (string * string array) ref = ref ("", [||])
|
||||
|
||||
let text_of (f : Form.t) =
|
||||
let s = Form.to_source f in
|
||||
let file, lines = !source in
|
||||
let l = f.loc in
|
||||
let from_source =
|
||||
if l.Loc.file <> file || l.Loc.line < 1 || l.Loc.line > Array.length lines then None
|
||||
else
|
||||
let text = lines.(l.Loc.line - 1) in
|
||||
let a = l.Loc.col - 1 in
|
||||
let b = if l.Loc.eline = l.Loc.line then l.Loc.ecol - 1 else String.length text in
|
||||
if a < 0 || b > String.length text || b <= a then None
|
||||
else
|
||||
let t = String.trim (String.sub text a (b - a)) in
|
||||
Some (if l.Loc.eline > l.Loc.line then t ^ " ..." else t)
|
||||
in
|
||||
let s = match from_source with Some t -> t | None -> Form.to_source f in
|
||||
if String.length s > 40 then String.sub s 0 37 ^ "..." else s
|
||||
|
||||
let unclosed p c l0 =
|
||||
@ -937,8 +954,48 @@ and value_line ?(block_ok = false) (s : st) ~after : Form.t =
|
||||
blk s l0 (block s ~after)
|
||||
end
|
||||
else
|
||||
match (peek p).tok with
|
||||
(* [let r = match a] with its arms under it, and [let r = if c] with its
|
||||
branches: a header read as the value, block and all. *)
|
||||
| NAME (("match" | "handler-case" | "handler-bind" | "restart-case") as w)
|
||||
when header_follow p w ->
|
||||
header s w
|
||||
| NAME "if" when header_follow p "if" && not (then_on_line p) -> header s "if"
|
||||
| _ ->
|
||||
let e, _ = expr p in
|
||||
lambda_block ~block_ok s e ~after:(text_of e)
|
||||
match (peek p).tok with
|
||||
(* [let v = with-foo(a):] and its block: the call takes the block, as it
|
||||
would on a line of its own. *)
|
||||
| COLON when (match e.v, (last p).tok with
|
||||
| Form.List (_ :: _), RP | Form.Sym _, NAME _ -> true
|
||||
| _ -> false) ->
|
||||
ignore (advance p);
|
||||
(match (peek p).tok with
|
||||
| NEWLINE -> ignore (advance p)
|
||||
| _ -> stray p ~after:":");
|
||||
let body = block s ~after:(text_of e ^ ":") in
|
||||
(match e.v with
|
||||
| Form.List items -> mk p e.loc (Form.List (items @ body))
|
||||
| _ -> mk p e.loc (Form.List (e :: body)))
|
||||
| COMMA ->
|
||||
failk "one-binding" (peek p).loc
|
||||
"%s is followed by a comma, and one line binds one name. Put each \
|
||||
binding on its own line, one after the other"
|
||||
(text_of e)
|
||||
| _ -> lambda_block ~block_ok s e ~after:(text_of e)
|
||||
|
||||
(* Whether this line has a [then] at depth zero: a one-line if. *)
|
||||
and then_on_line p =
|
||||
let rec go k depth =
|
||||
let t = peek_at p k in
|
||||
match t.tok with
|
||||
| NEWLINE | EOF -> false
|
||||
| NAME "then" when depth = 0 -> true
|
||||
| LP | LB | LC -> go (k + 1) (depth + 1)
|
||||
| RP | RB | RC -> go (k + 1) (max 0 (depth - 1))
|
||||
| _ -> go (k + 1) depth
|
||||
in
|
||||
go 1 0
|
||||
|
||||
and lambda_block ?(block_ok = false) (s : st) (e : Form.t) ~after =
|
||||
let p = s.p in
|
||||
@ -1474,13 +1531,16 @@ and lines (s : st) (one : unit -> Form.t list) : Form.t list =
|
||||
(** All top-level forms in a [.fln] source string. [col] is the column the
|
||||
text's top level starts at, 1 for a file. *)
|
||||
let read_all ?(col = 1) ~file src =
|
||||
let toks = layout ~base:col (lex ~file src) in
|
||||
let s = { p = { toks; i = 0 }; lets = [] } in
|
||||
let fs = stmts s in
|
||||
(match (peek s.p).tok with
|
||||
| EOF -> ()
|
||||
| tk -> failk "unexpected-token" (where_ s.p) "unexpected %s" (show tk));
|
||||
fs
|
||||
let saved = !source in
|
||||
source := (file, Array.of_list (String.split_on_char '\n' src));
|
||||
Fun.protect ~finally:(fun () -> source := saved) (fun () ->
|
||||
let toks = layout ~base:col (lex ~file src) in
|
||||
let s = { p = { toks; i = 0 }; lets = [] } in
|
||||
let fs = stmts s in
|
||||
(match (peek s.p).tok with
|
||||
| EOF -> ()
|
||||
| tk -> failk "unexpected-token" (where_ s.p) "unexpected %s" (show tk));
|
||||
fs)
|
||||
|
||||
let read_file path =
|
||||
let ic = open_in_bin path in
|
||||
|
||||
100
lib/paren_printer.ml
Normal file
100
lib/paren_printer.ml
Normal file
@ -0,0 +1,100 @@
|
||||
(** [Form.t] to paren text, for [flan convert] of a [.fln] file: the other
|
||||
direction of [Indent_printer]. It keeps what [Form.pretty] cannot — the
|
||||
source's number spellings and comments, through [Source_text] — and lays
|
||||
a form out the way the corpus is written: flat when it fits, otherwise
|
||||
the head and the arguments that name the form on the first line and the
|
||||
rest one per line, two columns in. *)
|
||||
|
||||
let width = 80
|
||||
|
||||
let rec flat spell (f : Form.t) =
|
||||
let seq l = String.concat " " (List.map (flat spell) l) in
|
||||
match f.v with
|
||||
| Form.Int _ | Form.Float _ ->
|
||||
(match spell f with Some t -> t | None -> Form.to_source f)
|
||||
| Form.List l -> "(" ^ seq l ^ ")"
|
||||
| Form.Vec l -> "[" ^ seq l ^ "]"
|
||||
| Form.Map l -> "{" ^ seq l ^ "}"
|
||||
| _ -> Form.to_source f
|
||||
|
||||
(* How many arguments stay on the head's line when the form is broken. *)
|
||||
let kept head =
|
||||
match head with
|
||||
| "defn" | "defn-" | "defmethod" -> 3
|
||||
| "defmacro" | "def" | "defonce" | "defconst" | "defstruct" | "defunion"
|
||||
| "defdata" | "defenum" | "import" | "defalias" -> 2
|
||||
| "do" | "cond" | "comment" | "restart-case" | "handler-case" -> 0
|
||||
| _ -> 1
|
||||
|
||||
(* [inside l] says whether a comment sits on a line of [f] before its last,
|
||||
where a flat [f] would leave it nowhere to go: such a form is broken. *)
|
||||
let rec layout ?(inside = fun _ -> false) spell col (f : Form.t) : string list =
|
||||
let layout = layout ~inside in
|
||||
let one = flat spell f in
|
||||
let tagl (x : Form.t) = function
|
||||
| first :: rest -> Source_text.tag x.loc.Loc.line first :: rest
|
||||
| [] -> []
|
||||
in
|
||||
if col + String.length one <= width && not (inside f) then [ one ]
|
||||
else
|
||||
let bracket o c items ~keep =
|
||||
let placed inner x =
|
||||
match layout spell inner x with
|
||||
| first :: more -> tagl x ((String.make inner ' ' ^ first) :: more)
|
||||
| [] -> []
|
||||
in
|
||||
let lines =
|
||||
let head_len k =
|
||||
col + 1 + String.length
|
||||
(String.concat " " (List.map (flat spell) (List.filteri (fun i _ -> i < k) items)))
|
||||
in
|
||||
let keep = if keep > 1 && head_len keep > width then 1 else keep in
|
||||
if keep > 0 then
|
||||
let first = List.filteri (fun i _ -> i < keep) items in
|
||||
let rest = List.filteri (fun i _ -> i >= keep) items in
|
||||
(o ^ String.concat " " (List.map (flat spell) first))
|
||||
:: List.concat_map (placed (col + 2)) rest
|
||||
else
|
||||
match items with
|
||||
| [] -> [ o ]
|
||||
| x :: xs ->
|
||||
(match layout spell (col + 1) x with
|
||||
| first :: more -> (o ^ first) :: more
|
||||
| [] -> [ o ])
|
||||
@ List.concat_map (placed (col + 1)) xs
|
||||
in
|
||||
let n = List.length lines in
|
||||
List.mapi (fun i l -> if i = n - 1 then l ^ c else l) lines
|
||||
in
|
||||
match f.v with
|
||||
| Form.List (({ v = Form.Sym h; _ }) :: _ as items) ->
|
||||
bracket "(" ")" items ~keep:(1 + min (kept h) (List.length items - 1))
|
||||
| Form.List items -> bracket "(" ")" items ~keep:0
|
||||
| Form.Vec items -> bracket "[" "]" items ~keep:0
|
||||
| Form.Map items -> bracket "{" "}" items ~keep:0
|
||||
| _ -> [ one ]
|
||||
|
||||
(** A whole file, with [source]'s comments and spellings when given. *)
|
||||
let program ?source (fs : Form.t list) : string =
|
||||
let spell =
|
||||
match source with Some src -> Source_text.spelling src | None -> fun _ -> None
|
||||
in
|
||||
let cs = match source with Some src -> Source_text.comments src | None -> [] in
|
||||
let inside (f : Form.t) =
|
||||
List.exists
|
||||
(fun (c : Source_text.comment) ->
|
||||
f.loc.Loc.line <= c.line && c.line < f.loc.Loc.eline)
|
||||
cs
|
||||
in
|
||||
let text =
|
||||
String.concat "\n\n"
|
||||
(List.map
|
||||
(fun (f : Form.t) ->
|
||||
String.concat "\n"
|
||||
(match layout ~inside spell 0 f with
|
||||
| first :: rest -> Source_text.tag f.loc.Loc.line first :: rest
|
||||
| [] -> []))
|
||||
fs)
|
||||
^ "\n"
|
||||
in
|
||||
Source_text.weave cs text
|
||||
173
lib/source_text.ml
Normal file
173
lib/source_text.ml
Normal file
@ -0,0 +1,173 @@
|
||||
(** What a printer needs from the text a program was read from and a
|
||||
[Form.t] does not carry: the comments, and the spelling of each number.
|
||||
[flan convert] reads both here and puts them back (author's decision 83),
|
||||
so a converted file keeps its [;] notes and its [0xFFF00FFF]s.
|
||||
|
||||
Both syntaxes share the lexical rules this depends on: a comment runs
|
||||
from [;] to the end of its line, a string is ["..."] with backslash
|
||||
escapes, and [\c] is a character — so [\;] is not a comment. *)
|
||||
|
||||
type comment = {
|
||||
line : int; (* 1-based *)
|
||||
text : string; (* from the [;] to the end of the line *)
|
||||
own_line : bool; (* nothing but spaces before it on its line *)
|
||||
gap_after : bool; (* the line after it is blank *)
|
||||
}
|
||||
|
||||
let comments (src : string) : comment list =
|
||||
let n = String.length src in
|
||||
let out = ref [] in
|
||||
let line = ref 1 and line_start = ref 0 in
|
||||
let i = ref 0 in
|
||||
while !i < n do
|
||||
(match src.[!i] with
|
||||
| '\n' -> incr line; line_start := !i + 1; incr i
|
||||
| '"' ->
|
||||
incr i;
|
||||
while !i < n && src.[!i] <> '"' do
|
||||
if src.[!i] = '\\' then incr i;
|
||||
if !i < n && src.[!i] = '\n' then (incr line; line_start := !i + 1);
|
||||
incr i
|
||||
done;
|
||||
incr i
|
||||
| '\\' -> i := !i + 2
|
||||
| ';' ->
|
||||
let j = ref !i in
|
||||
while !j < n && src.[!j] <> '\n' do incr j done;
|
||||
let text = String.sub src !i (!j - !i) in
|
||||
let text =
|
||||
if text <> "" && text.[String.length text - 1] = '\r'
|
||||
then String.sub text 0 (String.length text - 1) else text
|
||||
in
|
||||
let before = String.sub src !line_start (!i - !line_start) in
|
||||
let k = ref (!j + 1) in
|
||||
while !k < n && (src.[!k] = ' ' || src.[!k] = '\r') do incr k done;
|
||||
let gap_after = !j < n && (!k >= n || src.[!k] = '\n') in
|
||||
out := { line = !line; text; own_line = String.trim before = ""; gap_after } :: !out;
|
||||
i := !j
|
||||
| _ -> incr i)
|
||||
done;
|
||||
List.rev !out
|
||||
|
||||
(** A number's text as written, when it reads back to the same value: the
|
||||
text under its span. [Form.Int] keeps only the value. *)
|
||||
let spelling (src : string) : Form.t -> string option =
|
||||
let lines = Array.of_list (String.split_on_char '\n' src) in
|
||||
fun (f : Form.t) ->
|
||||
let l = f.loc in
|
||||
if l.Loc.line < 1 || l.Loc.line > Array.length lines || l.Loc.eline <> l.Loc.line
|
||||
then None
|
||||
else
|
||||
let text = lines.(l.Loc.line - 1) in
|
||||
let a = l.Loc.col - 1 and b = l.Loc.ecol - 1 in
|
||||
if a < 0 || b > String.length text || b <= a then None
|
||||
else
|
||||
let t = String.sub text a (b - a) in
|
||||
match f.v with
|
||||
| Form.Int i when Int64.of_string_opt t = Some i -> Some t
|
||||
| Form.Float x
|
||||
when String.exists (fun c -> c = '.' || c = 'e' || c = 'E') t
|
||||
&& (match float_of_string_opt t with
|
||||
| Some y -> Int64.equal (Int64.bits_of_float x) (Int64.bits_of_float y)
|
||||
| None -> false) ->
|
||||
Some t
|
||||
| _ -> None
|
||||
|
||||
(* ── Lines tagged with where they came from ───────────────────────────
|
||||
|
||||
A printer marks the first line of each form it lays out with the source
|
||||
line that form started on. [weave] reads the marks back out and uses them
|
||||
to put each comment where it was: an own-line comment above the first
|
||||
line that came from after it, a trailing comment at the end of the line
|
||||
the code it followed was printed on. *)
|
||||
|
||||
let tag (line : int) (text : string) =
|
||||
(* A tag already there is a form nested at the start of this one's first
|
||||
line; the outer form started no later, so it wins. *)
|
||||
let text =
|
||||
if String.length text > 0 && text.[0] = '\001' then
|
||||
match String.index_opt text '\002' with
|
||||
| Some k -> String.sub text (k + 1) (String.length text - k - 1)
|
||||
| None -> text
|
||||
else text
|
||||
in
|
||||
if line <= 0 then text
|
||||
else "\001" ^ string_of_int line ^ "\002" ^ text
|
||||
|
||||
let untag (text : string) : int option * string =
|
||||
if String.length text > 0 && text.[0] = '\001' then
|
||||
match String.index_opt text '\002' with
|
||||
| Some k ->
|
||||
(int_of_string_opt (String.sub text 1 (k - 1)),
|
||||
String.sub text (k + 1) (String.length text - k - 1))
|
||||
| None -> (None, text)
|
||||
else (None, text)
|
||||
|
||||
let indent_of s =
|
||||
let n = String.length s in
|
||||
let rec go i = if i < n && s.[i] = ' ' then go (i + 1) else i in
|
||||
go 0
|
||||
|
||||
let weave (cs : comment list) (text : string) : string =
|
||||
let lines = Array.of_list (List.map untag (String.split_on_char '\n' text)) in
|
||||
let n = Array.length lines in
|
||||
let tags = Array.map fst lines and body = Array.map snd lines in
|
||||
let before = Array.make (n + 1) [] and trailing = Array.make n [] in
|
||||
List.iter
|
||||
(fun c ->
|
||||
if c.own_line then begin
|
||||
(* The first line printed from code after the comment. *)
|
||||
let rec find i =
|
||||
if i >= n then n
|
||||
else match tags.(i) with Some t when t > c.line -> i | _ -> find (i + 1)
|
||||
in
|
||||
let i = find 0 in
|
||||
before.(i) <- c :: before.(i)
|
||||
end
|
||||
else begin
|
||||
(* The line the code before it went to: the latest line tagged at
|
||||
or before the comment's own line. *)
|
||||
let best = ref (-1) and best_tag = ref 0 in
|
||||
Array.iteri
|
||||
(fun i t ->
|
||||
match t with
|
||||
| Some t when t <= c.line && t >= !best_tag -> best := i; best_tag := t
|
||||
| _ -> ())
|
||||
tags;
|
||||
if !best < 0 then before.(0) <- c :: before.(0)
|
||||
else trailing.(!best) <- c :: trailing.(!best)
|
||||
end)
|
||||
cs;
|
||||
let b = Buffer.create (String.length text + 256) in
|
||||
let emit s = Buffer.add_string b s; Buffer.add_char b '\n' in
|
||||
for i = 0 to n do
|
||||
let ind =
|
||||
if i < n then indent_of body.(i)
|
||||
else 0
|
||||
in
|
||||
List.iter
|
||||
(fun c ->
|
||||
emit (String.make ind ' ' ^ c.text);
|
||||
(* A comment set apart from what follows it, at the top level, stays
|
||||
set apart: a file's header, a section rule. *)
|
||||
if c.gap_after && ind = 0 && i < n then emit "")
|
||||
(List.rev before.(i));
|
||||
if i < n then begin
|
||||
match List.rev trailing.(i) with
|
||||
| [] -> emit body.(i)
|
||||
| first :: more ->
|
||||
emit (body.(i) ^ " " ^ first.text);
|
||||
(* A second trailing comment for the same printed line goes on its
|
||||
own line under it, which reads the same and keeps both. *)
|
||||
let ind = if i + 1 < n then indent_of body.(i + 1) else indent_of body.(i) in
|
||||
List.iter (fun c -> emit (String.make ind ' ' ^ c.text)) more
|
||||
end
|
||||
done;
|
||||
(* [text] ended in a newline, which split into a last empty line. *)
|
||||
let s = Buffer.contents b in
|
||||
let rec trim s =
|
||||
let k = String.length s in
|
||||
if k >= 2 && s.[k - 1] = '\n' && s.[k - 2] = '\n' then trim (String.sub s 0 (k - 1))
|
||||
else s
|
||||
in
|
||||
trim s
|
||||
@ -93,6 +93,13 @@ let () =
|
||||
|
||||
(* ── The round trip over the corpus ────────────────────────────────── *)
|
||||
|
||||
(* The comments of a text, as a sorted list: where each lands may move — a
|
||||
comment inside an expression printed on one line goes above it — but none
|
||||
may be lost or made. *)
|
||||
let comment_texts src =
|
||||
List.sort compare
|
||||
(List.map (fun (c : Source_text.comment) -> String.trim c.text) (Source_text.comments src))
|
||||
|
||||
(* Every .flan the build tree holds. [..] is the workspace root from here;
|
||||
the deps in test/dune decide what is in it. *)
|
||||
let corpus () =
|
||||
@ -124,8 +131,24 @@ let () =
|
||||
| exception e -> fail "round trip %s: %s" path (diag_text e)
|
||||
| back ->
|
||||
let a = List.map norm forms and b = List.map norm back in
|
||||
if same_forms a b then incr ok
|
||||
else fail "round trip %s: %s" path (describe_diff a b))
|
||||
if not (same_forms a b) then
|
||||
fail "round trip %s: %s" path (describe_diff a b)
|
||||
else if comment_texts text <> comment_texts source then
|
||||
fail "round trip %s: the comments did not all come through" path
|
||||
else begin
|
||||
(* And back to parens, from the indented text: the forms and
|
||||
the comments survive the second printer too. *)
|
||||
let paren = Paren_printer.program ~source:text back in
|
||||
match Reader.read_all ~file:path paren with
|
||||
| exception e -> fail "back to parens %s: %s" path (diag_text e)
|
||||
| again ->
|
||||
if not (same_forms (List.map norm again) b) then
|
||||
fail "back to parens %s: %s" path
|
||||
(describe_diff b (List.map norm again))
|
||||
else if comment_texts paren <> comment_texts source then
|
||||
fail "back to parens %s: the comments did not all come through" path
|
||||
else incr ok
|
||||
end)
|
||||
(corpus ());
|
||||
Printf.printf "round trip: %d files\n" !ok;
|
||||
(* The deps decide what is walked, and a stanza that lost them would pass
|
||||
@ -269,7 +292,14 @@ let () =
|
||||
(* Messages with a shape of their own. *)
|
||||
refuses "parenthesised pair" "x = (a, b)" "indent/tuple" "[a, b]";
|
||||
refuses "rest parameter" "fn f(& rest) -> () = 0" "indent/rest-parameter" "xs: [T]";
|
||||
refuses "assignment as a test" "if x = 1\n y" "indent/assign-in-test" "x == ...";
|
||||
refuses "assignment as a test" "if x = 1\n y" "indent/assign-in-test" "write == instead";
|
||||
(* A message quotes the text as written, never the paren form. *)
|
||||
refuses "two assignments" "if a then b = c = d" "indent/assign-in-test" "if a then b = c,";
|
||||
refuses "a let-bound if with no block" "let r = if a > 1\nr" "indent/expected-block" "if a > 1 takes";
|
||||
refuses "two bindings on a line" "let v: i32 = a, w = b" "indent/one-binding" "a is followed by a comma";
|
||||
reads "a let-bound match" "let r = match a\n 1 -> 2\n _ -> 3\nr" "(let [r (match a 1 2 _ 3)] r)";
|
||||
reads "a let-bound if" "let q = if a\n 1\nelse\n 2\nq" "(let [q (if a 1 2)] q)";
|
||||
reads "a let-bound call with a block" "let v = foo(a):\n x\nv" "(let [v (foo a x)] v)";
|
||||
refuses "colon after if" "if c:\n y" "indent/header-colon" "no colon";
|
||||
refuses "colon after a return type" "fn f() -> i32:\n 0" "indent/header-colon" "no colon";
|
||||
refuses "colon after a number" "while x < 3:\n y" "indent/header-colon" "no colon";
|
||||
@ -300,7 +330,22 @@ let () =
|
||||
prints "no arguments before the block" "(comment (f))" "comment:\n f()";
|
||||
prints "typed let" "(defn f [] i32 (let [x (the i32 5)] x))" "let x: i32 = 5";
|
||||
prints "do in an arm is a block" "(defn f [] () (match s _ (do (a) (b))))" "_ ->\n a()";
|
||||
prints "hex spelling" "(def c dyn 0xFFF00FFF)" "0xFFF00FFF"
|
||||
prints "hex spelling" "(def c dyn 0xFFF00FFF)" "0xFFF00FFF";
|
||||
prints "own-line comment above its form" "(defn f [] ()\n ;; why\n (g))" " ;; why\n g()";
|
||||
prints "trailing comment at its line's end" "(defn f [] ()\n (g) ; note\n (h))" " g() ; note\n";
|
||||
(* The other direction keeps them too. *)
|
||||
let back name src want =
|
||||
match Indent_reader.read_all ~file:"<b>" src with
|
||||
| forms ->
|
||||
let got = Paren_printer.program ~source:src forms in
|
||||
if not (Test_support.contains got want) then
|
||||
fail "%s: printed %S, wanted it to contain %S" name got want
|
||||
| exception e -> fail "%s: %s" name (diag_text e)
|
||||
in
|
||||
back "spellings to parens" "fn main() -> i32\n println(0x1F, 1e3, 1_000, 3.0, 2.50, 0b101)\n 0"
|
||||
"(println 0x1F 1e3 1_000 3.0 2.50 0b101)";
|
||||
back "comments to parens" "; head\n\nfn main() -> i32\n ; why\n g() ; note\n 0"
|
||||
"; head\n\n(defn main [] i32\n ; why\n (g) ; note\n 0)"
|
||||
|
||||
(* ── Loading ───────────────────────────────────────────────────────── *)
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user