Allowing generalized rules in typed symbols.

1 files changed, 20 insertions, 1 deletions

diff --git a/intf/extend.mli b/intf/extend.mli
index 57abdc38fb..e1520dec54 100644
--- a/intf/extend.mli
+++ b/intf/extend.mli
@@ -65,6 +65,17 @@ type user_symbol =
 
 (** {5 Type-safe grammar extension} *)
 
+(** (a, b, r) adj => [a = x₁ -> ... xₙ -> r] & [b = x₁ * (... (xₙ * unit))]. *)
+type (_, _, _) adj =
+| Adj0 : ('r, unit, 'r) adj
+| AdjS : ('s, 'b, 'r) adj -> ('a -> 's, 'a * 'b, 'r) adj
+
+type _ index =
+| I0 : 'a -> ('a * 'r) index
+| IS : 'a index -> ('b * 'a) index
+
+(** This type should be marshallable, this is why we use a convoluted
+    representation in the [Arules] constructor instead of putting a function. *)
 type ('self, 'a) symbol =
 | Atoken : Tok.t -> ('self, string) symbol
 | Alist1 : ('self, 'a) symbol -> ('self, 'a list) symbol
@@ -77,11 +88,19 @@ type ('self, 'a) symbol =
 | Anext : ('self, 'self) symbol
 | Aentry : 'a Entry.t -> ('self, 'a) symbol
 | Aentryl : 'a Entry.t * int -> ('self, 'a) symbol
+| Arules : 'a rules -> ('self, 'a index) symbol
 
-type ('self, _, 'r) rule =
+and ('self, _, 'r) rule =
 | Stop : ('self, 'r, 'r) rule
 | Next : ('self, 'a, 'r) rule * ('self, 'b) symbol -> ('self, 'b -> 'a, 'r) rule
 
+and 'a rules =
+| Rule0 : unit rules
+| RuleS :
+  ('any, 'act, Loc.t -> Loc.t * 'a) rule *
+  ('act, 'a, Loc.t -> Loc.t * 'a) adj *
+  'b rules -> ((Loc.t * 'a) * 'b) rules
+
 type 'a production_rule =
 | Rule : ('a, 'act, Loc.t -> 'a) rule * 'act -> 'a production_rule