summaryrefslogtreecommitdiffstats
path: root/camlp4/meta
diff options
context:
space:
mode:
authorMichel Mauny <Michel.Mauny@ensta.fr>2003-07-15 16:59:02 +0000
committerMichel Mauny <Michel.Mauny@ensta.fr>2003-07-15 16:59:02 +0000
commit8c7572788743b5f8e14608966e9d2670d09d1a14 (patch)
treea55352455ab99d9aef5f63dda5a208eaa0739caf /camlp4/meta
parent0b785f8ea6fe566d445c673bc5188e6c322ea3a2 (diff)
Added support for recursive modules
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@5696 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'camlp4/meta')
-rw-r--r--camlp4/meta/pa_r.ml11
-rw-r--r--camlp4/meta/q_MLast.ml11
2 files changed, 22 insertions, 0 deletions
diff --git a/camlp4/meta/pa_r.ml b/camlp4/meta/pa_r.ml
index ebd0ba4dd..e867746e9 100644
--- a/camlp4/meta/pa_r.ml
+++ b/camlp4/meta/pa_r.ml
@@ -220,6 +220,8 @@ EXTEND
| "include"; me = module_expr -> <:str_item< include $me$ >>
| "module"; i = UIDENT; mb = module_binding ->
<:str_item< module $i$ = $mb$ >>
+ | "module"; "rec"; nmtmes = LIST1 module_rec_binding SEP "and" ->
+ MLast.StRecMod loc nmtmes
| "module"; "type"; i = UIDENT; "="; mt = module_type ->
<:str_item< module type $i$ = $mt$ >>
| "open"; i = mod_ident -> <:str_item< open $i$ >>
@@ -241,6 +243,10 @@ EXTEND
<:module_expr< ( $me$ : $mt$ ) >>
| "="; me = module_expr -> <:module_expr< $me$ >> ] ]
;
+ module_rec_binding:
+ [ [ m = UIDENT; ":"; mt = module_type; "="; me = module_expr ->
+ (m, mt, me) ] ]
+ ;
module_type:
[ [ "functor"; "("; i = UIDENT; ":"; t = SELF; ")"; "->"; mt = SELF ->
<:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ]
@@ -267,6 +273,8 @@ EXTEND
| "include"; mt = module_type -> <:sig_item< include $mt$ >>
| "module"; i = UIDENT; mt = module_declaration ->
<:sig_item< module $i$ : $mt$ >>
+ | "module"; "rec"; mds = LIST1 module_rec_declaration SEP "and" ->
+ MLast.SgRecMod loc mds
| "module"; "type"; i = UIDENT; "="; mt = module_type ->
<:sig_item< module type $i$ = $mt$ >>
| "open"; i = mod_ident -> <:sig_item< open $i$ >>
@@ -281,6 +289,9 @@ EXTEND
| "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF ->
<:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ] ]
;
+ module_rec_declaration:
+ [ [ m = UIDENT; ":"; mt = module_type -> (m, mt)] ]
+ ;
with_constr:
[ [ "type"; i = mod_ident; tpl = LIST0 type_parameter; "="; t = ctyp ->
<:with_constr< type $i$ $list:tpl$ = $t$ >>
diff --git a/camlp4/meta/q_MLast.ml b/camlp4/meta/q_MLast.ml
index 0da0005f8..984492709 100644
--- a/camlp4/meta/q_MLast.ml
+++ b/camlp4/meta/q_MLast.ml
@@ -305,6 +305,8 @@ EXTEND
| "include"; me = module_expr -> Qast.Node "StInc" [Qast.Loc; me]
| "module"; i = a_UIDENT; mb = module_binding ->
Qast.Node "StMod" [Qast.Loc; i; mb]
+ | "module"; "rec"; nmtmes = SLIST1 module_rec_binding SEP "and" ->
+ Qast.Node "StRecMod" [Qast.Loc; nmtmes]
| "module"; "type"; i = a_UIDENT; "="; mt = module_type ->
Qast.Node "StMty" [Qast.Loc; i; mt]
| "open"; i = mod_ident -> Qast.Node "StOpn" [Qast.Loc; i]
@@ -326,6 +328,10 @@ EXTEND
Qast.Node "MeTyc" [Qast.Loc; me; mt]
| "="; me = module_expr -> me ] ]
;
+ module_rec_binding:
+ [ [ m = a_UIDENT; ":"; mt = module_type; "="; me = module_expr ->
+ Qast.Tuple [m; me; mt] ] ]
+ ;
module_type:
[ [ "functor"; "("; i = a_UIDENT; ":"; t = SELF; ")"; "->"; mt = SELF ->
Qast.Node "MtFun" [Qast.Loc; i; t; mt] ]
@@ -359,6 +365,8 @@ EXTEND
Qast.Node "SgMod" [Qast.Loc; i; mt]
| "module"; "type"; i = a_UIDENT; "="; mt = module_type ->
Qast.Node "SgMty" [Qast.Loc; i; mt]
+ | "module"; "rec"; mds = SLIST1 module_rec_declaration SEP "and" ->
+ Qast.Node "SgRecMod" [Qast.Loc; mds]
| "open"; i = mod_ident -> Qast.Node "SgOpn" [Qast.Loc; i]
| "type"; tdl = SLIST1 type_declaration SEP "and" ->
Qast.Node "SgTyp" [Qast.Loc; tdl]
@@ -371,6 +379,9 @@ EXTEND
| "("; i = a_UIDENT; ":"; t = module_type; ")"; mt = SELF ->
Qast.Node "MtFun" [Qast.Loc; i; t; mt] ] ]
;
+ module_rec_declaration:
+ [ [ m = a_UIDENT; ":"; mt = module_type -> Qast.Tuple [m; mt] ] ]
+ ;
with_constr:
[ [ "type"; i = mod_ident; tpl = SLIST0 type_parameter; "="; t = ctyp ->
Qast.Node "WcTyp" [Qast.Loc; i; tpl; t]