summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2013-10-01 01:32:58 +0000
committerJacques Garrigue <garrigue at math.nagoya-u.ac.jp>2013-10-01 01:32:58 +0000
commit2d5bd020211be4104dec7c9e7792f458ffc101c8 (patch)
tree8d6362ec126ad44e70c199f4dab0a77c127ba99c
parentcc31694f7ca1043080fc290e5a82520513cf7f94 (diff)
downloadocaml-2d5bd020211be4104dec7c9e7792f458ffc101c8.tar.gz
bootstrap camlp4
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14203 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat
-rw-r--r--camlp4/boot/Camlp4.ml853
-rw-r--r--camlp4/boot/camlp4boot.ml42
2 files changed, 697 insertions, 198 deletions
diff --git a/camlp4/boot/Camlp4.ml b/camlp4/boot/Camlp4.ml
index 3bfde79e5b..be79b84c79 100644
--- a/camlp4/boot/Camlp4.ml
+++ b/camlp4/boot/Camlp4.ml
@@ -929,6 +929,8 @@ module Sig =
| (* t of & t *)
TyPkg of loc * module_type
| (* (module S) *)
+ TyAtt of loc * string * str_item * ctyp
+ | (* .. [@attr] *)
TyAnt of loc * string
and (* $s$ *)
patt =
@@ -985,6 +987,8 @@ module Sig =
| (* `s *)
PaLaz of loc * patt
| (* lazy p *)
+ PaAtt of loc * string * str_item * patt
+ | (* .. [@attr] *)
PaMod of loc * string
and (* (module M) *)
expr =
@@ -1074,6 +1078,8 @@ module Sig =
ExFUN of loc * string * expr
| (* (module ME : S) which is represented as (module (ME : S)) *)
ExPkg of loc * module_expr
+ | (* e [@attr] *)
+ ExAtt of loc * string * str_item * expr
and module_type =
| MtNil of loc
| (* i *)
@@ -1089,7 +1095,9 @@ module Sig =
MtWit of loc * module_type * with_constr
| (* module type of m *)
MtOf of loc * module_expr
- | MtAnt of loc * string
+ | MtAtt of loc * string * str_item * module_type
+ | (* .. [@attr] *)
+ MtAnt of loc * string
and (* $s$ *)
sig_item =
| SgNil of loc
@@ -1187,7 +1195,9 @@ module Sig =
| (* (value e) *)
(* (value e : S) which is represented as (value (e : S)) *)
MePkg of loc * expr
- | MeAnt of loc * string
+ | MeAtt of loc * string * str_item * module_expr
+ | (* .. [@attr] *)
+ MeAnt of loc * string
and (* $s$ *)
str_item =
| StNil of loc
@@ -1236,6 +1246,8 @@ module Sig =
| (* ct = ct *)
CtEq of loc * class_type * class_type
| (* $s$ *)
+ CtAtt of loc * string * str_item * class_type
+ | (* .. [@attr] *)
CtAnt of loc * string
and class_sig_item =
| CgNil of loc
@@ -1272,6 +1284,8 @@ module Sig =
| (* ce = ce *)
CeEq of loc * class_expr * class_expr
| (* $s$ *)
+ CeAtt of loc * string * str_item * class_expr
+ | (* .. [@attr] *)
CeAnt of loc * string
and class_str_item =
| CrNil of loc
@@ -1805,6 +1819,7 @@ module Sig =
| TyAmp of loc * ctyp * ctyp
| TyOfAmp of loc * ctyp * ctyp
| TyPkg of loc * module_type
+ | TyAtt of loc * string * str_item * ctyp
| TyAnt of loc * string
and patt =
| PaNil of loc
@@ -1835,6 +1850,7 @@ module Sig =
| PaTyp of loc * ident
| PaVrn of loc * string
| PaLaz of loc * patt
+ | PaAtt of loc * string * str_item * patt
| PaMod of loc * string
and expr =
| ExNil of loc
@@ -1881,6 +1897,7 @@ module Sig =
| ExOpI of loc * ident * override_flag * expr
| ExFUN of loc * string * expr
| ExPkg of loc * module_expr
+ | ExAtt of loc * string * str_item * expr
and module_type =
| MtNil of loc
| MtId of loc * ident
@@ -1889,6 +1906,7 @@ module Sig =
| MtSig of loc * sig_item
| MtWit of loc * module_type * with_constr
| MtOf of loc * module_expr
+ | MtAtt of loc * string * str_item * module_type
| MtAnt of loc * string
and sig_item =
| SgNil of loc
@@ -1943,6 +1961,7 @@ module Sig =
| MeStr of loc * str_item
| MeTyc of loc * module_expr * module_type
| MePkg of loc * expr
+ | MeAtt of loc * string * str_item * module_expr
| MeAnt of loc * string
and str_item =
| StNil of loc
@@ -1969,6 +1988,7 @@ module Sig =
| CtAnd of loc * class_type * class_type
| CtCol of loc * class_type * class_type
| CtEq of loc * class_type * class_type
+ | CtAtt of loc * string * str_item * class_type
| CtAnt of loc * string
and class_sig_item =
| CgNil of loc
@@ -1989,6 +2009,7 @@ module Sig =
| CeTyc of loc * class_expr * class_type
| CeAnd of loc * class_expr * class_expr
| CeEq of loc * class_expr * class_expr
+ | CeAtt of loc * string * str_item * class_expr
| CeAnt of loc * string
and class_str_item =
| CrNil of loc
@@ -6943,6 +6964,7 @@ module Struct =
| Ast.PaLab (_, _, (Ast.PaNil _)) -> true
| Ast.PaLab (_, _, p) -> is_irrefut_patt p
| Ast.PaLaz (_, p) -> is_irrefut_patt p
+ | Ast.PaAtt (_loc, _s, _str, p) -> is_irrefut_patt p
| Ast.PaId (_, _) -> false
| Ast.PaMod (_, _) -> true
| Ast.PaVrn (_, _) | Ast.PaStr (_, _) | Ast.PaRng (_, _, _) |
@@ -7480,6 +7502,19 @@ module Struct =
and meta_class_expr _loc =
function
| Ast.CeAnt (x0, x1) -> Ast.ExAnt (x0, x1)
+ | Ast.CeAtt (x0, x1, x2, x3) ->
+ Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExId (_loc,
+ (Ast.IdAcc (_loc,
+ (Ast.IdUid (_loc, "Ast")),
+ (Ast.IdUid (_loc, "CeAtt")))))),
+ (meta_loc _loc x0))),
+ (meta_string _loc x1))),
+ (meta_str_item _loc x2))),
+ (meta_class_expr _loc x3))
| Ast.CeEq (x0, x1, x2) ->
Ast.ExApp (_loc,
(Ast.ExApp (_loc,
@@ -7777,6 +7812,19 @@ module Struct =
and meta_class_type _loc =
function
| Ast.CtAnt (x0, x1) -> Ast.ExAnt (x0, x1)
+ | Ast.CtAtt (x0, x1, x2, x3) ->
+ Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExId (_loc,
+ (Ast.IdAcc (_loc,
+ (Ast.IdUid (_loc, "Ast")),
+ (Ast.IdUid (_loc, "CtAtt")))))),
+ (meta_loc _loc x0))),
+ (meta_string _loc x1))),
+ (meta_str_item _loc x2))),
+ (meta_class_type _loc x3))
| Ast.CtEq (x0, x1, x2) ->
Ast.ExApp (_loc,
(Ast.ExApp (_loc,
@@ -7855,6 +7903,19 @@ module Struct =
and meta_ctyp _loc =
function
| Ast.TyAnt (x0, x1) -> Ast.ExAnt (x0, x1)
+ | Ast.TyAtt (x0, x1, x2, x3) ->
+ Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExId (_loc,
+ (Ast.IdAcc (_loc,
+ (Ast.IdUid (_loc, "Ast")),
+ (Ast.IdUid (_loc, "TyAtt")))))),
+ (meta_loc _loc x0))),
+ (meta_string _loc x1))),
+ (meta_str_item _loc x2))),
+ (meta_ctyp _loc x3))
| Ast.TyPkg (x0, x1) ->
Ast.ExApp (_loc,
(Ast.ExApp (_loc,
@@ -8261,6 +8322,19 @@ module Struct =
(Ast.IdUid (_loc, "DiTo")))))
and meta_expr _loc =
function
+ | Ast.ExAtt (x0, x1, x2, x3) ->
+ Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExId (_loc,
+ (Ast.IdAcc (_loc,
+ (Ast.IdUid (_loc, "Ast")),
+ (Ast.IdUid (_loc, "ExAtt")))))),
+ (meta_loc _loc x0))),
+ (meta_string _loc x1))),
+ (meta_str_item _loc x2))),
+ (meta_expr _loc x3))
| Ast.ExPkg (x0, x1) ->
Ast.ExApp (_loc,
(Ast.ExApp (_loc,
@@ -8874,6 +8948,19 @@ module Struct =
and meta_module_expr _loc =
function
| Ast.MeAnt (x0, x1) -> Ast.ExAnt (x0, x1)
+ | Ast.MeAtt (x0, x1, x2, x3) ->
+ Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExId (_loc,
+ (Ast.IdAcc (_loc,
+ (Ast.IdUid (_loc, "Ast")),
+ (Ast.IdUid (_loc, "MeAtt")))))),
+ (meta_loc _loc x0))),
+ (meta_string _loc x1))),
+ (meta_str_item _loc x2))),
+ (meta_module_expr _loc x3))
| Ast.MePkg (x0, x1) ->
Ast.ExApp (_loc,
(Ast.ExApp (_loc,
@@ -8946,6 +9033,19 @@ module Struct =
and meta_module_type _loc =
function
| Ast.MtAnt (x0, x1) -> Ast.ExAnt (x0, x1)
+ | Ast.MtAtt (x0, x1, x2, x3) ->
+ Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExId (_loc,
+ (Ast.IdAcc (_loc,
+ (Ast.IdUid (_loc, "Ast")),
+ (Ast.IdUid (_loc, "MtAtt")))))),
+ (meta_loc _loc x0))),
+ (meta_string _loc x1))),
+ (meta_str_item _loc x2))),
+ (meta_module_type _loc x3))
| Ast.MtOf (x0, x1) ->
Ast.ExApp (_loc,
(Ast.ExApp (_loc,
@@ -9046,6 +9146,19 @@ module Struct =
(Ast.IdUid (_loc, "PaMod")))))),
(meta_loc _loc x0))),
(meta_string _loc x1))
+ | Ast.PaAtt (x0, x1, x2, x3) ->
+ Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExApp (_loc,
+ (Ast.ExId (_loc,
+ (Ast.IdAcc (_loc,
+ (Ast.IdUid (_loc, "Ast")),
+ (Ast.IdUid (_loc, "PaAtt")))))),
+ (meta_loc _loc x0))),
+ (meta_string _loc x1))),
+ (meta_str_item _loc x2))),
+ (meta_patt _loc x3))
| Ast.PaLaz (x0, x1) ->
Ast.ExApp (_loc,
(Ast.ExApp (_loc,
@@ -9815,6 +9928,19 @@ module Struct =
and meta_class_expr _loc =
function
| Ast.CeAnt (x0, x1) -> Ast.PaAnt (x0, x1)
+ | Ast.CeAtt (x0, x1, x2, x3) ->
+ Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaId (_loc,
+ (Ast.IdAcc (_loc,
+ (Ast.IdUid (_loc, "Ast")),
+ (Ast.IdUid (_loc, "CeAtt")))))),
+ (meta_loc _loc x0))),
+ (meta_string _loc x1))),
+ (meta_str_item _loc x2))),
+ (meta_class_expr _loc x3))
| Ast.CeEq (x0, x1, x2) ->
Ast.PaApp (_loc,
(Ast.PaApp (_loc,
@@ -10112,6 +10238,19 @@ module Struct =
and meta_class_type _loc =
function
| Ast.CtAnt (x0, x1) -> Ast.PaAnt (x0, x1)
+ | Ast.CtAtt (x0, x1, x2, x3) ->
+ Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaId (_loc,
+ (Ast.IdAcc (_loc,
+ (Ast.IdUid (_loc, "Ast")),
+ (Ast.IdUid (_loc, "CtAtt")))))),
+ (meta_loc _loc x0))),
+ (meta_string _loc x1))),
+ (meta_str_item _loc x2))),
+ (meta_class_type _loc x3))
| Ast.CtEq (x0, x1, x2) ->
Ast.PaApp (_loc,
(Ast.PaApp (_loc,
@@ -10190,6 +10329,19 @@ module Struct =
and meta_ctyp _loc =
function
| Ast.TyAnt (x0, x1) -> Ast.PaAnt (x0, x1)
+ | Ast.TyAtt (x0, x1, x2, x3) ->
+ Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaId (_loc,
+ (Ast.IdAcc (_loc,
+ (Ast.IdUid (_loc, "Ast")),
+ (Ast.IdUid (_loc, "TyAtt")))))),
+ (meta_loc _loc x0))),
+ (meta_string _loc x1))),
+ (meta_str_item _loc x2))),
+ (meta_ctyp _loc x3))
| Ast.TyPkg (x0, x1) ->
Ast.PaApp (_loc,
(Ast.PaApp (_loc,
@@ -10596,6 +10748,19 @@ module Struct =
(Ast.IdUid (_loc, "DiTo")))))
and meta_expr _loc =
function
+ | Ast.ExAtt (x0, x1, x2, x3) ->
+ Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaId (_loc,
+ (Ast.IdAcc (_loc,
+ (Ast.IdUid (_loc, "Ast")),
+ (Ast.IdUid (_loc, "ExAtt")))))),
+ (meta_loc _loc x0))),
+ (meta_string _loc x1))),
+ (meta_str_item _loc x2))),
+ (meta_expr _loc x3))
| Ast.ExPkg (x0, x1) ->
Ast.PaApp (_loc,
(Ast.PaApp (_loc,
@@ -11209,6 +11374,19 @@ module Struct =
and meta_module_expr _loc =
function
| Ast.MeAnt (x0, x1) -> Ast.PaAnt (x0, x1)
+ | Ast.MeAtt (x0, x1, x2, x3) ->
+ Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaId (_loc,
+ (Ast.IdAcc (_loc,
+ (Ast.IdUid (_loc, "Ast")),
+ (Ast.IdUid (_loc, "MeAtt")))))),
+ (meta_loc _loc x0))),
+ (meta_string _loc x1))),
+ (meta_str_item _loc x2))),
+ (meta_module_expr _loc x3))
| Ast.MePkg (x0, x1) ->
Ast.PaApp (_loc,
(Ast.PaApp (_loc,
@@ -11281,6 +11459,19 @@ module Struct =
and meta_module_type _loc =
function
| Ast.MtAnt (x0, x1) -> Ast.PaAnt (x0, x1)
+ | Ast.MtAtt (x0, x1, x2, x3) ->
+ Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaId (_loc,
+ (Ast.IdAcc (_loc,
+ (Ast.IdUid (_loc, "Ast")),
+ (Ast.IdUid (_loc, "MtAtt")))))),
+ (meta_loc _loc x0))),
+ (meta_string _loc x1))),
+ (meta_str_item _loc x2))),
+ (meta_module_type _loc x3))
| Ast.MtOf (x0, x1) ->
Ast.PaApp (_loc,
(Ast.PaApp (_loc,
@@ -11381,6 +11572,19 @@ module Struct =
(Ast.IdUid (_loc, "PaMod")))))),
(meta_loc _loc x0))),
(meta_string _loc x1))
+ | Ast.PaAtt (x0, x1, x2, x3) ->
+ Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaApp (_loc,
+ (Ast.PaId (_loc,
+ (Ast.IdAcc (_loc,
+ (Ast.IdUid (_loc, "Ast")),
+ (Ast.IdUid (_loc, "PaAtt")))))),
+ (meta_loc _loc x0))),
+ (meta_string _loc x1))),
+ (meta_str_item _loc x2))),
+ (meta_patt _loc x3))
| Ast.PaLaz (x0, x1) ->
Ast.PaApp (_loc,
(Ast.PaApp (_loc,
@@ -12377,6 +12581,12 @@ module Struct =
| PaLaz (_x, _x_i1) ->
let _x = o#loc _x in
let _x_i1 = o#patt _x_i1 in PaLaz (_x, _x_i1)
+ | PaAtt (_x, _x_i1, _x_i2, _x_i3) ->
+ let _x = o#loc _x in
+ let _x_i1 = o#string _x_i1 in
+ let _x_i2 = o#str_item _x_i2 in
+ let _x_i3 = o#patt _x_i3
+ in PaAtt (_x, _x_i1, _x_i2, _x_i3)
| PaMod (_x, _x_i1) ->
let _x = o#loc _x in
let _x_i1 = o#string _x_i1 in PaMod (_x, _x_i1)
@@ -12416,6 +12626,12 @@ module Struct =
| MtOf (_x, _x_i1) ->
let _x = o#loc _x in
let _x_i1 = o#module_expr _x_i1 in MtOf (_x, _x_i1)
+ | MtAtt (_x, _x_i1, _x_i2, _x_i3) ->
+ let _x = o#loc _x in
+ let _x_i1 = o#string _x_i1 in
+ let _x_i2 = o#str_item _x_i2 in
+ let _x_i3 = o#module_type _x_i3
+ in MtAtt (_x, _x_i1, _x_i2, _x_i3)
| MtAnt (_x, _x_i1) ->
let _x = o#loc _x in
let _x_i1 = o#string _x_i1 in MtAnt (_x, _x_i1)
@@ -12447,6 +12663,12 @@ module Struct =
| MePkg (_x, _x_i1) ->
let _x = o#loc _x in
let _x_i1 = o#expr _x_i1 in MePkg (_x, _x_i1)
+ | MeAtt (_x, _x_i1, _x_i2, _x_i3) ->
+ let _x = o#loc _x in
+ let _x_i1 = o#string _x_i1 in
+ let _x_i2 = o#str_item _x_i2 in
+ let _x_i3 = o#module_expr _x_i3
+ in MeAtt (_x, _x_i1, _x_i2, _x_i3)
| MeAnt (_x, _x_i1) ->
let _x = o#loc _x in
let _x_i1 = o#string _x_i1 in MeAnt (_x, _x_i1)
@@ -12705,6 +12927,12 @@ module Struct =
| ExPkg (_x, _x_i1) ->
let _x = o#loc _x in
let _x_i1 = o#module_expr _x_i1 in ExPkg (_x, _x_i1)
+ | ExAtt (_x, _x_i1, _x_i2, _x_i3) ->
+ let _x = o#loc _x in
+ let _x_i1 = o#string _x_i1 in
+ let _x_i2 = o#str_item _x_i2 in
+ let _x_i3 = o#expr _x_i3
+ in ExAtt (_x, _x_i1, _x_i2, _x_i3)
method direction_flag : direction_flag -> direction_flag =
function
| DiTo -> DiTo
@@ -12852,6 +13080,12 @@ module Struct =
| TyPkg (_x, _x_i1) ->
let _x = o#loc _x in
let _x_i1 = o#module_type _x_i1 in TyPkg (_x, _x_i1)
+ | TyAtt (_x, _x_i1, _x_i2, _x_i3) ->
+ let _x = o#loc _x in
+ let _x_i1 = o#string _x_i1 in
+ let _x_i2 = o#str_item _x_i2 in
+ let _x_i3 = o#ctyp _x_i3
+ in TyAtt (_x, _x_i1, _x_i2, _x_i3)
| TyAnt (_x, _x_i1) ->
let _x = o#loc _x in
let _x_i1 = o#string _x_i1 in TyAnt (_x, _x_i1)
@@ -12889,6 +13123,12 @@ module Struct =
let _x_i1 = o#class_type _x_i1 in
let _x_i2 = o#class_type _x_i2
in CtEq (_x, _x_i1, _x_i2)
+ | CtAtt (_x, _x_i1, _x_i2, _x_i3) ->
+ let _x = o#loc _x in
+ let _x_i1 = o#string _x_i1 in
+ let _x_i2 = o#str_item _x_i2 in
+ let _x_i3 = o#class_type _x_i3
+ in CtAtt (_x, _x_i1, _x_i2, _x_i3)
| CtAnt (_x, _x_i1) ->
let _x = o#loc _x in
let _x_i1 = o#string _x_i1 in CtAnt (_x, _x_i1)
@@ -13024,6 +13264,12 @@ module Struct =
let _x_i1 = o#class_expr _x_i1 in
let _x_i2 = o#class_expr _x_i2
in CeEq (_x, _x_i1, _x_i2)
+ | CeAtt (_x, _x_i1, _x_i2, _x_i3) ->
+ let _x = o#loc _x in
+ let _x_i1 = o#string _x_i1 in
+ let _x_i2 = o#str_item _x_i2 in
+ let _x_i3 = o#class_expr _x_i3
+ in CeAtt (_x, _x_i1, _x_i2, _x_i3)
| CeAnt (_x, _x_i1) ->
let _x = o#loc _x in
let _x_i1 = o#string _x_i1 in CeAnt (_x, _x_i1)
@@ -13267,6 +13513,10 @@ module Struct =
let o = o#loc _x in let o = o#string _x_i1 in o
| PaLaz (_x, _x_i1) ->
let o = o#loc _x in let o = o#patt _x_i1 in o
+ | PaAtt (_x, _x_i1, _x_i2, _x_i3) ->
+ let o = o#loc _x in
+ let o = o#string _x_i1 in
+ let o = o#str_item _x_i2 in let o = o#patt _x_i3 in o
| PaMod (_x, _x_i1) ->
let o = o#loc _x in let o = o#string _x_i1 in o
method override_flag : override_flag -> 'self_type =
@@ -13299,6 +13549,11 @@ module Struct =
let o = o#with_constr _x_i2 in o
| MtOf (_x, _x_i1) ->
let o = o#loc _x in let o = o#module_expr _x_i1 in o
+ | MtAtt (_x, _x_i1, _x_i2, _x_i3) ->
+ let o = o#loc _x in
+ let o = o#string _x_i1 in
+ let o = o#str_item _x_i2 in
+ let o = o#module_type _x_i3 in o
| MtAnt (_x, _x_i1) ->
let o = o#loc _x in let o = o#string _x_i1 in o
method module_expr : module_expr -> 'self_type =
@@ -13323,6 +13578,11 @@ module Struct =
let o = o#module_type _x_i2 in o
| MePkg (_x, _x_i1) ->
let o = o#loc _x in let o = o#expr _x_i1 in o
+ | MeAtt (_x, _x_i1, _x_i2, _x_i3) ->
+ let o = o#loc _x in
+ let o = o#string _x_i1 in
+ let o = o#str_item _x_i2 in
+ let o = o#module_expr _x_i3 in o
| MeAnt (_x, _x_i1) ->
let o = o#loc _x in let o = o#string _x_i1 in o
method module_binding : module_binding -> 'self_type =
@@ -13520,6 +13780,10 @@ module Struct =
let o = o#string _x_i1 in let o = o#expr _x_i2 in o
| ExPkg (_x, _x_i1) ->
let o = o#loc _x in let o = o#module_expr _x_i1 in o
+ | ExAtt (_x, _x_i1, _x_i2, _x_i3) ->
+ let o = o#loc _x in
+ let o = o#string _x_i1 in
+ let o = o#str_item _x_i2 in let o = o#expr _x_i3 in o
method direction_flag : direction_flag -> 'self_type =
function
| DiTo -> o
@@ -13630,6 +13894,10 @@ module Struct =
let o = o#ctyp _x_i1 in let o = o#ctyp _x_i2 in o
| TyPkg (_x, _x_i1) ->
let o = o#loc _x in let o = o#module_type _x_i1 in o
+ | TyAtt (_x, _x_i1, _x_i2, _x_i3) ->
+ let o = o#loc _x in
+ let o = o#string _x_i1 in
+ let o = o#str_item _x_i2 in let o = o#ctyp _x_i3 in o
| TyAnt (_x, _x_i1) ->
let o = o#loc _x in let o = o#string _x_i1 in o
method class_type : class_type -> 'self_type =
@@ -13658,6 +13926,11 @@ module Struct =
let o = o#loc _x in
let o = o#class_type _x_i1 in
let o = o#class_type _x_i2 in o
+ | CtAtt (_x, _x_i1, _x_i2, _x_i3) ->
+ let o = o#loc _x in
+ let o = o#string _x_i1 in
+ let o = o#str_item _x_i2 in
+ let o = o#class_type _x_i3 in o
| CtAnt (_x, _x_i1) ->
let o = o#loc _x in let o = o#string _x_i1 in o
method class_str_item : class_str_item -> 'self_type =
@@ -13765,6 +14038,11 @@ module Struct =
let o = o#loc _x in
let o = o#class_expr _x_i1 in
let o = o#class_expr _x_i2 in o
+ | CeAtt (_x, _x_i1, _x_i2, _x_i3) ->
+ let o = o#loc _x in
+ let o = o#string _x_i1 in
+ let o = o#str_item _x_i2 in
+ let o = o#class_expr _x_i3 in o
| CeAnt (_x, _x_i1) ->
let o = o#loc _x in let o = o#string _x_i1 in o
method binding : binding -> 'self_type =
@@ -14182,29 +14460,40 @@ module Struct =
let with_loc txt loc =
Camlp4_import.Location.mkloc txt (mkloc loc)
- let mktyp loc d = { ptyp_desc = d; ptyp_loc = mkloc loc; ptyp_attributes = []}
+ let mktyp loc d =
+ { ptyp_desc = d; ptyp_loc = mkloc loc; ptyp_attributes = []; }
- let mkpat loc d = { ppat_desc = d; ppat_loc = mkloc loc; ppat_attributes = []}
+ let mkpat loc d =
+ { ppat_desc = d; ppat_loc = mkloc loc; ppat_attributes = []; }
- let mkghpat loc d = { ppat_desc = d; ppat_loc = mkghloc loc; ppat_attributes = []}
+ let mkghpat loc d =
+ { ppat_desc = d; ppat_loc = mkghloc loc; ppat_attributes = [];
+ }
- let mkexp loc d = { pexp_desc = d; pexp_loc = mkloc loc; pexp_attributes = []}
+ let mkexp loc d =
+ { pexp_desc = d; pexp_loc = mkloc loc; pexp_attributes = []; }
- let mkmty loc d = { pmty_desc = d; pmty_loc = mkloc loc; pmty_attributes = []}
+ let mkmty loc d =
+ { pmty_desc = d; pmty_loc = mkloc loc; pmty_attributes = []; }
let mksig loc d = { psig_desc = d; psig_loc = mkloc loc; }
- let mkmod loc d = { pmod_desc = d; pmod_loc = mkloc loc; pmod_attributes = []}
+ let mkmod loc d =
+ { pmod_desc = d; pmod_loc = mkloc loc; pmod_attributes = []; }
let mkstr loc d = { pstr_desc = d; pstr_loc = mkloc loc; }
- let mkcty loc d = { pcty_desc = d; pcty_loc = mkloc loc; pcty_attributes = []}
+ let mkcty loc d =
+ { pcty_desc = d; pcty_loc = mkloc loc; pcty_attributes = []; }
- let mkcl loc d = { pcl_desc = d; pcl_loc = mkloc loc; pcl_attributes = []}
+ let mkcl loc d =
+ { pcl_desc = d; pcl_loc = mkloc loc; pcl_attributes = []; }
- let mkcf loc d = { pcf_desc = d; pcf_loc = mkloc loc; pcf_attributes = [] }
+ let mkcf loc d =
+ { pcf_desc = d; pcf_loc = mkloc loc; pcf_attributes = []; }
- let mkctf loc d = { pctf_desc = d; pctf_loc = mkloc loc; pctf_attributes = [] }
+ let mkctf loc d =
+ { pctf_desc = d; pctf_loc = mkloc loc; pctf_attributes = []; }
let mkpolytype t =
match t.ptyp_desc with
@@ -14358,6 +14647,10 @@ module Struct =
((loc, (IdLid ((loc, "*predef*"))),
(IdLid ((loc, "option"))))))))
+ let attribute_fwd = ref (fun _ _ _ -> assert false)
+
+ let attribute loc s str = !attribute_fwd loc s str
+
let rec ctyp =
function
| TyId (loc, i) ->
@@ -14388,15 +14681,22 @@ module Struct =
| TyArr (loc, t1, t2) ->
mktyp loc (Ptyp_arrow ("", (ctyp t1), (ctyp t2)))
| Ast.TyObj (loc, fl, Ast.RvNil) ->
- mktyp loc (Ptyp_object (meth_list fl [], Closed))
+ mktyp loc (Ptyp_object ((meth_list fl []), Closed))
| Ast.TyObj (loc, fl, Ast.RvRowVar) ->
- mktyp loc
- (Ptyp_object (meth_list fl [], Open))
- | TyCls (loc, id) ->
- mktyp loc (Ptyp_class ((ident id), []))
+ mktyp loc (Ptyp_object ((meth_list fl []), Open))
+ | TyCls (loc, id) -> mktyp loc (Ptyp_class ((ident id), []))
| Ast.TyPkg (loc, pt) ->
let (i, cs) = package_type pt
in mktyp loc (Ptyp_package (i, cs))
+ | TyAtt (loc, s, str, e) ->
+ let e = ctyp e
+ in
+ {
+ (e)
+ with
+ ptyp_attributes =
+ e.ptyp_attributes @ [ attribute loc s str ];
+ }
| TyLab (loc, _, _) ->
error loc "labelled type not allowed here"
| TyMan (loc, _, _) ->
@@ -14459,7 +14759,7 @@ module Struct =
match fl with
| Ast.TyNil _ -> acc
| Ast.TySem (_, t1, t2) -> meth_list t1 (meth_list t2 acc)
- | Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdLid (_, lab)))), t) ->
+ | Ast.TyCol (_, (Ast.TyId (_, (Ast.IdLid (_, lab)))), t) ->
(lab, (mkpolytype (ctyp t))) :: acc
| _ -> assert false
and package_type_constraints wc acc =
@@ -14481,16 +14781,16 @@ module Struct =
| mt -> error (loc_of_module_type mt) "unexpected package type"
let mktype loc name tl cl tk tp tm =
- {
- ptype_name = name;
- ptype_params = tl;
- ptype_cstrs = cl;
- ptype_kind = tk;
- ptype_private = tp;
- ptype_manifest = tm;
- ptype_loc = mkloc loc;
- ptype_attributes = [];
- }
+ {
+ ptype_name = name;
+ ptype_params = tl;
+ ptype_cstrs = cl;
+ ptype_kind = tk;
+ ptype_private = tp;
+ ptype_manifest = tm;
+ ptype_loc = mkloc loc;
+ ptype_attributes = [];
+ }
let mkprivate' m = if m then Private else Public
@@ -14504,32 +14804,58 @@ module Struct =
function
| Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdLid (sloc, s)))),
(Ast.TyMut (_, t))) ->
- {pld_name=with_loc s sloc;
- pld_mutable=Mutable;
- pld_type=mkpolytype (ctyp t);
- pld_loc=mkloc loc;
- pld_attributes=[];
- }
+ {
+ pld_name = with_loc s sloc;
+ pld_mutable = Mutable;
+ pld_type = mkpolytype (ctyp t);
+ pld_loc = mkloc loc;
+ pld_attributes = [];
+ }
| Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdLid (sloc, s)))), t) ->
- {pld_name=with_loc s sloc;
- pld_mutable=Immutable;
- pld_type=mkpolytype (ctyp t);
- pld_loc=mkloc loc;
- pld_attributes=[];
+ {
+ pld_name = with_loc s sloc;
+ pld_mutable = Immutable;
+ pld_type = mkpolytype (ctyp t);
+ pld_loc = mkloc loc;
+ pld_attributes = [];
}
| _ -> assert false
let mkvariant =
function
| Ast.TyId (loc, (Ast.IdUid (sloc, s))) ->
- {pcd_name = with_loc (conv_con s) sloc; pcd_args = []; pcd_res = None; pcd_loc = mkloc loc; pcd_attributes = []}
+ {
+ pcd_name = with_loc (conv_con s) sloc;
+ pcd_args = [];
+ pcd_res = None;
+ pcd_loc = mkloc loc;
+ pcd_attributes = [];
+ }
| Ast.TyOf (loc, (Ast.TyId (_, (Ast.IdUid (sloc, s)))), t) ->
- {pcd_name = with_loc (conv_con s) sloc; pcd_args = List.map ctyp (list_of_ctyp t []); pcd_res = None; pcd_loc = mkloc loc; pcd_attributes = []}
+ {
+ pcd_name = with_loc (conv_con s) sloc;
+ pcd_args = List.map ctyp (list_of_ctyp t []);
+ pcd_res = None;
+ pcd_loc = mkloc loc;
+ pcd_attributes = [];
+ }
| Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdUid (sloc, s)))),
(Ast.TyArr (_, t, u))) ->
- {pcd_name = with_loc (conv_con s) sloc; pcd_args = List.map ctyp (list_of_ctyp t []); pcd_res = Some (ctyp u); pcd_loc = mkloc loc; pcd_attributes = []}
+ {
+ pcd_name = with_loc (conv_con s) sloc;
+ pcd_args = List.map ctyp (list_of_ctyp t []);
+ pcd_res = Some (ctyp u);
+ pcd_loc = mkloc loc;
+ pcd_attributes = [];
+ }
| Ast.TyCol (loc, (Ast.TyId (_, (Ast.IdUid (sloc, s)))), t) ->
- {pcd_name = with_loc (conv_con s) sloc; pcd_args = []; pcd_res = Some (ctyp t); pcd_loc = mkloc loc; pcd_attributes = []}
+ {
+ pcd_name = with_loc (conv_con s) sloc;
+ pcd_args = [];
+ pcd_res = Some (ctyp t);
+ pcd_loc = mkloc loc;
+ pcd_attributes = [];
+ }
| _ -> assert false
let rec type_decl name tl cl loc m pflag =
@@ -14559,15 +14885,21 @@ module Struct =
match t with
| Ast.TyNil _ -> None
| _ -> Some (ctyp t)
- in mktype loc name tl cl Ptype_abstract (mkprivate' pflag) m)
+ in
+ mktype loc name tl cl Ptype_abstract
+ (mkprivate' pflag) m)
- let type_decl name tl cl t loc = type_decl name tl cl loc None false t
+ let type_decl name tl cl t loc =
+ type_decl name tl cl loc None false t
let mkvalue_desc loc name t p =
- { pval_name = name;
- pval_type = ctyp t; pval_prim = p; pval_loc = mkloc loc;
+ {
+ pval_name = name;
+ pval_type = ctyp t;
+ pval_prim = p;
+ pval_loc = mkloc loc;
pval_attributes = [];
- }
+ }
let rec list_of_meta_list =
function
@@ -14599,9 +14931,9 @@ module Struct =
match t with
| Ast.TyApp (_, t1, t2) ->
type_parameters t1 (type_parameters t2 acc)
- | Ast.TyQuP (_, s) -> (s, (true, false)) :: acc
- | Ast.TyQuM (_, s) -> (s, (false, true)) :: acc
- | Ast.TyQuo (_, s) -> (s, (false, false)) :: acc
+ | Ast.TyQuP (_, s) -> (s, Covariant) :: acc
+ | Ast.TyQuM (_, s) -> (s, Contravariant) :: acc
+ | Ast.TyQuo (_, s) -> (s, Invariant) :: acc
| _ -> assert false
let rec optional_type_parameters t acc =
@@ -14624,12 +14956,10 @@ module Struct =
match t with
| Ast.TyCom (_, t1, t2) ->
class_parameters t1 (class_parameters t2 acc)
- | Ast.TyQuP (loc, s) ->
- ((with_loc s loc), Covariant) :: acc
+ | Ast.TyQuP (loc, s) -> ((with_loc s loc), Covariant) :: acc
| Ast.TyQuM (loc, s) ->
((with_loc s loc), Contravariant) :: acc
- | Ast.TyQuo (loc, s) ->
- ((with_loc s loc), Invariant) :: acc
+ | Ast.TyQuo (loc, s) -> ((with_loc s loc), Invariant) :: acc
| _ -> assert false
let rec type_parameters_and_type_name t acc =
@@ -14644,35 +14974,38 @@ module Struct =
let (id, tpl) = type_parameters_and_type_name id_tpl [] in
let (kind, priv, ct) = opt_private_ctyp ct
in
- pwith_type id
- {
- ptype_name = Camlp4_import.Location.mkloc (Camlp4_import.Longident.last id.txt) id.loc;
- ptype_params = tpl;
- ptype_cstrs = [];
- ptype_kind = kind;
- ptype_private = priv;
- ptype_manifest = Some ct;
- ptype_loc = mkloc loc;
- ptype_attributes = [];
- }
+ pwith_type id
+ {
+ ptype_name =
+ Camlp4_import.Location.mkloc
+ (Camlp4_import.Longident.last id.txt) id.loc;
+ ptype_params = tpl;
+ ptype_cstrs = [];
+ ptype_kind = kind;
+ ptype_private = priv;
+ ptype_manifest = Some ct;
+ ptype_loc = mkloc loc;
+ ptype_attributes = [];
+ }
let rec mkwithc wc acc =
match wc with
| Ast.WcNil _ -> acc
| Ast.WcTyp (loc, id_tpl, ct) ->
- (mkwithtyp (fun lid x -> Pwith_type (lid, x)) loc id_tpl ct) :: acc
+ (mkwithtyp (fun lid x -> Pwith_type (lid, x)) loc id_tpl ct) ::
+ acc
| Ast.WcMod (_, i1, i2) ->
- (Pwith_module (long_uident i1, long_uident i2)) :: acc
+ (Pwith_module ((long_uident i1), (long_uident i2))) :: acc
| Ast.WcTyS (loc, id_tpl, ct) ->
(mkwithtyp (fun _ x -> Pwith_typesubst x) loc id_tpl ct) ::
acc
| Ast.WcMoS (loc, i1, i2) ->
- begin match long_uident i1 with
- | {txt=Lident s; loc} ->
- (Pwith_modsubst ({txt=s;loc},long_uident i2)) ::
- acc
- | _ -> error loc "bad 'with module :=' constraint"
- end
+ (match long_uident i1 with
+ | { txt = Lident s; loc = loc } ->
+ (Pwith_modsubst ({ txt = s; loc = loc; },
+ (long_uident i2))) ::
+ acc
+ | _ -> error loc "bad 'with module :=' constraint")
| Ast.WcAnd (_, wc1, wc2) -> mkwithc wc1 (mkwithc wc2 acc)
| Ast.WcAnt (loc, _) ->
error loc "bad with constraint (antiquotation)"
@@ -14707,8 +15040,7 @@ module Struct =
| Ast.PaId (loc, (Ast.IdLid (sloc, s))) ->
mkpat loc (Ppat_var (with_loc s sloc))
| Ast.PaId (loc, i) ->
- let p =
- Ppat_construct ((long_uident ~conv_con i), None)
+ let p = Ppat_construct ((long_uident ~conv_con i), None)
in mkpat loc p
| PaAli (loc, p1, p2) ->
let (p, i) =
@@ -14732,18 +15064,16 @@ module Struct =
in
(match (patt f).ppat_desc with
| Ppat_construct (li, None) ->
- let a =
- match al with
- | [ a ] -> a
- | _ -> mkpat loc (Ppat_tuple al)
- in
- mkpat loc
- (Ppat_construct (li, (Some a)))
+ let a =
+ (match al with
+ | [ a ] -> a
+ | _ -> mkpat loc (Ppat_tuple al))
+ in mkpat loc (Ppat_construct (li, (Some a)))
| Ppat_variant (s, None) ->
let a =
- match al with
- | [ a ] -> a
- | _ -> mkpat loc (Ppat_tuple al)
+ (match al with
+ | [ a ] -> a
+ | _ -> mkpat loc (Ppat_tuple al))
in mkpat loc (Ppat_variant (s, (Some a)))
| _ ->
error (loc_of_patt f)
@@ -14814,7 +15144,7 @@ module Struct =
| PaStr (loc, s) ->
mkpat loc
(Ppat_constant
- (Const_string (string_of_string_token loc s, None)))
+ (Const_string ((string_of_string_token loc s), None)))
| Ast.PaTup (loc, (Ast.PaCom (_, p1, p2))) ->
mkpat loc
(Ppat_tuple
@@ -14827,6 +15157,15 @@ module Struct =
mkpat loc (Ppat_variant ((conv_con s), None))
| PaLaz (loc, p) -> mkpat loc (Ppat_lazy (patt p))
| PaMod (loc, m) -> mkpat loc (Ppat_unpack (with_loc m loc))
+ | PaAtt (loc, s, str, e) ->
+ let e = patt e
+ in
+ {
+ (e)
+ with
+ ppat_attributes =
+ e.ppat_attributes @ [ attribute loc s str ];
+ }
| (PaEq (_, _, _) | PaSem (_, _, _) | PaCom (_, _, _) | PaNil _
as p) -> error (loc_of_patt p) "invalid pattern"
and mklabpat =
@@ -14890,8 +15229,9 @@ module Struct =
List.mem s var_names -> Ptyp_var ("&" ^ s)
| Ptyp_constr (longident, lst) ->
Ptyp_constr (longident, (List.map loop lst))
- | Ptyp_object (lst, o) ->
- Ptyp_object (List.map (fun (s, t) -> (s, loop t)) lst, o)
+ | Ptyp_object ((lst, o)) ->
+ Ptyp_object
+ (((List.map (fun (s, t) -> (s, (loop t))) lst), o))
| Ptyp_class (longident, lst) ->
Ptyp_class ((longident, (List.map loop lst)))
| Ptyp_alias (core_type, string) ->
@@ -14906,6 +15246,7 @@ module Struct =
Ptyp_package
((longident,
(List.map (fun (n, typ) -> (n, (loop typ))) lst)))
+ | Ptyp_extension x -> Ptyp_extension x
in { (t) with ptyp_desc = desc; }
and loop_row_field x =
match x with
@@ -14925,13 +15266,13 @@ module Struct =
e) ->
let (e, l) =
(match sep_expr_acc [] e with
- | (loc, ml, Ast.ExId (sloc, (Ast.IdUid (_, s)))) :: l ->
- ((mkexp loc
- (Pexp_construct ((mkli sloc (conv_con s) ml),
- None))),
- l)
- | (loc, ml, Ast.ExId (sloc, (Ast.IdLid (_, s)))) :: l ->
- ((mkexp loc (Pexp_ident (mkli sloc s ml))), l)
+ | (loc, ml, Ast.ExId (_, (Ast.IdUid (_, s)))) :: l ->
+ ((mkexp loc
+ (Pexp_construct ((mkli loc (conv_con s) ml),
+ None))),
+ l)
+ | (loc, ml, Ast.ExId (_, (Ast.IdLid (_, s)))) :: l ->
+ ((mkexp loc (Pexp_ident (mkli loc s ml))), l)
| (_, [], e) :: l -> ((expr e), l)
| _ -> error loc "bad ast in expression") in
let (_, e) =
@@ -14957,21 +15298,18 @@ module Struct =
in
(match (expr f).pexp_desc with
| Pexp_construct (li, None) ->
- let al = List.map snd al
- in
- let a =
- match al with
- | [ a ] -> a
- | _ -> mkexp loc (Pexp_tuple al)
- in
- mkexp loc
- (Pexp_construct (li, (Some a)))
+ let al = List.map snd al in
+ let a =
+ (match al with
+ | [ a ] -> a
+ | _ -> mkexp loc (Pexp_tuple al))
+ in mkexp loc (Pexp_construct (li, (Some a)))
| Pexp_variant (s, None) ->
let al = List.map snd al in
let a =
- match al with
- | [ a ] -> a
- | _ -> mkexp loc (Pexp_tuple al)
+ (match al with
+ | [ a ] -> a
+ | _ -> mkexp loc (Pexp_tuple al))
in mkexp loc (Pexp_variant (s, (Some a)))
| _ -> mkexp loc (Pexp_apply ((expr f), al)))
| ExAre (loc, e1, e2) ->
@@ -14982,7 +15320,13 @@ module Struct =
[ ("", (expr e1)); ("", (expr e2)) ]))
| ExArr (loc, e) ->
mkexp loc (Pexp_array (List.map expr (list_of_expr e [])))
- | ExAsf loc -> mkexp loc (Pexp_assert (mkexp loc (Pexp_construct ({txt=Lident "false"; loc=mkloc loc}, None))))
+ | ExAsf loc ->
+ mkexp loc
+ (Pexp_assert
+ (mkexp loc
+ (Pexp_construct
+ ({ txt = Lident "false"; loc = mkloc loc; },
+ None))))
| ExAss (loc, e, v) ->
let e =
(match e with
@@ -15019,9 +15363,7 @@ module Struct =
| ExCoe (loc, e, t1, t2) ->
let t1 =
(match t1 with | Ast.TyNil _ -> None | t -> Some (ctyp t))
- in
- mkexp loc
- (Pexp_coerce ((expr e), t1, ctyp t2))
+ in mkexp loc (Pexp_coerce ((expr e), t1, (ctyp t2)))
| ExFlo (loc, s) ->
mkexp loc
(Pexp_constant (Const_float (remove_underscores s)))
@@ -15032,20 +15374,16 @@ module Struct =
(Pexp_for ((with_loc i loc), (expr e1), (expr e2),
(mkdirection df), (expr e3)))
| Ast.ExFun (loc, (Ast.McArr (_, (PaLab (_, lab, po)), w, e)))
- ->
- mkfun loc lab None (patt_of_lab loc lab po) e w
+ -> mkfun loc lab None (patt_of_lab loc lab po) e w
| Ast.ExFun (loc,
(Ast.McArr (_, (PaOlbi (_, lab, p, e1)), w, e2))) ->
let lab = paolab lab p
- in
- mkfun loc ("?" ^ lab) (Some (expr e1)) (patt p) e2 w
+ in mkfun loc ("?" ^ lab) (Some (expr e1)) (patt p) e2 w
| Ast.ExFun (loc, (Ast.McArr (_, (PaOlb (_, lab, p)), w, e)))
->
let lab = paolab lab p
- in
- mkfun loc ("?" ^ lab) None (patt_of_lab loc lab p) e w
- | ExFun (loc, a) ->
- mkexp loc (Pexp_function (match_case a []))
+ in mkfun loc ("?" ^ lab) None (patt_of_lab loc lab p) e w
+ | ExFun (loc, a) -> mkexp loc (Pexp_function (match_case a []))
| ExIfe (loc, e1, e2, e3) ->
mkexp loc
(Pexp_ifthenelse ((expr e1), (expr e2), (Some (expr e3))))
@@ -15133,7 +15471,7 @@ module Struct =
| ExStr (loc, s) ->
mkexp loc
(Pexp_constant
- (Const_string (string_of_string_token loc s, None)))
+ (Const_string ((string_of_string_token loc s), None)))
| ExTry (loc, e, a) ->
mkexp loc (Pexp_try ((expr e), (match_case a [])))
| Ast.ExTup (loc, (Ast.ExCom (_, e1, e2))) ->
@@ -15142,8 +15480,7 @@ module Struct =
(List.map expr (list_of_expr e1 (list_of_expr e2 []))))
| Ast.ExTup (loc, _) -> error loc "singleton tuple"
| ExTyc (loc, e, t) ->
- mkexp loc
- (Pexp_constraint ((expr e), (ctyp t)))
+ mkexp loc (Pexp_constraint ((expr e), (ctyp t)))
| Ast.ExId (loc, (Ast.IdUid (_, "()"))) ->
mkexp loc
(Pexp_construct ((lident_with_loc "()" loc), None))
@@ -15164,8 +15501,8 @@ module Struct =
| Ast.ExPkg (loc, (Ast.MeTyc (_, me, pt))) ->
mkexp loc
(Pexp_constraint
- (mkexp loc (Pexp_pack (module_expr me)),
- mktyp loc (Ptyp_package (package_type pt))))
+ (((mkexp loc (Pexp_pack (module_expr me))),
+ (mktyp loc (Ptyp_package (package_type pt))))))
| Ast.ExPkg (loc, me) -> mkexp loc (Pexp_pack (module_expr me))
| ExFUN (loc, i, e) -> mkexp loc (Pexp_newtype (i, (expr e)))
| Ast.ExCom (loc, _, _) ->
@@ -15173,6 +15510,15 @@ module Struct =
| Ast.ExSem (loc, _, _) ->
error loc
"expr; expr: not allowed here, use do {...} or [|...|] to surround them"
+ | ExAtt (loc, s, str, e) ->
+ let e = expr e
+ in
+ {
+ (e)
+ with
+ pexp_attributes =
+ e.pexp_attributes @ [ attribute loc s str ];
+ }
| (ExId (_, _) | ExNil _ as e) ->
error (loc_of_expr e) "invalid expr"
and patt_of_lab _loc lab =
@@ -15208,9 +15554,7 @@ module Struct =
let ty' = varify_constructors vars (ctyp ty) in
let mkexp = mkexp _loc in
let mkpat = mkpat _loc in
- let e =
- mkexp
- (Pexp_constraint ((expr e), (ctyp ty))) in
+ let e = mkexp (Pexp_constraint ((expr e), (ctyp ty))) in
let rec mk_newtypes x =
(match x with
| [ newtype ] -> mkexp (Pexp_newtype ((newtype, e)))
@@ -15223,34 +15567,35 @@ module Struct =
(Ppat_constraint
(((mkpat (Ppat_var (with_loc bind_name sloc))),
(mktyp _loc (Ptyp_poly (ampersand_vars, ty')))))) in
- let e = mk_newtypes vars in {pvb_pat=pat; pvb_expr=e; pvb_attributes=[]} :: acc
+ let e = mk_newtypes vars
+ in
+ { pvb_pat = pat; pvb_expr = e; pvb_attributes = []; } ::
+ acc
| Ast.BiEq (_loc, p,
(Ast.ExTyc (_, e, (Ast.TyPol (_, vs, ty))))) ->
- {pvb_pat=patt (Ast.PaTyc (_loc, p, (Ast.TyPol (_loc, vs, ty))));
- pvb_expr=expr e;
- pvb_attributes=[]} :: acc
- | Ast.BiEq (_, p, e) -> {pvb_pat=patt p; pvb_expr=expr e; pvb_attributes=[]} :: acc
+ {
+ pvb_pat =
+ patt (Ast.PaTyc (_loc, p, (Ast.TyPol (_loc, vs, ty))));
+ pvb_expr = expr e;
+ pvb_attributes = [];
+ } :: acc
+ | Ast.BiEq (_, p, e) ->
+ { pvb_pat = patt p; pvb_expr = expr e; pvb_attributes = [];
+ } :: acc
| Ast.BiNil _ -> acc
| _ -> assert false
and match_case x acc =
match x with
| Ast.McOr (_, x, y) -> match_case x (match_case y acc)
- | Ast.McArr (_, p, w, e) -> when_expr (patt p) e w :: acc
+ | Ast.McArr (_, p, w, e) -> (when_expr (patt p) e w) :: acc
| Ast.McNil _ -> acc
| _ -> assert false
and when_expr p e w =
- let g =
- match w with
- | Ast.ExNil _ -> None
- | w -> Some (expr w)
- in
- {pc_lhs = p; pc_guard = g; pc_rhs = expr e}
+ let g = match w with | Ast.ExNil _ -> None | g -> Some (expr g)
+ in { pc_lhs = p; pc_guard = g; pc_rhs = expr e; }
and mkfun loc lab def p e w =
- begin match w with
- | Ast.ExNil _ -> ()
- | _ -> assert false
- end;
- mkexp loc (Pexp_fun (lab, def, p, expr e))
+ let () = match w with | Ast.ExNil _ -> () | _ -> assert false
+ in mkexp loc (Pexp_fun (lab, def, p, (expr e)))
and mklabexp x acc =
match x with
| Ast.RbSem (_, x, y) -> mklabexp x (mklabexp y acc)
@@ -15276,10 +15621,10 @@ module Struct =
in ((ctyp t1), (ctyp t2), (mkloc loc)))
cl
in
- (type_decl (with_loc c cloc)
- (List.fold_right optional_type_parameters tl []) cl
- td cloc) ::
- acc
+ (type_decl (with_loc c cloc)
+ (List.fold_right optional_type_parameters tl []) cl td
+ cloc) ::
+ acc
| _ -> assert false
and module_type =
function
@@ -15298,6 +15643,15 @@ module Struct =
mkmty loc (Pmty_with ((module_type mt), (mkwithc wc [])))
| Ast.MtOf (loc, me) ->
mkmty loc (Pmty_typeof (module_expr me))
+ | MtAtt (loc, s, str, e) ->
+ let e = module_type e
+ in
+ {
+ (e)
+ with
+ pmty_attributes =
+ e.pmty_attributes @ [ attribute loc s str ];
+ }
| Ast.MtAnt (_, _) -> assert false
and sig_item s l =
match s with
@@ -15318,27 +15672,44 @@ module Struct =
| SgDir (_, _, _) -> l
| Ast.SgExc (loc, (Ast.TyId (_, (Ast.IdUid (_, s))))) ->
(mksig loc
- (Psig_exception {pcd_name=with_loc (conv_con s) loc; pcd_args=[];pcd_attributes=[]; pcd_loc=mkloc loc; pcd_res=None})) ::
+ (Psig_exception
+ {
+ pcd_name = with_loc (conv_con s) loc;
+ pcd_args = [];
+ pcd_attributes = [];
+ pcd_res = None;
+ pcd_loc = mkloc loc;
+ })) ::
l
| Ast.SgExc (loc,
(Ast.TyOf (_, (Ast.TyId (_, (Ast.IdUid (_, s)))), t))) ->
(mksig loc
- (Psig_exception {pcd_name=with_loc (conv_con s) loc;
- pcd_args=List.map ctyp (list_of_ctyp t []);
- pcd_loc = mkloc loc;
- pcd_res = None;
- pcd_attributes = []})) :: l
+ (Psig_exception
+ {
+ pcd_name = with_loc (conv_con s) loc;
+ pcd_args = List.map ctyp (list_of_ctyp t []);
+ pcd_attributes = [];
+ pcd_res = None;
+ pcd_loc = mkloc loc;
+ })) ::
+ l
| SgExc (_, _) -> assert false
| SgExt (loc, n, t, sl) ->
(mksig loc
(Psig_value
- (mkvalue_desc loc (with_loc n loc) t (list_of_meta_list sl)))) ::
+ (mkvalue_desc loc (with_loc n loc) t
+ (list_of_meta_list sl)))) ::
l
| SgInc (loc, mt) ->
- (mksig loc (Psig_include (module_type mt, []))) :: l
+ (mksig loc (Psig_include ((module_type mt), []))) :: l
| SgMod (loc, n, mt) ->
(mksig loc
- (Psig_module {pmd_name=with_loc n loc; pmd_type=module_type mt; pmd_attributes=[]})) ::
+ (Psig_module
+ {
+ pmd_name = with_loc n loc;
+ pmd_type = module_type mt;
+ pmd_attributes = [];
+ })) ::
l
| SgRecMod (loc, mb) ->
(mksig loc (Psig_recmodule (module_sig_binding mb []))) ::
@@ -15348,7 +15719,15 @@ module Struct =
(match mt with
| MtQuo (_, _) -> None
| _ -> Some (module_type mt))
- in (mksig loc (Psig_modtype {pmtd_name=with_loc n loc; pmtd_type=si; pmtd_attributes=[]})) :: l
+ in
+ (mksig loc
+ (Psig_modtype
+ {
+ pmtd_name = with_loc n loc;
+ pmtd_type = si;
+ pmtd_attributes = [];
+ })) ::
+ l
| SgOpn (loc, id) ->
(mksig loc (Psig_open (Fresh, (long_uident id), []))) :: l
| SgTyp (loc, tdl) ->
@@ -15363,20 +15742,29 @@ module Struct =
| Ast.MbAnd (_, x, y) ->
module_sig_binding x (module_sig_binding y acc)
| Ast.MbCol (loc, s, mt) ->
- {pmd_name=with_loc s loc; pmd_type=module_type mt; pmd_attributes=[]} :: acc
+ {
+ pmd_name = with_loc s loc;
+ pmd_type = module_type mt;
+ pmd_attributes = [];
+ } :: acc
| _ -> assert false
and module_str_binding x acc =
match x with
| Ast.MbAnd (_, x, y) ->
module_str_binding x (module_str_binding y acc)
| Ast.MbColEq (loc, s, mt, me) ->
- {pmb_name=with_loc s loc;
- pmb_expr=
- {pmod_loc=Camlp4_import.Location.none;
- pmod_desc=Pmod_constraint(module_expr me,module_type mt);
- pmod_attributes=[];
- };
- pmb_attributes=[]} :: acc
+ {
+ pmb_name = with_loc s loc;
+ pmb_expr =
+ {
+ pmod_loc = Camlp4_import.Location.none;
+ pmod_desc =
+ Pmod_constraint
+ (((module_expr me), (module_type mt)));
+ pmod_attributes = [];
+ };
+ pmb_attributes = [];
+ } :: acc
| _ -> assert false
and module_expr =
function
@@ -15400,8 +15788,17 @@ module Struct =
(mkexp loc
(Pexp_constraint
(((expr e),
- mktyp loc (Ptyp_package (package_type pt)))))))
+ (mktyp loc (Ptyp_package (package_type pt))))))))
| Ast.MePkg (loc, e) -> mkmod loc (Pmod_unpack (expr e))
+ | MeAtt (loc, s, str, e) ->
+ let e = module_expr e
+ in
+ {
+ (e)
+ with
+ pmod_attributes =
+ e.pmod_attributes @ [ attribute loc s str ];
+ }
| Ast.MeAnt (loc, _) ->
error loc "antiquotation in module_expr"
and str_item s l =
@@ -15424,13 +15821,27 @@ module Struct =
| Ast.StExc (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))), Ast.
ONone) ->
(mkstr loc
- (Pstr_exception {pcd_name=with_loc (conv_con s) loc;pcd_args=[];pcd_attributes=[];pcd_res=None;pcd_loc=mkloc loc})) ::
+ (Pstr_exception
+ {
+ pcd_name = with_loc (conv_con s) loc;
+ pcd_args = [];
+ pcd_attributes = [];
+ pcd_res = None;
+ pcd_loc = mkloc loc;
+ })) ::
l
| Ast.StExc (loc,
(Ast.TyOf (_, (Ast.TyId (_, (Ast.IdUid (_, s)))), t)), Ast.
ONone) ->
(mkstr loc
- (Pstr_exception {pcd_name=with_loc (conv_con s) loc; pcd_args=List.map ctyp (list_of_ctyp t []);pcd_attributes=[];pcd_res=None;pcd_loc=mkloc loc})) ::
+ (Pstr_exception
+ {
+ pcd_name = with_loc (conv_con s) loc;
+ pcd_args = List.map ctyp (list_of_ctyp t []);
+ pcd_attributes = [];
+ pcd_res = None;
+ pcd_loc = mkloc loc;
+ })) ::
l
| Ast.StExc (loc, (Ast.TyId (_, (Ast.IdUid (_, s)))),
(Ast.OSome i)) ->
@@ -15442,23 +15853,24 @@ module Struct =
(Ast.TyOf (_, (Ast.TyId (_, (Ast.IdUid (_, _)))), _)),
(Ast.OSome _)) -> error loc "type in exception alias"
| StExc (_, _, _) -> assert false
- | StExp (loc, e) -> (mkstr loc (Pstr_eval (expr e, []))) :: l
+ | StExp (loc, e) -> (mkstr loc (Pstr_eval ((expr e), []))) :: l
| StExt (loc, n, t, sl) ->
(mkstr loc
(Pstr_primitive
- (mkvalue_desc loc (with_loc n loc) t (list_of_meta_list sl)))) ::
+ (mkvalue_desc loc (with_loc n loc) t
+ (list_of_meta_list sl)))) ::
l
| StInc (loc, me) ->
- (mkstr loc (Pstr_include (module_expr me, []))) :: l
+ (mkstr loc (Pstr_include (((module_expr me), [])))) :: l
| StMod (loc, n, me) ->
(mkstr loc
(Pstr_module
- {pmb_name=with_loc n loc;
- pmb_expr=module_expr me;
- pmb_attributes=[]
- }
- ))
- :: l
+ {
+ pmb_name = with_loc n loc;
+ pmb_expr = module_expr me;
+ pmb_attributes = [];
+ })) ::
+ l
| StRecMod (loc, mb) ->
(mkstr loc (Pstr_recmodule (module_str_binding mb []))) ::
l
@@ -15467,10 +15879,20 @@ module Struct =
(match mt with
| MtQuo (_, _) -> None
| _ -> Some (module_type mt))
- in (mkstr loc (Pstr_modtype {pmtd_name=with_loc n loc; pmtd_type=si; pmtd_attributes=[]})) :: l
+ in
+ (mkstr loc
+ (Pstr_modtype
+ {
+ pmtd_name = with_loc n loc;
+ pmtd_type = si;
+ pmtd_attributes = [];
+ })) ::
+ l
| StOpn (loc, ov, id) ->
- let fresh = override_flag loc ov in
- (mkstr loc (Pstr_open (fresh, (long_uident id), []))) :: l
+ let fresh = override_flag loc ov
+ in
+ (mkstr loc (Pstr_open (fresh, (long_uident id), []))) ::
+ l
| StTyp (loc, tdl) ->
(mkstr loc (Pstr_type (mktype_decl tdl []))) :: l
| StVal (loc, rf, bi) ->
@@ -15498,10 +15920,16 @@ module Struct =
in
mkcty loc
(Pcty_signature
- {
- pcsig_self = ctyp t;
- pcsig_fields = cil;
- })
+ { pcsig_self = ctyp t; pcsig_fields = cil; })
+ | CtAtt (loc, s, str, e) ->
+ let e = class_type e
+ in
+ {
+ (e)
+ with
+ pcty_attributes =
+ e.pcty_attributes @ [ attribute loc s str ];
+ }
| CtCon (loc, _, _, _) ->
error loc "invalid virtual class inside a class type"
| CtAnt (_, _) | CtEq (_, _, _) | CtCol (_, _, _) |
@@ -15534,16 +15962,15 @@ module Struct =
let params =
(match params with
| Ast.TyNil _ -> []
- | t ->
- class_parameters t [])
+ | t -> class_parameters t [])
in
{
pci_virt = mkvirtual vir;
pci_params = params;
pci_name = with_loc name nloc;
pci_expr = class_type ct;
- pci_loc = mkloc loc;
pci_attributes = [];
+ pci_loc = mkloc loc;
}
| ct ->
error (loc_of_class_type ct)
@@ -15559,7 +15986,8 @@ module Struct =
(mkctf loc (Pctf_inherit (class_type ct))) :: l
| CgMth (loc, s, pf, t) ->
(mkctf loc
- (Pctf_method ((s, (mkprivate pf), Concrete, (mkpolytype (ctyp t)))))) ::
+ (Pctf_method
+ ((s, (mkprivate pf), Concrete, (mkpolytype (ctyp t)))))) ::
l
| CgVal (loc, s, b, v, t) ->
(mkctf loc
@@ -15567,7 +15995,8 @@ module Struct =
l
| CgVir (loc, s, b, t) ->
(mkctf loc
- (Pctf_method ((s, (mkprivate b), Virtual, (mkpolytype (ctyp t)))))) ::
+ (Pctf_method
+ ((s, (mkprivate b), Virtual, (mkpolytype (ctyp t)))))) ::
l
| CgAnt (_, _) -> assert false
and class_expr =
@@ -15612,6 +16041,15 @@ module Struct =
| CeTyc (loc, ce, ct) ->
mkcl loc
(Pcl_constraint ((class_expr ce), (class_type ct)))
+ | CeAtt (loc, s, str, e) ->
+ let e = class_expr e
+ in
+ {
+ (e)
+ with
+ pcl_attributes =
+ e.pcl_attributes @ [ attribute loc s str ];
+ }
| CeCon (loc, _, _, _) ->
error loc "invalid virtual class inside a class expression"
| CeAnt (_, _) | CeEq (_, _, _) | CeAnd (_, _, _) | CeNil _ ->
@@ -15641,24 +16079,25 @@ module Struct =
(mkcf loc
(Pcf_method
(((with_loc s loc), (mkprivate pf),
- Cfk_concrete ((override_flag loc ov), e))))) ::
+ (Cfk_concrete (((override_flag loc ov), e))))))) ::
l
| CrVal (loc, s, ov, mf, e) ->
(mkcf loc
(Pcf_val
(((with_loc s loc), (mkmutable mf),
- Cfk_concrete ((override_flag loc ov), (expr e)))))) ::
+ (Cfk_concrete (((override_flag loc ov), (expr e)))))))) ::
l
| CrVir (loc, s, pf, t) ->
(mkcf loc
(Pcf_method
(((with_loc s loc), (mkprivate pf),
- Cfk_virtual (mkpolytype (ctyp t)))))) ::
+ (Cfk_virtual (mkpolytype (ctyp t))))))) ::
l
| CrVvr (loc, s, mf, t) ->
(mkcf loc
(Pcf_val
- (((with_loc s loc), (mkmutable mf), Cfk_virtual (ctyp t))))) ::
+ (((with_loc s loc), (mkmutable mf),
+ (Cfk_virtual (ctyp t)))))) ::
l
| CrAnt (_, _) -> assert false
@@ -15680,6 +16119,11 @@ module Struct =
| StDir (_, d, dp) -> Ptop_dir (d, (directive dp))
| si -> Ptop_def (str_item si)
+ let attribute loc s str =
+ ((with_loc s loc), (PStr (str_item str)))
+
+ let () = attribute_fwd := attribute
+
end
end
@@ -19557,6 +20001,8 @@ module Printers =
| Ast.ExPkg (_, me) ->
pp f "@[<hv0>@[<hv2>(module %a@])@]" o#module_expr
me
+ | Ast.ExAtt (_loc, s, str, e) ->
+ pp f "((%a)[@@%s %a])" o#expr e s o#str_item str
| Ast.ExApp (_, _, _) | Ast.ExAcc (_, _, _) |
Ast.ExAre (_, _, _) | Ast.ExSte (_, _, _) |
Ast.ExAss (_, _, _) | Ast.ExSnd (_, _, _) |
@@ -19693,6 +20139,8 @@ module Printers =
Ast.PaCom (_, _, _) | Ast.PaSem (_, _, _) |
Ast.PaEq (_, _, _) | Ast.PaLaz (_, _)
as p) -> pp f "@[<1>(%a)@]" o#patt p
+ | Ast.PaAtt (_loc, s, str, e) ->
+ pp f "((%a)[@@%s %a])" o#patt e s o#str_item str
method patt_tycon =
fun f ->
function
@@ -19741,6 +20189,8 @@ module Printers =
| Ast.TyVrn (_, s) -> pp f "`%a" o#var s
| Ast.TySta (_, t1, t2) ->
pp f "%a *@ %a" o#simple_ctyp t1 o#simple_ctyp t2
+ | Ast.TyAtt (_loc, s, str, e) ->
+ pp f "((%a)[@@%s %a])" o#ctyp e s o#str_item str
| Ast.TyNil _ -> assert false
| t -> pp f "@[<1>(%a)@]" o#ctyp t
method ctyp =
@@ -19960,6 +20410,9 @@ module Printers =
| Ast.MtQuo (_, s) -> pp f "'%a" o#var s
| Ast.MtSig (_, sg) ->
pp f "@[<hv0>@[<hv2>sig@ %a@]@ end@]" o#sig_item sg
+ | Ast.MtAtt (_loc, s, str, e) ->
+ pp f "((%a)[@@%s %a])" o#module_type e s o#str_item
+ str
| Ast.MtWit (_, mt, wc) ->
pp f "@[<2>%a@ with@ %a@]" o#module_type mt
o#with_constraint wc
@@ -20022,6 +20475,9 @@ module Printers =
o#module_type mt
| Ast.MePkg (_, e) ->
pp f "@[<1>(%s %a)@]" o#value_val o#expr e
+ | Ast.MeAtt (_loc, s, str, e) ->
+ pp f "((%a)[@@%s %a])" o#module_expr e s o#str_item
+ str
method class_expr =
fun f ce ->
let () = o#node f ce Ast.loc_of_class_expr
@@ -20068,6 +20524,9 @@ module Printers =
| Ast.CeEq (_, ce1, ce2) ->
pp f "@[<2>%a =@]@ %a" o#class_expr ce1
o#class_expr ce2
+ | Ast.CeAtt (_loc, s, str, e) ->
+ pp f "((%a)[@@%s %a])" o#class_expr e s o#str_item
+ str
| _ -> assert false
method class_type =
fun f ct ->
@@ -20104,6 +20563,9 @@ module Printers =
pp f "%a :@ %a" o#class_type ct1 o#class_type ct2
| Ast.CtEq (_, ct1, ct2) ->
pp f "%a =@ %a" o#class_type ct1 o#class_type ct2
+ | Ast.CtAtt (_loc, s, str, e) ->
+ pp f "((%a)[@@%s %a])" o#class_type e s o#str_item
+ str
| _ -> assert false
method class_sig_item =
fun f csg ->
@@ -21647,4 +22109,3 @@ module Register :
end
-
diff --git a/camlp4/boot/camlp4boot.ml b/camlp4/boot/camlp4boot.ml
index 4065ec3192..8cdb994e12 100644
--- a/camlp4/boot/camlp4boot.ml
+++ b/camlp4/boot/camlp4boot.ml
@@ -1915,7 +1915,19 @@ New syntax:\
((fun () ->
(None,
[ ((Some "top"), (Some Camlp4.Sig.Grammar.RightA),
- [ ([ Gram.Skeyword "object";
+ [ ([ Gram.Sself; Gram.Skeyword "[@";
+ Gram.Snterm
+ (Gram.Entry.obj
+ (a_LIDENT : 'a_LIDENT Gram.Entry.t));
+ Gram.Snterm
+ (Gram.Entry.obj
+ (str_items : 'str_items Gram.Entry.t));
+ Gram.Skeyword "]" ],
+ (Gram.Action.mk
+ (fun _ (str : 'str_items) (s : 'a_LIDENT) _
+ (e : 'expr) (_loc : Gram.Loc.t) ->
+ (Ast.ExAtt (_loc, s, str, e) : 'expr))));
+ ([ Gram.Skeyword "object";
Gram.Snterm
(Gram.Entry.obj
(opt_class_self_patt :
@@ -3586,7 +3598,20 @@ New syntax:\
Gram.extend (patt : 'patt Gram.Entry.t)
((fun () ->
(None,
- [ ((Some "|"), (Some Camlp4.Sig.Grammar.LeftA),
+ [ ((Some "attribute"), None,
+ [ ([ Gram.Sself; Gram.Skeyword "[@";
+ Gram.Snterm
+ (Gram.Entry.obj
+ (a_LIDENT : 'a_LIDENT Gram.Entry.t));
+ Gram.Snterm
+ (Gram.Entry.obj
+ (str_items : 'str_items Gram.Entry.t));
+ Gram.Skeyword "]" ],
+ (Gram.Action.mk
+ (fun _ (str : 'str_items) (s : 'a_LIDENT) _
+ (e : 'patt) (_loc : Gram.Loc.t) ->
+ (Ast.PaAtt (_loc, s, str, e) : 'patt)))) ]);
+ ((Some "|"), (Some Camlp4.Sig.Grammar.LeftA),
[ ([ Gram.Sself; Gram.Skeyword "|"; Gram.Sself ],
(Gram.Action.mk
(fun (p2 : 'patt) _ (p1 : 'patt)
@@ -4947,6 +4972,19 @@ New syntax:\
| Invalid_argument s ->
raise (Stream.Error s) :
'ctyp)))) ]);
+ ((Some "attribute"), None,
+ [ ([ Gram.Sself; Gram.Skeyword "[@";
+ Gram.Snterm
+ (Gram.Entry.obj
+ (a_LIDENT : 'a_LIDENT Gram.Entry.t));
+ Gram.Snterm
+ (Gram.Entry.obj
+ (str_items : 'str_items Gram.Entry.t));
+ Gram.Skeyword "]" ],
+ (Gram.Action.mk
+ (fun _ (str : 'str_items) (s : 'a_LIDENT) _
+ (e : 'ctyp) (_loc : Gram.Loc.t) ->
+ (Ast.TyAtt (_loc, s, str, e) : 'ctyp)))) ]);
((Some "simple"), None,
[ ([ Gram.Skeyword "("; Gram.Skeyword "module";
Gram.Snterm
View Lorry Controller Status