Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added lookup of constructors by type in env.ml and specification of constructors types in Ppat_construct 

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/gadts@10736 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Jacques Le Normand 2010-10-21 07:53:39 +00:00
parent 61d816352c
commit 10f670297c
15 changed files with 77 additions and 242 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
parsing/parser.mly
View File

@ -123,7 +123,7 @@ let rec mktailexp = function
let rec mktailpat = function
[] ->
ghpat(Ppat_construct(Lident "[]", None, false))
ghpat(Ppat_construct(Lident "[]", None, false,None))
| p1 :: pl ->
let pat_pl = mktailpat pl in
let l = {loc_start = p1.ppat_loc.loc_start;
@ -131,7 +131,7 @@ let rec mktailpat = function
loc_ghost = true}
in
let arg = {ppat_desc = Ppat_tuple [p1; pat_pl]; ppat_loc = l} in
{ppat_desc = Ppat_construct(Lident "::", Some arg, false); ppat_loc = l}
{ppat_desc = Ppat_construct(Lident "::", Some arg, false,None); ppat_loc = l}
let ghstrexp e =
{ pstr_desc = Pstr_eval e; pstr_loc = {e.pexp_loc with loc_ghost = true} }
@ -1211,15 +1211,15 @@ pattern:
| pattern_comma_list %prec below_COMMA
{ mkpat(Ppat_tuple(List.rev $1)) }
| constr_longident pattern %prec prec_constr_appl
{ mkpat(Ppat_construct($1, Some $2, false)) }
{ mkpat(Ppat_construct($1, Some $2, false,None)) }
| name_tag pattern %prec prec_constr_appl
{ mkpat(Ppat_variant($1, Some $2)) }
| pattern COLONCOLON pattern
{ mkpat(Ppat_construct(Lident "::", Some(ghpat(Ppat_tuple[$1;$3])),
false)) }
false, None)) }
| LPAREN COLONCOLON RPAREN LPAREN pattern COMMA pattern RPAREN
{ mkpat(Ppat_construct(Lident "::", Some(ghpat(Ppat_tuple[$5;$7])),
false)) }
false, None)) }
| pattern BAR pattern
{ mkpat(Ppat_or($1, $3)) }
| LAZY simple_pattern
@ -1235,7 +1235,7 @@ simple_pattern:
| CHAR DOTDOT CHAR
{ mkrangepat $1 $3 }
| constr_longident
{ mkpat(Ppat_construct($1, None, false)) }
{ mkpat(Ppat_construct($1, None, false, None)) }
| name_tag
{ mkpat(Ppat_variant($1, None)) }
| SHARP type_longident

2
parsing/parsetree.mli
View File

@ -71,7 +71,7 @@ and pattern_desc =
| Ppat_alias of pattern * string
| Ppat_constant of constant
| Ppat_tuple of pattern list
| Ppat_construct of Longident.t * pattern option * bool
| Ppat_construct of Longident.t * pattern option * bool * Longident.t option
| Ppat_variant of label * pattern option
| Ppat_record of (Longident.t * pattern) list * closed_flag
| Ppat_array of pattern list

2
parsing/printast.ml
View File

@ -182,7 +182,7 @@ and pattern i ppf x =
| Ppat_tuple (l) ->
line i ppf "Ppat_tuple\n";
list i pattern ppf l;
| Ppat_construct (li, po, b) ->
| Ppat_construct (li, po, b, _) ->
line i ppf "Ppat_construct %a\n" fmt_longident li;
option i pattern ppf po;
bool i ppf b;

2
typing/btype.ml
View File

