Skip to content

Commit

Permalink
checkpoint2
Browse files Browse the repository at this point in the history
  • Loading branch information
@trdthg
trdthg committed Jul 23, 2024
1 parent 012eeaa commit 74a2afe
Show file tree
Hide file tree
Showing 6 changed files with 530 additions and 180 deletions.
119 changes: 66 additions & 53 deletions src/lib/format_sail.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -77,11 +77,28 @@ let rec map_last f = function
let x = f false x in
x :: map_last f xs

let line_comment_opt = function Comment (Lexer.Comment_line, _, _, contents, _trailing) -> Some contents | _ -> None
let is_comment chunk = match chunk with Comment (_, _, _, _, _) | Doc_comment _ -> true | _ -> false
let is_block chunk = match chunk with Block (_, _) -> true | _ -> false
let is_match chunk = match chunk with Match _ -> true | _ -> false
let is_let chunk = match chunk with Binder (_, _, _, _) -> true | _ -> false

let rec function_with_only_one_rule ?(ignore_rule = fun chunk -> false) chunks target_rule =
let rec go chunks target_count other_count =
match chunks with
| [] -> (target_count, other_count)
| hd :: tl ->
let target_count, other_count =
if target_rule hd then (target_count + 1, other_count)
else if ignore_rule hd then (target_count, other_count)
else (target_count, other_count + 1)
in
go tl target_count other_count
in
let target, other = go chunks 0 0 in
target = 1 && other = 0
let rec chunks_one_block_like chunks = function_with_only_one_rule chunks (fun chunk -> is_block chunk || is_match chunk)
(* Remove additional (> 1) trailing newlines at the end of a string *)
let discard_extra_trailing_newlines s =
let len = String.length s in
Expand Down Expand Up @@ -194,8 +211,6 @@ module PPrintWrapper = struct
let group doc = Group doc
let group_indent doc n = group (nest n doc)

let space = char ' '
let enclose l r x = l ^^ x ^^ r
Expand All @@ -217,6 +232,15 @@ module PPrintWrapper = struct
let surround n b opening contents closing = opening ^^ Nest (n, break b ^^ contents) ^^ break b ^^ closing
let surround_hardline ?(is_block = true) h n b opening contents closing =
let b = if h then hardline else break b in
group (opening ^^ nest n (b ^^ contents) ^^ (if is_block then b else empty) ^^ closing)
let group_indent n doc = group (nest n doc)
let prefix_hardline h n b contents =
let b = if h then hardline else break b in
group (nest n (b ^^ contents))
let repeat n doc =
let rec go n acc = if n = 0 then acc else go (n - 1) (doc ^^ acc) in
go n empty
Expand Down Expand Up @@ -383,10 +407,6 @@ let softline = break 0
let prefix_parens n x y =
x ^^ ifflat space (space ^^ char '(') ^^ nest n (softline ^^ y) ^^ softline ^^ ifflat empty (char ')')
let surround_hardline ?(is_block = true) h n b opening contents closing =
let b = if h then hardline else break b in
group (opening ^^ nest n (b ^^ contents) ^^ (if is_block then b else empty) ^^ closing)

type config = { indent : int; preserve_structure : bool; line_width : int; ribbon_width : float }
let default_config = { indent = 4; preserve_structure = false; line_width = 120; ribbon_width = 1. }
Expand Down Expand Up @@ -455,6 +475,8 @@ let rec can_chunks_list_wrap cqs =
match c with
(* Atom *)
| Atom _ -> true
(* Xs[unsigned(r)], *)
| App (_, chunks) -> can_chunks_list_wrap chunks
(* unit => (), *)
| Delim _ | Opt_delim _ -> true
(* (v128 >> shift)[64..0] *)
Expand Down Expand Up @@ -483,25 +505,6 @@ module Make (Config : CONFIG) = struct
let indent = Config.config.indent
let preserve_structure = Config.config.preserve_structure
let rec function_with_only_one_rule chunks target_rule ignore_rule =
let rec go chunks target_count other_count =
match chunks with
| [] -> (target_count, other_count)
| hd :: tl ->
let target_count, other_count =
if target_rule hd then (target_count + 1, other_count)
else if ignore_rule hd then (target_count, other_count)
else (target_count, other_count + 1)
in
go tl target_count other_count
in
let target, other = go chunks 0 0 in
target = 1 && other = 0

let rec function_with_only_one_blcok chunks = function_with_only_one_rule chunks is_block is_comment

let rec function_with_only_one_let chunks = function_with_only_one_rule chunks is_let is_comment

