Skip to content

Commit cc7d295

Browse files
IwanKaramazowIwanKaramazow
authored
Implemente outcome printing of poly variants (rescript-lang#73)
* Implement outcome printing of polymorphic variants * Omit printing of leading Ptyp_variant bar when layout doesn't break. type color = [ #Red | #Blue | #Green ] VS type color = [ | #Red | #Blue | #Green ] Should be consistent with outcome printer * Improve consistency spacing brackets surrounding poly vars in outcome printer [ #red ] should be [#red] * Improve consistency spacing brackets surrounding poly vars in typexpr printer [ #red ] should be [#red] * Print exotic names escaped in poly-var outcome printer * Document meaning of outcome printer
1 parent 2107584 commit cc7d295

File tree

9 files changed

+456
-44
lines changed

9 files changed

+456
-44
lines changed

‎syntax/.depend

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,7 @@ src/napkin_multi_printer.cmx : src/napkin_reason_binary_driver.cmx \
4444
src/napkin_driver.cmx src/napkin_diagnostics.cmx \
4545
src/napkin_ast_conversion.cmx src/napkin_multi_printer.cmi
4646
src/napkin_multi_printer.cmi :
47-
src/napkin_outcome_printer.cmx : src/napkin_doc.cmx \
47+
src/napkin_outcome_printer.cmx : src/napkin_token.cmx src/napkin_doc.cmx \
4848
src/napkin_outcome_printer.cmi
4949
src/napkin_outcome_printer.cmi :
5050
src/napkin_parens.cmx : src/napkin_parsetree_viewer.cmx \

‎syntax/src/napkin_doc.ml

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
module MiniBuffer = Napkin_minibuffer
2+
23
type mode = Break | Flat
34

45
type lineStyle =
@@ -308,4 +309,4 @@ let debug t =
308309
in
309310
let doc = toDoc t in
310311
toString ~width:10 doc |> print_endline
311-
[@@live]
312+
[@@live]

‎syntax/src/napkin_outcome_printer.ml

Lines changed: 148 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,54 @@
1-
module Doc = Napkin_doc
1+
(* For the curious: the outcome printer is a printer to print data
2+
* from the outcometree.mli file in the ocaml compiler.
3+
* The outcome tree is used by:
4+
* - ocaml's toplevel/repl, print results/errors
5+
* - super errors, print nice errors
6+
* - editor tooling, e.g. show type on hover
7+
*
8+
* In general it represent messages to show results or errors to the user. *)
9+
10+
module Doc = Napkin_doc
11+
module Token = Napkin_token
12+
13+
type identifierStyle =
14+
| ExoticIdent
15+
| NormalIdent
16+
17+
let classifyIdentContent ~allowUident txt =
18+
let len = String.length txt in
19+
let rec go i =
20+
if i == len then NormalIdent
21+
else
22+
let c = String.unsafe_get txt i in
23+
if i == 0 && not (
24+
(allowUident && (c >= 'A' && c <= 'Z')) ||
25+
(c >= 'a' && c <= 'z') || c = '_' || (c >= '0' && c <= '9')) then
26+
ExoticIdent
27+
else if not (
28+
(c >= 'a' && c <= 'z')
29+
|| (c >= 'A' && c <= 'Z')
30+
|| c = '\''
31+
|| c = '_'
32+
|| (c >= '0' && c <= '9'))
33+
then
34+
ExoticIdent
35+
else
36+
go (i + 1)
37+
in
38+
if Token.isKeywordTxt txt then
39+
ExoticIdent
40+
else
41+
go 0
42+
43+
let printIdentLike ~allowUident txt =
44+
match classifyIdentContent ~allowUident txt with
45+
| ExoticIdent -> Doc.concat [
46+
Doc.text "\\\"";
47+
Doc.text txt;
48+
Doc.text"\""
49+
]
50+
| NormalIdent -> Doc.text txt
51+
252
(* Napkin doesn't have parenthesized identifiers.
353
* We don't support custom operators. *)
454
let parenthesized_ident _name = true
@@ -45,9 +95,9 @@
4595
print_ident fmt id2;
4696
Format.pp_print_char fmt ')' *)
4797

48-
let rec printOutIdentDoc (ident : Outcometree.out_ident) =
98+
let rec printOutIdentDoc ?(allowUident=true) (ident : Outcometree.out_ident) =
4999
match ident with
50-
| Oide_ident s -> Doc.text s
100+
| Oide_ident s -> printIdentLike ~allowUident s
51101
| Oide_dot (ident, s) -> Doc.concat [
52102
printOutIdentDoc ident;
53103
Doc.dot;
@@ -95,15 +145,58 @@
95145

96146
let rec printOutTypeDoc (outType: Outcometree.out_type) =
97147
match outType with
98-
| Otyp_abstract | Otyp_variant _ (* don't support poly-variants atm *) | Otyp_open -> Doc.nil
148+
| Otyp_abstract | Otyp_open -> Doc.nil
149+
| Otyp_variant (nonGen, outVariant, closed, labels) ->
150+
(* bool * out_variant * bool * (string list) option *)
151+
let opening = match (closed, labels) with
152+
| (true, None) -> (* [#A | #B] *) Doc.softLine
153+
| (false, None) ->
154+
(* [> #A | #B] *)
155+
Doc.concat [Doc.greaterThan; Doc.line]
156+
| (true, Some []) ->
157+
(* [< #A | #B] *)
158+
Doc.concat [Doc.lessThan; Doc.line]
159+
| (true, Some _) ->
160+
(* [< #A | #B > #X #Y ] *)
161+
Doc.concat [Doc.lessThan; Doc.line]
162+
| (false, Some _) ->
163+
(* impossible!? ocaml seems to print ?, see oprint.ml in 4.06 *)
164+
Doc.concat [Doc.text "?"; Doc.line]
165+
in
166+
Doc.group (
167+
Doc.concat [
168+
if nonGen then Doc.text "_" else Doc.nil;
169+
Doc.lbracket;
170+
Doc.indent (
171+
Doc.concat [
172+
opening;
173+
printOutVariant outVariant
174+
]
175+
);
176+
begin match labels with
177+
| None | Some [] -> Doc.nil
178+
| Some tags ->
179+
Doc.group (
180+
Doc.concat [
181+
Doc.space;
182+
Doc.join ~sep:Doc.space (
183+
List.map (fun lbl -> printIdentLike ~allowUident:true lbl) tags
184+
)
185+
]
186+
)
187+
end;
188+
Doc.softLine;
189+
Doc.rbracket;
190+
]
191+
)
99192
| Otyp_alias (typ, aliasTxt) ->
100193
Doc.concat [
101194
printOutTypeDoc typ;
102195
Doc.text " as '";
103196
Doc.text aliasTxt
104197
]
105198
| Otyp_constr (outIdent, []) ->
106-
printOutIdentDoc outIdent
199+
printOutIdentDoc ~allowUident:false outIdent
107200
| Otyp_manifest (typ1, typ2) ->
108201
Doc.concat [
109202
printOutTypeDoc typ1;
@@ -236,6 +329,52 @@
236329
| Otyp_module (_modName, _stringList, _outTypes) ->
237330
Doc.nil
238331

332+
and printOutVariant variant = match variant with
333+
| Ovar_fields fields -> (* (string * bool * out_type list) list *)
334+
Doc.join ~sep:Doc.line (
335+
(*
336+
* [< | #T([< u2]) & ([< u2]) & ([< u1])] --> no ampersand
337+
* [< | #S & ([< u2]) & ([< u2]) & ([< u1])] --> ampersand
338+
*)
339+
List.mapi (fun i (name, ampersand, types) ->
340+
let needsParens = match types with
341+
| [(Outcometree.Otyp_tuple _)] -> false
342+
| _ -> true
343+
in
344+
Doc.concat [
345+
if i > 0 then
346+
Doc.text "| "
347+
else
348+
Doc.ifBreaks (Doc.text "| ") Doc.nil;
349+
Doc.group (
350+
Doc.concat [
351+
Doc.text "#";
352+
printIdentLike ~allowUident:true name;
353+
match types with
354+
| [] -> Doc.nil
355+
| types ->
356+
Doc.concat [
357+
if ampersand then Doc.text " & " else Doc.nil;
358+
Doc.indent (
359+
Doc.concat [
360+
Doc.join ~sep:(Doc.concat [Doc.text " &"; Doc.line])
361+
(List.map (fun typ ->
362+
let outTypeDoc = printOutTypeDoc typ in
363+
if needsParens then
364+
Doc.concat [Doc.lparen; outTypeDoc; Doc.rparen]
365+
else
366+
outTypeDoc
367+
) types)
368+
];
369+
);
370+
]
371+
]
372+
)
373+
]
374+
) fields
375+
)
376+
| Ovar_typ typ -> printOutTypeDoc typ
377+
239378
and printObjectFields fields rest =
240379
let dots = match rest with
241380
| Some non_gen -> Doc.text ((if non_gen then "_" else "") ^ "..")
@@ -337,7 +476,7 @@
337476
Doc.group (
338477
Doc.concat [
339478
if mut then Doc.text "mutable " else Doc.nil;
340-
Doc.text name;
479+
printIdentLike ~allowUident:false name;
341480
Doc.text ": ";
342481
printOutTypeDoc arg;
343482
]
@@ -532,7 +671,7 @@
532671
Doc.concat [
533672
attrs;
534673
kw;
535-
Doc.text outTypeDecl.otype_name;
674+
printIdentLike ~allowUident:false outTypeDecl.otype_name;
536675
typeParams;
537676
kind
538677
]
@@ -666,7 +805,7 @@
666805
Doc.group (
667806
Doc.concat [
668807
Doc.text "type ";
669-
Doc.text outExt.oext_type_name;
808+
printIdentLike ~allowUident:false outExt.oext_type_name;
670809
typeParams;
671810
Doc.text " += ";
672811
Doc.line;
@@ -705,7 +844,7 @@
705844
Doc.group (
706845
Doc.concat [
707846
Doc.text "type ";
708-
Doc.text typeExtension.otyext_name;
847+
printIdentLike ~allowUident:false typeExtension.otyext_name;
709848
typeParams;
710849
Doc.text " += ";
711850
if typeExtension.otyext_private = Asttypes.Private then

‎syntax/src/napkin_outcome_printer.mli

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,12 @@
1-
1+
(* For the curious: the outcome printer is a printer to print data
2+
* from the outcometree.mli file in the ocaml compiler.
3+
* The outcome tree is used by:
4+
* - ocaml's toplevel/repl, print results/errors
5+
* - super errors, print nice errors
6+
* - editor tooling, e.g. show type on hover
7+
*
8+
* In general it represent messages to show results or errors to the user. *)
29

310
val parenthesized_ident : string -> bool [@@live]
411

5-
val setup : unit lazy_t [@@live]
12+
val setup : unit lazy_t [@@live]

‎syntax/src/napkin_printer.ml

Lines changed: 19 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1635,13 +1635,13 @@ and printTypExpr (typExpr : Parsetree.core_type) cmtTbl =
16351635
in
16361636
let docs = List.map printRowField rowFields in
16371637
let cases = Doc.join ~sep:(Doc.concat [Doc.line; Doc.text "| "]) docs in
1638-
let cases = if docs = [] then cases else Doc.concat [Doc.text "| "; cases] in
1638+
let cases = if docs = [] then cases else Doc.concat [Doc.ifBreaks (Doc.text "| ") Doc.nil; cases] in
16391639
let openingSymbol =
16401640
if closedFlag = Open
1641-
then Doc.greaterThan
1641+
then Doc.concat [Doc.greaterThan; Doc.line]
16421642
else if labelsOpt = None
1643-
then Doc.nil
1644-
else Doc.lessThan in
1643+
then Doc.softLine
1644+
else Doc.concat [Doc.lessThan; Doc.line] in
16451645
let hasLabels = labelsOpt <> None && labelsOpt <> Some [] in
16461646
let labels = match labelsOpt with
16471647
| None
@@ -1651,7 +1651,21 @@ and printTypExpr (typExpr : Parsetree.core_type) cmtTbl =
16511651
Doc.concat (List.map (fun label -> Doc.concat [Doc.line; Doc.text "#" ; printIdentLike ~allowUident:true label] ) labels)
16521652
in
16531653
let closingSymbol = if hasLabels then Doc.text " >" else Doc.nil in
1654-
Doc.group (Doc.concat [Doc.lbracket; openingSymbol; Doc.line; cases; closingSymbol; labels; Doc.line; Doc.rbracket])
1654+
Doc.group (
1655+
Doc.concat [
1656+
Doc.lbracket;
1657+
Doc.indent (
1658+
Doc.concat [
1659+
openingSymbol;
1660+
cases;
1661+
closingSymbol;
1662+
labels;
1663+
]
1664+
);
1665+
Doc.softLine;
1666+
Doc.rbracket
1667+
]
1668+
)
16551669
in
16561670
let shouldPrintItsOwnAttributes = match typExpr.ptyp_desc with
16571671
| Ptyp_arrow _ (* es6 arrow types print their own attributes *)

0 commit comments

Comments
 (0)