@ -315,7 +315,7 @@ let unmark_type_decl decl =
Type_abstract -> ()
| Type_generalized_variant cstrs ->
List.iter
(fun (c, tl,ret_type_opt) ->
(fun (c, tl, ret_type_opt) ->
List.iter unmark_type tl;
Misc.may unmark_type ret_type_opt)
cstrs

196
typing/ctype.ml
View File

@ -1,199 +1,3 @@
module Printtyp_ =
struct
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy and Jerome Vouillon, projet Cristal, INRIA Rocquencourt*)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Printing functions *)
open Misc
open Format
open Longident
open Path
open Asttypes
open Types
open Btype
open Outcometree
(* Print a long identifier *)
let rec longident ppf = function
| Lident s -> fprintf ppf "%s" s
| Ldot(p, s) -> fprintf ppf "%a.%s" longident p s
| Lapply(p1, p2) -> fprintf ppf "%a(%a)" longident p1 longident p2
(* Print an identifier *)
let unique_names = ref Ident.empty
let ident_name id =
try Ident.find_same id !unique_names with Not_found -> Ident.name id
let add_unique id =
try ignore (Ident.find_same id !unique_names)
with Not_found ->
unique_names := Ident.add id (Ident.unique_toplevel_name id) !unique_names
let ident ppf id = fprintf ppf "%s" (ident_name id)
(* Print a path *)
let ident_pervasive = Ident.create_persistent "Pervasives"
let rec tree_of_path = function
| Pident id ->
Oide_ident (ident_name id)
| Pdot(Pident id, s, pos) when Ident.same id ident_pervasive ->
Oide_ident s
| Pdot(p, s, pos) ->
Oide_dot (tree_of_path p, s)
| Papply(p1, p2) ->
Oide_apply (tree_of_path p1, tree_of_path p2)
let rec path ppf = function
| Pident id ->
ident ppf id
| Pdot(Pident id, s, pos) when Ident.same id ident_pervasive ->
fprintf ppf "%s" s
| Pdot(p, s, pos) ->
fprintf ppf "%a.%s" path p s
| Papply(p1, p2) ->
fprintf ppf "%a(%a)" path p1 path p2
(* Print a recursive annotation *)
let tree_of_rec = function
| Trec_not -> Orec_not
| Trec_first -> Orec_first
| Trec_next -> Orec_next
(* Print a raw type expression, with sharing *)
let raw_list pr ppf = function
[] -> fprintf ppf "[]"
| a :: l ->
fprintf ppf "@[<1>[%a%t]@]" pr a
(fun ppf -> List.iter (fun x -> fprintf ppf ";@,%a" pr x) l)
let rec safe_kind_repr v = function
Fvar {contents=Some k} ->
if List.memq k v then "Fvar loop" else
safe_kind_repr (k::v) k
| Fvar _ -> "Fvar None"
| Fpresent -> "Fpresent"
| Fabsent -> "Fabsent"
let rec safe_commu_repr v = function
Cok -> "Cok"
| Cunknown -> "Cunknown"
| Clink r ->
if List.memq r v then "Clink loop" else
safe_commu_repr (r::v) !r
let rec safe_repr v = function
{desc = Tlink t} when not (List.memq t v) ->
safe_repr (t::v) t
| t -> t
let rec list_of_memo = function
Mnil -> []
| Mcons (priv, p, t1, t2, rem) -> p :: list_of_memo rem
| Mlink rem -> list_of_memo !rem
let visited = ref []
let rec raw_type ppf ty =
let ty = safe_repr [] ty in
if List.memq ty !visited then fprintf ppf "{id=%d}" ty.id else begin
visited := ty :: !visited;
fprintf ppf "@[<1>{id=%d;level=%d;desc=@,%a}@]" ty.id ty.level
raw_type_desc ty.desc
end
and raw_type_list tl = raw_list raw_type tl
and raw_type_desc ppf = function
Tvar -> fprintf ppf "Tvar"
| Tarrow(l,t1,t2,c) ->
fprintf ppf "@[<hov1>Tarrow(%s,@,%a,@,%a,@,%s)@]"
l raw_type t1 raw_type t2
(safe_commu_repr [] c)
| Ttuple tl ->
fprintf ppf "@[<1>Ttuple@,%a@]" raw_type_list tl
| Tconstr (p, tl, abbrev) ->
fprintf ppf "@[<hov1>Tconstr(@,%a,@,%a,@,%a)@]" path p
raw_type_list tl
(raw_list path) (list_of_memo !abbrev)
| Tobject (t, nm) ->
fprintf ppf "@[<hov1>Tobject(@,%a,@,@[<1>ref%t@])@]" raw_type t
(fun ppf ->
match !nm with None -> fprintf ppf " None"
| Some(p,tl) ->
fprintf ppf "(Some(@,%a,@,%a))" path p raw_type_list tl)
| Tfield (f, k, t1, t2) ->
fprintf ppf "@[<hov1>Tfield(@,%s,@,%s,@,%a,@;<0 -1>%a)@]" f
(safe_kind_repr [] k)
raw_type t1 raw_type t2
| Tnil -> fprintf ppf "Tnil"
| Tlink t -> fprintf ppf "@[<1>Tlink@,%a@]" raw_type t
| Tsubst t -> fprintf ppf "@[<1>Tsubst@,%a@]" raw_type t
| Tunivar -> fprintf ppf "Tunivar"
| Tpoly (t, tl) ->
fprintf ppf "@[<hov1>Tpoly(@,%a,@,%a)@]"
raw_type t
raw_type_list tl
| Tvariant row ->
fprintf ppf
"@[<hov1>{@[%s@,%a;@]@ @[%s@,%a;@]@ %s%b;@ %s%b;@ @[<1>%s%t@]}@]"
"row_fields="
(raw_list (fun ppf (l, f) ->
fprintf ppf "@[%s,@ %a@]" l raw_field f))
row.row_fields
"row_more=" raw_type row.row_more
"row_closed=" row.row_closed
"row_fixed=" row.row_fixed
"row_name="
(fun ppf ->
match row.row_name with None -> fprintf ppf "None"
| Some(p,tl) ->
fprintf ppf "Some(@,%a,@,%a)" path p raw_type_list tl)
| Tpackage (p, _, tl) ->
fprintf ppf "@[<hov1>Tpackage(@,%a@,%a)@]" path p
raw_type_list tl
and raw_field ppf = function
Rpresent None -> fprintf ppf "Rpresent None"
| Rpresent (Some t) -> fprintf ppf "@[<1>Rpresent(Some@,%a)@]" raw_type t
| Reither (c,tl,m,e) ->
fprintf ppf "@[<hov1>Reither(%b,@,%a,@,%b,@,@[<1>ref%t@])@]" c
raw_type_list tl m
(fun ppf ->
match !e with None -> fprintf ppf " None"
| Some f -> fprintf ppf "@,@[<1>(%a)@]" raw_field f)
| Rabsent -> fprintf ppf "Rabsent"
let raw_type_expr ppf t =
visited := [];
raw_type ppf t;
visited := []
end
(***********************************************************************)
(* *)
(* Objective Caml *)

