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

clean-up of universal and recursive types 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4912 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Jacques Garrigue 2002-06-10 02:39:35 +00:00
parent 6b8a377e3b
commit d13715755c
5 changed files with 34 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
stdlib/sys.ml
View File

@ -78,4 +78,4 @@ let catch_break on =
(* OCaml version string, moved from utils/config.mlp.
Must be in the format described in sys.mli. *)
let ocaml_version = "3.04+13 (2002-06-05)"
let ocaml_version = "3.04+14 (2002-06-10)"

2
typing/ctype.mli
View File

@ -142,7 +142,7 @@ val filter_method: Env.t -> string -> private_flag -> type_expr -> type_expr
(* A special case of unification (with {m : 'a; 'b}). *)
val check_filter_method: Env.t -> string -> private_flag -> type_expr -> unit
(* A special case of unification (with {m : 'a; 'b}), returning unit. *)
val occur: Env.t -> type_expr -> type_expr -> unit
val deep_occur: type_expr -> type_expr -> bool
val filter_self_method:
Env.t -> string -> private_flag -> (Ident.t * type_expr) Meths.t ref ->
type_expr -> Ident.t * type_expr

14
typing/printtyp.ml
View File

@ -534,15 +534,11 @@ let prepare_class_field ty =
let rec prepare_class_type params = function
| Tcty_constr (p, tyl, cty) ->
let sty = Ctype.self_type cty in
begin try
if List.memq sty !visited_objects
|| List.exists (fun ty -> (repr ty).desc <> Tvar) params
then raise (Unify []);
List.iter (occur Env.empty sty) tyl;
List.iter mark_loops tyl
with Unify _ ->
prepare_class_type params cty
end
if List.memq sty !visited_objects
|| List.exists (fun ty -> (repr ty).desc <> Tvar) params
|| List.exists (deep_occur sty) tyl
then prepare_class_type params cty
else List.iter mark_loops tyl
| Tcty_signature sign ->
let sty = repr sign.cty_self in
(* Self may have a name *)

2
typing/typecore.ml
View File

@ -695,7 +695,7 @@ let rec type_approx env sexp =
(* List labels in a function type, and whether return type is a variable *)
let rec list_labels_aux env visited ls ty_fun =
let ty = expand_head env ty_fun in
if !Clflags.recursive_types && List.memq ty visited then
if List.memq ty visited then
List.rev ls, false
else match ty.desc with
Tarrow (l, _, ty_res, _) ->

52
typing/typetexp.ml
View File

@ -241,9 +241,9 @@ let rec transl_type env policy rowvar styp =
present;
let bound = ref row.row_bound in
let fixed = rowvar <> None || policy = Univars in
let static = List.length row.row_fields = 1 in
let single = List.length row.row_fields = 1 in
let fields =
if static then row.row_fields else
if single then row.row_fields else
List.map
(fun (l,f) -> l,
if List.mem l present then f else
@ -256,22 +256,17 @@ let rec transl_type env policy rowvar styp =
| _ -> f)
row.row_fields
in
let row = { row_closed = true;
row_fields = fields;
row_bound = !bound;
row_name = Some (path, args);
row_fixed = fixed;
row_more = match rowvar with
Some v ->
if static then
raise(Error(styp.ptyp_loc,
No_row_variable "variant "));
v
| None ->
if static then newty Tnil else
if policy = Univars then new_pre_univar ()
else newvar () }
in newty (Tvariant row)
let row = { row_closed = true; row_fields = fields;
row_bound = !bound; row_name = Some (path, args);
row_fixed = fixed; row_more = newvar () } in
let static = Btype.static_row row in
let row =
if static then row else
{ row with row_more = match rowvar with Some v -> v
| None ->
if policy = Univars then new_pre_univar ()
else newvar () } in
newty (Tvariant row)
| Tobject (fi, _) ->
let _, tv = flatten_fields fi in
if policy = Univars then pre_univars := tv :: !pre_univars;
@ -335,10 +330,12 @@ let rec transl_type env policy rowvar styp =
instance t
end
| Ptyp_variant(fields, closed, present) ->
if rowvar <> None && present = None && closed then
raise (Error(styp.ptyp_loc, No_row_variable "variant "));
let bound = ref [] and name = ref None in
let fixed = rowvar <> None || policy = Univars in
let mkfield l f =
newty (Tvariant {row_fields=[l,f]; row_more=newty Tnil;
newty (Tvariant {row_fields=[l,f]; row_more=newvar();
row_bound=[]; row_closed=true;
row_fixed=fixed; row_name=None}) in
let add_typed_field loc l f fields =
@ -429,14 +426,9 @@ let rec transl_type env policy rowvar styp =
row_fixed = fixed; row_name = !name } in
let static = Btype.static_row row in
let row =
{ row with row_more =
match rowvar with
Some v ->
if static then
raise(Error(styp.ptyp_loc, No_row_variable "variant "));
v
if static then row else
{ row with row_more = match rowvar with Some v -> v
| None ->
if static then newty Tnil else
if policy = Univars then new_pre_univar () else
if policy = Fixed && not static then
raise(Error(styp.ptyp_loc, Unbound_type_variable "[..]"))
@ -452,6 +444,7 @@ let rec transl_type env policy rowvar styp =
univars := new_univars @ !univars;
let ty = transl_type env policy None st in
univars := old_univars;
let ty_list = List.filter (fun tu -> deep_occur (repr tu) ty) ty_list in
newty (Tpoly(ty, ty_list))
and transl_fields env policy rowvar =
@ -493,6 +486,13 @@ let transl_simple_type_univars env styp =
[] !pre_univars
in
pre_univars := [];
(* add this code to allow reuse of variable names
Tbl.iter
(fun name ty ->
if List.exists (fun tu -> repr ty == repr tu) univs
then type_variables := Tbl.remove name !type_variables)
!type_variables;
*)
instance (Btype.newgenty (Tpoly (typ, univs)))
let transl_simple_type_delayed env styp =