2006-06-29 01:12:46 -07:00
|
|
|
open Camlp4; (* -*- camlp4r -*- *)
|
|
|
|
(****************************************************************************)
|
|
|
|
(* *)
|
2011-07-27 07:17:02 -07:00
|
|
|
(* OCaml *)
|
2006-06-29 01:12:46 -07:00
|
|
|
(* *)
|
|
|
|
(* INRIA Rocquencourt *)
|
|
|
|
(* *)
|
|
|
|
(* Copyright 2002-2006 Institut National de Recherche en Informatique et *)
|
|
|
|
(* en Automatique. All rights reserved. This file is distributed under *)
|
|
|
|
(* the terms of the GNU Library General Public License, with the special *)
|
2011-07-27 07:17:02 -07:00
|
|
|
(* exception on linking described in LICENSE at the top of the OCaml *)
|
|
|
|
(* source tree. *)
|
2006-06-29 01:12:46 -07:00
|
|
|
(* *)
|
|
|
|
(****************************************************************************)
|
|
|
|
|
|
|
|
(* Authors:
|
|
|
|
* - Daniel de Rauglaudre: initial version
|
|
|
|
* - Nicolas Pouillard: refactoring
|
|
|
|
*)
|
|
|
|
|
|
|
|
module Id = struct
|
2007-11-27 05:27:22 -08:00
|
|
|
value name = "Camlp4OCamlRevisedParser";
|
2008-10-27 07:03:57 -07:00
|
|
|
value version = Sys.ocaml_version;
|
2006-06-29 01:12:46 -07:00
|
|
|
end;
|
|
|
|
|
2007-02-07 02:09:29 -08:00
|
|
|
module Make (Syntax : Sig.Camlp4Syntax) = struct
|
|
|
|
open Sig;
|
2006-06-29 01:12:46 -07:00
|
|
|
include Syntax;
|
|
|
|
|
2007-02-07 02:09:29 -08:00
|
|
|
(* Camlp4_config.constructors_arity.val := True; *)
|
|
|
|
Camlp4_config.constructors_arity.val := False;
|
2006-06-29 01:12:46 -07:00
|
|
|
|
|
|
|
value help_sequences () =
|
|
|
|
do {
|
|
|
|
Printf.eprintf "\
|
2011-07-20 02:17:07 -07:00
|
|
|
New syntax:\
|
|
|
|
\n (e1; e2; ... ; en) OR begin e1; e2; ... ; en end\
|
|
|
|
\n while e do e1; e2; ... ; en done\
|
|
|
|
\n for v = v1 to/downto v2 do e1; e2; ... ; en done\
|
|
|
|
\nOld syntax (still supported):\
|
|
|
|
\n do {e1; e2; ... ; en}\
|
|
|
|
\n while e do {e1; e2; ... ; en}\
|
|
|
|
\n for v = v1 to/downto v2 do {e1; e2; ... ; en}\
|
|
|
|
\nVery old (no more supported) syntax:\
|
|
|
|
\n do e1; e2; ... ; en-1; return en\
|
|
|
|
\n while e do e1; e2; ... ; en; done\
|
|
|
|
\n for v = v1 to/downto v2 do e1; e2; ... ; en; done\
|
|
|
|
\n";
|
2006-06-29 01:12:46 -07:00
|
|
|
flush stderr;
|
|
|
|
exit 1
|
|
|
|
}
|
|
|
|
;
|
|
|
|
Options.add "-help_seq" (Arg.Unit help_sequences)
|
|
|
|
"Print explanations about new sequences and exit.";
|
|
|
|
|
|
|
|
Gram.Entry.clear a_CHAR;
|
|
|
|
Gram.Entry.clear a_FLOAT;
|
|
|
|
Gram.Entry.clear a_INT;
|
|
|
|
Gram.Entry.clear a_INT32;
|
|
|
|
Gram.Entry.clear a_INT64;
|
|
|
|
Gram.Entry.clear a_LABEL;
|
|
|
|
Gram.Entry.clear a_LIDENT;
|
|
|
|
Gram.Entry.clear a_NATIVEINT;
|
|
|
|
Gram.Entry.clear a_OPTLABEL;
|
|
|
|
Gram.Entry.clear a_STRING;
|
|
|
|
Gram.Entry.clear a_UIDENT;
|
|
|
|
Gram.Entry.clear a_ident;
|
|
|
|
Gram.Entry.clear amp_ctyp;
|
|
|
|
Gram.Entry.clear and_ctyp;
|
2006-06-29 17:40:58 -07:00
|
|
|
Gram.Entry.clear match_case;
|
|
|
|
Gram.Entry.clear match_case0;
|
|
|
|
Gram.Entry.clear match_case_quot;
|
2006-06-29 01:12:46 -07:00
|
|
|
Gram.Entry.clear binding;
|
|
|
|
Gram.Entry.clear binding_quot;
|
2007-10-08 07:19:34 -07:00
|
|
|
Gram.Entry.clear rec_binding_quot;
|
2006-06-29 01:12:46 -07:00
|
|
|
Gram.Entry.clear class_declaration;
|
|
|
|
Gram.Entry.clear class_description;
|
|
|
|
Gram.Entry.clear class_expr;
|
|
|
|
Gram.Entry.clear class_expr_quot;
|
|
|
|
Gram.Entry.clear class_fun_binding;
|
|
|
|
Gram.Entry.clear class_fun_def;
|
|
|
|
Gram.Entry.clear class_info_for_class_expr;
|
|
|
|
Gram.Entry.clear class_info_for_class_type;
|
|
|
|
Gram.Entry.clear class_longident;
|
|
|
|
Gram.Entry.clear class_longident_and_param;
|
|
|
|
Gram.Entry.clear class_name_and_param;
|
|
|
|
Gram.Entry.clear class_sig_item;
|
|
|
|
Gram.Entry.clear class_sig_item_quot;
|
|
|
|
Gram.Entry.clear class_signature;
|
|
|
|
Gram.Entry.clear class_str_item;
|
|
|
|
Gram.Entry.clear class_str_item_quot;
|
|
|
|
Gram.Entry.clear class_structure;
|
|
|
|
Gram.Entry.clear class_type;
|
|
|
|
Gram.Entry.clear class_type_declaration;
|
|
|
|
Gram.Entry.clear class_type_longident;
|
|
|
|
Gram.Entry.clear class_type_longident_and_param;
|
|
|
|
Gram.Entry.clear class_type_plus;
|
|
|
|
Gram.Entry.clear class_type_quot;
|
|
|
|
Gram.Entry.clear comma_ctyp;
|
|
|
|
Gram.Entry.clear comma_expr;
|
|
|
|
Gram.Entry.clear comma_ipatt;
|
|
|
|
Gram.Entry.clear comma_patt;
|
|
|
|
Gram.Entry.clear comma_type_parameter;
|
|
|
|
Gram.Entry.clear constrain;
|
|
|
|
Gram.Entry.clear constructor_arg_list;
|
|
|
|
Gram.Entry.clear constructor_declaration;
|
|
|
|
Gram.Entry.clear constructor_declarations;
|
|
|
|
Gram.Entry.clear ctyp;
|
|
|
|
Gram.Entry.clear ctyp_quot;
|
|
|
|
Gram.Entry.clear cvalue_binding;
|
|
|
|
Gram.Entry.clear direction_flag;
|
|
|
|
Gram.Entry.clear dummy;
|
|
|
|
Gram.Entry.clear eq_expr;
|
|
|
|
Gram.Entry.clear expr;
|
|
|
|
Gram.Entry.clear expr_eoi;
|
|
|
|
Gram.Entry.clear expr_quot;
|
|
|
|
Gram.Entry.clear field_expr;
|
2008-10-04 03:47:56 -07:00
|
|
|
Gram.Entry.clear field_expr_list;
|
2006-06-29 01:12:46 -07:00
|
|
|
Gram.Entry.clear fun_binding;
|
|
|
|
Gram.Entry.clear fun_def;
|
|
|
|
Gram.Entry.clear ident;
|
|
|
|
Gram.Entry.clear ident_quot;
|
|
|
|
Gram.Entry.clear implem;
|
|
|
|
Gram.Entry.clear interf;
|
|
|
|
Gram.Entry.clear ipatt;
|
|
|
|
Gram.Entry.clear ipatt_tcon;
|
|
|
|
Gram.Entry.clear label;
|
|
|
|
Gram.Entry.clear label_declaration;
|
2008-10-04 03:47:56 -07:00
|
|
|
Gram.Entry.clear label_declaration_list;
|
|
|
|
Gram.Entry.clear label_expr_list;
|
2006-06-29 01:12:46 -07:00
|
|
|
Gram.Entry.clear label_expr;
|
|
|
|
Gram.Entry.clear label_ipatt;
|
2008-10-04 03:47:56 -07:00
|
|
|
Gram.Entry.clear label_ipatt_list;
|
2006-06-29 01:12:46 -07:00
|
|
|
Gram.Entry.clear label_longident;
|
|
|
|
Gram.Entry.clear label_patt;
|
2008-10-04 03:47:56 -07:00
|
|
|
Gram.Entry.clear label_patt_list;
|
2006-06-29 01:12:46 -07:00
|
|
|
Gram.Entry.clear labeled_ipatt;
|
|
|
|
Gram.Entry.clear let_binding;
|
|
|
|
Gram.Entry.clear meth_list;
|
2008-10-04 03:47:56 -07:00
|
|
|
Gram.Entry.clear meth_decl;
|
2006-06-29 01:12:46 -07:00
|
|
|
Gram.Entry.clear module_binding;
|
|
|
|
Gram.Entry.clear module_binding0;
|
|
|
|
Gram.Entry.clear module_binding_quot;
|
|
|
|
Gram.Entry.clear module_declaration;
|
|
|
|
Gram.Entry.clear module_expr;
|
|
|
|
Gram.Entry.clear module_expr_quot;
|
|
|
|
Gram.Entry.clear module_longident;
|
|
|
|
Gram.Entry.clear module_longident_with_app;
|
|
|
|
Gram.Entry.clear module_rec_declaration;
|
|
|
|
Gram.Entry.clear module_type;
|
|
|
|
Gram.Entry.clear module_type_quot;
|
|
|
|
Gram.Entry.clear more_ctyp;
|
|
|
|
Gram.Entry.clear name_tags;
|
|
|
|
Gram.Entry.clear opt_as_lident;
|
|
|
|
Gram.Entry.clear opt_class_self_patt;
|
|
|
|
Gram.Entry.clear opt_class_self_type;
|
|
|
|
Gram.Entry.clear opt_comma_ctyp;
|
|
|
|
Gram.Entry.clear opt_dot_dot;
|
|
|
|
Gram.Entry.clear opt_eq_ctyp;
|
|
|
|
Gram.Entry.clear opt_expr;
|
|
|
|
Gram.Entry.clear opt_meth_list;
|
|
|
|
Gram.Entry.clear opt_mutable;
|
|
|
|
Gram.Entry.clear opt_polyt;
|
|
|
|
Gram.Entry.clear opt_private;
|
|
|
|
Gram.Entry.clear opt_rec;
|
|
|
|
Gram.Entry.clear opt_virtual;
|
|
|
|
Gram.Entry.clear opt_when_expr;
|
|
|
|
Gram.Entry.clear patt;
|
|
|
|
Gram.Entry.clear patt_as_patt_opt;
|
|
|
|
Gram.Entry.clear patt_eoi;
|
|
|
|
Gram.Entry.clear patt_quot;
|
|
|
|
Gram.Entry.clear patt_tcon;
|
|
|
|
Gram.Entry.clear phrase;
|
|
|
|
Gram.Entry.clear poly_type;
|
|
|
|
Gram.Entry.clear row_field;
|
|
|
|
Gram.Entry.clear sem_expr;
|
|
|
|
Gram.Entry.clear sem_expr_for_list;
|
|
|
|
Gram.Entry.clear sem_patt;
|
|
|
|
Gram.Entry.clear sem_patt_for_list;
|
|
|
|
Gram.Entry.clear semi;
|
|
|
|
Gram.Entry.clear sequence;
|
|
|
|
Gram.Entry.clear sig_item;
|
|
|
|
Gram.Entry.clear sig_item_quot;
|
|
|
|
Gram.Entry.clear sig_items;
|
|
|
|
Gram.Entry.clear star_ctyp;
|
|
|
|
Gram.Entry.clear str_item;
|
|
|
|
Gram.Entry.clear str_item_quot;
|
|
|
|
Gram.Entry.clear str_items;
|
|
|
|
Gram.Entry.clear top_phrase;
|
|
|
|
Gram.Entry.clear type_constraint;
|
|
|
|
Gram.Entry.clear type_declaration;
|
|
|
|
Gram.Entry.clear type_ident_and_parameters;
|
|
|
|
Gram.Entry.clear type_kind;
|
|
|
|
Gram.Entry.clear type_longident;
|
|
|
|
Gram.Entry.clear type_longident_and_parameters;
|
|
|
|
Gram.Entry.clear type_parameter;
|
|
|
|
Gram.Entry.clear type_parameters;
|
|
|
|
Gram.Entry.clear typevars;
|
|
|
|
Gram.Entry.clear use_file;
|
|
|
|
Gram.Entry.clear val_longident;
|
|
|
|
Gram.Entry.clear value_let;
|
|
|
|
Gram.Entry.clear value_val;
|
|
|
|
Gram.Entry.clear with_constr;
|
|
|
|
Gram.Entry.clear with_constr_quot;
|
|
|
|
|
|
|
|
value neg_string n =
|
|
|
|
let len = String.length n in
|
|
|
|
if len > 0 && n.[0] = '-' then String.sub n 1 (len - 1)
|
|
|
|
else "-" ^ n
|
|
|
|
;
|
|
|
|
|
|
|
|
value mkumin _loc f arg =
|
|
|
|
match arg with
|
|
|
|
[ <:expr< $int:n$ >> -> <:expr< $int:neg_string n$ >>
|
|
|
|
| <:expr< $int32:n$ >> -> <:expr< $int32:neg_string n$ >>
|
|
|
|
| <:expr< $int64:n$ >> -> <:expr< $int64:neg_string n$ >>
|
|
|
|
| <:expr< $nativeint:n$ >> -> <:expr< $nativeint:neg_string n$ >>
|
|
|
|
| <:expr< $flo:n$ >> -> <:expr< $flo:neg_string n$ >>
|
|
|
|
| _ -> <:expr< $lid:"~" ^ f$ $arg$ >> ];
|
|
|
|
|
|
|
|
value mklistexp _loc last =
|
|
|
|
loop True where rec loop top =
|
|
|
|
fun
|
|
|
|
[ [] ->
|
|
|
|
match last with
|
|
|
|
[ Some e -> e
|
|
|
|
| None -> <:expr< [] >> ]
|
|
|
|
| [e1 :: el] ->
|
|
|
|
let _loc =
|
|
|
|
if top then _loc else Loc.merge (Ast.loc_of_expr e1) _loc
|
|
|
|
in
|
|
|
|
<:expr< [$e1$ :: $loop False el$] >> ]
|
|
|
|
;
|
|
|
|
|
|
|
|
value mkassert _loc =
|
|
|
|
fun
|
|
|
|
[ <:expr< False >> ->
|
2007-10-08 07:19:34 -07:00
|
|
|
<:expr< assert False >> (* this case takes care about
|
|
|
|
the special assert false node *)
|
2006-06-29 01:12:46 -07:00
|
|
|
| e -> <:expr< assert $e$ >> ]
|
|
|
|
;
|
|
|
|
|
|
|
|
value append_eLem el e = el @ [e];
|
|
|
|
value mk_anti ?(c = "") n s = "\\$"^n^c^":"^s;
|
|
|
|
|
2006-07-12 07:23:36 -07:00
|
|
|
value mksequence _loc =
|
|
|
|
fun
|
|
|
|
[ <:expr< $_$; $_$ >> | <:expr< $anti:_$ >> as e -> <:expr< do { $e$ } >>
|
|
|
|
| e -> e ]
|
|
|
|
;
|
|
|
|
|
2007-10-08 07:19:34 -07:00
|
|
|
value mksequence' _loc =
|
|
|
|
fun
|
|
|
|
[ <:expr< $_$; $_$ >> as e -> <:expr< do { $e$ } >>
|
|
|
|
| e -> e ]
|
|
|
|
;
|
|
|
|
|
2010-05-11 08:18:42 -07:00
|
|
|
value rec lid_of_ident =
|
|
|
|
fun
|
|
|
|
[ <:ident< $_$ . $i$ >> -> lid_of_ident i
|
|
|
|
| <:ident< $lid:lid$ >> -> lid
|
|
|
|
| _ -> assert False ];
|
|
|
|
|
2007-10-08 07:19:34 -07:00
|
|
|
value module_type_app mt1 mt2 =
|
|
|
|
match (mt1, mt2) with
|
|
|
|
[ (<:module_type@_loc< $id:i1$ >>, <:module_type< $id:i2$ >>) ->
|
|
|
|
<:module_type< $id:<:ident< $i1$ $i2$ >>$ >>
|
|
|
|
| _ -> raise Stream.Failure ];
|
|
|
|
|
|
|
|
value module_type_acc mt1 mt2 =
|
|
|
|
match (mt1, mt2) with
|
|
|
|
[ (<:module_type@_loc< $id:i1$ >>, <:module_type< $id:i2$ >>) ->
|
|
|
|
<:module_type< $id:<:ident< $i1$.$i2$ >>$ >>
|
|
|
|
| _ -> raise Stream.Failure ];
|
|
|
|
|
2006-06-29 01:12:46 -07:00
|
|
|
value bigarray_get _loc arr arg =
|
|
|
|
let coords =
|
|
|
|
match arg with
|
|
|
|
[ <:expr< ($e1$, $e2$) >> | <:expr< $e1$, $e2$ >> ->
|
|
|
|
Ast.list_of_expr e1 (Ast.list_of_expr e2 [])
|
|
|
|
| _ -> [arg] ]
|
|
|
|
in
|
|
|
|
match coords with
|
|
|
|
[ [c1] -> <:expr< Bigarray.Array1.get $arr$ $c1$ >>
|
|
|
|
| [c1; c2] -> <:expr< Bigarray.Array2.get $arr$ $c1$ $c2$ >>
|
|
|
|
| [c1; c2; c3] -> <:expr< Bigarray.Array3.get $arr$ $c1$ $c2$ $c3$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
(* | coords -> <:expr< Bigarray.Genarray.get $arr$ [| $list:coords$ |] >> ] *)
|
2006-06-29 01:12:46 -07:00
|
|
|
| coords ->
|
|
|
|
<:expr< Bigarray.Genarray.get $arr$ [| $Ast.exSem_of_list coords$ |] >> ];
|
|
|
|
|
|
|
|
value bigarray_set _loc var newval =
|
|
|
|
match var with
|
|
|
|
[ <:expr< Bigarray.Array1.get $arr$ $c1$ >> ->
|
|
|
|
Some <:expr< Bigarray.Array1.set $arr$ $c1$ $newval$ >>
|
|
|
|
| <:expr< Bigarray.Array2.get $arr$ $c1$ $c2$ >> ->
|
|
|
|
Some <:expr< Bigarray.Array2.set $arr$ $c1$ $c2$ $newval$ >>
|
|
|
|
| <:expr< Bigarray.Array3.get $arr$ $c1$ $c2$ $c3$ >> ->
|
|
|
|
Some <:expr< Bigarray.Array3.set $arr$ $c1$ $c2$ $c3$ $newval$ >>
|
|
|
|
| <:expr< Bigarray.Genarray.get $arr$ [| $coords$ |] >> ->
|
|
|
|
Some <:expr< Bigarray.Genarray.set $arr$ [| $coords$ |] $newval$ >>
|
|
|
|
| _ -> None ];
|
|
|
|
|
2006-07-17 07:18:26 -07:00
|
|
|
value stopped_at _loc =
|
|
|
|
Some (Loc.move_line 1 _loc) (* FIXME be more precise *);
|
|
|
|
|
2012-04-11 14:34:51 -07:00
|
|
|
value rec generalized_type_of_type =
|
|
|
|
fun
|
|
|
|
[ <:ctyp< $t1$ -> $t2$ >> ->
|
|
|
|
let (tl, rt) = generalized_type_of_type t2 in
|
|
|
|
([t1 :: tl], rt)
|
|
|
|
| t ->
|
|
|
|
([], t) ]
|
|
|
|
;
|
|
|
|
|
2007-10-08 07:19:34 -07:00
|
|
|
value symbolchar =
|
|
|
|
let list =
|
|
|
|
['$'; '!'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?';
|
|
|
|
'@'; '^'; '|'; '~'; '\\']
|
2006-06-29 01:12:46 -07:00
|
|
|
in
|
2007-10-08 07:19:34 -07:00
|
|
|
let rec loop s i =
|
|
|
|
if i == String.length s then True
|
|
|
|
else if List.mem s.[i] list then loop s (i + 1)
|
|
|
|
else False
|
|
|
|
in
|
|
|
|
loop
|
|
|
|
;
|
|
|
|
|
2010-08-02 07:37:22 -07:00
|
|
|
value setup_op_parser entry p =
|
|
|
|
Gram.Entry.setup_parser entry
|
|
|
|
(parser
|
|
|
|
[: `(KEYWORD x | SYMBOL x, ti) when p x :] ->
|
|
|
|
let _loc = Gram.token_location ti in
|
|
|
|
<:expr< $lid:x$ >>);
|
|
|
|
|
2007-10-08 07:19:34 -07:00
|
|
|
let list = ['!'; '?'; '~'] in
|
|
|
|
let excl = ["!="; "??"] in
|
2010-08-02 07:37:22 -07:00
|
|
|
setup_op_parser prefixop
|
|
|
|
(fun x -> not (List.mem x excl) && String.length x >= 2 &&
|
|
|
|
List.mem x.[0] list && symbolchar x 1);
|
2007-10-08 07:19:34 -07:00
|
|
|
|
2010-01-22 04:48:24 -08:00
|
|
|
let list_ok = ["<"; ">"; "<="; ">="; "="; "<>"; "=="; "!="; "$"] in
|
2007-10-08 07:19:34 -07:00
|
|
|
let list_first_char_ok = ['='; '<'; '>'; '|'; '&'; '$'; '!'] in
|
|
|
|
let excl = ["<-"; "||"; "&&"] in
|
2010-08-02 07:37:22 -07:00
|
|
|
setup_op_parser infixop0
|
|
|
|
(fun x -> (List.mem x list_ok) ||
|
|
|
|
(not (List.mem x excl) && String.length x >= 2 &&
|
|
|
|
List.mem x.[0] list_first_char_ok && symbolchar x 1));
|
2007-10-08 07:19:34 -07:00
|
|
|
|
|
|
|
let list = ['@'; '^'] in
|
2010-08-02 07:37:22 -07:00
|
|
|
setup_op_parser infixop1
|
|
|
|
(fun x -> String.length x >= 1 && List.mem x.[0] list &&
|
|
|
|
symbolchar x 1);
|
2007-10-08 07:19:34 -07:00
|
|
|
|
|
|
|
let list = ['+'; '-'] in
|
2010-08-02 07:37:22 -07:00
|
|
|
setup_op_parser infixop2
|
|
|
|
(fun x -> x <> "->" && String.length x >= 1 && List.mem x.[0] list &&
|
|
|
|
symbolchar x 1);
|
2007-10-08 07:19:34 -07:00
|
|
|
|
|
|
|
let list = ['*'; '/'; '%'; '\\'] in
|
2010-08-02 07:37:22 -07:00
|
|
|
setup_op_parser infixop3
|
|
|
|
(fun x -> String.length x >= 1 && List.mem x.[0] list &&
|
|
|
|
(x.[0] <> '*' || String.length x < 2 || x.[1] <> '*') &&
|
|
|
|
symbolchar x 1);
|
2007-10-08 07:19:34 -07:00
|
|
|
|
2010-08-02 07:37:22 -07:00
|
|
|
setup_op_parser infixop4
|
|
|
|
(fun x -> String.length x >= 2 && x.[0] == '*' && x.[1] == '*' &&
|
|
|
|
symbolchar x 2);
|
2006-06-29 01:12:46 -07:00
|
|
|
|
2007-11-21 09:51:16 -08:00
|
|
|
value rec infix_kwds_filter =
|
|
|
|
parser
|
|
|
|
[ [: `((KEYWORD "(", _) as tok); xs :] ->
|
|
|
|
match xs with parser
|
2012-02-17 04:52:04 -08:00
|
|
|
[ [: `(KEYWORD ("or"|"mod"|"land"|"lor"|"lxor"|"lsl"|"lsr"|"asr" as i), _loc);
|
2007-11-21 09:51:16 -08:00
|
|
|
`(KEYWORD ")", _); xs :] ->
|
|
|
|
[: `(LIDENT i, _loc); infix_kwds_filter xs :]
|
|
|
|
| [: xs :] ->
|
|
|
|
[: `tok; infix_kwds_filter xs :] ]
|
|
|
|
| [: `x; xs :] -> [: `x; infix_kwds_filter xs :] ];
|
|
|
|
|
|
|
|
Token.Filter.define_filter (Gram.get_filter ())
|
|
|
|
(fun f strm -> infix_kwds_filter (f strm));
|
2006-06-29 01:12:46 -07:00
|
|
|
|
2007-10-08 07:19:34 -07:00
|
|
|
Gram.Entry.setup_parser sem_expr begin
|
|
|
|
let symb1 = Gram.parse_tokens_after_filter expr in
|
|
|
|
let symb =
|
|
|
|
parser
|
2010-08-02 07:37:22 -07:00
|
|
|
[ [: `(ANTIQUOT ("list" as n) s, ti) :] ->
|
|
|
|
let _loc = Gram.token_location ti in
|
|
|
|
<:expr< $anti:mk_anti ~c:"expr;" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| [: a = symb1 :] -> a ]
|
|
|
|
in
|
2006-06-29 01:12:46 -07:00
|
|
|
let rec kont al =
|
|
|
|
parser
|
2010-08-02 07:37:22 -07:00
|
|
|
[ [: `(KEYWORD ";", _); a = symb; s :] ->
|
|
|
|
let _loc = Loc.merge (Ast.loc_of_expr al)
|
|
|
|
(Ast.loc_of_expr a) in
|
|
|
|
kont <:expr< $al$; $a$ >> s
|
2006-06-29 01:12:46 -07:00
|
|
|
| [: :] -> al ]
|
|
|
|
in
|
2007-10-08 07:19:34 -07:00
|
|
|
parser [: a = symb; s :] -> kont a s
|
|
|
|
end;
|
2006-06-29 01:12:46 -07:00
|
|
|
|
|
|
|
EXTEND Gram
|
|
|
|
GLOBAL:
|
2007-10-08 07:19:34 -07:00
|
|
|
a_CHAR a_FLOAT a_INT a_INT32 a_INT64 a_LABEL a_LIDENT rec_binding_quot
|
|
|
|
a_NATIVEINT a_OPTLABEL a_STRING a_UIDENT a_ident
|
2006-06-29 17:40:58 -07:00
|
|
|
amp_ctyp and_ctyp match_case match_case0 match_case_quot binding binding_quot
|
2006-06-29 01:12:46 -07:00
|
|
|
class_declaration class_description class_expr class_expr_quot
|
|
|
|
class_fun_binding class_fun_def class_info_for_class_expr
|
|
|
|
class_info_for_class_type class_longident class_longident_and_param
|
|
|
|
class_name_and_param class_sig_item class_sig_item_quot class_signature
|
|
|
|
class_str_item class_str_item_quot class_structure class_type
|
|
|
|
class_type_declaration class_type_longident
|
|
|
|
class_type_longident_and_param class_type_plus class_type_quot
|
|
|
|
comma_ctyp comma_expr comma_ipatt comma_patt comma_type_parameter
|
|
|
|
constrain constructor_arg_list constructor_declaration
|
|
|
|
constructor_declarations ctyp ctyp_quot cvalue_binding direction_flag
|
2008-10-04 03:47:56 -07:00
|
|
|
dummy eq_expr expr expr_eoi expr_quot field_expr field_expr_list fun_binding
|
2006-06-29 01:12:46 -07:00
|
|
|
fun_def ident ident_quot implem interf ipatt ipatt_tcon label
|
2008-10-04 03:47:56 -07:00
|
|
|
label_declaration label_declaration_list label_expr label_expr_list
|
|
|
|
label_ipatt label_ipatt_list label_longident label_patt label_patt_list
|
|
|
|
labeled_ipatt let_binding meth_list meth_decl module_binding module_binding0
|
2006-06-29 01:12:46 -07:00
|
|
|
module_binding_quot module_declaration module_expr module_expr_quot
|
|
|
|
module_longident module_longident_with_app module_rec_declaration
|
|
|
|
module_type module_type_quot more_ctyp name_tags opt_as_lident
|
2006-06-29 05:18:56 -07:00
|
|
|
opt_class_self_patt opt_class_self_type opt_comma_ctyp opt_dot_dot opt_eq_ctyp opt_expr
|
|
|
|
opt_meth_list opt_mutable opt_polyt opt_private opt_rec
|
|
|
|
opt_virtual opt_when_expr patt patt_as_patt_opt patt_eoi
|
2007-10-08 07:19:34 -07:00
|
|
|
patt_quot patt_tcon phrase poly_type row_field
|
2006-06-29 01:12:46 -07:00
|
|
|
sem_expr sem_expr_for_list sem_patt sem_patt_for_list semi sequence
|
|
|
|
sig_item sig_item_quot sig_items star_ctyp str_item str_item_quot
|
|
|
|
str_items top_phrase type_constraint type_declaration
|
|
|
|
type_ident_and_parameters type_kind type_longident
|
|
|
|
type_longident_and_parameters type_parameter type_parameters typevars
|
2007-10-08 07:19:34 -07:00
|
|
|
use_file val_longident value_let value_val with_constr with_constr_quot
|
2010-08-02 07:37:22 -07:00
|
|
|
infixop0 infixop1 infixop2 infixop3 infixop4 do_sequence package_type
|
|
|
|
rec_flag_quot direction_flag_quot mutable_flag_quot private_flag_quot
|
|
|
|
virtual_flag_quot row_var_flag_quot override_flag_quot;
|
2006-06-29 01:12:46 -07:00
|
|
|
module_expr:
|
2007-11-21 09:51:16 -08:00
|
|
|
[ "top"
|
|
|
|
[ "functor"; "("; i = a_UIDENT; ":"; t = module_type; ")"; "->";
|
2006-06-29 01:12:46 -07:00
|
|
|
me = SELF ->
|
|
|
|
<:module_expr< functor ( $i$ : $t$ ) -> $me$ >>
|
2006-06-29 05:18:56 -07:00
|
|
|
| "struct"; st = str_items; "end" ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:module_expr< struct $st$ end >> ]
|
2007-11-21 09:51:16 -08:00
|
|
|
| "apply"
|
|
|
|
[ me1 = SELF; me2 = SELF -> <:module_expr< $me1$ $me2$ >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| "simple"
|
|
|
|
[ `ANTIQUOT (""|"mexp"|"anti"|"list" as n) s ->
|
|
|
|
<:module_expr< $anti:mk_anti ~c:"module_expr" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.module_expr_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| i = module_longident -> <:module_expr< $id:i$ >>
|
|
|
|
| "("; me = SELF; ":"; mt = module_type; ")" ->
|
|
|
|
<:module_expr< ( $me$ : $mt$ ) >>
|
2010-05-19 05:25:27 -07:00
|
|
|
| "("; me = SELF; ")" -> <:module_expr< $me$ >>
|
|
|
|
| "("; value_val; e = expr; ")" ->
|
|
|
|
<:module_expr< (value $e$) >>
|
|
|
|
| "("; value_val; e = expr; ":"; p = package_type; ")" ->
|
|
|
|
<:module_expr< (value $e$ : $p$) >> ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
|
|
|
str_item:
|
|
|
|
[ "top"
|
|
|
|
[ "exception"; t = constructor_declaration ->
|
|
|
|
<:str_item< exception $t$ >>
|
|
|
|
| "exception"; t = constructor_declaration; "="; i = type_longident ->
|
|
|
|
<:str_item< exception $t$ = $i$ >>
|
2007-02-26 08:32:47 -08:00
|
|
|
| "external"; i = a_LIDENT; ":"; t = ctyp; "="; sl = string_list ->
|
|
|
|
<:str_item< external $i$ : $t$ = $sl$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| "include"; me = module_expr -> <:str_item< include $me$ >>
|
|
|
|
| "module"; i = a_UIDENT; mb = module_binding0 ->
|
|
|
|
<:str_item< module $i$ = $mb$ >>
|
|
|
|
| "module"; "rec"; mb = module_binding ->
|
|
|
|
<:str_item< module rec $mb$ >>
|
2011-07-20 02:17:07 -07:00
|
|
|
| "module"; "type"; i = a_ident; "="; mt = module_type ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:str_item< module type $i$ = $mt$ >>
|
|
|
|
| "open"; i = module_longident -> <:str_item< open $i$ >>
|
|
|
|
| "type"; td = type_declaration ->
|
|
|
|
<:str_item< type $td$ >>
|
|
|
|
| value_let; r = opt_rec; bi = binding ->
|
2006-07-08 11:10:11 -07:00
|
|
|
<:str_item< value $rec:r$ $bi$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| "class"; cd = class_declaration ->
|
|
|
|
<:str_item< class $cd$ >>
|
|
|
|
| "class"; "type"; ctd = class_type_declaration ->
|
|
|
|
<:str_item< class type $ctd$ >>
|
|
|
|
| `ANTIQUOT (""|"stri"|"anti"|"list" as n) s ->
|
|
|
|
<:str_item< $anti:mk_anti ~c:"str_item" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.str_item_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| e = expr -> <:str_item< $exp:e$ >> ] ]
|
|
|
|
;
|
|
|
|
module_binding0:
|
|
|
|
[ RIGHTA
|
|
|
|
[ "("; m = a_UIDENT; ":"; mt = module_type; ")"; mb = SELF ->
|
|
|
|
<:module_expr< functor ( $m$ : $mt$ ) -> $mb$ >>
|
|
|
|
| ":"; mt = module_type; "="; me = module_expr ->
|
|
|
|
<:module_expr< ( $me$ : $mt$ ) >>
|
|
|
|
| "="; me = module_expr -> <:module_expr< $me$ >> ] ]
|
|
|
|
;
|
|
|
|
module_binding:
|
|
|
|
[ LEFTA
|
|
|
|
[ b1 = SELF; "and"; b2 = SELF ->
|
|
|
|
<:module_binding< $b1$ and $b2$ >>
|
|
|
|
| `ANTIQUOT ("module_binding"|"anti"|"list" as n) s ->
|
|
|
|
<:module_binding< $anti:mk_anti ~c:"module_binding" n s$ >>
|
|
|
|
| `ANTIQUOT ("" as n) s ->
|
|
|
|
<:module_binding< $anti:mk_anti ~c:"module_binding" n s$ >>
|
|
|
|
| `ANTIQUOT ("" as n) m; ":"; mt = module_type; "="; me = module_expr ->
|
|
|
|
<:module_binding< $mk_anti n m$ : $mt$ = $me$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.module_binding_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| m = a_UIDENT; ":"; mt = module_type; "="; me = module_expr ->
|
|
|
|
<:module_binding< $m$ : $mt$ = $me$ >> ] ]
|
|
|
|
;
|
|
|
|
module_type:
|
2007-11-21 09:51:16 -08:00
|
|
|
[ "top"
|
|
|
|
[ "functor"; "("; i = a_UIDENT; ":"; t = SELF; ")"; "->"; mt = SELF ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ]
|
2007-11-21 09:51:16 -08:00
|
|
|
| "with"
|
|
|
|
[ mt = SELF; "with"; wc = with_constr ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:module_type< $mt$ with $wc$ >> ]
|
2007-11-21 09:51:16 -08:00
|
|
|
| "apply"
|
|
|
|
[ mt1 = SELF; mt2 = SELF; dummy -> module_type_app mt1 mt2 ]
|
|
|
|
| "."
|
|
|
|
[ mt1 = SELF; "."; mt2 = SELF -> module_type_acc mt1 mt2 ]
|
|
|
|
| "sig"
|
|
|
|
[ "sig"; sg = sig_items; "end" ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:module_type< sig $sg$ end >> ]
|
|
|
|
| "simple"
|
|
|
|
[ `ANTIQUOT (""|"mtyp"|"anti"|"list" as n) s ->
|
|
|
|
<:module_type< $anti:mk_anti ~c:"module_type" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.module_type_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| i = module_longident_with_app -> <:module_type< $id:i$ >>
|
|
|
|
| "'"; i = a_ident -> <:module_type< ' $i$ >>
|
2011-07-20 02:17:07 -07:00
|
|
|
| "("; mt = SELF; ")" -> <:module_type< $mt$ >>
|
2011-07-29 03:32:43 -07:00
|
|
|
| "module"; "type"; "of"; me = module_expr ->
|
|
|
|
<:module_type< module type of $me$ >> ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
|
|
|
sig_item:
|
|
|
|
[ "top"
|
|
|
|
[ `ANTIQUOT (""|"sigi"|"anti"|"list" as n) s ->
|
|
|
|
<:sig_item< $anti:mk_anti ~c:"sig_item" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.sig_item_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| "exception"; t = constructor_declaration ->
|
|
|
|
<:sig_item< exception $t$ >>
|
2007-02-26 08:32:47 -08:00
|
|
|
| "external"; i = a_LIDENT; ":"; t = ctyp; "="; sl = string_list ->
|
|
|
|
<:sig_item< external $i$ : $t$ = $sl$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| "include"; mt = module_type -> <:sig_item< include $mt$ >>
|
|
|
|
| "module"; i = a_UIDENT; mt = module_declaration ->
|
|
|
|
<:sig_item< module $i$ : $mt$ >>
|
|
|
|
| "module"; "rec"; mb = module_rec_declaration ->
|
|
|
|
<:sig_item< module rec $mb$ >>
|
2011-07-20 02:17:07 -07:00
|
|
|
| "module"; "type"; i = a_ident; "="; mt = module_type ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:sig_item< module type $i$ = $mt$ >>
|
2011-07-20 02:17:07 -07:00
|
|
|
| "module"; "type"; i = a_ident ->
|
2007-10-08 07:19:34 -07:00
|
|
|
<:sig_item< module type $i$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| "open"; i = module_longident -> <:sig_item< open $i$ >>
|
|
|
|
| "type"; t = type_declaration ->
|
|
|
|
<:sig_item< type $t$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| value_val; i = a_LIDENT; ":"; t = ctyp ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:sig_item< value $i$ : $t$ >>
|
|
|
|
| "class"; cd = class_description ->
|
|
|
|
<:sig_item< class $cd$ >>
|
|
|
|
| "class"; "type"; ctd = class_type_declaration ->
|
|
|
|
<:sig_item< class type $ctd$ >> ] ]
|
|
|
|
;
|
|
|
|
module_declaration:
|
|
|
|
[ RIGHTA
|
|
|
|
[ ":"; mt = module_type -> <:module_type< $mt$ >>
|
|
|
|
| "("; i = a_UIDENT; ":"; t = module_type; ")"; mt = SELF ->
|
|
|
|
<:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ] ]
|
|
|
|
;
|
|
|
|
module_rec_declaration:
|
|
|
|
[ LEFTA
|
|
|
|
[ m1 = SELF; "and"; m2 = SELF -> <:module_binding< $m1$ and $m2$ >>
|
|
|
|
| `ANTIQUOT (""|"module_binding"|"anti"|"list" as n) s ->
|
|
|
|
<:module_binding< $anti:mk_anti ~c:"module_binding" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.module_binding_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| m = a_UIDENT; ":"; mt = module_type -> <:module_binding< $m$ : $mt$ >>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
with_constr:
|
|
|
|
[ LEFTA
|
|
|
|
[ wc1 = SELF; "and"; wc2 = SELF -> <:with_constr< $wc1$ and $wc2$ >>
|
|
|
|
| `ANTIQUOT (""|"with_constr"|"anti"|"list" as n) s ->
|
|
|
|
<:with_constr< $anti:mk_anti ~c:"with_constr" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.with_constr_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| "type"; `ANTIQUOT (""|"typ"|"anti" as n) s; "="; t = ctyp ->
|
|
|
|
<:with_constr< type $anti:mk_anti ~c:"ctyp" n s$ = $t$ >>
|
|
|
|
| "type"; t1 = type_longident_and_parameters; "="; t2 = ctyp ->
|
|
|
|
<:with_constr< type $t1$ = $t2$ >>
|
|
|
|
| "module"; i1 = module_longident; "="; i2 = module_longident_with_app ->
|
2010-05-17 02:32:09 -07:00
|
|
|
<:with_constr< module $i1$ = $i2$ >>
|
|
|
|
| "type"; `ANTIQUOT (""|"typ"|"anti" as n) s; ":="; t = ctyp ->
|
|
|
|
<:with_constr< type $anti:mk_anti ~c:"ctyp" n s$ := $t$ >>
|
|
|
|
| "type"; t1 = type_longident_and_parameters; ":="; t2 = ctyp ->
|
|
|
|
<:with_constr< type $t1$ := $t2$ >>
|
|
|
|
| "module"; i1 = module_longident; ":="; i2 = module_longident_with_app ->
|
|
|
|
<:with_constr< module $i1$ := $i2$ >> ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
|
|
|
expr:
|
|
|
|
[ "top" RIGHTA
|
2007-10-08 07:19:34 -07:00
|
|
|
[ "let"; r = opt_rec; bi = binding; "in"; x = SELF ->
|
2006-07-08 11:10:11 -07:00
|
|
|
<:expr< let $rec:r$ $bi$ in $x$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| "let"; "module"; m = a_UIDENT; mb = module_binding0; "in"; e = SELF ->
|
|
|
|
<:expr< let module $m$ = $mb$ in $e$ >>
|
2010-05-12 09:00:06 -07:00
|
|
|
| "let"; "open"; i = module_longident; "in"; e = SELF ->
|
|
|
|
<:expr< let open $id:i$ in $e$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| "fun"; "["; a = LIST0 match_case0 SEP "|"; "]" ->
|
|
|
|
<:expr< fun [ $list:a$ ] >>
|
2007-11-27 05:34:33 -08:00
|
|
|
| "fun"; e = fun_def -> e
|
2007-10-08 07:19:34 -07:00
|
|
|
| "match"; e = sequence; "with"; a = match_case ->
|
|
|
|
<:expr< match $mksequence' _loc e$ with [ $a$ ] >>
|
|
|
|
| "try"; e = sequence; "with"; a = match_case ->
|
|
|
|
<:expr< try $mksequence' _loc e$ with [ $a$ ] >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| "if"; e1 = SELF; "then"; e2 = SELF; "else"; e3 = SELF ->
|
|
|
|
<:expr< if $e1$ then $e2$ else $e3$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| "do"; seq = do_sequence -> mksequence _loc seq
|
|
|
|
| "for"; i = a_LIDENT; "="; e1 = sequence; df = direction_flag;
|
|
|
|
e2 = sequence; "do"; seq = do_sequence ->
|
|
|
|
<:expr< for $i$ = $mksequence' _loc e1$ $to:df$ $mksequence' _loc e2$ do { $seq$ } >>
|
|
|
|
| "while"; e = sequence; "do"; seq = do_sequence ->
|
|
|
|
<:expr< while $mksequence' _loc e$ do { $seq$ } >>
|
2006-06-29 05:18:56 -07:00
|
|
|
| "object"; csp = opt_class_self_patt; cst = class_structure; "end" ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:expr< object ($csp$) $cst$ end >> ]
|
|
|
|
| "where"
|
|
|
|
[ e = SELF; "where"; rf = opt_rec; lb = let_binding ->
|
2006-07-08 11:10:11 -07:00
|
|
|
<:expr< let $rec:rf$ $lb$ in $e$ >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| ":=" NONA
|
|
|
|
[ e1 = SELF; ":="; e2 = SELF; dummy ->
|
|
|
|
match bigarray_set _loc e1 e2 with
|
|
|
|
[ Some e -> e
|
|
|
|
| None -> <:expr< $e1$ := $e2$ >> ] ]
|
|
|
|
| "||" RIGHTA
|
2007-10-08 07:19:34 -07:00
|
|
|
[ e1 = SELF; op = infixop6; e2 = SELF -> <:expr< $op$ $e1$ $e2$ >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| "&&" RIGHTA
|
2007-10-08 07:19:34 -07:00
|
|
|
[ e1 = SELF; op = infixop5; e2 = SELF -> <:expr< $op$ $e1$ $e2$ >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| "<" LEFTA
|
2007-10-08 07:19:34 -07:00
|
|
|
[ e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $op$ $e1$ $e2$ >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| "^" RIGHTA
|
2007-10-08 07:19:34 -07:00
|
|
|
[ e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $op$ $e1$ $e2$ >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| "+" LEFTA
|
2007-10-08 07:19:34 -07:00
|
|
|
[ e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $op$ $e1$ $e2$ >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| "*" LEFTA
|
2007-10-08 07:19:34 -07:00
|
|
|
[ e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >>
|
|
|
|
| e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >>
|
|
|
|
| e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $op$ $e1$ $e2$ >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| "**" RIGHTA
|
2007-10-08 07:19:34 -07:00
|
|
|
[ e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >>
|
|
|
|
| e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $op$ $e1$ $e2$ >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| "unary minus" NONA
|
|
|
|
[ "-"; e = SELF -> mkumin _loc "-" e
|
|
|
|
| "-."; e = SELF -> mkumin _loc "-." e ]
|
|
|
|
| "apply" LEFTA
|
|
|
|
[ e1 = SELF; e2 = SELF -> <:expr< $e1$ $e2$ >>
|
|
|
|
| "assert"; e = SELF -> mkassert _loc e
|
|
|
|
| "new"; i = class_longident -> <:expr< new $i$ >>
|
|
|
|
| "lazy"; e = SELF -> <:expr< lazy $e$ >> ]
|
|
|
|
| "label" NONA
|
|
|
|
[ "~"; i = a_LIDENT; ":"; e = SELF -> <:expr< ~ $i$ : $e$ >>
|
|
|
|
| "~"; i = a_LIDENT -> <:expr< ~ $i$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
|
|
|
|
(* Here it's LABEL and not tilde_label since ~a:b is different than ~a : b *)
|
|
|
|
| `LABEL i; e = SELF -> <:expr< ~ $i$ : $e$ >>
|
|
|
|
|
|
|
|
(* Same remark for ?a:b *)
|
2006-06-29 01:12:46 -07:00
|
|
|
| `OPTLABEL i; e = SELF -> <:expr< ? $i$ : $e$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
|
2006-06-29 01:12:46 -07:00
|
|
|
| "?"; i = a_LIDENT; ":"; e = SELF -> <:expr< ? $i$ : $e$ >>
|
|
|
|
| "?"; i = a_LIDENT -> <:expr< ? $i$ >> ]
|
|
|
|
| "." LEFTA
|
|
|
|
[ e1 = SELF; "."; "("; e2 = SELF; ")" -> <:expr< $e1$ .( $e2$ ) >>
|
|
|
|
| e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >>
|
|
|
|
| e1 = SELF; "."; "{"; e2 = comma_expr; "}" -> bigarray_get _loc e1 e2
|
|
|
|
| e1 = SELF; "."; e2 = SELF -> <:expr< $e1$ . $e2$ >>
|
|
|
|
| e = SELF; "#"; lab = label -> <:expr< $e$ # $lab$ >> ]
|
|
|
|
| "~-" NONA
|
2007-10-08 07:19:34 -07:00
|
|
|
[ "!"; e = SELF -> <:expr< $e$.val >>
|
|
|
|
| f = prefixop; e = SELF -> <:expr< $f$ $e$ >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| "simple"
|
2007-10-08 07:19:34 -07:00
|
|
|
[ `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.expr_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| `ANTIQUOT ("exp"|""|"anti" as n) s ->
|
|
|
|
<:expr< $anti:mk_anti ~c:"expr" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `ANTIQUOT ("`bool" as n) s ->
|
2007-12-18 01:02:19 -08:00
|
|
|
<:expr< $id:<:ident< $anti:mk_anti n s$ >>$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| `ANTIQUOT ("tup" as n) s ->
|
2007-10-08 07:19:34 -07:00
|
|
|
<:expr< $tup: <:expr< $anti:mk_anti ~c:"expr" n s$ >>$ >>
|
|
|
|
| `ANTIQUOT ("seq" as n) s ->
|
|
|
|
<:expr< do $anti:mk_anti ~c:"expr" n s$ done >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| s = a_INT -> <:expr< $int:s$ >>
|
|
|
|
| s = a_INT32 -> <:expr< $int32:s$ >>
|
|
|
|
| s = a_INT64 -> <:expr< $int64:s$ >>
|
|
|
|
| s = a_NATIVEINT -> <:expr< $nativeint:s$ >>
|
|
|
|
| s = a_FLOAT -> <:expr< $flo:s$ >>
|
|
|
|
| s = a_STRING -> <:expr< $str:s$ >>
|
|
|
|
| s = a_CHAR -> <:expr< $chr:s$ >>
|
2010-08-02 07:37:22 -07:00
|
|
|
| i = TRY module_longident_dot_lparen; e = sequence; ")" ->
|
|
|
|
<:expr< let open $i$ in $e$ >>
|
|
|
|
| i = TRY val_longident -> <:expr< $id:i$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| "`"; s = a_ident -> <:expr< ` $s$ >>
|
|
|
|
| "["; "]" -> <:expr< [] >>
|
|
|
|
| "["; mk_list = sem_expr_for_list; "::"; last = expr; "]" ->
|
|
|
|
mk_list last
|
|
|
|
| "["; mk_list = sem_expr_for_list; "]" ->
|
|
|
|
mk_list <:expr< [] >>
|
|
|
|
| "[|"; "|]" -> <:expr< [| $<:expr<>>$ |] >>
|
|
|
|
| "[|"; el = sem_expr; "|]" -> <:expr< [| $el$ |] >>
|
2008-10-04 03:47:56 -07:00
|
|
|
| "{"; el = label_expr_list; "}" -> <:expr< { $el$ } >>
|
|
|
|
| "{"; "("; e = SELF; ")"; "with"; el = label_expr_list; "}" ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:expr< { ($e$) with $el$ } >>
|
|
|
|
| "{<"; ">}" -> <:expr< {<>} >>
|
2008-10-04 03:47:56 -07:00
|
|
|
| "{<"; fel = field_expr_list; ">}" -> <:expr< {< $fel$ >} >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| "("; ")" -> <:expr< () >>
|
|
|
|
| "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >>
|
|
|
|
| "("; e = SELF; ","; el = comma_expr; ")" -> <:expr< ( $e$, $el$ ) >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| "("; e = SELF; ";"; seq = sequence; ")" -> mksequence _loc <:expr< $e$; $seq$ >>
|
2008-10-04 09:50:21 -07:00
|
|
|
| "("; e = SELF; ";"; ")" -> mksequence _loc e
|
2006-06-29 01:12:46 -07:00
|
|
|
| "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" ->
|
|
|
|
<:expr< ($e$ : $t$ :> $t2$ ) >>
|
|
|
|
| "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| "("; e = SELF; ")" -> e
|
|
|
|
| "begin"; seq = sequence; "end" -> mksequence _loc seq
|
2010-05-19 05:25:27 -07:00
|
|
|
| "begin"; "end" -> <:expr< () >>
|
|
|
|
| "("; "module"; me = module_expr; ")" ->
|
|
|
|
<:expr< (module $me$) >>
|
|
|
|
| "("; "module"; me = module_expr; ":"; pt = package_type; ")" ->
|
|
|
|
<:expr< (module $me$ : $pt$) >>
|
|
|
|
] ]
|
2007-10-08 07:19:34 -07:00
|
|
|
;
|
|
|
|
do_sequence:
|
2010-08-02 07:37:22 -07:00
|
|
|
[ [ seq = TRY ["{"; seq = sequence; "}" -> seq] -> seq
|
|
|
|
| TRY ["{"; "}"] -> <:expr< () >>
|
|
|
|
| seq = TRY [seq = sequence; "done" -> seq] -> seq
|
|
|
|
| "done" -> <:expr< () >>
|
2007-10-08 07:19:34 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
infixop5:
|
|
|
|
[ [ x = [ "&" | "&&" ] -> <:expr< $lid:x$ >> ] ]
|
|
|
|
;
|
|
|
|
infixop6:
|
|
|
|
[ [ x = [ "or" | "||" ] -> <:expr< $lid:x$ >> ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
|
|
|
sem_expr_for_list:
|
|
|
|
[ [ e = expr; ";"; el = SELF -> fun acc -> <:expr< [ $e$ :: $el acc$ ] >>
|
2010-08-02 07:37:22 -07:00
|
|
|
| e = expr; ";" -> fun acc -> <:expr< [ $e$ :: $acc$ ] >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| e = expr -> fun acc -> <:expr< [ $e$ :: $acc$ ] >>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
comma_expr:
|
|
|
|
[ [ e1 = SELF; ","; e2 = SELF -> <:expr< $e1$, $e2$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `ANTIQUOT ("list" as n) s -> <:expr< $anti:mk_anti ~c:"expr," n s$ >>
|
2008-10-04 09:49:54 -07:00
|
|
|
| e = expr LEVEL "top" -> e ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
|
|
|
dummy:
|
|
|
|
[ [ -> () ] ]
|
|
|
|
;
|
2007-11-21 09:51:16 -08:00
|
|
|
sequence':
|
|
|
|
[ [ -> fun e -> e
|
|
|
|
| ";" -> fun e -> e
|
|
|
|
| ";"; el = sequence -> fun e -> <:expr< $e$; $el$ >> ] ]
|
|
|
|
;
|
2006-06-29 01:12:46 -07:00
|
|
|
sequence:
|
2007-11-21 09:51:16 -08:00
|
|
|
[ [ "let"; rf = opt_rec; bi = binding; "in"; e = expr; k = sequence' ->
|
|
|
|
k <:expr< let $rec:rf$ $bi$ in $e$ >>
|
|
|
|
| "let"; rf = opt_rec; bi = binding; ";"; el = SELF ->
|
2006-07-12 07:23:36 -07:00
|
|
|
<:expr< let $rec:rf$ $bi$ in $mksequence _loc el$ >>
|
2007-11-21 09:51:16 -08:00
|
|
|
| "let"; "module"; m = a_UIDENT; mb = module_binding0; "in"; e = expr; k = sequence' ->
|
|
|
|
k <:expr< let module $m$ = $mb$ in $e$ >>
|
|
|
|
| "let"; "module"; m = a_UIDENT; mb = module_binding0; ";"; el = SELF ->
|
|
|
|
<:expr< let module $m$ = $mb$ in $mksequence _loc el$ >>
|
2010-05-12 09:00:06 -07:00
|
|
|
| "let"; "open"; i = module_longident; "in"; e = SELF ->
|
|
|
|
<:expr< let open $id:i$ in $e$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `ANTIQUOT ("list" as n) s -> <:expr< $anti:mk_anti ~c:"expr;" n s$ >>
|
2007-11-21 09:51:16 -08:00
|
|
|
| e = expr; k = sequence' -> k e ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
|
|
|
binding:
|
|
|
|
[ LEFTA
|
|
|
|
[ `ANTIQUOT ("binding"|"list" as n) s ->
|
|
|
|
<:binding< $anti:mk_anti ~c:"binding" n s$ >>
|
|
|
|
| `ANTIQUOT (""|"anti" as n) s; "="; e = expr ->
|
|
|
|
<:binding< $anti:mk_anti ~c:"patt" n s$ = $e$ >>
|
|
|
|
| `ANTIQUOT (""|"anti" as n) s -> <:binding< $anti:mk_anti ~c:"binding" n s$ >>
|
|
|
|
| b1 = SELF; "and"; b2 = SELF -> <:binding< $b1$ and $b2$ >>
|
|
|
|
| b = let_binding -> b
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
let_binding:
|
|
|
|
[ [ p = ipatt; e = fun_binding -> <:binding< $p$ = $e$ >> ] ]
|
|
|
|
;
|
|
|
|
fun_binding:
|
|
|
|
[ RIGHTA
|
2010-08-02 07:37:22 -07:00
|
|
|
[ TRY ["("; "type"]; i = a_LIDENT; ")"; e = SELF ->
|
|
|
|
<:expr< fun (type $i$) -> $e$ >>
|
2012-04-23 04:58:40 -07:00
|
|
|
| p = TRY labeled_ipatt; e = SELF ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:expr< fun $p$ -> $e$ >>
|
2012-04-23 04:58:40 -07:00
|
|
|
| bi = cvalue_binding -> bi
|
2010-05-17 04:59:06 -07:00
|
|
|
] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
2006-06-29 17:40:58 -07:00
|
|
|
match_case:
|
2007-10-08 07:19:34 -07:00
|
|
|
[ [ "["; l = LIST0 match_case0 SEP "|"; "]" -> Ast.mcOr_of_list l
|
|
|
|
| p = ipatt; "->"; e = expr -> <:match_case< $p$ -> $e$ >> ] ]
|
2006-06-29 14:51:42 -07:00
|
|
|
;
|
2006-06-29 17:40:58 -07:00
|
|
|
match_case0:
|
|
|
|
[ [ `ANTIQUOT ("match_case"|"list" as n) s ->
|
|
|
|
<:match_case< $anti:mk_anti ~c:"match_case" n s$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| `ANTIQUOT (""|"anti" as n) s ->
|
2006-06-29 17:40:58 -07:00
|
|
|
<:match_case< $anti:mk_anti ~c:"match_case" n s$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| `ANTIQUOT (""|"anti" as n) s; "->"; e = expr ->
|
2006-06-29 17:40:58 -07:00
|
|
|
<:match_case< $anti:mk_anti ~c:"patt" n s$ -> $e$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| `ANTIQUOT (""|"anti" as n) s; "when"; w = expr; "->"; e = expr ->
|
2006-06-29 17:40:58 -07:00
|
|
|
<:match_case< $anti:mk_anti ~c:"patt" n s$ when $w$ -> $e$ >>
|
|
|
|
| p = patt_as_patt_opt; w = opt_when_expr; "->"; e = expr -> <:match_case< $p$ when $w$ -> $e$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
opt_when_expr:
|
|
|
|
[ [ "when"; w = expr -> w
|
|
|
|
| -> <:expr<>>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
patt_as_patt_opt:
|
|
|
|
[ [ p1 = patt; "as"; p2 = patt -> <:patt< ($p1$ as $p2$) >>
|
|
|
|
| p = patt -> p
|
|
|
|
] ]
|
|
|
|
;
|
2008-10-04 03:47:56 -07:00
|
|
|
label_expr_list:
|
|
|
|
[ [ b1 = label_expr; ";"; b2 = SELF -> <:rec_binding< $b1$ ; $b2$ >>
|
|
|
|
| b1 = label_expr; ";" -> b1
|
|
|
|
| b1 = label_expr -> b1
|
|
|
|
] ];
|
2006-06-29 01:12:46 -07:00
|
|
|
label_expr:
|
2008-10-04 03:47:56 -07:00
|
|
|
[ [ `ANTIQUOT ("rec_binding" as n) s ->
|
2007-10-08 07:19:34 -07:00
|
|
|
<:rec_binding< $anti:mk_anti ~c:"rec_binding" n s$ >>
|
|
|
|
| `ANTIQUOT (""|"anti" as n) s ->
|
|
|
|
<:rec_binding< $anti:mk_anti ~c:"rec_binding" n s$ >>
|
|
|
|
| `ANTIQUOT (""|"anti" as n) s; "="; e = expr ->
|
|
|
|
<:rec_binding< $anti:mk_anti ~c:"ident" n s$ = $e$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| `ANTIQUOT ("list" as n) s ->
|
2007-10-08 07:19:34 -07:00
|
|
|
<:rec_binding< $anti:mk_anti ~c:"rec_binding" n s$ >>
|
2010-05-11 08:18:42 -07:00
|
|
|
| i = label_longident; e = fun_binding -> <:rec_binding< $i$ = $e$ >>
|
|
|
|
| i = label_longident ->
|
|
|
|
<:rec_binding< $i$ = $lid:lid_of_ident i$ >> ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
|
|
|
fun_def:
|
2010-08-02 07:37:22 -07:00
|
|
|
[ [ TRY ["("; "type"]; i = a_LIDENT; ")";
|
2010-05-19 07:45:14 -07:00
|
|
|
e = fun_def_cont_no_when ->
|
2010-08-02 07:37:22 -07:00
|
|
|
<:expr< fun (type $i$) -> $e$ >>
|
|
|
|
| p = TRY labeled_ipatt; (w, e) = fun_def_cont ->
|
2007-11-27 05:34:33 -08:00
|
|
|
<:expr< fun [ $p$ when $w$ -> $e$ ] >> ] ]
|
|
|
|
;
|
|
|
|
fun_def_cont:
|
2006-06-29 01:12:46 -07:00
|
|
|
[ RIGHTA
|
2010-08-02 07:37:22 -07:00
|
|
|
[ TRY ["("; "type"]; i = a_LIDENT; ")";
|
2010-05-19 07:45:14 -07:00
|
|
|
e = fun_def_cont_no_when ->
|
2010-08-02 07:37:22 -07:00
|
|
|
(<:expr<>>, <:expr< fun (type $i$) -> $e$ >>)
|
|
|
|
| p = TRY labeled_ipatt; (w,e) = SELF ->
|
2010-05-19 07:45:14 -07:00
|
|
|
(<:expr<>>, <:expr< fun [ $p$ when $w$ -> $e$ ] >>)
|
2007-11-27 05:34:33 -08:00
|
|
|
| "when"; w = expr; "->"; e = expr -> (w, e)
|
|
|
|
| "->"; e = expr -> (<:expr<>>, e) ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
2010-05-19 07:45:14 -07:00
|
|
|
fun_def_cont_no_when:
|
|
|
|
[ RIGHTA
|
2010-08-02 07:37:22 -07:00
|
|
|
[ TRY ["("; "type"]; i = a_LIDENT; ")";
|
|
|
|
e = fun_def_cont_no_when -> <:expr< fun (type $i$) -> $e$ >>
|
|
|
|
| p = TRY labeled_ipatt; (w,e) = fun_def_cont ->
|
2010-05-19 07:45:14 -07:00
|
|
|
<:expr< fun [ $p$ when $w$ -> $e$ ] >>
|
|
|
|
| "->"; e = expr -> e ] ]
|
|
|
|
;
|
2006-06-29 01:12:46 -07:00
|
|
|
patt:
|
2007-11-21 09:51:16 -08:00
|
|
|
[ "|" LEFTA
|
2006-06-29 01:12:46 -07:00
|
|
|
[ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ]
|
2007-11-21 09:51:16 -08:00
|
|
|
| ".." NONA
|
2006-06-29 01:12:46 -07:00
|
|
|
[ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ]
|
2007-11-21 09:51:16 -08:00
|
|
|
| "apply" LEFTA
|
2008-07-09 06:03:38 -07:00
|
|
|
[ p1 = SELF; p2 = SELF -> <:patt< $p1$ $p2$ >>
|
|
|
|
| "lazy"; p = SELF -> <:patt< lazy $p$ >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| "simple"
|
|
|
|
[ `ANTIQUOT (""|"pat"|"anti" as n) s ->
|
|
|
|
<:patt< $anti:mk_anti ~c:"patt" n s$ >>
|
|
|
|
| `ANTIQUOT ("tup" as n) s -> <:patt< ($tup:<:patt< $anti:mk_anti ~c:"patt" n s$ >>$) >>
|
2007-12-18 01:02:19 -08:00
|
|
|
| `ANTIQUOT ("`bool" as n) s -> <:patt< $id:<:ident< $anti:mk_anti n s$ >>$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| i = ident -> <:patt< $id:i$ >>
|
|
|
|
| s = a_INT -> <:patt< $int:s$ >>
|
|
|
|
| s = a_INT32 -> <:patt< $int32:s$ >>
|
|
|
|
| s = a_INT64 -> <:patt< $int64:s$ >>
|
|
|
|
| s = a_NATIVEINT -> <:patt< $nativeint:s$ >>
|
|
|
|
| s = a_FLOAT -> <:patt< $flo:s$ >>
|
|
|
|
| s = a_STRING -> <:patt< $str:s$ >>
|
|
|
|
| s = a_CHAR -> <:patt< $chr:s$ >>
|
|
|
|
| "-"; s = a_INT -> <:patt< $int:neg_string s$ >>
|
|
|
|
| "-"; s = a_INT32 -> <:patt< $int32:neg_string s$ >>
|
|
|
|
| "-"; s = a_INT64 -> <:patt< $int64:neg_string s$ >>
|
|
|
|
| "-"; s = a_NATIVEINT -> <:patt< $nativeint:neg_string s$ >>
|
|
|
|
| "-"; s = a_FLOAT -> <:patt< $flo:neg_string s$ >>
|
|
|
|
| "["; "]" -> <:patt< [] >>
|
|
|
|
| "["; mk_list = sem_patt_for_list; "::"; last = patt; "]" ->
|
|
|
|
mk_list last
|
|
|
|
| "["; mk_list = sem_patt_for_list; "]" ->
|
|
|
|
mk_list <:patt< [] >>
|
|
|
|
| "[|"; "|]" -> <:patt< [| $<:patt<>>$ |] >>
|
|
|
|
| "[|"; pl = sem_patt; "|]" -> <:patt< [| $pl$ |] >>
|
2008-10-04 03:47:56 -07:00
|
|
|
| "{"; pl = label_patt_list; "}" -> <:patt< { $pl$ } >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| "("; ")" -> <:patt< () >>
|
2010-10-21 16:59:33 -07:00
|
|
|
| "("; "module"; m = a_UIDENT; ")" -> <:patt< (module $m$) >>
|
|
|
|
| "("; "module"; m = a_UIDENT; ":"; pt = package_type; ")" ->
|
|
|
|
<:patt< ((module $m$) : (module $pt$)) >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| "("; p = SELF; ")" -> p
|
|
|
|
| "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >>
|
|
|
|
| "("; p = SELF; "as"; p2 = SELF; ")" -> <:patt< ($p$ as $p2$) >>
|
|
|
|
| "("; p = SELF; ","; pl = comma_patt; ")" -> <:patt< ($p$, $pl$) >>
|
|
|
|
| "_" -> <:patt< _ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.patt_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| "`"; s = a_ident -> <:patt< ` $s$ >>
|
|
|
|
| "#"; i = type_longident -> <:patt< # $i$ >>
|
|
|
|
| `LABEL i; p = SELF -> <:patt< ~ $i$ : $p$ >>
|
|
|
|
| "~"; `ANTIQUOT (""|"lid" as n) i; ":"; p = SELF ->
|
|
|
|
<:patt< ~ $mk_anti n i$ : $p$ >>
|
|
|
|
| "~"; `ANTIQUOT (""|"lid" as n) i -> <:patt< ~ $mk_anti n i$ >>
|
|
|
|
| "~"; `LIDENT i -> <:patt< ~ $i$ >>
|
|
|
|
(* | i = opt_label; "("; p = patt_tcon; ")" -> *)
|
|
|
|
(* <:patt< ? $i$ : ($p$) >> *)
|
|
|
|
| `OPTLABEL i; "("; p = patt_tcon; f = eq_expr; ")" -> f i p
|
|
|
|
| "?"; `ANTIQUOT (""|"lid" as n) i; ":"; "("; p = patt_tcon; f = eq_expr; ")" ->
|
|
|
|
f (mk_anti n i) p
|
|
|
|
| "?"; `LIDENT i -> <:patt< ? $i$ >>
|
|
|
|
| "?"; `ANTIQUOT (""|"lid" as n) i -> <:patt< ? $mk_anti n i$ >>
|
|
|
|
| "?"; "("; p = patt_tcon; ")" ->
|
|
|
|
<:patt< ? ($p$) >>
|
|
|
|
| "?"; "("; p = patt_tcon; "="; e = expr; ")" ->
|
|
|
|
<:patt< ? ($p$ = $e$) >> ] ]
|
|
|
|
;
|
|
|
|
comma_patt:
|
|
|
|
[ [ p1 = SELF; ","; p2 = SELF -> <:patt< $p1$, $p2$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `ANTIQUOT ("list" as n) s -> <:patt< $anti:mk_anti ~c:"patt," n s$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| p = patt -> p ] ]
|
|
|
|
;
|
|
|
|
sem_patt:
|
|
|
|
[ LEFTA
|
2010-08-02 07:37:22 -07:00
|
|
|
[ p1 = patt; ";"; p2 = SELF -> <:patt< $p1$; $p2$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `ANTIQUOT ("list" as n) s -> <:patt< $anti:mk_anti ~c:"patt;" n s$ >>
|
2010-08-02 07:37:22 -07:00
|
|
|
| p = patt; ";" -> p
|
2006-06-29 01:12:46 -07:00
|
|
|
| p = patt -> p ] ]
|
|
|
|
;
|
|
|
|
sem_patt_for_list:
|
|
|
|
[ [ p = patt; ";"; pl = SELF -> fun acc -> <:patt< [ $p$ :: $pl acc$ ] >>
|
2010-08-02 07:37:22 -07:00
|
|
|
| p = patt; ";" -> fun acc -> <:patt< [ $p$ :: $acc$ ] >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| p = patt -> fun acc -> <:patt< [ $p$ :: $acc$ ] >>
|
|
|
|
] ]
|
|
|
|
;
|
2008-10-04 03:47:56 -07:00
|
|
|
label_patt_list:
|
|
|
|
[ [ p1 = label_patt; ";"; p2 = SELF -> <:patt< $p1$ ; $p2$ >>
|
2010-05-11 07:24:44 -07:00
|
|
|
| p1 = label_patt; ";"; "_" -> <:patt< $p1$ ; _ >>
|
|
|
|
| p1 = label_patt; ";"; "_"; ";" -> <:patt< $p1$ ; _ >>
|
2008-10-04 03:47:56 -07:00
|
|
|
| p1 = label_patt; ";" -> p1
|
|
|
|
| p1 = label_patt -> p1
|
|
|
|
] ];
|
2006-06-29 01:12:46 -07:00
|
|
|
label_patt:
|
2008-10-04 03:47:56 -07:00
|
|
|
[ [ `ANTIQUOT (""|"pat"|"anti" as n) s ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:patt< $anti:mk_anti ~c:"patt" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.patt_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| `ANTIQUOT ("list" as n) s ->
|
|
|
|
<:patt< $anti:mk_anti ~c:"patt;" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| i = label_longident; "="; p = patt -> <:patt< $i$ = $p$ >>
|
2010-05-11 08:18:42 -07:00
|
|
|
| i = label_longident -> <:patt< $i$ = $lid:lid_of_ident i$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
ipatt:
|
2008-10-04 03:47:56 -07:00
|
|
|
[ [ "{"; pl = label_ipatt_list; "}" -> <:patt< { $pl$ } >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| `ANTIQUOT (""|"pat"|"anti" as n) s ->
|
|
|
|
<:patt< $anti:mk_anti ~c:"patt" n s$ >>
|
|
|
|
| `ANTIQUOT ("tup" as n) s ->
|
|
|
|
<:patt< ($tup:<:patt< $anti:mk_anti ~c:"patt" n s$ >>$) >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.patt_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| "("; ")" -> <:patt< () >>
|
2010-10-21 16:59:33 -07:00
|
|
|
| "("; "module"; m = a_UIDENT; ")" -> <:patt< (module $m$) >>
|
|
|
|
| "("; "module"; m = a_UIDENT; ":"; pt = package_type; ")" ->
|
|
|
|
<:patt< ((module $m$) : (module $pt$)) >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| "("; p = SELF; ")" -> p
|
|
|
|
| "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >>
|
|
|
|
| "("; p = SELF; "as"; p2 = SELF; ")" -> <:patt< ($p$ as $p2$) >>
|
|
|
|
| "("; p = SELF; ","; pl = comma_ipatt; ")" -> <:patt< ($p$, $pl$) >>
|
|
|
|
| s = a_LIDENT -> <:patt< $lid:s$ >>
|
|
|
|
| "_" -> <:patt< _ >> ] ]
|
|
|
|
;
|
|
|
|
labeled_ipatt:
|
|
|
|
[ [ p = ipatt -> p ] ]
|
|
|
|
;
|
|
|
|
comma_ipatt:
|
|
|
|
[ LEFTA
|
|
|
|
[ p1 = SELF; ","; p2 = SELF -> <:patt< $p1$, $p2$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `ANTIQUOT ("list" as n) s -> <:patt< $anti:mk_anti ~c:"patt," n s$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| p = ipatt -> p ] ]
|
|
|
|
;
|
2008-10-04 03:47:56 -07:00
|
|
|
label_ipatt_list:
|
|
|
|
[ [ p1 = label_ipatt; ";"; p2 = SELF -> <:patt< $p1$ ; $p2$ >>
|
2012-03-08 11:52:03 -08:00
|
|
|
| p1 = label_ipatt; ";"; "_" -> <:patt< $p1$ ; _ >>
|
|
|
|
| p1 = label_ipatt; ";"; "_"; ";" -> <:patt< $p1$ ; _ >>
|
2008-10-04 03:47:56 -07:00
|
|
|
| p1 = label_ipatt; ";" -> p1
|
|
|
|
| p1 = label_ipatt -> p1
|
|
|
|
] ];
|
2006-06-29 01:12:46 -07:00
|
|
|
label_ipatt:
|
2008-10-04 03:47:56 -07:00
|
|
|
[ [ `ANTIQUOT (""|"pat"|"anti" as n) s ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:patt< $anti:mk_anti ~c:"patt" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `ANTIQUOT ("list" as n) s -> <:patt< $anti:mk_anti ~c:"patt;" n s$ >>
|
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.patt_tag
|
|
|
|
| i = label_longident; "="; p = ipatt -> <:patt< $i$ = $p$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
type_declaration:
|
|
|
|
[ LEFTA
|
|
|
|
[ `ANTIQUOT (""|"typ"|"anti" as n) s ->
|
|
|
|
<:ctyp< $anti:mk_anti ~c:"ctyp" n s$ >>
|
|
|
|
| `ANTIQUOT ("list" as n) s ->
|
|
|
|
<:ctyp< $anti:mk_anti ~c:"ctypand" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.ctyp_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| t1 = SELF; "and"; t2 = SELF -> <:ctyp< $t1$ and $t2$ >>
|
|
|
|
| (n, tpl) = type_ident_and_parameters; tk = opt_eq_ctyp;
|
2007-10-08 07:19:34 -07:00
|
|
|
cl = LIST0 constrain -> Ast.TyDcl _loc n tpl tk cl ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
|
|
|
constrain:
|
|
|
|
[ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ]
|
|
|
|
;
|
|
|
|
opt_eq_ctyp:
|
2007-10-08 07:19:34 -07:00
|
|
|
[ [ "="; tk = type_kind -> tk
|
|
|
|
| -> <:ctyp<>> ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
|
|
|
type_kind:
|
|
|
|
[ [ t = ctyp -> t ] ]
|
|
|
|
;
|
|
|
|
type_ident_and_parameters:
|
2010-11-19 08:40:08 -08:00
|
|
|
[ [ i = a_LIDENT; tpl = LIST0 optional_type_parameter -> (i, tpl) ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
|
|
|
type_longident_and_parameters:
|
|
|
|
[ [ i = type_longident; tpl = type_parameters -> tpl <:ctyp< $id:i$ >>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
type_parameters:
|
|
|
|
[ [ t1 = type_parameter; t2 = SELF ->
|
|
|
|
fun acc -> t2 <:ctyp< $acc$ $t1$ >>
|
|
|
|
| t = type_parameter -> fun acc -> <:ctyp< $acc$ $t$ >>
|
|
|
|
| -> fun t -> t
|
|
|
|
] ]
|
|
|
|
;
|
2010-11-19 08:40:08 -08:00
|
|
|
|
2006-06-29 01:12:46 -07:00
|
|
|
type_parameter:
|
|
|
|
[ [ `ANTIQUOT (""|"typ"|"anti" as n) s -> <:ctyp< $anti:mk_anti n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.ctyp_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| "'"; i = a_ident -> <:ctyp< '$lid:i$ >>
|
|
|
|
| "+"; "'"; i = a_ident -> <:ctyp< +'$lid:i$ >>
|
|
|
|
| "-"; "'"; i = a_ident -> <:ctyp< -'$lid:i$ >> ] ]
|
|
|
|
;
|
2010-11-19 08:40:08 -08:00
|
|
|
optional_type_parameter:
|
|
|
|
[ [ `ANTIQUOT (""|"typ"|"anti" as n) s -> <:ctyp< $anti:mk_anti n s$ >>
|
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.ctyp_tag
|
|
|
|
| "'"; i = a_ident -> <:ctyp< '$lid:i$ >>
|
|
|
|
| "+"; "'"; i = a_ident -> <:ctyp< +'$lid:i$ >>
|
|
|
|
| "-"; "'"; i = a_ident -> <:ctyp< -'$lid:i$ >>
|
2012-07-30 11:04:46 -07:00
|
|
|
| "+"; "_" -> Ast.TyAnP _loc
|
2010-11-19 08:40:08 -08:00
|
|
|
| "-"; "_" -> Ast.TyAnM _loc
|
|
|
|
| "_" -> Ast.TyAny _loc
|
|
|
|
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
|
|
|
|
|
2006-06-29 01:12:46 -07:00
|
|
|
ctyp:
|
2007-11-21 09:51:16 -08:00
|
|
|
[ "==" LEFTA
|
2006-06-29 01:12:46 -07:00
|
|
|
[ t1 = SELF; "=="; t2 = SELF -> <:ctyp< $t1$ == $t2$ >> ]
|
2007-11-21 09:51:16 -08:00
|
|
|
| "private" NONA
|
2006-06-29 01:12:46 -07:00
|
|
|
[ "private"; t = ctyp LEVEL "alias" -> <:ctyp< private $t$ >> ]
|
|
|
|
| "alias" LEFTA
|
|
|
|
[ t1 = SELF; "as"; t2 = SELF -> <:ctyp< $t1$ as $t2$ >> ]
|
2007-11-21 09:51:16 -08:00
|
|
|
| "forall" LEFTA
|
2006-06-29 01:12:46 -07:00
|
|
|
[ "!"; t1 = typevars; "."; t2 = ctyp -> <:ctyp< ! $t1$ . $t2$ >> ]
|
|
|
|
| "arrow" RIGHTA
|
|
|
|
[ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ]
|
|
|
|
| "label" NONA
|
|
|
|
[ "~"; i = a_LIDENT; ":"; t = SELF -> <:ctyp< ~ $i$ : $t$ >>
|
|
|
|
| i = a_LABEL; t = SELF -> <:ctyp< ~ $i$ : $t$ >>
|
|
|
|
| "?"; i = a_LIDENT; ":"; t = SELF -> <:ctyp< ? $i$ : $t$ >>
|
|
|
|
| i = a_OPTLABEL; t = SELF -> <:ctyp< ? $i$ : $t$ >> ]
|
2007-11-21 09:51:16 -08:00
|
|
|
| "apply" LEFTA
|
2006-06-29 01:12:46 -07:00
|
|
|
[ t1 = SELF; t2 = SELF ->
|
|
|
|
let t = <:ctyp< $t1$ $t2$ >> in
|
|
|
|
try <:ctyp< $id:Ast.ident_of_ctyp t$ >>
|
|
|
|
with [ Invalid_argument _ -> t ] ]
|
2007-11-21 09:51:16 -08:00
|
|
|
| "." LEFTA
|
2006-06-29 01:12:46 -07:00
|
|
|
[ t1 = SELF; "."; t2 = SELF ->
|
|
|
|
try <:ctyp< $id:Ast.ident_of_ctyp t1$.$id:Ast.ident_of_ctyp t2$ >>
|
|
|
|
with [ Invalid_argument s -> raise (Stream.Error s) ] ]
|
|
|
|
| "simple"
|
|
|
|
[ "'"; i = a_ident -> <:ctyp< '$i$ >>
|
|
|
|
| "_" -> <:ctyp< _ >>
|
|
|
|
| `ANTIQUOT (""|"typ"|"anti" as n) s ->
|
|
|
|
<:ctyp< $anti:mk_anti ~c:"ctyp" n s$ >>
|
|
|
|
| `ANTIQUOT ("tup" as n) s ->
|
|
|
|
<:ctyp< ($tup:<:ctyp< $anti:mk_anti ~c:"ctyp" n s$ >>$) >>
|
|
|
|
| `ANTIQUOT ("id" as n) s ->
|
|
|
|
<:ctyp< $id:<:ident< $anti:mk_anti ~c:"ident" n s$ >>$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.ctyp_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| i = a_LIDENT -> <:ctyp< $lid:i$ >>
|
|
|
|
| i = a_UIDENT -> <:ctyp< $uid:i$ >>
|
|
|
|
| "("; t = SELF; "*"; tl = star_ctyp; ")" ->
|
|
|
|
<:ctyp< ( $t$ * $tl$ ) >>
|
|
|
|
| "("; t = SELF; ")" -> t
|
2009-03-05 08:11:15 -08:00
|
|
|
| "["; "]" -> <:ctyp< [ ] >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| "["; t = constructor_declarations; "]" -> <:ctyp< [ $t$ ] >>
|
|
|
|
| "["; "="; rfl = row_field; "]" ->
|
|
|
|
<:ctyp< [ = $rfl$ ] >>
|
|
|
|
| "["; ">"; "]" -> <:ctyp< [ > $<:ctyp<>>$ ] >>
|
|
|
|
| "["; ">"; rfl = row_field; "]" ->
|
|
|
|
<:ctyp< [ > $rfl$ ] >>
|
|
|
|
| "["; "<"; rfl = row_field; "]" ->
|
|
|
|
<:ctyp< [ < $rfl$ ] >>
|
|
|
|
| "["; "<"; rfl = row_field; ">"; ntl = name_tags; "]" ->
|
|
|
|
<:ctyp< [ < $rfl$ > $ntl$ ] >>
|
|
|
|
| "[<"; rfl = row_field; "]" ->
|
|
|
|
<:ctyp< [ < $rfl$ ] >>
|
|
|
|
| "[<"; rfl = row_field; ">"; ntl = name_tags; "]" ->
|
|
|
|
<:ctyp< [ < $rfl$ > $ntl$ ] >>
|
2008-10-04 03:47:56 -07:00
|
|
|
| "{"; t = label_declaration_list; "}" -> <:ctyp< { $t$ } >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| "#"; i = class_longident -> <:ctyp< # $i$ >>
|
2008-10-04 03:47:56 -07:00
|
|
|
| "<"; t = opt_meth_list; ">" -> t
|
2010-05-19 05:25:27 -07:00
|
|
|
| "("; "module"; p = package_type; ")" -> <:ctyp< (module $p$) >>
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
star_ctyp:
|
2007-10-08 07:19:34 -07:00
|
|
|
[ [ `ANTIQUOT (""|"typ" as n) s ->
|
|
|
|
<:ctyp< $anti:mk_anti ~c:"ctyp" n s$ >>
|
|
|
|
| `ANTIQUOT ("list" as n) s ->
|
|
|
|
<:ctyp< $anti:mk_anti ~c:"ctyp*" n s$ >>
|
|
|
|
| t1 = SELF; "*"; t2 = SELF ->
|
|
|
|
<:ctyp< $t1$ * $t2$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| t = ctyp -> t
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
constructor_declarations:
|
2007-10-08 07:19:34 -07:00
|
|
|
[ [ `ANTIQUOT (""|"typ" as n) s ->
|
|
|
|
<:ctyp< $anti:mk_anti ~c:"ctyp" n s$ >>
|
|
|
|
| `ANTIQUOT ("list" as n) s ->
|
|
|
|
<:ctyp< $anti:mk_anti ~c:"ctyp|" n s$ >>
|
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.ctyp_tag
|
|
|
|
| t1 = SELF; "|"; t2 = SELF ->
|
|
|
|
<:ctyp< $t1$ | $t2$ >>
|
|
|
|
| s = a_UIDENT; "of"; t = constructor_arg_list ->
|
|
|
|
<:ctyp< $uid:s$ of $t$ >>
|
2012-04-11 14:34:51 -07:00
|
|
|
| s = a_UIDENT; ":"; t = ctyp ->
|
|
|
|
let (tl, rt) = generalized_type_of_type t in
|
|
|
|
<:ctyp< $uid:s$ : ($Ast.tyAnd_of_list tl$ -> $rt$) >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| s = a_UIDENT ->
|
2012-07-30 11:04:46 -07:00
|
|
|
<:ctyp< $uid:s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
|
|
|
constructor_declaration:
|
|
|
|
[ [ `ANTIQUOT (""|"typ" as n) s ->
|
|
|
|
<:ctyp< $anti:mk_anti ~c:"ctyp" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.ctyp_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| s = a_UIDENT; "of"; t = constructor_arg_list ->
|
|
|
|
<:ctyp< $uid:s$ of $t$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| s = a_UIDENT ->
|
|
|
|
<:ctyp< $uid:s$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
constructor_arg_list:
|
2006-07-05 04:25:36 -07:00
|
|
|
[ [ `ANTIQUOT ("list" as n) s ->
|
|
|
|
<:ctyp< $anti:mk_anti ~c:"ctypand" n s$ >>
|
|
|
|
| t1 = SELF; "and"; t2 = SELF -> <:ctyp< $t1$ and $t2$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| t = ctyp -> t
|
|
|
|
] ]
|
|
|
|
;
|
2008-10-04 03:47:56 -07:00
|
|
|
label_declaration_list:
|
|
|
|
[ [ t1 = label_declaration; ";"; t2 = SELF -> <:ctyp< $t1$; $t2$ >>
|
|
|
|
| t1 = label_declaration; ";" -> t1
|
|
|
|
| t1 = label_declaration -> t1
|
|
|
|
] ]
|
|
|
|
;
|
2006-06-29 01:12:46 -07:00
|
|
|
label_declaration:
|
2008-10-04 03:47:56 -07:00
|
|
|
[ [ `ANTIQUOT (""|"typ" as n) s ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:ctyp< $anti:mk_anti ~c:"ctyp" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `ANTIQUOT ("list" as n) s ->
|
|
|
|
<:ctyp< $anti:mk_anti ~c:"ctyp;" n s$ >>
|
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.ctyp_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| s = a_LIDENT; ":"; t = poly_type -> <:ctyp< $lid:s$ : $t$ >>
|
|
|
|
| s = a_LIDENT; ":"; "mutable"; t = poly_type ->
|
|
|
|
<:ctyp< $lid:s$ : mutable $t$ >>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
a_ident:
|
|
|
|
[ [ i = a_LIDENT -> i
|
|
|
|
| i = a_UIDENT -> i ] ]
|
|
|
|
;
|
|
|
|
ident:
|
|
|
|
[ [ `ANTIQUOT (""|"id"|"anti"|"list" as n) s ->
|
|
|
|
<:ident< $anti:mk_anti ~c:"ident" n s$ >>
|
|
|
|
| i = a_UIDENT -> <:ident< $uid:i$ >>
|
|
|
|
| i = a_LIDENT -> <:ident< $lid:i$ >>
|
|
|
|
| `ANTIQUOT (""|"id"|"anti"|"list" as n) s; "."; i = SELF ->
|
|
|
|
<:ident< $anti:mk_anti ~c:"ident" n s$.$i$ >>
|
|
|
|
| i = a_UIDENT; "."; j = SELF -> <:ident< $uid:i$.$j$ >> ] ]
|
|
|
|
;
|
|
|
|
module_longident:
|
|
|
|
[ [ `ANTIQUOT (""|"id"|"anti"|"list" as n) s ->
|
|
|
|
<:ident< $anti:mk_anti ~c:"ident" n s$ >>
|
|
|
|
| m = a_UIDENT; "."; l = SELF -> <:ident< $uid:m$.$l$ >>
|
|
|
|
| i = a_UIDENT -> <:ident< $uid:i$ >> ] ]
|
|
|
|
;
|
|
|
|
module_longident_with_app:
|
2007-10-08 07:19:34 -07:00
|
|
|
[ "apply"
|
|
|
|
[ i = SELF; j = SELF -> <:ident< $i$ $j$ >> ]
|
|
|
|
| "."
|
|
|
|
[ i = SELF; "."; j = SELF -> <:ident< $i$.$j$ >> ]
|
|
|
|
| "simple"
|
|
|
|
[ `ANTIQUOT (""|"id"|"anti"|"list" as n) s ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:ident< $anti:mk_anti ~c:"ident" n s$ >>
|
|
|
|
| i = a_UIDENT -> <:ident< $uid:i$ >>
|
|
|
|
| "("; i = SELF; ")" -> i ] ]
|
|
|
|
;
|
2010-08-02 07:37:22 -07:00
|
|
|
module_longident_dot_lparen:
|
|
|
|
[ [ `ANTIQUOT (""|"id"|"anti"|"list" as n) s; "."; "(" ->
|
|
|
|
<:ident< $anti:mk_anti ~c:"ident" n s$ >>
|
|
|
|
| m = a_UIDENT; "."; l = SELF -> <:ident< $uid:m$.$l$ >>
|
|
|
|
| i = a_UIDENT; "."; "(" -> <:ident< $uid:i$ >> ] ]
|
|
|
|
;
|
2006-06-29 01:12:46 -07:00
|
|
|
type_longident:
|
2007-10-08 07:19:34 -07:00
|
|
|
[ "apply"
|
|
|
|
[ i = SELF; j = SELF -> <:ident< $i$ $j$ >> ]
|
|
|
|
| "."
|
|
|
|
[ i = SELF; "."; j = SELF -> <:ident< $i$.$j$ >> ]
|
|
|
|
| "simple"
|
|
|
|
[ `ANTIQUOT (""|"id"|"anti"|"list" as n) s ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:ident< $anti:mk_anti ~c:"ident" n s$ >>
|
|
|
|
| i = a_LIDENT -> <:ident< $lid:i$ >>
|
|
|
|
| i = a_UIDENT -> <:ident< $uid:i$ >>
|
|
|
|
| "("; i = SELF; ")" -> i ] ]
|
|
|
|
;
|
|
|
|
label_longident:
|
|
|
|
[ [ `ANTIQUOT (""|"id"|"anti"|"list" as n) s ->
|
|
|
|
<:ident< $anti:mk_anti ~c:"ident" n s$ >>
|
|
|
|
| m = a_UIDENT; "."; l = SELF -> <:ident< $uid:m$.$l$ >>
|
|
|
|
| i = a_LIDENT -> <:ident< $lid:i$ >> ] ]
|
|
|
|
;
|
|
|
|
class_type_longident:
|
|
|
|
[ [ x = type_longident -> x ] ]
|
|
|
|
;
|
|
|
|
val_longident:
|
|
|
|
[ [ x = ident -> x ] ]
|
|
|
|
;
|
|
|
|
class_longident:
|
|
|
|
[ [ x = label_longident -> x ] ]
|
|
|
|
;
|
|
|
|
class_declaration:
|
|
|
|
[ LEFTA
|
|
|
|
[ c1 = SELF; "and"; c2 = SELF ->
|
|
|
|
<:class_expr< $c1$ and $c2$ >>
|
|
|
|
| `ANTIQUOT (""|"cdcl"|"anti"|"list" as n) s ->
|
|
|
|
<:class_expr< $anti:mk_anti ~c:"class_expr" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.class_expr_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| ci = class_info_for_class_expr; ce = class_fun_binding ->
|
|
|
|
<:class_expr< $ci$ = $ce$ >>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
class_fun_binding:
|
|
|
|
[ [ "="; ce = class_expr -> ce
|
|
|
|
| ":"; ct = class_type_plus; "="; ce = class_expr ->
|
|
|
|
<:class_expr< ($ce$ : $ct$) >>
|
|
|
|
| p = labeled_ipatt; cfb = SELF ->
|
|
|
|
<:class_expr< fun $p$ -> $cfb$ >>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
class_info_for_class_type:
|
|
|
|
[ [ mv = opt_virtual; (i, ot) = class_name_and_param ->
|
2007-10-08 07:19:34 -07:00
|
|
|
<:class_type< $virtual:mv$ $lid:i$ [ $ot$ ] >>
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
class_info_for_class_expr:
|
2007-10-08 07:19:34 -07:00
|
|
|
[ [ mv = opt_virtual; (i, ot) = class_name_and_param ->
|
|
|
|
<:class_expr< $virtual:mv$ $lid:i$ [ $ot$ ] >>
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
class_name_and_param:
|
|
|
|
[ [ i = a_LIDENT; "["; x = comma_type_parameter; "]" -> (i, x)
|
|
|
|
| i = a_LIDENT -> (i, <:ctyp<>>)
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
comma_type_parameter:
|
2007-10-08 07:19:34 -07:00
|
|
|
[ [ t1 = SELF; ","; t2 = SELF -> <:ctyp< $t1$, $t2$ >>
|
|
|
|
| `ANTIQUOT ("list" as n) s -> <:ctyp< $anti:mk_anti ~c:"ctyp," n s$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| t = type_parameter -> t
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
opt_comma_ctyp:
|
|
|
|
[ [ "["; x = comma_ctyp; "]" -> x
|
|
|
|
| -> <:ctyp<>>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
comma_ctyp:
|
|
|
|
[ [ t1 = SELF; ","; t2 = SELF -> <:ctyp< $t1$, $t2$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `ANTIQUOT ("list" as n) s -> <:ctyp< $anti:mk_anti ~c:"ctyp," n s$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| t = ctyp -> t
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
class_fun_def:
|
|
|
|
[ [ p = labeled_ipatt; ce = SELF -> <:class_expr< fun $p$ -> $ce$ >>
|
|
|
|
| "->"; ce = class_expr -> ce ] ]
|
|
|
|
;
|
|
|
|
class_expr:
|
|
|
|
[ "top"
|
2007-10-08 07:19:34 -07:00
|
|
|
[ "fun"; p = labeled_ipatt; ce = class_fun_def ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:class_expr< fun $p$ -> $ce$ >>
|
|
|
|
| "let"; rf = opt_rec; bi = binding; "in"; ce = SELF ->
|
2006-07-08 11:10:11 -07:00
|
|
|
<:class_expr< let $rec:rf$ $bi$ in $ce$ >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| "apply" NONA
|
|
|
|
[ ce = SELF; e = expr LEVEL "label" ->
|
|
|
|
<:class_expr< $ce$ $e$ >> ]
|
|
|
|
| "simple"
|
|
|
|
[ `ANTIQUOT (""|"cexp"|"anti" as n) s ->
|
|
|
|
<:class_expr< $anti:mk_anti ~c:"class_expr" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.class_expr_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| ce = class_longident_and_param -> ce
|
2006-06-29 05:18:56 -07:00
|
|
|
| "object"; csp = opt_class_self_patt; cst = class_structure; "end" ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:class_expr< object ($csp$) $cst$ end >>
|
|
|
|
| "("; ce = SELF; ":"; ct = class_type; ")" ->
|
|
|
|
<:class_expr< ($ce$ : $ct$) >>
|
|
|
|
| "("; ce = SELF; ")" -> ce ] ]
|
|
|
|
;
|
|
|
|
class_longident_and_param:
|
|
|
|
[ [ ci = class_longident; "["; t = comma_ctyp; "]" ->
|
|
|
|
<:class_expr< $id:ci$ [ $t$ ] >>
|
|
|
|
| ci = class_longident -> <:class_expr< $id:ci$ >>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
class_structure:
|
|
|
|
[ [ `ANTIQUOT (""|"cst"|"anti"|"list" as n) s ->
|
|
|
|
<:class_str_item< $anti:mk_anti ~c:"class_str_item" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `ANTIQUOT (""|"cst"|"anti"|"list" as n) s; semi; cst = SELF ->
|
|
|
|
<:class_str_item< $anti:mk_anti ~c:"class_str_item" n s$; $cst$ >>
|
2006-06-29 05:18:56 -07:00
|
|
|
| l = LIST0 [ cst = class_str_item; semi -> cst ] -> Ast.crSem_of_list l
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
opt_class_self_patt:
|
|
|
|
[ [ "("; p = patt; ")" -> p
|
|
|
|
| "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >>
|
|
|
|
| -> <:patt<>> ] ]
|
|
|
|
;
|
|
|
|
class_str_item:
|
|
|
|
[ LEFTA
|
|
|
|
[ `ANTIQUOT (""|"cst"|"anti"|"list" as n) s ->
|
|
|
|
<:class_str_item< $anti:mk_anti ~c:"class_str_item" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.class_str_item_tag
|
2010-08-02 07:37:22 -07:00
|
|
|
| "inherit"; o = opt_override; ce = class_expr; pb = opt_as_lident ->
|
|
|
|
<:class_str_item< inherit $override:o$ $ce$ as $pb$ >>
|
|
|
|
| o = value_val_opt_override; mf = opt_mutable; lab = label; e = cvalue_binding ->
|
|
|
|
<:class_str_item< value $override:o$ $mutable:mf$ $lab$ = $e$ >>
|
|
|
|
| o = value_val_opt_override; mf = opt_mutable; "virtual"; l = label; ":"; t = poly_type ->
|
|
|
|
if o <> <:override_flag<>> then
|
|
|
|
raise (Stream.Error "override (!) is incompatible with virtual")
|
|
|
|
else
|
|
|
|
<:class_str_item< value virtual $mutable:mf$ $l$ : $t$ >>
|
|
|
|
| o = value_val_opt_override; "virtual"; mf = opt_mutable; l = label; ":"; t = poly_type ->
|
|
|
|
if o <> <:override_flag<>> then
|
|
|
|
raise (Stream.Error "override (!) is incompatible with virtual")
|
|
|
|
else
|
|
|
|
<:class_str_item< value virtual $mutable:mf$ $l$ : $t$ >>
|
|
|
|
| o = method_opt_override; "virtual"; pf = opt_private; l = label; ":"; t = poly_type ->
|
|
|
|
if o <> <:override_flag<>> then
|
|
|
|
raise (Stream.Error "override (!) is incompatible with virtual")
|
|
|
|
else
|
|
|
|
<:class_str_item< method virtual $private:pf$ $l$ : $t$ >>
|
|
|
|
| o = method_opt_override; pf = opt_private; l = label; topt = opt_polyt; e = fun_binding ->
|
|
|
|
<:class_str_item< method $override:o$ $private:pf$ $l$ : $topt$ = $e$ >>
|
|
|
|
| o = method_opt_override; pf = opt_private; "virtual"; l = label; ":"; t = poly_type ->
|
|
|
|
if o <> <:override_flag<>> then
|
|
|
|
raise (Stream.Error "override (!) is incompatible with virtual")
|
|
|
|
else
|
|
|
|
<:class_str_item< method virtual $private:pf$ $l$ : $t$ >>
|
2007-11-21 09:51:16 -08:00
|
|
|
| type_constraint; t1 = ctyp; "="; t2 = ctyp ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:class_str_item< type $t1$ = $t2$ >>
|
|
|
|
| "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ]
|
|
|
|
;
|
2010-08-02 07:37:22 -07:00
|
|
|
method_opt_override:
|
|
|
|
[ [ "method"; "!" -> <:override_flag< ! >>
|
|
|
|
| "method"; `ANTIQUOT (("!"|"override"|"anti") as n) s -> Ast.OvAnt (mk_anti n s)
|
|
|
|
| "method" -> <:override_flag<>>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
value_val_opt_override:
|
|
|
|
[ [ value_val; "!" -> <:override_flag< ! >>
|
|
|
|
| value_val; `ANTIQUOT (("!"|"override"|"anti") as n) s -> Ast.OvAnt (mk_anti n s)
|
|
|
|
| value_val -> <:override_flag<>>
|
|
|
|
] ]
|
|
|
|
;
|
2006-06-29 01:12:46 -07:00
|
|
|
opt_as_lident:
|
|
|
|
[ [ "as"; i = a_LIDENT -> i
|
|
|
|
| -> ""
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
opt_polyt:
|
|
|
|
[ [ ":"; t = poly_type -> t
|
|
|
|
| -> <:ctyp<>> ] ]
|
|
|
|
;
|
|
|
|
cvalue_binding:
|
|
|
|
[ [ "="; e = expr -> e
|
2012-07-30 11:04:46 -07:00
|
|
|
| ":"; "type"; t1 = unquoted_typevars; "." ; t2 = ctyp ; "="; e = expr ->
|
|
|
|
let u = Ast.TyTypePol _loc t1 t2 in
|
|
|
|
<:expr< ($e$ : $u$) >>
|
2010-05-17 04:59:06 -07:00
|
|
|
| ":"; t = poly_type; "="; e = expr -> <:expr< ($e$ : $t$) >>
|
|
|
|
| ":"; t = poly_type; ":>"; t2 = ctyp; "="; e = expr ->
|
|
|
|
match t with
|
|
|
|
[ <:ctyp< ! $_$ . $_$ >> -> raise (Stream.Error "unexpected polytype here")
|
|
|
|
| _ -> <:expr< ($e$ : $t$ :> $t2$) >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| ":>"; t = ctyp; "="; e = expr -> <:expr< ($e$ :> $t$) >> ] ]
|
|
|
|
;
|
|
|
|
label:
|
|
|
|
[ [ i = a_LIDENT -> i ] ]
|
|
|
|
;
|
|
|
|
class_type:
|
|
|
|
[ [ `ANTIQUOT (""|"ctyp"|"anti" as n) s ->
|
|
|
|
<:class_type< $anti:mk_anti ~c:"class_type" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.class_type_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| ct = class_type_longident_and_param -> ct
|
2006-06-29 05:18:56 -07:00
|
|
|
| "object"; cst = opt_class_self_type; csg = class_signature; "end" ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:class_type< object ($cst$) $csg$ end >> ] ]
|
|
|
|
;
|
|
|
|
class_type_longident_and_param:
|
|
|
|
[ [ i = class_type_longident; "["; t = comma_ctyp; "]" ->
|
|
|
|
<:class_type< $id:i$ [ $t$ ] >>
|
|
|
|
| i = class_type_longident -> <:class_type< $id:i$ >> ] ]
|
|
|
|
;
|
|
|
|
class_type_plus:
|
|
|
|
[ [ "["; t = ctyp; "]"; "->"; ct = SELF -> <:class_type< [ $t$ ] -> $ct$ >>
|
|
|
|
| ct = class_type -> ct ] ]
|
|
|
|
;
|
|
|
|
opt_class_self_type:
|
|
|
|
[ [ "("; t = ctyp; ")" -> t
|
|
|
|
| -> <:ctyp<>> ] ]
|
|
|
|
;
|
|
|
|
class_signature:
|
|
|
|
[ [ `ANTIQUOT (""|"csg"|"anti"|"list" as n) s ->
|
|
|
|
<:class_sig_item< $anti:mk_anti ~c:"class_sig_item" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `ANTIQUOT (""|"csg"|"anti"|"list" as n) s; semi; csg = SELF ->
|
|
|
|
<:class_sig_item< $anti:mk_anti ~c:"class_sig_item" n s$; $csg$ >>
|
2006-06-29 05:18:56 -07:00
|
|
|
| l = LIST0 [ csg = class_sig_item; semi -> csg ] -> Ast.cgSem_of_list l
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
class_sig_item:
|
|
|
|
[ [ `ANTIQUOT (""|"csg"|"anti"|"list" as n) s ->
|
|
|
|
<:class_sig_item< $anti:mk_anti ~c:"class_sig_item" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.class_sig_item_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| "inherit"; cs = class_type -> <:class_sig_item< inherit $cs$ >>
|
|
|
|
| value_val; mf = opt_mutable; mv = opt_virtual;
|
|
|
|
l = label; ":"; t = ctyp ->
|
2006-07-08 11:10:11 -07:00
|
|
|
<:class_sig_item< value $mutable:mf$ $virtual:mv$ $l$ : $t$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| "method"; "virtual"; pf = opt_private; l = label; ":"; t = poly_type ->
|
2006-07-08 11:10:11 -07:00
|
|
|
<:class_sig_item< method virtual $private:pf$ $l$ : $t$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| "method"; pf = opt_private; l = label; ":"; t = poly_type ->
|
2006-07-08 11:10:11 -07:00
|
|
|
<:class_sig_item< method $private:pf$ $l$ : $t$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| "method"; pf = opt_private; "virtual"; l = label; ":"; t = poly_type ->
|
|
|
|
<:class_sig_item< method virtual $private:pf$ $l$ : $t$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| type_constraint; t1 = ctyp; "="; t2 = ctyp ->
|
|
|
|
<:class_sig_item< type $t1$ = $t2$ >> ] ]
|
|
|
|
;
|
|
|
|
type_constraint:
|
2007-10-08 07:19:34 -07:00
|
|
|
[ [ "type" | "constraint" -> () ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
|
|
|
class_description:
|
|
|
|
[ [ cd1 = SELF; "and"; cd2 = SELF -> <:class_type< $cd1$ and $cd2$ >>
|
|
|
|
| `ANTIQUOT (""|"typ"|"anti"|"list" as n) s ->
|
|
|
|
<:class_type< $anti:mk_anti ~c:"class_type" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.class_type_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| ci = class_info_for_class_type; ":"; ct = class_type_plus -> <:class_type< $ci$ : $ct$ >>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
class_type_declaration:
|
|
|
|
[ LEFTA
|
|
|
|
[ cd1 = SELF; "and"; cd2 = SELF -> <:class_type< $cd1$ and $cd2$ >>
|
|
|
|
| `ANTIQUOT (""|"typ"|"anti"|"list" as n) s ->
|
|
|
|
<:class_type< $anti:mk_anti ~c:"class_type" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.class_type_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| ci = class_info_for_class_type; "="; ct = class_type -> <:class_type< $ci$ = $ct$ >>
|
|
|
|
] ]
|
|
|
|
;
|
2008-10-04 03:47:56 -07:00
|
|
|
field_expr_list:
|
|
|
|
[ [ b1 = field_expr; ";"; b2 = SELF -> <:rec_binding< $b1$ ; $b2$ >>
|
|
|
|
| b1 = field_expr; ";" -> b1
|
|
|
|
| b1 = field_expr -> b1
|
|
|
|
] ];
|
2006-06-29 01:12:46 -07:00
|
|
|
field_expr:
|
2008-10-04 03:47:56 -07:00
|
|
|
[ [ `ANTIQUOT (""|"bi"|"anti" as n) s ->
|
2007-10-08 07:19:34 -07:00
|
|
|
<:rec_binding< $anti:mk_anti ~c:"rec_binding" n s$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| `ANTIQUOT ("list" as n) s ->
|
2007-10-08 07:19:34 -07:00
|
|
|
<:rec_binding< $anti:mk_anti ~c:"rec_binding" n s$ >>
|
2011-07-20 02:17:07 -07:00
|
|
|
| l = label; "="; e = expr LEVEL "top" -> <:rec_binding< $lid:l$ = $e$ >> ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
|
|
|
meth_list:
|
2008-10-04 03:47:56 -07:00
|
|
|
[ [ m = meth_decl; ";"; (ml, v) = SELF -> (<:ctyp< $m$; $ml$ >>, v)
|
|
|
|
| m = meth_decl; ";"; v = opt_dot_dot -> (m, v)
|
|
|
|
| m = meth_decl; v = opt_dot_dot -> (m, v)
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
meth_decl:
|
|
|
|
[ [ `ANTIQUOT (""|"typ" as n) s -> <:ctyp< $anti:mk_anti ~c:"ctyp" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `ANTIQUOT ("list" as n) s -> <:ctyp< $anti:mk_anti ~c:"ctyp;" n s$ >>
|
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.ctyp_tag
|
|
|
|
| lab = a_LIDENT; ":"; t = poly_type -> <:ctyp< $lid:lab$ : $t$ >> ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
|
|
|
opt_meth_list:
|
2008-10-04 03:47:56 -07:00
|
|
|
[ [ (ml, v) = meth_list -> <:ctyp< < $ml$ $..:v$ > >>
|
|
|
|
| v = opt_dot_dot -> <:ctyp< < $..:v$ > >>
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
poly_type:
|
|
|
|
[ [ t = ctyp -> t ] ]
|
|
|
|
;
|
2010-05-19 05:25:27 -07:00
|
|
|
package_type:
|
|
|
|
[ [ p = module_type -> p ] ]
|
|
|
|
;
|
2006-06-29 01:12:46 -07:00
|
|
|
typevars:
|
|
|
|
[ LEFTA
|
|
|
|
[ t1 = SELF; t2 = SELF -> <:ctyp< $t1$ $t2$ >>
|
|
|
|
| `ANTIQUOT (""|"typ" as n) s ->
|
|
|
|
<:ctyp< $anti:mk_anti ~c:"ctyp" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.ctyp_tag
|
2006-06-29 01:12:46 -07:00
|
|
|
| "'"; i = a_ident -> <:ctyp< '$lid:i$ >>
|
|
|
|
] ]
|
|
|
|
;
|
2010-11-19 08:40:08 -08:00
|
|
|
unquoted_typevars:
|
|
|
|
[ LEFTA
|
|
|
|
[ t1 = SELF; t2 = SELF -> <:ctyp< $t1$ $t2$ >>
|
|
|
|
| `ANTIQUOT (""|"typ" as n) s ->
|
|
|
|
<:ctyp< $anti:mk_anti ~c:"ctyp" n s$ >>
|
|
|
|
| `QUOTATION x -> Quotation.expand _loc x Quotation.DynAst.ctyp_tag
|
|
|
|
| i = a_ident -> <:ctyp< $lid:i$ >>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
|
2006-06-29 01:12:46 -07:00
|
|
|
row_field:
|
|
|
|
[ [ `ANTIQUOT (""|"typ" as n) s ->
|
|
|
|
<:ctyp< $anti:mk_anti ~c:"ctyp" n s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `ANTIQUOT ("list" as n) s ->
|
|
|
|
<:ctyp< $anti:mk_anti ~c:"ctyp|" n s$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| t1 = SELF; "|"; t2 = SELF -> <:ctyp< $t1$ | $t2$ >>
|
|
|
|
| "`"; i = a_ident -> <:ctyp< `$i$ >>
|
|
|
|
| "`"; i = a_ident; "of"; "&"; t = amp_ctyp -> <:ctyp< `$i$ of & $t$ >>
|
|
|
|
| "`"; i = a_ident; "of"; t = amp_ctyp -> <:ctyp< `$i$ of $t$ >>
|
|
|
|
| t = ctyp -> t ] ]
|
|
|
|
;
|
|
|
|
amp_ctyp:
|
|
|
|
[ [ t1 = SELF; "&"; t2 = SELF -> <:ctyp< $t1$ & $t2$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `ANTIQUOT ("list" as n) s -> <:ctyp< $anti:mk_anti ~c:"ctyp&" n s$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| t = ctyp -> t
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
name_tags:
|
|
|
|
[ [ `ANTIQUOT (""|"typ" as n) s ->
|
|
|
|
<:ctyp< $anti:mk_anti ~c:"ctyp" n s$ >>
|
|
|
|
| t1 = SELF; t2 = SELF -> <:ctyp< $t1$ $t2$ >>
|
|
|
|
| "`"; i = a_ident -> <:ctyp< `$i$ >>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
eq_expr:
|
|
|
|
[ [ "="; e = expr -> fun i p -> <:patt< ? $i$ : ($p$ = $e$) >>
|
|
|
|
| -> fun i p -> <:patt< ? $i$ : ($p$) >> ] ]
|
|
|
|
;
|
|
|
|
patt_tcon:
|
|
|
|
[ [ p = patt; ":"; t = ctyp -> <:patt< ($p$ : $t$) >>
|
|
|
|
| p = patt -> p ] ]
|
|
|
|
;
|
|
|
|
ipatt:
|
|
|
|
[ [ `LABEL i; p = SELF -> <:patt< ~ $i$ : $p$ >>
|
|
|
|
| "~"; `ANTIQUOT (""|"lid" as n) i; ":"; p = SELF ->
|
|
|
|
<:patt< ~ $mk_anti n i$ : $p$ >>
|
|
|
|
| "~"; `ANTIQUOT (""|"lid" as n) i -> <:patt< ~ $mk_anti n i$ >>
|
|
|
|
| "~"; `LIDENT i -> <:patt< ~ $i$ >>
|
|
|
|
(* | i = opt_label; "("; p = ipatt_tcon; ")" ->
|
|
|
|
<:patt< ? $i$ : ($p$) >>
|
|
|
|
| i = opt_label; "("; p = ipatt_tcon; "="; e = expr; ")" ->
|
|
|
|
<:patt< ? $i$ : ($p$ = $e$) >> *)
|
|
|
|
| `OPTLABEL i; "("; p = ipatt_tcon; f = eq_expr; ")" -> f i p
|
|
|
|
| "?"; `ANTIQUOT (""|"lid" as n) i; ":"; "("; p = ipatt_tcon;
|
|
|
|
f = eq_expr; ")" -> f (mk_anti n i) p
|
|
|
|
| "?"; `LIDENT i -> <:patt< ? $i$ >>
|
|
|
|
| "?"; `ANTIQUOT (""|"lid" as n) i -> <:patt< ? $mk_anti n i$ >>
|
|
|
|
| "?"; "("; p = ipatt_tcon; ")" ->
|
|
|
|
<:patt< ? ($p$) >>
|
|
|
|
| "?"; "("; p = ipatt_tcon; "="; e = expr; ")" ->
|
|
|
|
<:patt< ? ($p$ = $e$) >> ] ]
|
|
|
|
;
|
|
|
|
ipatt_tcon:
|
|
|
|
[ [ p = ipatt; ":"; t = ctyp -> <:patt< ($p$ : $t$) >>
|
|
|
|
| p = ipatt -> p ] ]
|
|
|
|
;
|
|
|
|
direction_flag:
|
2010-08-02 07:37:22 -07:00
|
|
|
[ [ "to" -> <:direction_flag< to >>
|
|
|
|
| "downto" -> <:direction_flag< downto >>
|
|
|
|
| `ANTIQUOT ("to"|"anti" as n) s -> Ast.DiAnt (mk_anti n s) ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
|
|
|
opt_private:
|
2010-08-02 07:37:22 -07:00
|
|
|
[ [ "private" -> <:private_flag< private >>
|
|
|
|
| `ANTIQUOT ("private"|"anti" as n) s -> Ast.PrAnt (mk_anti n s)
|
|
|
|
| -> <:private_flag<>>
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
opt_mutable:
|
2010-08-02 07:37:22 -07:00
|
|
|
[ [ "mutable" -> <:mutable_flag< mutable >>
|
|
|
|
| `ANTIQUOT ("mutable"|"anti" as n) s -> Ast.MuAnt (mk_anti n s)
|
|
|
|
| -> <:mutable_flag<>>
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
opt_virtual:
|
2010-08-02 07:37:22 -07:00
|
|
|
[ [ "virtual" -> <:virtual_flag< virtual >>
|
|
|
|
| `ANTIQUOT ("virtual"|"anti" as n) s -> Ast.ViAnt (mk_anti n s)
|
|
|
|
| -> <:virtual_flag<>>
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
opt_dot_dot:
|
2010-08-02 07:37:22 -07:00
|
|
|
[ [ ".." -> <:row_var_flag< .. >>
|
|
|
|
| `ANTIQUOT (".."|"anti" as n) s -> Ast.RvAnt (mk_anti n s)
|
|
|
|
| -> <:row_var_flag<>>
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
opt_rec:
|
2010-08-02 07:37:22 -07:00
|
|
|
[ [ "rec" -> <:rec_flag< rec >>
|
|
|
|
| `ANTIQUOT ("rec"|"anti" as n) s -> Ast.ReAnt (mk_anti n s)
|
|
|
|
| -> <:rec_flag<>>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
opt_override:
|
|
|
|
[ [ "!" -> <:override_flag< ! >>
|
|
|
|
| `ANTIQUOT (("!"|"override"|"anti") as n) s -> Ast.OvAnt (mk_anti n s)
|
|
|
|
| -> <:override_flag<>>
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
opt_expr:
|
|
|
|
[ [ e = expr -> e
|
|
|
|
| -> <:expr<>>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
interf:
|
|
|
|
[ [ "#"; n = a_LIDENT; dp = opt_expr; semi ->
|
2006-07-17 07:18:26 -07:00
|
|
|
([ <:sig_item< # $n$ $dp$ >> ], stopped_at _loc)
|
2006-06-29 01:12:46 -07:00
|
|
|
| si = sig_item; semi; (sil, stopped) = SELF -> ([si :: sil], stopped)
|
2006-07-17 07:18:26 -07:00
|
|
|
| `EOI -> ([], None) ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
2006-06-29 05:18:56 -07:00
|
|
|
sig_items:
|
2006-06-29 01:12:46 -07:00
|
|
|
[ [ `ANTIQUOT (""|"sigi"|"anti"|"list" as n) s ->
|
|
|
|
<:sig_item< $anti:mk_anti n ~c:"sig_item" s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `ANTIQUOT (""|"sigi"|"anti"|"list" as n) s; semi; sg = SELF ->
|
|
|
|
<:sig_item< $anti:mk_anti n ~c:"sig_item" s$; $sg$ >>
|
2006-06-29 05:18:56 -07:00
|
|
|
| l = LIST0 [ sg = sig_item; semi -> sg ] -> Ast.sgSem_of_list l
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
implem:
|
|
|
|
[ [ "#"; n = a_LIDENT; dp = opt_expr; semi ->
|
2006-07-17 07:18:26 -07:00
|
|
|
([ <:str_item< # $n$ $dp$ >> ], stopped_at _loc)
|
2006-06-29 01:12:46 -07:00
|
|
|
| si = str_item; semi; (sil, stopped) = SELF -> ([si :: sil], stopped)
|
2006-07-17 07:18:26 -07:00
|
|
|
| `EOI -> ([], None)
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
2006-06-29 05:18:56 -07:00
|
|
|
str_items:
|
2006-06-29 01:12:46 -07:00
|
|
|
[ [ `ANTIQUOT (""|"stri"|"anti"|"list" as n) s ->
|
|
|
|
<:str_item< $anti:mk_anti n ~c:"str_item" s$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| `ANTIQUOT (""|"stri"|"anti"|"list" as n) s; semi; st = SELF ->
|
|
|
|
<:str_item< $anti:mk_anti n ~c:"str_item" s$; $st$ >>
|
2006-06-29 05:18:56 -07:00
|
|
|
| l = LIST0 [ st = str_item; semi -> st ] -> Ast.stSem_of_list l
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
top_phrase:
|
|
|
|
[ [ ph = phrase -> Some ph
|
|
|
|
| `EOI -> None
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
use_file:
|
|
|
|
[ [ "#"; n = a_LIDENT; dp = opt_expr; semi ->
|
2006-07-17 07:18:26 -07:00
|
|
|
([ <:str_item< # $n$ $dp$ >> ], stopped_at _loc)
|
2006-06-29 01:12:46 -07:00
|
|
|
| si = str_item; semi; (sil, stopped) = SELF -> ([si :: sil], stopped)
|
2006-07-17 07:18:26 -07:00
|
|
|
| `EOI -> ([], None)
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
phrase:
|
|
|
|
[ [ "#"; n = a_LIDENT; dp = opt_expr; semi ->
|
|
|
|
<:str_item< # $n$ $dp$ >>
|
|
|
|
| st = str_item; semi -> st
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
a_INT:
|
|
|
|
[ [ `ANTIQUOT (""|"int"|"`int" as n) s -> mk_anti n s
|
|
|
|
| `INT _ s -> s ] ]
|
|
|
|
;
|
|
|
|
a_INT32:
|
|
|
|
[ [ `ANTIQUOT (""|"int32"|"`int32" as n) s -> mk_anti n s
|
|
|
|
| `INT32 _ s -> s ] ]
|
|
|
|
;
|
|
|
|
a_INT64:
|
|
|
|
[ [ `ANTIQUOT (""|"int64"|"`int64" as n) s -> mk_anti n s
|
|
|
|
| `INT64 _ s -> s ] ]
|
|
|
|
;
|
|
|
|
a_NATIVEINT:
|
|
|
|
[ [ `ANTIQUOT (""|"nativeint"|"`nativeint" as n) s -> mk_anti n s
|
|
|
|
| `NATIVEINT _ s -> s ] ]
|
|
|
|
;
|
|
|
|
a_FLOAT:
|
|
|
|
[ [ `ANTIQUOT (""|"flo"|"`flo" as n) s -> mk_anti n s
|
|
|
|
| `FLOAT _ s -> s ] ]
|
|
|
|
;
|
|
|
|
a_CHAR:
|
|
|
|
[ [ `ANTIQUOT (""|"chr"|"`chr" as n) s -> mk_anti n s
|
|
|
|
| `CHAR _ s -> s ] ]
|
|
|
|
;
|
|
|
|
a_UIDENT:
|
|
|
|
[ [ `ANTIQUOT (""|"uid" as n) s -> mk_anti n s
|
|
|
|
| `UIDENT s -> s ] ]
|
|
|
|
;
|
|
|
|
a_LIDENT:
|
|
|
|
[ [ `ANTIQUOT (""|"lid" as n) s -> mk_anti n s
|
|
|
|
| `LIDENT s -> s ] ]
|
|
|
|
;
|
|
|
|
a_LABEL:
|
|
|
|
[ [ "~"; `ANTIQUOT ("" as n) s; ":" -> mk_anti n s
|
|
|
|
| `LABEL s -> s ] ]
|
|
|
|
;
|
|
|
|
a_OPTLABEL:
|
|
|
|
[ [ "?"; `ANTIQUOT ("" as n) s; ":" -> mk_anti n s
|
|
|
|
| `OPTLABEL s -> s ] ]
|
|
|
|
;
|
|
|
|
a_STRING:
|
|
|
|
[ [ `ANTIQUOT (""|"str"|"`str" as n) s -> mk_anti n s
|
|
|
|
| `STRING _ s -> s ] ]
|
|
|
|
;
|
2007-02-26 08:32:47 -08:00
|
|
|
string_list:
|
|
|
|
[ [ `ANTIQUOT (""|"str_list") s -> Ast.LAnt (mk_anti "str_list" s)
|
|
|
|
| `STRING _ x; xs = string_list -> Ast.LCons x xs
|
|
|
|
| `STRING _ x -> Ast.LCons x Ast.LNil ] ]
|
|
|
|
;
|
2006-06-29 01:12:46 -07:00
|
|
|
value_let:
|
|
|
|
[ [ "value" -> () ] ]
|
|
|
|
;
|
|
|
|
value_val:
|
|
|
|
[ [ "value" -> () ] ]
|
|
|
|
;
|
|
|
|
semi:
|
|
|
|
[ [ ";" -> () ] ]
|
|
|
|
;
|
|
|
|
expr_quot:
|
|
|
|
[ [ e1 = expr; ","; e2 = comma_expr -> <:expr< $e1$, $e2$ >>
|
|
|
|
| e1 = expr; ";"; e2 = sem_expr -> <:expr< $e1$; $e2$ >>
|
|
|
|
| e = expr -> e
|
|
|
|
| -> <:expr<>>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
patt_quot:
|
|
|
|
[ [ x = patt; ","; y = comma_patt -> <:patt< $x$, $y$ >>
|
|
|
|
| x = patt; ";"; y = sem_patt -> <:patt< $x$; $y$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| x = patt; "="; y = patt ->
|
|
|
|
let i =
|
|
|
|
match x with
|
|
|
|
[ <:patt@loc< $anti:s$ >> -> <:ident@loc< $anti:s$ >>
|
|
|
|
| p -> Ast.ident_of_patt p ]
|
|
|
|
in
|
|
|
|
<:patt< $i$ = $y$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| x = patt -> x
|
|
|
|
| -> <:patt<>>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
ctyp_quot:
|
|
|
|
[ [ x = more_ctyp; ","; y = comma_ctyp -> <:ctyp< $x$, $y$ >>
|
2008-10-04 03:47:56 -07:00
|
|
|
| x = more_ctyp; ";"; y = label_declaration_list -> <:ctyp< $x$; $y$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| x = more_ctyp; "|"; y = constructor_declarations -> <:ctyp< $x$ | $y$ >>
|
2006-07-05 04:25:36 -07:00
|
|
|
| x = more_ctyp; "of"; y = constructor_arg_list -> <:ctyp< $x$ of $y$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| x = more_ctyp; "of"; y = constructor_arg_list; "|"; z = constructor_declarations ->
|
|
|
|
<:ctyp< $ <:ctyp< $x$ of $y$ >> $ | $z$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| x = more_ctyp; "of"; "&"; y = amp_ctyp -> <:ctyp< $x$ of & $y$ >>
|
2007-10-08 07:19:34 -07:00
|
|
|
| x = more_ctyp; "of"; "&"; y = amp_ctyp; "|"; z = row_field ->
|
|
|
|
<:ctyp< $ <:ctyp< $x$ of & $y$ >> $ | $z$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| x = more_ctyp; ":"; y = more_ctyp -> <:ctyp< $x$ : $y$ >>
|
2008-10-04 03:47:56 -07:00
|
|
|
| x = more_ctyp; ":"; y = more_ctyp; ";"; z = label_declaration_list ->
|
2007-10-08 07:19:34 -07:00
|
|
|
<:ctyp< $ <:ctyp< $x$ : $y$ >> $ ; $z$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| x = more_ctyp; "*"; y = star_ctyp -> <:ctyp< $x$ * $y$ >>
|
|
|
|
| x = more_ctyp; "&"; y = amp_ctyp -> <:ctyp< $x$ & $y$ >>
|
2006-07-05 04:25:36 -07:00
|
|
|
| x = more_ctyp; "and"; y = constructor_arg_list -> <:ctyp< $x$ and $y$ >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| x = more_ctyp -> x
|
|
|
|
| -> <:ctyp<>>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
more_ctyp:
|
|
|
|
[ [ "mutable"; x = SELF -> <:ctyp< mutable $x$ >>
|
2007-12-18 01:00:37 -08:00
|
|
|
| "`"; x = a_ident -> <:ctyp< `$x$ >>
|
2011-07-20 02:17:07 -07:00
|
|
|
| x = ctyp -> x
|
2006-06-29 01:12:46 -07:00
|
|
|
| x = type_parameter -> x
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
str_item_quot:
|
|
|
|
[ [ "#"; n = a_LIDENT; dp = opt_expr -> <:str_item< # $n$ $dp$ >>
|
2012-01-05 01:35:47 -08:00
|
|
|
| st1 = str_item; semi; st2 = SELF ->
|
|
|
|
match st2 with
|
|
|
|
[ <:str_item<>> -> st1
|
|
|
|
| _ -> <:str_item< $st1$; $st2$ >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| st = str_item -> st
|
|
|
|
| -> <:str_item<>> ] ]
|
|
|
|
;
|
|
|
|
sig_item_quot:
|
|
|
|
[ [ "#"; n = a_LIDENT; dp = opt_expr -> <:sig_item< # $n$ $dp$ >>
|
2012-01-05 01:35:47 -08:00
|
|
|
| sg1 = sig_item; semi; sg2 = SELF ->
|
|
|
|
match sg2 with
|
2012-01-10 12:19:33 -08:00
|
|
|
[ <:sig_item<>> -> sg1
|
2012-01-05 01:35:47 -08:00
|
|
|
| _ -> <:sig_item< $sg1$; $sg2$ >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| sg = sig_item -> sg
|
|
|
|
| -> <:sig_item<>> ] ]
|
|
|
|
;
|
|
|
|
module_type_quot:
|
|
|
|
[ [ x = module_type -> x
|
2007-10-08 07:19:34 -07:00
|
|
|
| -> <:module_type<>>
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
|
|
|
module_expr_quot:
|
|
|
|
[ [ x = module_expr -> x
|
2007-10-08 07:19:34 -07:00
|
|
|
| -> <:module_expr<>>
|
2006-06-29 01:12:46 -07:00
|
|
|
] ]
|
|
|
|
;
|
2006-06-29 17:40:58 -07:00
|
|
|
match_case_quot:
|
2007-10-08 07:19:34 -07:00
|
|
|
[ [ x = LIST0 match_case0 SEP "|" -> <:match_case< $list:x$ >>
|
2006-06-29 17:40:58 -07:00
|
|
|
| -> <:match_case<>> ] ]
|
2006-06-29 01:12:46 -07:00
|
|
|
;
|
|
|
|
binding_quot:
|
2007-10-08 07:19:34 -07:00
|
|
|
[ [ x = binding -> x
|
2006-06-29 01:12:46 -07:00
|
|
|
| -> <:binding<>>
|
|
|
|
] ]
|
|
|
|
;
|
2007-10-08 07:19:34 -07:00
|
|
|
rec_binding_quot:
|
2008-10-04 03:47:56 -07:00
|
|
|
[ [ x = label_expr_list -> x
|
2007-10-08 07:19:34 -07:00
|
|
|
| -> <:rec_binding<>> ] ]
|
|
|
|
;
|
2006-06-29 01:12:46 -07:00
|
|
|
module_binding_quot:
|
|
|
|
[ [ b1 = SELF; "and"; b2 = SELF ->
|
|
|
|
<:module_binding< $b1$ and $b2$ >>
|
|
|
|
| `ANTIQUOT ("module_binding"|"anti" as n) s ->
|
|
|
|
<:module_binding< $anti:mk_anti ~c:"module_binding" n s$ >>
|
|
|
|
| `ANTIQUOT ("" as n) s -> <:module_binding< $anti:mk_anti ~c:"module_binding" n s$ >>
|
|
|
|
| `ANTIQUOT ("" as n) m; ":"; mt = module_type ->
|
|
|
|
<:module_binding< $mk_anti n m$ : $mt$ >>
|
|
|
|
| `ANTIQUOT ("" as n) m; ":"; mt = module_type; "="; me = module_expr ->
|
|
|
|
<:module_binding< $mk_anti n m$ : $mt$ = $me$ >>
|
|
|
|
| m = a_UIDENT; ":"; mt = module_type -> <:module_binding< $m$ : $mt$ >>
|
|
|
|
| m = a_UIDENT; ":"; mt = module_type; "="; me = module_expr ->
|
|
|
|
<:module_binding< $m$ : $mt$ = $me$ >>
|
|
|
|
| -> <:module_binding<>>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
ident_quot:
|
2007-11-21 09:51:16 -08:00
|
|
|
[ "apply"
|
|
|
|
[ i = SELF; j = SELF -> <:ident< $i$ $j$ >> ]
|
|
|
|
| "."
|
|
|
|
[ i = SELF; "."; j = SELF -> <:ident< $i$.$j$ >> ]
|
|
|
|
| "simple"
|
|
|
|
[ `ANTIQUOT (""|"id"|"anti"|"list" as n) s ->
|
2006-06-29 01:12:46 -07:00
|
|
|
<:ident< $anti:mk_anti ~c:"ident" n s$ >>
|
|
|
|
| i = a_UIDENT -> <:ident< $uid:i$ >>
|
|
|
|
| i = a_LIDENT -> <:ident< $lid:i$ >>
|
|
|
|
| `ANTIQUOT (""|"id"|"anti"|"list" as n) s; "."; i = SELF ->
|
|
|
|
<:ident< $anti:mk_anti ~c:"ident" n s$.$i$ >>
|
|
|
|
| "("; i = SELF; ")" -> i
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
class_expr_quot:
|
|
|
|
[ [ ce1 = SELF; "and"; ce2 = SELF -> <:class_expr< $ce1$ and $ce2$ >>
|
|
|
|
| ce1 = SELF; "="; ce2 = SELF -> <:class_expr< $ce1$ = $ce2$ >>
|
|
|
|
| "virtual"; (i, ot) = class_name_and_param ->
|
2007-10-08 07:19:34 -07:00
|
|
|
<:class_expr< virtual $lid:i$ [ $ot$ ] >>
|
2006-07-08 11:10:11 -07:00
|
|
|
| `ANTIQUOT ("virtual" as n) s; i = ident; ot = opt_comma_ctyp ->
|
2010-08-02 07:37:22 -07:00
|
|
|
let anti = Ast.ViAnt (mk_anti ~c:"class_expr" n s) in
|
2007-10-08 07:19:34 -07:00
|
|
|
<:class_expr< $virtual:anti$ $id:i$ [ $ot$ ] >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| x = class_expr -> x
|
|
|
|
| -> <:class_expr<>>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
class_type_quot:
|
|
|
|
[ [ ct1 = SELF; "and"; ct2 = SELF -> <:class_type< $ct1$ and $ct2$ >>
|
|
|
|
| ct1 = SELF; "="; ct2 = SELF -> <:class_type< $ct1$ = $ct2$ >>
|
|
|
|
| ct1 = SELF; ":"; ct2 = SELF -> <:class_type< $ct1$ : $ct2$ >>
|
|
|
|
| "virtual"; (i, ot) = class_name_and_param ->
|
2007-10-08 07:19:34 -07:00
|
|
|
<:class_type< virtual $lid:i$ [ $ot$ ] >>
|
2006-07-08 11:10:11 -07:00
|
|
|
| `ANTIQUOT ("virtual" as n) s; i = ident; ot = opt_comma_ctyp ->
|
2010-08-02 07:37:22 -07:00
|
|
|
let anti = Ast.ViAnt (mk_anti ~c:"class_type" n s) in
|
2007-10-08 07:19:34 -07:00
|
|
|
<:class_type< $virtual:anti$ $id:i$ [ $ot$ ] >>
|
2006-06-29 01:12:46 -07:00
|
|
|
| x = class_type_plus -> x
|
|
|
|
| -> <:class_type<>>
|
|
|
|
] ]
|
|
|
|
;
|
|
|
|
class_str_item_quot:
|
|
|
|
[ [ x1 = class_str_item; semi; x2 = SELF ->
|
2012-01-05 01:43:50 -08:00
|
|
|
match x2 with
|
|
|
|
[ <:class_str_item<>> -> x1
|
|
|
|
| _ -> <:class_str_item< $x1$; $x2$ >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| x = class_str_item -> x
|
|
|
|
| -> <:class_str_item<>> ] ]
|
|
|
|
;
|
|
|
|
class_sig_item_quot:
|
2012-01-05 01:43:50 -08:00
|
|
|
[ [ x1 = class_sig_item; semi; x2 = SELF ->
|
|
|
|
match x2 with
|
|
|
|
[ <:class_sig_item<>> -> x1
|
|
|
|
| _ -> <:class_sig_item< $x1$; $x2$ >> ]
|
2006-06-29 01:12:46 -07:00
|
|
|
| x = class_sig_item -> x
|
|
|
|
| -> <:class_sig_item<>> ] ]
|
|
|
|
;
|
|
|
|
with_constr_quot:
|
|
|
|
[ [ x = with_constr -> x
|
|
|
|
| -> <:with_constr<>> ] ]
|
|
|
|
;
|
2010-08-02 07:37:22 -07:00
|
|
|
rec_flag_quot: [ [ x = opt_rec -> x ] ];
|
|
|
|
direction_flag_quot: [ [ x = direction_flag -> x ] ];
|
|
|
|
mutable_flag_quot: [ [ x = opt_mutable -> x ] ];
|
|
|
|
private_flag_quot: [ [ x = opt_private -> x ] ];
|
|
|
|
virtual_flag_quot: [ [ x = opt_virtual -> x ] ];
|
|
|
|
row_var_flag_quot: [ [ x = opt_dot_dot -> x ] ];
|
|
|
|
override_flag_quot: [ [ x = opt_override -> x ] ];
|
2006-06-29 01:12:46 -07:00
|
|
|
patt_eoi:
|
|
|
|
[ [ x = patt; `EOI -> x ] ]
|
|
|
|
;
|
|
|
|
expr_eoi:
|
|
|
|
[ [ x = expr; `EOI -> x ] ]
|
|
|
|
;
|
|
|
|
END;
|
|
|
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
let module M = Register.OCamlSyntaxExtension Id Make in ();
|