2
typing/ctype.mli
View File

@ -247,4 +247,4 @@ val collapse_conj_params: Env.t -> type_expr list -> unit
(* Collapse conjunctive types in class parameters *)
val get_current_level: unit -> int
val lid_of_path: string -> Path.t -> Longident.t

32
typing/env.ml
View File

@ -21,8 +21,6 @@ open Longident
open Path
open Types
let store_type_called = ref 0
type error =
Not_an_interface of string
| Corrupted_interface of string
@ -47,6 +45,7 @@ type t = {
values: (Path.t * value_description) Ident.tbl;
annotations: (Path.t * Annot.ident) Ident.tbl;
constrs: constructor_description Ident.tbl;
constrs_by_type: (string * constructor_description) list Ident.tbl;
labels: label_description Ident.tbl;
types: (Path.t * type_declaration) Ident.tbl;
modules: (Path.t * module_type) Ident.tbl;
@ -67,6 +66,7 @@ and structure_components = {
mutable comp_values: (string, (value_description * int)) Tbl.t;
mutable comp_annotations: (string, (Annot.ident * int)) Tbl.t;
mutable comp_constrs: (string, (constructor_description * int)) Tbl.t;
mutable comp_constrs_by_type: (string, ((string * constructor_description) list * int)) Tbl.t;
mutable comp_labels: (string, (label_description * int)) Tbl.t;
mutable comp_types: (string, (type_declaration * int)) Tbl.t;
mutable comp_modules: (string, (module_type Lazy.t * int)) Tbl.t;
@ -92,7 +92,7 @@ let empty = {
labels = Ident.empty; types = Ident.empty;
modules = Ident.empty; modtypes = Ident.empty;
components = Ident.empty; classes = Ident.empty;
cltypes = Ident.empty;
cltypes = Ident.empty; constrs_by_type = Ident.empty ;
summary = Env_empty }
let diff_keys is_local tbl1 tbl2 =
@ -116,6 +116,7 @@ let is_local_exn = function
let diff env1 env2 =
diff_keys is_local env1.values env2.values @
diff_keys is_local_exn env1.constrs env2.constrs @
(* diff_keys is_local env1.constrs_by_type env2.constrs_by_type @ (* GAH: not sure this is correct *) *)
diff_keys is_local env1.modules env2.modules @
diff_keys is_local env1.classes env2.classes
@ -429,6 +430,8 @@ let lookup_annot id e =
lookup (fun env -> env.annotations) (fun sc -> sc.comp_annotations) id e
and lookup_constructor =
lookup_simple (fun env -> env.constrs) (fun sc -> sc.comp_constrs)
and lookup_constructors_by_type =
lookup_simple (fun env -> env.constrs_by_type) (fun sc -> sc.comp_constrs_by_type)
and lookup_label =
lookup_simple (fun env -> env.labels) (fun sc -> sc.comp_labels)
and lookup_type =
@ -455,11 +458,9 @@ let rec scrape_modtype mty env =
(* Compute constructor descriptions *)
let constructors_of_type ty_path decl =
let handle_variants cstrs =
let ret = Datarepr.constructor_descrs
(Btype.newgenty (Tconstr(ty_path, decl.type_params, ref Mnil)))
cstrs decl.type_private
in
ret
Datarepr.constructor_descrs
(Btype.newgenty (Tconstr(ty_path, decl.type_params, ref Mnil)))
cstrs decl.type_private
in
match decl.type_kind with
| Type_generalized_variant cstrs -> handle_variants cstrs
@ -521,7 +522,7 @@ let rec components_of_module env sub path mty =
Tmty_signature sg ->
let c =
{ comp_values = Tbl.empty; comp_annotations = Tbl.empty;
comp_constrs = Tbl.empty;
comp_constrs = Tbl.empty; comp_constrs_by_type = Tbl.empty;
comp_labels = Tbl.empty; comp_types = Tbl.empty;
comp_modules = Tbl.empty; comp_modtypes = Tbl.empty;
comp_components = Tbl.empty; comp_classes = Tbl.empty;
@ -547,10 +548,15 @@ let rec components_of_module env sub path mty =
let decl' = Subst.type_declaration sub decl in
c.comp_types <-
Tbl.add (Ident.name id) (decl', nopos) c.comp_types;
let constructors = constructors_of_type path decl' in
let constrs_by_type =
Tbl.add (Ident.name id) (constructors,nopos) c.comp_constrs_by_type
in
c.comp_constrs_by_type <- constrs_by_type;
List.iter
(fun (name, descr) ->
c.comp_constrs <- Tbl.add name (descr, nopos) c.comp_constrs)
(constructors_of_type path decl');
constructors;
List.iter
(fun (name, descr) ->
c.comp_labels <- Tbl.add name (descr, nopos) c.comp_labels)
@ -601,7 +607,7 @@ let rec components_of_module env sub path mty =
| Tmty_ident p ->
Structure_comps {
comp_values = Tbl.empty; comp_annotations = Tbl.empty;
comp_constrs = Tbl.empty;
comp_constrs = Tbl.empty; comp_constrs_by_type = Tbl.empty;
comp_labels = Tbl.empty; comp_types = Tbl.empty;
comp_modules = Tbl.empty; comp_modtypes = Tbl.empty;
comp_components = Tbl.empty; comp_classes = Tbl.empty;
@ -621,13 +627,15 @@ and store_annot id path annot env =
else env
and store_type id path info env =
let constructors = constructors_of_type path info in
{ env with
constrs =
List.fold_right
(fun (name, descr) constrs ->
Ident.add (Ident.create name) descr constrs)
(constructors_of_type path info)
constructors
env.constrs;
constrs_by_type = Ident.add id constructors env.constrs_by_type;
labels =
List.fold_right
(fun (name, descr) labels ->

1
typing/env.mli
View File

@ -42,6 +42,7 @@ val find_modtype_expansion: Path.t -> t -> Types.module_type
val lookup_value: Longident.t -> t -> Path.t * value_description
val lookup_annot: Longident.t -> t -> Path.t * Annot.ident
val lookup_constructor: Longident.t -> t -> constructor_description
val lookup_constructors_by_type: Longident.t -> t -> (string * constructor_description) list
val lookup_label: Longident.t -> t -> label_description
val lookup_type: Longident.t -> t -> Path.t * type_declaration
val lookup_module: Longident.t -> t -> Path.t * module_type

27
typing/parmatch.ml
View File

@ -1743,7 +1743,6 @@ let filter_map f =
in
loop
(* given a set of patterns P it will generate
{ q : exists p in P and branches b in p such that q = P[C/b]
where C is a list of generalized constructors} *)
@ -1752,7 +1751,7 @@ let generate_all (env:Env.t) : pattern -> pattern list =
{ppat_desc = desc;
ppat_loc = Location.none}
in
let make_constr ty_res lid' (s,args,ret) =
let make_constr ty_res ty_res_lid lid' (s,args,ret) =
let original_constructor_name =
match lid' with
| Longident.Lident s -> s
@ -1786,14 +1785,14 @@ let generate_all (env:Env.t) : pattern -> pattern list =
in
match args with
| [] ->
Some (make_pat (Ppat_construct (lid,None,false)),ty_res)
Some (make_pat (Ppat_construct (lid,None,false,Some ty_res_lid)),ty_res)
| [x] ->
let arg = make_pat Ppat_any in
Some (make_pat (Ppat_construct (lid,Some arg,false)),ty_res)
Some (make_pat (Ppat_construct (lid,Some arg,false,Some ty_res_lid)),ty_res)
| _ ->
let arg = make_pat (Ppat_tuple (List.map (fun _ -> make_pat Ppat_any) args)) in
(* GAH: what is the third argument of Ppat_construct? In parser.mly it is always false *)
Some (make_pat (Ppat_construct (lid,Some arg,false)),ty_res)
Some (make_pat (Ppat_construct (lid,Some arg,false,Some ty_res_lid)),ty_res)
in
let rec select : 'a list list -> 'a list list =
function
@ -1833,11 +1832,11 @@ let generate_all (env:Env.t) : pattern -> pattern list =
let type_equivalence (_,t) (_,t') =
Ctype.equal Env.empty true [t] [t']
in
let rec loop (p:pattern) : pattern list =
let rec loop p =
match p.ppat_desc with
| Ppat_any | Ppat_var _ | Ppat_constant _ | Ppat_type _ ->
[make_pat Ppat_any]
| Ppat_construct (lid,arg,status) ->
| Ppat_construct (lid,arg,status,_) ->
let constr =
match lid with
| Longident.Ldot (Longident.Lident "*predef*", s) ->
@ -1850,18 +1849,24 @@ let generate_all (env:Env.t) : pattern -> pattern list =
let decl = get_type_descr ty_res env in
begin match decl.type_kind with
| Type_generalized_variant constr_list ->
let constrs = filter_map (make_constr ty_res lid) constr_list in
let lid_of_tyres =
match ty_res.desc with
| Tconstr(p,_,_) ->
Ctype.lid_of_path "" p
| _ -> assert false
in
let constrs = filter_map (make_constr ty_res lid_of_tyres lid) constr_list in
let constrs = uniquefy type_equivalence constrs in
List.map fst constrs
| _ -> [] end
in
begin match arg with
| None -> make_pat (Ppat_construct(lid,None,status)) :: other_constructors
| None -> make_pat (Ppat_construct(lid, None, status, None)) :: other_constructors
| Some p ->
let ps = loop p in
let current_constructors =
List.map
(fun p -> make_pat (Ppat_construct(lid,Some p,status))) ps
(fun p -> make_pat (Ppat_construct(lid, Some p, status, None))) ps
in
current_constructors @ other_constructors end
| Ppat_array pats ->
@ -1908,7 +1913,7 @@ let generate_all (env:Env.t) : pattern -> pattern list =
| x -> x
let check_partial loc env pred ps typed_ps =
let qs = generate_all ps env in
let qs = generate_all ps env in
let rec comparable q =
let rec loop =
function

2
typing/subst.ml
View File

@ -168,7 +168,7 @@ let type_declaration s decl =
Type_abstract -> Type_abstract
| Type_generalized_variant cstrs ->
Type_generalized_variant(
List.map (fun (n, args,ret_type_opt) ->
List.map (fun (n, args, ret_type_opt) ->
let ret_type_opt =
Misc.may_map (typexp s) ret_type_opt
in

4
typing/typeclass.ml
View File

@ -768,11 +768,11 @@ and class_expr cl_num val_env met_env scl =
[{ppat_loc = loc; ppat_desc =
Ppat_construct(Longident.(Ldot (Lident"*predef*", "Some")),
Some{ppat_loc = loc; ppat_desc = Ppat_var"*sth*"},
false)},
false, None)},
{pexp_loc = loc; pexp_desc = Pexp_ident(Longident.Lident"*sth*")};
{ppat_loc = loc; ppat_desc =
Ppat_construct(Longident.(Ldot (Lident"*predef*", "None")),
None, false)},
None, false, None)},
default] in
let smatch =
{pexp_loc = loc; pexp_desc =

31
typing/typecore.ml
View File

@ -502,9 +502,27 @@ let rec type_pat mode (env:Env.t ref) sp expected_ty =
pat_loc = loc;
pat_type = expected_ty;
pat_env = !env }
|Ppat_construct(lid, sarg, explicit_arity) ->
let constr = Typetexp.find_constructor !env loc lid in
let _ =
|Ppat_construct(lid, sarg, explicit_arity, type_lid) ->
let constr =
match type_lid with
| None ->
Typetexp.find_constructor !env loc lid
| Some type_lid ->
let constructor_name = Longident.last lid in
let constructors =
match type_lid with
| Longident.Ldot (Longident.Lident "*predef*", s) ->
Env.lookup_constructors_by_type (Longident.Lident s) Env.initial
| _ ->
Env.lookup_constructors_by_type type_lid !env
in
match List.filter (fun (n,_) -> n = constructor_name) constructors with
| [] -> raise Not_found
| [(_,c)] ->
c
| _ -> assert false
in
let () =
let (_, ty_res) = instance_constructor constr in
match (repr ty_res).desc with
| Tconstr(p,args,m) ->
@ -523,7 +541,8 @@ let rec type_pat mode (env:Env.t ref) sp expected_ty =
Location.prerr_warning sp.ppat_loc
Warnings.Wildcard_arg_to_constant_constr;
replicate_list sp constr.cstr_arity
| Some sp -> [sp] in
| Some sp -> [sp]
in
if List.length sargs <> constr.cstr_arity then
raise(Error(loc, Constructor_arity_mismatch(lid,
constr.cstr_arity, List.length sargs)));
@ -2124,12 +2143,12 @@ and type_expect ?in_function env sexp ty_expected =
Ppat_construct
(Longident.(Ldot (Lident "*predef*", "Some")),
Some {ppat_loc = default_loc; ppat_desc = Ppat_var "*sth*"},
false)},
false, None)},
{pexp_loc = default_loc;
pexp_desc = Pexp_ident(Longident.Lident "*sth*")};
{ppat_loc = default_loc;
ppat_desc = Ppat_construct
(Longident.(Ldot (Lident "*predef*", "None")), None, false)},
(Longident.(Ldot (Lident "*predef*", "None")), None, false, None)},
default;
] in
let smatch = {

3
typing/types.ml
View File

@ -154,10 +154,9 @@ type type_declaration =
and type_kind =
Type_abstract
(* | Type_variant of (string * type_expr list) list*)
| Type_record of
(string * mutable_flag * type_expr) list * record_representation
| Type_generalized_variant of (string * type_expr list * type_expr option) list
| Type_generalized_variant of (string * type_expr list * type_expr option) list
type exception_declaration = type_expr list

1
typing/types.mli
View File

@ -148,7 +148,6 @@ type type_declaration =
and type_kind =
Type_abstract
(* | Type_variant of (string * type_expr list) list*)
| Type_record of
(string * mutable_flag * type_expr) list * record_representation
| Type_generalized_variant of (string * type_expr list * type_expr option) list

2
typing/unused_var.ml
View File

@ -67,7 +67,7 @@ let rec get_vars ((vacc, asacc) as acc) p =
get_vars (vacc, ((v, p.ppat_loc, ref false) :: asacc)) pp
| Ppat_constant _ -> acc
| Ppat_tuple pl -> List.fold_left get_vars acc pl
| Ppat_construct (_, po, _) -> get_vars_option acc po
| Ppat_construct (_, po, _, _) -> get_vars_option acc po
| Ppat_variant (_, po) -> get_vars_option acc po
| Ppat_record (ipl, cls) ->
List.fold_left (fun a (_, p) -> get_vars a p) acc ipl