Skip to content

Commit 1b26a6c

Browse files
author
Guillaume Petiot
authored
Externalize Prec, Assoc and better precedence ambiguity type (ocaml-ppx#1378)
1 parent 3fa074b commit 1b26a6c

File tree

8 files changed

+195
-148
lines changed

8 files changed

+195
-148
lines changed

Diff for: ‎lib/Assoc.ml

+37
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,37 @@
1+
(**************************************************************************)
2+
(* *)
3+
(* OCamlFormat *)
4+
(* *)
5+
(* Copyright (c) Facebook, Inc. and its affiliates. *)
6+
(* *)
7+
(* This source code is licensed under the MIT license found in *)
8+
(* the LICENSE file in the root directory of this source tree. *)
9+
(* *)
10+
(**************************************************************************)
11+
12+
(** Associativities of Ast terms. *)
13+
type t = Left | Non | Right
14+
15+
let to_string = function Left -> "Left" | Non -> "Non" | Right -> "Right"
16+
17+
let equal : t -> t -> bool = Poly.( = )
18+
19+
(** Compute associativity from precedence, since associativity is uniform
20+
across precedence levels. *)
21+
let of_prec (x : Prec.t) =
22+
match x with
23+
| Low | Semi | LessMinus -> Non
24+
| ColonEqual -> Right
25+
| As -> Non
26+
| Comma -> Non
27+
| MinusGreater | BarBar | AmperAmper -> Right
28+
| InfixOp0 -> Left
29+
| InfixOp1 -> Right
30+
| ColonColon -> Right
31+
| InfixOp2 | InfixOp3 -> Left
32+
| InfixOp4 -> Right
33+
| UMinus | Apply -> Non
34+
| HashOp -> Left
35+
| Dot -> Left
36+
| High -> Non
37+
| Atomic -> Non

Diff for: ‎lib/Assoc.mli

+21
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
(**************************************************************************)
2+
(* *)
3+
(* OCamlFormat *)
4+
(* *)
5+
(* Copyright (c) Facebook, Inc. and its affiliates. *)
6+
(* *)
7+
(* This source code is licensed under the MIT license found in *)
8+
(* the LICENSE file in the root directory of this source tree. *)
9+
(* *)
10+
(**************************************************************************)
11+
12+
(** Associativities of Ast terms *)
13+
type t = Left | Non | Right
14+
15+
val to_string : t -> string
16+
17+
val equal : t -> t -> bool
18+
19+
val of_prec : Prec.t -> t
20+
(** [of_prec prec] is the associativity of Ast terms with precedence [prec].
21+
(Associativity is uniform across precedence levels.) *)

Diff for: ‎lib/Ast.ml

+31-110
Original file line numberDiff line numberDiff line change
@@ -719,90 +719,6 @@ let break_between s ~cmts ~has_cmts_before ~has_cmts_after (i1, c1) (i2, c2)
719719
true (* always break between an item and a directive *)
720720
| _ -> assert false
721721

722-
(** Precedence levels of Ast terms. *)
723-
type prec =
724-
| Low
725-
| Semi
726-
| LessMinus
727-
| ColonEqual
728-
| As
729-
| Comma
730-
| MinusGreater
731-
| BarBar
732-
| AmperAmper
733-
| InfixOp0
734-
| InfixOp1
735-
| ColonColon
736-
| InfixOp2
737-
| InfixOp3
738-
| InfixOp4
739-
| UMinus
740-
| Apply
741-
| HashOp
742-
| Dot
743-
| High
744-
| Atomic
745-
746-
let compare_prec : prec -> prec -> int = Poly.compare
747-
748-
let equal_prec a b = compare_prec a b = 0
749-
750-
let string_of_prec = function
751-
| Low -> "Low"
752-
| Semi -> "Semi"
753-
| LessMinus -> "LessMinus"
754-
| ColonEqual -> "ColonEqual"
755-
| As -> "As"
756-
| Comma -> "Comma"
757-
| MinusGreater -> "MinusGreater"
758-
| BarBar -> "BarBar"
759-
| AmperAmper -> "AmperAmper"
760-
| InfixOp0 -> "InfixOp0"
761-
| InfixOp1 -> "InfixOp1"
762-
| ColonColon -> "ColonColon"
763-
| InfixOp2 -> "InfixOp2"
764-
| InfixOp3 -> "InfixOp3"
765-
| InfixOp4 -> "InfixOp4"
766-
| UMinus -> "UMinus"
767-
| Apply -> "Apply"
768-
| Dot -> "Dot"
769-
| HashOp -> "HashOp"
770-
| High -> "High"
771-
| Atomic -> "Atomic"
772-
773-
let _ = string_of_prec
774-
775-
(** Associativities of Ast terms. *)
776-
type assoc = Left | Non | Right
777-
778-
let string_of_assoc = function
779-
| Left -> "Left"
780-
| Non -> "Non"
781-
| Right -> "Right"
782-
783-
let _ = string_of_assoc
784-
785-
let equal_assoc : assoc -> assoc -> bool = Poly.( = )
786-
787-
(** Compute associativity from precedence, since associativity is uniform
788-
across precedence levels. *)
789-
let assoc_of_prec = function
790-
| Low | Semi | LessMinus -> Non
791-
| ColonEqual -> Right
792-
| As -> Non
793-
| Comma -> Non
794-
| MinusGreater | BarBar | AmperAmper -> Right
795-
| InfixOp0 -> Left
796-
| InfixOp1 -> Right
797-
| ColonColon -> Right
798-
| InfixOp2 | InfixOp3 -> Left
799-
| InfixOp4 -> Right
800-
| UMinus | Apply -> Non
801-
| HashOp -> Left
802-
| Dot -> Left
803-
| High -> Non
804-
| Atomic -> Non
805-
806722
(** Term-in-context, [{ctx; ast}] records that [ast] is (considered to be) an
807723
immediate sub-term of [ctx] as assumed by the operations in
808724
[Requires_sub_terms]. *)
@@ -866,7 +782,7 @@ and Requires_sub_terms : sig
866782

867783
val exposed_left_exp : expression -> bool
868784

869-
val prec_ast : T.t -> prec option
785+
val prec_ast : T.t -> Prec.t option
870786

871787
val parenze_typ : core_type In_ctx.xt -> bool
872788

@@ -1557,6 +1473,8 @@ end = struct
15571473
[ctx]. Also returns whether [ast] is the left, right, or neither child
15581474
of [ctx]. Meaningful for binary operators, otherwise returns [None]. *)
15591475
let prec_ctx ctx =
1476+
let open Prec in
1477+
let open Assoc in
15601478
let is_tuple_lvl1_in_constructor ty = function
15611479
| {ptype_kind= Ptype_variant cd1N; _} ->
15621480
List.exists cd1N ~f:(function
@@ -1701,7 +1619,9 @@ end = struct
17011619

17021620
(** [prec_ast ast] is the precedence of [ast]. Meaningful for binary
17031621
operators, otherwise returns [None]. *)
1704-
let prec_ast = function
1622+
let prec_ast =
1623+
let open Prec in
1624+
function
17051625
| Pld _ -> None
17061626
| Typ {ptyp_desc; _} -> (
17071627
match ptyp_desc with
@@ -1801,22 +1721,23 @@ end = struct
18011721
binary operators, otherwise returns [None] if [ctx] has no precedence
18021722
or [Some None] if [ctx] does but [ast] does not. *)
18031723
let ambig_prec ({ast; _} as xast) =
1804-
prec_ctx xast
1805-
>>| fun (prec_ctx, which_child) ->
1806-
prec_ast ast
1807-
>>| fun prec_ast ->
1808-
match compare_prec prec_ctx prec_ast with
1809-
| 0 ->
1810-
(* which child and associativity match: no parens *)
1811-
(* which child and assoc conflict: add parens *)
1812-
equal_assoc which_child Non
1813-
|| not (equal_assoc (assoc_of_prec prec_ast) which_child)
1814-
| cmp when cmp < 0 ->
1815-
(* ast higher precedence than context: no parens *)
1816-
false
1817-
| _ (* > 0 *) ->
1818-
(* context higher prec than ast: add parens *)
1819-
true
1724+
match prec_ctx xast with
1725+
| Some (prec_ctx, which_child) -> (
1726+
match prec_ast ast with
1727+
| Some prec_ast ->
1728+
let ambiguous =
1729+
match Prec.compare prec_ctx prec_ast with
1730+
| 0 ->
1731+
(* which child and associativity match: no parens *)
1732+
(* which child and assoc conflict: add parens *)
1733+
Assoc.equal which_child Non
1734+
|| not (Assoc.equal (Assoc.of_prec prec_ast) which_child)
1735+
(* add parens only when the context has a higher prec than ast *)
1736+
| cmp -> cmp >= 0
1737+
in
1738+
if ambiguous then `Ambiguous else `Non_ambiguous
1739+
| None -> `No_prec_ast )
1740+
| None -> `No_prec_ctx
18201741

18211742
(** [parenze_typ {ctx; ast}] holds when type [ast] should be parenthesized
18221743
in context [ctx]. *)
@@ -1864,15 +1785,15 @@ end = struct
18641785
true
18651786
| _ -> (
18661787
match ambig_prec (sub_ast ~ctx (Typ typ)) with
1867-
| Some (Some true) -> true
1788+
| `Ambiguous -> true
18681789
| _ -> false )
18691790

18701791
(** [parenze_cty {ctx; ast}] holds when class type [ast] should be
18711792
parenthesized in context [ctx]. *)
18721793
let parenze_cty ({ctx; ast= cty} as xcty) =
18731794
assert_check_cty xcty ;
18741795
match ambig_prec (sub_ast ~ctx (Cty cty)) with
1875-
| Some (Some true) -> true
1796+
| `Ambiguous -> true
18761797
| _ -> false
18771798

18781799
(** [parenze_mty {ctx; ast}] holds when module type [ast] should be
@@ -2224,7 +2145,7 @@ end = struct
22242145
({pexp_desc= Pexp_ident {txt= Lident i; _}; _}, _ :: (_, e2) :: _)
22252146
when e2 == exp && is_infix_id i
22262147
&& Option.value_map ~default:false (prec_ast ctx) ~f:(fun p ->
2227-
compare_prec p Apply < 0 ) ->
2148+
Prec.compare p Apply < 0 ) ->
22282149
true
22292150
| Pexp_apply
22302151
({pexp_desc= Pexp_ident lid; _}, (_ :: (_, e2) :: _ as args))
@@ -2235,8 +2156,8 @@ end = struct
22352156
| _ -> false
22362157
in
22372158
match ambig_prec (sub_ast ~ctx (Exp exp)) with
2238-
| None -> false (* ctx not apply *)
2239-
| Some (Some true) -> true (* exp is apply and ambig *)
2159+
| `No_prec_ctx -> false (* ctx not apply *)
2160+
| `Ambiguous -> true (* exp is apply and ambig *)
22402161
| _ -> (
22412162
match ctx with
22422163
| Exp {pexp_desc; _} ->
@@ -2403,8 +2324,8 @@ end = struct
24032324
and parenze_cl ({ctx; ast= cl} as xcl) =
24042325
assert_check_cl xcl ;
24052326
match ambig_prec (sub_ast ~ctx (Cl cl)) with
2406-
| None -> false
2407-
| Some (Some true) -> true
2327+
| `No_prec_ctx -> false
2328+
| `Ambiguous -> true
24082329
| _ -> exposed_right_cl Non_apply cl
24092330

24102331
let parenze_nested_exp {ctx; ast= exp} =
@@ -2428,7 +2349,7 @@ end = struct
24282349
noise *)
24292350
false
24302351
| None, _ | _, None -> false
2431-
| Some p1, Some p2 -> not (equal_prec p1 p2)
2352+
| Some p1, Some p2 -> not (Prec.equal p1 p2)
24322353
end
24332354

24342355
include In_ctx

Diff for: ‎lib/Ast.mli

+1-34
Original file line numberDiff line numberDiff line change
@@ -124,39 +124,6 @@ val location : t -> Location.t
124124
val dump : Format.formatter -> t -> unit
125125
(** Debug: Dump the representation of an Ast term. *)
126126

127-
(** Precedence levels of Ast terms. *)
128-
type prec =
129-
| Low
130-
| Semi
131-
| LessMinus
132-
| ColonEqual
133-
| As
134-
| Comma
135-
| MinusGreater
136-
| BarBar
137-
| AmperAmper
138-
| InfixOp0
139-
| InfixOp1
140-
| ColonColon
141-
| InfixOp2
142-
| InfixOp3
143-
| InfixOp4
144-
| UMinus
145-
| Apply
146-
| HashOp
147-
| Dot (** [x.y] and [x#y] *)
148-
| High
149-
| Atomic
150-
151-
val equal_prec : prec -> prec -> bool
152-
153-
(** Associativities of Ast terms *)
154-
type assoc = Left | Non | Right
155-
156-
val assoc_of_prec : prec -> assoc
157-
(** [assoc_of_prec prec] is the associativity of Ast terms with precedence
158-
[prec]. (Associativity is uniform across precedence levels.) *)
159-
160127
(** Term-in-context [{ctx; ast}] records that [ast] is (considered to be) an
161128
immediate sub-term of [ctx]. *)
162129
type 'a xt = private {ctx: t; ast: 'a}
@@ -203,7 +170,7 @@ val exposed_left_exp : expression -> bool
203170
(** [exposed_left_exp exp] holds if the left-most subexpression of [exp] is a
204171
prefix operators. *)
205172

206-
val prec_ast : t -> prec option
173+
val prec_ast : t -> Prec.t option
207174
(** [prec_ast ast] is the precedence of [ast]. Meaningful for binary
208175
operators, otherwise returns [None]. *)
209176

Diff for: ‎lib/Prec.ml

+61
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,61 @@
1+
(**************************************************************************)
2+
(* *)
3+
(* OCamlFormat *)
4+
(* *)
5+
(* Copyright (c) Facebook, Inc. and its affiliates. *)
6+
(* *)
7+
(* This source code is licensed under the MIT license found in *)
8+
(* the LICENSE file in the root directory of this source tree. *)
9+
(* *)
10+
(**************************************************************************)
11+
12+
(** Precedence levels of Ast terms. *)
13+
type t =
14+
| Low
15+
| Semi
16+
| LessMinus
17+
| ColonEqual
18+
| As
19+
| Comma
20+
| MinusGreater
21+
| BarBar
22+
| AmperAmper
23+
| InfixOp0
24+
| InfixOp1
25+
| ColonColon
26+
| InfixOp2
27+
| InfixOp3
28+
| InfixOp4
29+
| UMinus
30+
| Apply
31+
| HashOp
32+
| Dot
33+
| High
34+
| Atomic
35+
36+
let compare : t -> t -> int = Poly.compare
37+
38+
let equal a b = compare a b = 0
39+
40+
let to_string = function
41+
| Low -> "Low"
42+
| Semi -> "Semi"
43+
| LessMinus -> "LessMinus"
44+
| ColonEqual -> "ColonEqual"
45+
| As -> "As"
46+
| Comma -> "Comma"
47+
| MinusGreater -> "MinusGreater"
48+
| BarBar -> "BarBar"
49+
| AmperAmper -> "AmperAmper"
50+
| InfixOp0 -> "InfixOp0"
51+
| InfixOp1 -> "InfixOp1"
52+
| ColonColon -> "ColonColon"
53+
| InfixOp2 -> "InfixOp2"
54+
| InfixOp3 -> "InfixOp3"
55+
| InfixOp4 -> "InfixOp4"
56+
| UMinus -> "UMinus"
57+
| Apply -> "Apply"
58+
| Dot -> "Dot"
59+
| HashOp -> "HashOp"
60+
| High -> "High"
61+
| Atomic -> "Atomic"

0 commit comments

Comments
 (0)