101 lines
3.8 KiB
OCaml
101 lines
3.8 KiB
OCaml
(** [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
|