summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--otherlibs/labltk/browser/searchid.ml2
-rw-r--r--parsing/ast_mapper.ml4
-rw-r--r--parsing/parser.mly12
-rw-r--r--parsing/parsetree.mli2
-rw-r--r--parsing/pprintast.ml1
-rw-r--r--parsing/printast.ml7
-rw-r--r--tools/depend.ml2
-rw-r--r--typing/typecore.ml6
8 files changed, 32 insertions, 4 deletions
diff --git a/otherlibs/labltk/browser/searchid.ml b/otherlibs/labltk/browser/searchid.ml
index 0cad8ffc7..11f0fa5bc 100644
--- a/otherlibs/labltk/browser/searchid.ml
+++ b/otherlibs/labltk/browser/searchid.ml
@@ -428,6 +428,8 @@ let rec bound_variables pat =
bound_variables pat1 @ bound_variables pat2
| Ppat_constraint (pat,_) -> bound_variables pat
| Ppat_lazy pat -> bound_variables pat
+ | Ppat_attribute (pat, _) -> bound_variables pat
+ | Ppat_extension _ -> []
let search_structure str ~name ~kind ~prefix =
let loc = ref 0 in
diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml
index d5f7c246b..690e26546 100644
--- a/parsing/ast_mapper.ml
+++ b/parsing/ast_mapper.ml
@@ -362,6 +362,8 @@ module P = struct
let type_ ?loc a = mk ?loc (Ppat_type a)
let lazy_ ?loc a = mk ?loc (Ppat_lazy a)
let unpack ?loc a = mk ?loc (Ppat_unpack a)
+ let attribute ?loc a b = mk ?loc (Ppat_attribute (a, b))
+ let extension ?loc a = mk ?loc (Ppat_extension a)
let map sub {ppat_desc = desc; ppat_loc = loc} =
let loc = sub # location loc in
@@ -381,6 +383,8 @@ module P = struct
| Ppat_type s -> type_ ~loc (map_loc sub s)
| Ppat_lazy p -> lazy_ ~loc (sub # pat p)
| Ppat_unpack s -> unpack ~loc (map_loc sub s)
+ | Ppat_attribute (body, x) -> attribute ~loc (sub # pat body) (sub # attribute x)
+ | Ppat_extension x -> extension ~loc (sub # extension x)
end
module CE = struct
diff --git a/parsing/parser.mly b/parsing/parser.mly
index 5c0c67ec4..3d938ef74 100644
--- a/parsing/parser.mly
+++ b/parsing/parser.mly
@@ -1079,10 +1079,6 @@ expr:
| expr attribute
{ mkexp (Pexp_attribute($1, $2)) }
;
-opt_expr:
- expr { $1 }
- | { ghunit () }
-;
simple_expr:
val_longident
{ mkexp(Pexp_ident (mkrhs $1 1)) }
@@ -1303,6 +1299,8 @@ pattern:
{ expecting 3 "pattern" }
| LAZY simple_pattern
{ mkpat(Ppat_lazy $2) }
+ | pattern attribute
+ { mkpat(Ppat_attribute($1, $2)) }
;
simple_pattern:
val_ident %prec below_EQUAL
@@ -1349,6 +1347,8 @@ simple_pattern:
{ mkpat(Ppat_constraint(mkpat(Ppat_unpack (mkrhs $3 3)),ghtyp(Ptyp_package $5))) }
| LPAREN MODULE UIDENT COLON package_type error
{ unclosed "(" 1 ")" 6 }
+ | extension
+ { mkpat(Ppat_extension $1) }
;
pattern_comma_list:
@@ -1900,4 +1900,8 @@ with_attribute:
extension:
LPARENCOLON LIDENT opt_expr RPAREN { ($2, $3) }
;
+opt_expr:
+ expr { $1 }
+ | { ghunit () }
+;
%%
diff --git a/parsing/parsetree.mli b/parsing/parsetree.mli
index f1cd345fa..b7f80fe9d 100644
--- a/parsing/parsetree.mli
+++ b/parsing/parsetree.mli
@@ -87,6 +87,8 @@ and pattern_desc =
| Ppat_type of Longident.t loc
| Ppat_lazy of pattern
| Ppat_unpack of string loc
+ | Ppat_attribute of (pattern * attribute)
+ | Ppat_extension of extension
and expression =
{ pexp_desc: expression_desc;
diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml
index 08cd939fb..bb5cbeea6 100644
--- a/parsing/pprintast.ml
+++ b/parsing/pprintast.ml
@@ -108,6 +108,7 @@ let rec is_irrefut_patt x =
| Ppat_or (l,r) -> is_irrefut_patt l || is_irrefut_patt r
| Ppat_record (ls,_) -> List.for_all (fun (_,x) -> is_irrefut_patt x) ls
| Ppat_lazy p -> is_irrefut_patt p
+ | Ppat_extension _ | Ppat_attribute _ -> assert false
| Ppat_constant _ | Ppat_construct _ | Ppat_variant _ | Ppat_array _ | Ppat_type _-> false (*conservative*)
class printer ()= object(self:'self)
val pipe = false
diff --git a/parsing/printast.ml b/parsing/printast.ml
index d4dc340d8..31d23eb6d 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -226,6 +226,13 @@ and pattern i ppf x =
longident_loc i ppf li
| Ppat_unpack s ->
line i ppf "Ppat_unpack %a\n" fmt_string_loc s;
+ | Ppat_attribute (body, (s, arg)) ->
+ line i ppf "Ppat_attribute \"%s\"\n" s;
+ expression i ppf arg;
+ pattern i ppf body
+ | Ppat_extension (s, arg) ->
+ line i ppf "Ppat_extension \"%s\"\n" s;
+ expression i ppf arg
and expression i ppf x =
line i ppf "expression %a\n" fmt_location x.pexp_loc;
diff --git a/tools/depend.ml b/tools/depend.ml
index 2f6d20f08..8a964bda1 100644
--- a/tools/depend.ml
+++ b/tools/depend.ml
@@ -124,6 +124,8 @@ let rec add_pattern bv pat =
| Ppat_type li -> add bv li
| Ppat_lazy p -> add_pattern bv p
| Ppat_unpack id -> pattern_bv := StringSet.add id.txt !pattern_bv
+ | Ppat_attribute (p, _) -> add_pattern bv p
+ | Ppat_extension _ -> ()
let add_pattern bv pat =
pattern_bv := bv;
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 6bd13007e..53c2f760a 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -1099,6 +1099,10 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
let (path, p,ty) = build_or_pat !env loc lid.txt in
unify_pat_types loc !env ty expected_ty;
{ p with pat_extra = (Tpat_type (path, lid), loc) :: p.pat_extra }
+ | Ppat_attribute (p, _attrs) ->
+ type_pat p expected_ty
+ | Ppat_extension (s, _arg) ->
+ raise (Error (loc, !env, Extension s))
let type_pat ?(allow_existentials=false) ?constrs ?labels
?(lev=get_current_level()) env sp expected_ty =
@@ -1699,11 +1703,13 @@ let contains_variant_either ty =
let iter_ppat f p =
match p.ppat_desc with
| Ppat_any | Ppat_var _ | Ppat_constant _
+ | Ppat_extension _
| Ppat_type _ | Ppat_unpack _ -> ()
| Ppat_array pats -> List.iter f pats
| Ppat_or (p1,p2) -> f p1; f p2
| Ppat_variant (_, arg) | Ppat_construct (_, arg, _) -> may f arg
| Ppat_tuple lst -> List.iter f lst
+ | Ppat_attribute (p, _)
| Ppat_alias (p,_) | Ppat_constraint (p,_) | Ppat_lazy p -> f p
| Ppat_record (args, flag) -> List.iter (fun (_,p) -> f p) args