summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--parsing/printast.ml3
-rw-r--r--parsing/printast.mli1
-rw-r--r--typing/btype.ml5
-rw-r--r--typing/ctype.ml226
-rw-r--r--typing/ctype.mli4
-rw-r--r--typing/parmatch.ml28
-rw-r--r--typing/typecore.ml38
-rw-r--r--typing/typecore.mli2
-rw-r--r--typing/typedecl.ml14
-rw-r--r--typing/typetexp.ml20
10 files changed, 10 insertions, 331 deletions
diff --git a/parsing/printast.ml b/parsing/printast.ml
index 992b5e0c8..821f76096 100644
--- a/parsing/printast.ml
+++ b/parsing/printast.ml
@@ -753,6 +753,3 @@ let top_phrase ppf x = toplevel_phrase 0 ppf x;;
let print_expression = expression 0 ;;
let print_pattern = pattern 0 ;;
-
-let print_core_type = core_type 0 ;;
-
diff --git a/parsing/printast.mli b/parsing/printast.mli
index 307b5a208..4bf4635cc 100644
--- a/parsing/printast.mli
+++ b/parsing/printast.mli
@@ -20,4 +20,3 @@ val implementation : formatter -> structure_item list -> unit;;
val top_phrase : formatter -> toplevel_phrase -> unit;;
val print_expression : formatter -> expression -> unit;;
val print_pattern : formatter -> pattern -> unit;;
-val print_core_type : formatter -> core_type -> unit;;
diff --git a/typing/btype.ml b/typing/btype.ml
index 302ba89cd..c9ed577ac 100644
--- a/typing/btype.ml
+++ b/typing/btype.ml
@@ -197,11 +197,6 @@ let iter_type_expr f ty =
| Tpoly (ty, tyl) -> f ty; List.iter f tyl
| Tpackage (_, _, l) -> List.iter f l
-
-
-
-
-
let rec iter_abbrev f = function
Mnil -> ()
| Mcons(_, _, ty, ty', rem) -> f ty; f ty'; iter_abbrev f rem
diff --git a/typing/ctype.ml b/typing/ctype.ml
index 17e084542..0108320ed 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -10,180 +10,6 @@
(* *)
(***********************************************************************)
-
-module Printtyp_ =
-struct
-
-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
-
-
(* $Id$ *)
(* Operations on core types *)
@@ -254,11 +80,6 @@ open Btype
[unify].
*)
-
-
-
-
-
(**** Errors ****)
exception Unify of (type_expr * type_expr) list
@@ -1068,7 +889,7 @@ let instance_constructor ?(in_pattern=None) cstr = (* GAH : how the blazes does
let ty = newvar () in
Ident.set_current_time ty.level;
let (id, new_env) = Env.enter_type (get_new_abstract_name ()) decl !env in
- let to_unify = newty2 generic_level (Tconstr (Path.Pident id,[],ref Mnil)) in (* GAH : ask garrigue, what in the world is an abbrev_memo ?? *)
+ let to_unify = newty2 existential.level (Tconstr (Path.Pident id,[],ref Mnil)) in (* GAH : ask garrigue, what in the world is an abbrev_memo ?? *)
link_type existential to_unify
in
List.iter process existentials end;
@@ -1800,17 +1621,6 @@ let reify env t = (* GAH: ask garrigue; is this right? *)
in
iter_type_expr iterator (full_expand !env t)
-
-let print_path_names t1 t2 =
- match t1.desc,t2.desc with
- | Tconstr (p1,[],_),Tconstr (p2,[],_) ->
- begin match p1,p2 with
- | Path.Pident q1,Path.Pident q2 ->
- Printf.printf "different paths but %s %s\n%!" (Ident.name q1) (Ident.name q2)
- | _ -> print_endline "not idents"
- end
- | _ -> print_endline "not constructors"
-
let unify_eq_set = Btype.TypeHash.create 10
let add_type_equality t1 t2 =
@@ -1948,35 +1758,14 @@ and unify3 env t1 t1' t2 t2' =
| _ -> ()
end
| (Ttuple tl1, Ttuple tl2) ->
-
unify_list env tl1 tl2
| (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _)) when Path.same p1 p2 ->
-
unify_list env tl1 tl2
-
| _,(Tconstr (Path.Pident p,[],_)) when not !pattern_unification -> (* GAH : must be abstract or else it would have been expanded, ask garrigue *)
raise (Unify [])
-
-(* let _,td = Env.lookup_type (Longident.parse (Ident.name p)) !env in*)
-(* let td = Env.lookup_type (Ident.name "t") !env in
- (match td.type_manifest with
- | None ->
- print_endline "no manifest 1"
- | Some ty ->
- print_endline (string_of_bool (ty == t1));
- print_endline "have a manifest 1");
-*)
-
-(* ignore(Env.find_type_expansion (Path.Pident p) !env);*)
-
-
-
| Tconstr (p1,[],_),Tconstr (p2,[],_) when Path.same p1 p2 ->
print_endline "same path yo";
-
-
(* GAH : must be abstract or else it would have been expanded, ask garrigue *)
-
| (Tconstr (Path.Pident p,[],_)),_ when !pattern_unification -> (* GAH : must be abstract or else it would have been expanded, ask garrigue *)
let t2 = copy t2 in
reify env t2 ;
@@ -2266,19 +2055,6 @@ and unify_row_field env fixed1 fixed2 more l f1 f2 =
;;
-
-let bare_tunivar x = (* GAH: ask garrigue about this. is it correct *)
- match (repr x).desc with
- | Tunivar -> true
- | _ -> false
-
-let bare_tvar x = (* GAH: ask garrigue about this. is it correct *)
- match (repr x).desc with
- | Tvar -> true
- | _ -> false
-
-
-
let unify env ty1 ty2 =
try
unify env ty1 ty2
diff --git a/typing/ctype.mli b/typing/ctype.mli
index eef51699a..9fbd925f4 100644
--- a/typing/ctype.mli
+++ b/typing/ctype.mli
@@ -245,10 +245,6 @@ val arity: type_expr -> int
val collapse_conj_params: Env.t -> type_expr list -> unit
(* Collapse conjunctive types in class parameters *)
-val set_unification_type : [`Pattern | `Expression] -> unit
-val get_unification_type : unit -> [`Pattern | `Expression]
-val bare_tunivar : type_expr -> bool
-val bare_tvar : type_expr -> bool
val set_gadt_pattern_level : unit -> unit
val get_gadt_pattern_level : unit -> int
diff --git a/typing/parmatch.ml b/typing/parmatch.ml
index 9cafac4a4..93218b673 100644
--- a/typing/parmatch.ml
+++ b/typing/parmatch.ml
@@ -263,7 +263,6 @@ let pretty_pat_now p =
top_pretty Format.str_formatter p ;
prerr_endline (Format.flush_str_formatter ())
-
let prerr_pat v =
top_pretty str_formatter v ;
prerr_string (flush_str_formatter ())
@@ -988,27 +987,6 @@ let rec try_many f = function
| r -> r
end
-(*let pretty_pss pss =
- let print_lst ppf lst =
- fprintf ppf "{";
- List.iter
- (top_pretty ppf)
- lst;
- fprintf ppf "}";
- in
- let print_lstlst ppf lstlst =
- fprintf ppf "[";
- List.iter
- (print_lst ppf)
- lstlst;
- fprintf ppf "]"
- in
- Format.fprintf Format.str_formatter "[%a]%!"
- print_lstlst pss;
- print_endline (Format.flush_str_formatter ())*)
-
-
-
let rec exhaust ext pss n =
match pss with
| [] -> Rsome (omegas n)
@@ -1047,8 +1025,7 @@ let rec exhaust ext pss n =
Essentially :
* D exhaustive => pss exhaustive
* D non-exhaustive => we have a non-filtered value
- *)
-
+ *)
let r = exhaust ext (filter_extra pss) (n-1) in
match r with
| Rnone -> Rnone
@@ -1126,9 +1103,6 @@ let pretty_pat p =
top_pretty Format.str_formatter p ;
prerr_string (Format.flush_str_formatter ())
-
-
-
type matrix = pattern list list
let pretty_line ps =
diff --git a/typing/typecore.ml b/typing/typecore.ml
index bc2e51a90..7aa752556 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -25,8 +25,6 @@ open Ctype
type error =
Polymorphic_label of Longident.t
| Constructor_arity_mismatch of Longident.t * int * int
- | Constructor_inhabit_tunivar of type_expr * Longident.t
- | Constant_inhabit_tunivar of type_expr
| Label_mismatch of Longident.t * (type_expr * type_expr) list
| Pattern_type_clash of (type_expr * type_expr) list
| Multiply_bound_variable of string
@@ -72,8 +70,6 @@ let type_module =
let type_open =
ref (fun _ -> assert false)
-
-
(* Forward declaration, to be filled in by Typeclass.class_structure *)
let type_object =
ref (fun env s -> assert false :
@@ -144,7 +140,6 @@ let rec extract_label_names sexp env ty =
(* Typing of patterns *)
-
let unify_pat_types loc env ty ty' =
try
unify env ty ty'
@@ -154,7 +149,6 @@ let unify_pat_types loc env ty ty' =
| Tags(l1,l2) ->
raise(Typetexp.Error(loc, Typetexp.Variant_tags (l1, l2)))
-
let unify_pat_types_gadt loc env ty ty' =
try
unify_gadt env ty ty'
@@ -421,7 +415,6 @@ let check_recordpat_labels loc lbl_pat_list closed =
(* Typing of patterns *)
let rec type_pat (env:Env.t ref) sp expected_ty =
-
let loc = sp.ppat_loc in
match sp.ppat_desc with
|Ppat_any ->
@@ -431,9 +424,7 @@ let rec type_pat (env:Env.t ref) sp expected_ty =
pat_type = expected_ty;
pat_env = !env }
| Ppat_var name ->
-
let id = enter_variable loc name expected_ty in (* GAH : what does this do? *)
-
rp {
pat_desc = Tpat_var id;
pat_loc = loc;
@@ -472,8 +463,6 @@ let rec type_pat (env:Env.t ref) sp expected_ty =
pat_type = q.pat_type;
pat_env = !env }
|Ppat_constant cst ->
- if bare_tunivar expected_ty then
- raise (Error(loc,Constant_inhabit_tunivar(expected_ty)));
unify_pat_types loc !env expected_ty (type_constant cst);
rp {
pat_desc = Tpat_constant cst;
@@ -626,7 +615,6 @@ let add_pattern_variables env =
)
pv env
-
let type_pattern env spat scope expected_ty =
reset_pattern scope;
set_gadt_pattern_level ();
@@ -635,7 +623,6 @@ let type_pattern env spat scope expected_ty =
let new_env = add_pattern_variables !new_env in
(pat, new_env, get_ref pattern_force)
-
let type_pattern_list env spatl scope expected_tys =
reset_pattern scope;
set_gadt_pattern_level ();
@@ -691,7 +678,7 @@ let type_self_pattern cl_num privty val_env met_env par_env spat =
let vars = ref Vars.empty in
let pv = !pattern_variables in
pattern_variables := [];
- let ((val_env:Env.t), met_env, par_env) =
+ let (val_env, met_env, par_env) =
List.fold_right
(fun (id, ty, _loc) (val_env, met_env, par_env) ->
(Env.add_value id {val_type = ty; val_kind = Val_unbound} val_env,
@@ -1091,7 +1078,6 @@ let unify_exp env exp expected_ty =
raise(Typetexp.Error(exp.exp_loc, Typetexp.Variant_tags (l1, l2)))
let rec type_exp env sexp =
-
let loc = sexp.pexp_loc in
match sexp.pexp_desc with
| Pexp_ident lid ->
@@ -1154,7 +1140,6 @@ let rec type_exp env sexp =
exp_type = body.exp_type;
exp_env = env }
| Pexp_function _ -> (* defined in type_expect *)
-
type_expect env sexp (newvar())
| Pexp_apply(sfunct, sargs) ->
begin_def (); (* one more level for non-returning functions *)
@@ -2025,7 +2010,6 @@ and type_construct env loc lid sarg explicit_arity ty_expected =
Some constructs are treated specially to provide better error messages. *)
and type_expect ?in_function env sexp ty_expected =
-
let loc = sexp.pexp_loc in
match sexp.pexp_desc with
Pexp_constant(Const_string s as cst) ->
@@ -2119,7 +2103,6 @@ and type_expect ?in_function env sexp ty_expected =
raise(Error(loc_fun,
Too_many_arguments (in_function <> None, ty_fun)))
in
-
let ty_arg =
if is_optional l then
let tv = newvar() in
@@ -2228,8 +2211,6 @@ and type_statement env sexp =
(* Typing of match cases *)
-
-
and type_cases ?in_function env ty_arg ty_res partial_loc caselist =
(* let ty_arg' = newvar () in *) (* GAH : must ask garrigue about this *)
let pattern_force = ref [] in
@@ -2264,8 +2245,6 @@ and type_cases ?in_function env ty_arg ty_res partial_loc caselist =
List.iter (iter_pattern finalize_variant) patl
end;
(* `Contaminating' unifications start here *)
-
-
List.iter (fun f -> f()) !pattern_force;
(* begin match pat_env_list with [] -> ()
@@ -2285,13 +2264,6 @@ and type_cases ?in_function env ty_arg ty_res partial_loc caselist =
| None -> Partial
| Some partial_loc ->
Parmatch.check_partial partial_loc cases env
-(* begin match r with
- | Partial ->
- List.iter (fun (p,_) -> Format.fprintf Format.std_formatter "p description: %a \np type:%a\n%!" Parmatch.top_pretty p Printtyp.raw_type_expr p.pat_type) cases
- | _ ->
- () end;
- r*)
-
in
add_delayed_check (fun () -> Parmatch.check_unused env cases);
cases, partial
@@ -2398,14 +2370,6 @@ let report_error ppf = function
"@[The constructor %a@ expects %i argument(s),@ \
but is applied here to %i argument(s)@]"
longident lid expected provided
- | Constructor_inhabit_tunivar(t,lid) ->
- fprintf ppf
- "The constructor %a does not inhabit the univarsal type %a"
- longident lid type_scheme t
- | Constant_inhabit_tunivar t ->
- fprintf ppf
- "This constant does not inhabit the type universal type %a"
- type_scheme t
| Label_mismatch(lid, trace) ->
report_unification_error ppf trace
(function ppf ->
diff --git a/typing/typecore.mli b/typing/typecore.mli
index 5114d3429..3fb90ff34 100644
--- a/typing/typecore.mli
+++ b/typing/typecore.mli
@@ -65,8 +65,6 @@ val self_coercion : (Path.t * Location.t list ref) list ref
type error =
Polymorphic_label of Longident.t
| Constructor_arity_mismatch of Longident.t * int * int
- | Constructor_inhabit_tunivar of type_expr * Longident.t
- | Constant_inhabit_tunivar of type_expr
| Label_mismatch of Longident.t * (type_expr * type_expr) list
| Pattern_type_clash of (type_expr * type_expr) list
| Multiply_bound_variable of string
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index 663641623..d349f0879 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -121,9 +121,6 @@ module StringSet =
let compare = compare
end)
-
-
-
let transl_declaration env (name, sdecl) id =
let param_counter = ref 0 in
(* Bind type parameters *)
@@ -162,7 +159,6 @@ let transl_declaration env (name, sdecl) id =
raise(Error(sdecl.ptype_loc, Duplicate_constructor name));
all_constrs := StringSet.add name !all_constrs)
cstrs;
-
if List.length (List.filter (fun (_, args, _, _) -> args <> []) cstrs) (* GAH: MIGHT BE WRONG *)
> (Config.max_tag + 1) then
raise(Error(sdecl.ptype_loc, Too_many_constructors));
@@ -218,10 +214,6 @@ let transl_declaration env (name, sdecl) id =
end;
type_variance = List.map (fun _ -> true, true, true) params;
} in
-
-
-
-
(* Check constraints *)
List.iter
(fun (ty, ty', loc) ->
@@ -273,7 +265,6 @@ module TypeSet =
end)
let rec check_constraints_rec env loc visited ty =
-
let ty = Ctype.repr ty in
if TypeSet.mem ty !visited then () else begin
visited := TypeSet.add ty !visited;
@@ -312,7 +303,6 @@ let check_constraints env (_, sdecl) (_, decl) =
(fun sty ty ->
check_constraints_rec env sty.ptyp_loc visited ty)
styl tyl;
-
(* GAH : ask garrigue how to do the following: *)
match sret_type_opt,ret_type_opt with
| Some sr,Some r ->
@@ -659,7 +649,6 @@ let rec compute_variance_fixpoint env decls required variances =
(fun (id, decl) req -> if not (is_sharp id) then
ignore (compute_variance_decl new_env true decl req))
new_decls required;
-
new_decls, new_env
end
@@ -727,8 +716,6 @@ let name_recursion sdecl id decl =
else decl
| _ -> decl
-
-
(* Translate a set of mutually recursive type declarations *)
let transl_type_decl env name_sdecl_list =
(* Add dummy types for fixed rows *)
@@ -802,7 +789,6 @@ let transl_type_decl env name_sdecl_list =
List.map (fun (_, sdecl) -> sdecl.ptype_variance, sdecl.ptype_loc)
name_sdecl_list
in
-
let final_decls, final_env =
compute_variance_fixpoint env decls required (List.map init_variance decls)
in
diff --git a/typing/typetexp.ml b/typing/typetexp.ml
index 566d68dca..ca422d49a 100644
--- a/typing/typetexp.ml
+++ b/typing/typetexp.ml
@@ -234,7 +234,7 @@ let rec transl_type env policy styp =
begin try
Ctype.enforce_constraints env constr
with Unify trace ->
- (print_endline "another mismatch from trans_type"; raise (Error(styp.ptyp_loc, Type_mismatch trace)))
+ raise (Error(styp.ptyp_loc, Type_mismatch trace))
end;
constr
| Ptyp_object fields ->
@@ -276,7 +276,7 @@ let rec transl_type env policy styp =
List.iter2
(fun (sty, ty) ty' ->
try unify_var env ty' ty with Unify trace ->
- (print_endline "yet another";raise (Error(sty.ptyp_loc, Type_mismatch (swap_list trace)))))
+ raise (Error(sty.ptyp_loc, Type_mismatch (swap_list trace))))
(List.combine stl args) params;
let ty =
try Ctype.expand_head env (newconstr path args)
@@ -495,11 +495,6 @@ and transl_fields env policy seen =
let ty2 = transl_fields env policy (s::seen) l in
newty (Tfield (s, Fpresent, ty1, ty2))
-
-
-
-
-
(* Make the rows "fixed" in this type, to make universal check easier *)
let rec make_fixed_univars ty =
let ty = repr ty in
@@ -538,12 +533,11 @@ let globalize_used_variables env fixed =
r := (loc, v, Tbl.find name !type_variables) :: !r
with Not_found ->
if fixed && (repr ty).desc = Tvar then
- begin
- raise(Error(loc, Unbound_type_variable ("'"^name)))
- end;
- let v2 = new_global_var () in
- r := (loc, v, v2) :: !r;
- type_variables := Tbl.add name v2 !type_variables)
+ raise(Error(loc, Unbound_type_variable ("'"^name)))
+ else
+ let v2 = new_global_var () in
+ r := (loc, v, v2) :: !r;
+ type_variables := Tbl.add name v2 !type_variables)
!used_variables;
used_variables := Tbl.empty;
fun () ->
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-19 03:05:43 +0000