diff options
author | Daniel de Rauglaudre <daniel.de_rauglaudre@inria.fr> | 2002-01-18 20:38:49 +0000 |
---|---|---|
committer | Daniel de Rauglaudre <daniel.de_rauglaudre@inria.fr> | 2002-01-18 20:38:49 +0000 |
commit | d007c8e43195202c74d1898ccd7b7422ae5cca2a (patch) | |
tree | a471d36d16de7cc2b06fbcc524251b645b283433 /camlp4/meta/q_MLast.ml | |
parent | 4e1a4e222bad22f6533c45cc536c99aecb1478f0 (diff) |
-
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4267 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'camlp4/meta/q_MLast.ml')
-rw-r--r-- | camlp4/meta/q_MLast.ml | 13 |
1 files changed, 9 insertions, 4 deletions
diff --git a/camlp4/meta/q_MLast.ml b/camlp4/meta/q_MLast.ml index 7bdfe1dd6..f204cd376 100644 --- a/camlp4/meta/q_MLast.ml +++ b/camlp4/meta/q_MLast.ml @@ -28,8 +28,6 @@ type ast = | Loc | Antiquot of MLast.loc and string ] ; -value list l = List l; -value option o = Option o; value antiquot k (bp, ep) x = let shift = if k = "" then String.length "$" @@ -52,6 +50,13 @@ value class_expr = Grammar.Entry.create gram "class expr"; value class_sig_item = Grammar.Entry.create gram "class signature item"; value class_str_item = Grammar.Entry.create gram "class structure item"; +value o2b = + fun + [ Option (Some _) -> Bool True + | Option None -> Bool False + | x -> x ] +; + value mkumin f arg = match arg with [ Node "ExInt" [Loc; Str n] when int_of_string n > 0 -> @@ -144,8 +149,8 @@ EXTEND | "open"; i = mod_ident -> Node "StOpn" [Loc; i] | "type"; tdl = SLIST1 type_declaration SEP "and" -> Node "StTyp" [Loc; tdl] - | "value"; r = rec_flag; l = SLIST1 let_binding SEP "and" -> - Node "StVal" [Loc; r; l] + | "value"; r = SOPT "rec"; l = SLIST1 let_binding SEP "and" -> + Node "StVal" [Loc; o2b r; l] | "#"; n = lident; dp = dir_param -> Node "StDir" [Loc; n; dp] | e = expr -> Node "StExp" [Loc; e] ] ] ; |