diff --git a/typing/ctype.ml b/typing/ctype.ml index f2acdd916..cbd5242f2 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -1314,33 +1314,6 @@ let rec non_recursive_abbrev visited env ty0 ty = let non_recursive_abbrev = non_recursive_abbrev (ref []) - -(* GAH: same as above, but for local constraints - ask garrigue about this *) -let rec local_non_recursive_abbrev visited env p ty = - let ty = repr ty in - if not (List.memq ty !visited) then begin - visited := ty :: !visited; - match ty.desc with - Tconstr(p', args, abbrev) -> - if Path.same p p' then raise Recursive_abbrev; - begin try - local_non_recursive_abbrev visited env p (try_expand_once_opt env ty) - with Cannot_expand -> - if !Clflags.recursive_types then () else - iter_type_expr (local_non_recursive_abbrev visited env p) ty - end - | Tobject _ | Tvariant _ -> - () - | _ -> - if !Clflags.recursive_types then () else - iter_type_expr (local_non_recursive_abbrev visited env p) ty - end - -let local_non_recursive_abbrev = local_non_recursive_abbrev (ref []) - - - let correct_abbrev env path params ty = check_abbrev_env env; let ty0 = newgenvar () in @@ -1399,6 +1372,31 @@ let occur env ty0 ty = raise (match exn with Occur -> Unify [] | _ -> exn) +let rec local_non_recursive_abbrev visited env p ty = + let ty = repr ty in + if not (List.memq ty !visited) then begin + visited := ty :: !visited; + match ty.desc with + Tconstr(p', args, abbrev) -> + if Path.same p p' then raise Recursive_abbrev; + begin try + local_non_recursive_abbrev visited env p (try_expand_once_opt env ty) + with Cannot_expand -> + if !Clflags.recursive_types then () else + iter_type_expr (local_non_recursive_abbrev visited env p) ty + end + | Tobject _ | Tvariant _ -> + () + | _ -> + if !Clflags.recursive_types then () else + iter_type_expr (local_non_recursive_abbrev visited env p) ty + end + +let local_non_recursive_abbrev = local_non_recursive_abbrev (ref []) + + + + (*****************************) (* Polymorphic Unification *) (*****************************) diff --git a/typing/parmatch.ml b/typing/parmatch.ml index 1f006b2e7..88565c5e9 100644 --- a/typing/parmatch.ml +++ b/typing/parmatch.ml @@ -1810,7 +1810,7 @@ let generate_all (env:Env.t) : pattern -> pattern list = | Tconstr (path,_,_) -> Env.find_type path tenv | _ -> fatal_error "Parmatch.get_type_descr" in - let mem pred elt = +(* let mem pred elt = let rec loop = function | [] -> false @@ -1819,7 +1819,6 @@ let generate_all (env:Env.t) : pattern -> pattern list = in loop in - let uniquefy pred = let rec loop sofar = function @@ -1831,7 +1830,7 @@ let generate_all (env:Env.t) : pattern -> pattern list = in let type_equivalence (_,t) (_,t') = Ctype.equal Env.empty true [t] [t'] - in + in*) let rec loop p = match p.ppat_desc with | Ppat_any | Ppat_var _ | Ppat_constant _ | Ppat_type _ | Ppat_unpack _ -> @@ -1858,7 +1857,7 @@ let generate_all (env:Env.t) : pattern -> pattern list = 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 +(* let constrs = uniquefy type_equivalence constrs in *) List.map fst constrs | _ -> [] end in