let rec doc_chunk ?(ungroup_tuple = false) ?(toplevel = false) ?(force_block_comment_end_with_hardline = false) opts =
function
| Atom s -> string s
Expand Down Expand Up @@ -548,7 +551,7 @@ module Make (Config : CONFIG) = struct
let doc =
infix indent spacing (string op)
(doc_chunks (opts |> lhs_prec |> expression_like) lhs)
(doc_chunks (opts |> rhs_prec |> expression_like) rhs)
(doc_chunks ~force_block_comment_end_with_hardline:true (opts |> rhs_prec |> expression_like) rhs)
in
if outer_prec > opts.precedence then parens doc else doc
| Ternary (x, op1, y, op2, z) ->
Expand Down Expand Up @@ -579,8 +582,8 @@ module Make (Config : CONFIG) = struct
let doc_i = separate space [string "if"; i] in
let doc_t = separate space [string "then"; t] in
let doc_e = separate space [string "else"; e] in
let sep = space in
doc_i ^^ sep ^^ doc_t ^^ sep ^^ doc_e ^^ sep |> atomic_parens opts
let sep is_wrap = if is_wrap then space else hardline in
doc_i ^^ sep i_wrap ^^ doc_t ^^ sep t_wrap ^^ doc_e |> atomic_parens opts
| If_then (bracing, i, t) ->
let i = doc_chunks (opts |> nonatomic |> expression_like) i in
let t =
Expand All @@ -600,7 +603,8 @@ module Make (Config : CONFIG) = struct
let exp_doc, exp_wrap = doc_exps (opts |> atomic |> expression_like) exp in
let exp_doc = group (empty ^^ nest 4 exp_doc ^^ empty) in
let ix_doc, ix_wrap = doc_exps (opts |> nonatomic |> expression_like) ix in
exp_doc ^^ char '[' ^^ ix_doc ^^ char ']' |> subatomic_parens opts
let hl = if ix_wrap then empty else hardline in
exp_doc ^^ char '[' ^^ ix_doc ^^ hl ^^ char ']' |> subatomic_parens opts
| Exists ex ->
let ex_doc =
doc_chunks (atomic opts) ex.vars
Expand Down Expand Up @@ -723,17 +727,9 @@ module Make (Config : CONFIG) = struct
separate space [string (binder_keyword binder); doc_chunks (atomic opts) x; char '=']
^^ nest 4 (hardline ^^ doc_chunks (nonatomic opts) y)
| Binder (binder, x, y, z) ->
let doc =
separate space
[
string (binder_keyword binder);
doc_chunks (atomic opts) x;
char '=';
doc_chunks (nonatomic opts) y;
string "in";
hardline;
]
in
let x, _ = doc_exps (atomic opts) x in
let y, _ = doc_exps (atomic opts) y in
let doc = separate space [string (binder_keyword binder); x; char '='; y; string "in"; hardline] in
Queue.fold
(fun acc chunk ->
let doc = doc_chunk ~force_block_comment_end_with_hardline:true opts chunk in
Expand Down Expand Up @@ -788,16 +784,30 @@ module Make (Config : CONFIG) = struct
and doc_exps ?(ungroup_tuple = false) opts exps =
let res = Queue.fold (fun doc chunk -> doc ^^ doc_chunk ~ungroup_tuple opts chunk) empty exps in
let is_single_block = function_with_only_one_blcok (List.of_seq (Queue.to_seq exps)) in
if can_chunks_list_wrap [exps] then (res, true)
else (
Printf.printf "exps_len: %d\n" (Queue.length exps);
( (* add indent for multi line exps which can't be wrapped *)
(* TODO: add () here, need to handle `,`, like `0b00000 => /**/ EXTZ(0x0),` *)
surround_hardline ~is_block:is_single_block false 4 0 empty res empty,
false
)
)
let no_prefix = chunks_one_block_like (List.of_seq (Queue.to_seq exps)) in
let wrapped = can_chunks_list_wrap [exps] in
let doc =
if wrapped || no_prefix then res
else
(* 1. add indent for multi line exps which can't be wrapped *)
(* 2. add hardline / space
* - if_stmt:
if
let a = 1 in
a
then {
// comment
1
} else { 2 }
- i has no braces, use hardline
- t has braces, use space
- e wraped, use space
*)
prefix_hardline false 4 0 res
in
(doc, wrapped)
and doc_pexp_chunks_pair opts pexp =
let pat = doc_chunks opts pexp.pat in
Expand All @@ -821,6 +831,7 @@ module Make (Config : CONFIG) = struct
match pexp.guard with
| None ->
let body_doc, _ = doc_exps opts pexp.body in
(if pexp.funcl_space then space else empty)
^^ group (doc_chunks ~ungroup_tuple:true opts pexp.pat ^^ return_typ)
^^ string "=" ^^ space ^^ body_doc
Expand Down Expand Up @@ -864,8 +875,10 @@ module Make (Config : CONFIG) = struct
let doc = splice_into_doc chunks empty in
(group doc, !requires_hardline)
and doc_chunks ?(ungroup_tuple = false) opts chunks =
Queue.fold (fun doc chunk -> doc ^^ doc_chunk ~ungroup_tuple opts chunk) empty chunks
and doc_chunks ?(ungroup_tuple = false) ?(force_block_comment_end_with_hardline = false) opts chunks =
Queue.fold
(fun doc chunk -> doc ^^ doc_chunk ~force_block_comment_end_with_hardline ~ungroup_tuple opts chunk)
empty chunks
let to_string doc =
let b = Buffer.create 1024 in
Expand Down
6 changes: 6 additions & 0 deletions test/format/default/demo.sail
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@

function rX r = match r {
_ =>
//
Xs[unsigned(r)],
}
Loading

0 comments on commit 74a2afe

Please sign in to comment.