organize type.ml a bit

type.ml

@@ -312,6 +312,8 @@ and decision_tree = {
 	dt_is_complex : bool;
 }
 
+(* ======= General utility ======= *)
+
 let alloc_var =
 	let uid = ref 0 in
 	(fun n t -> incr uid; { v_name = n; v_type = t; v_id = !uid; v_capture = false; v_extra = None; v_meta = [] })
@@ -337,16 +339,6 @@ let tfun pl r = TFun (List.map (fun t -> "",false,t) pl,r)
 
 let fun_args l = List.map (fun (a,c,t) -> a, c <> None, t) l
 
-let field_name f =
-	match f with
-	| FAnon f | FInstance (_,f) | FStatic (_,f) | FClosure (_,f) -> f.cf_name
-	| FEnum (_,f) -> f.ef_name
-	| FDynamic n -> n
-
-let extract_field = function
-	| FAnon f | FInstance (_,f) | FStatic (_,f) | FClosure (_,f) -> Some f
-	| _ -> None
-
 let mk_class m path pos =
 	{
 		cl_path = path;
@@ -432,76 +424,6 @@ let t_infos t : tinfos =
 
 let t_path t = (t_infos t).mt_path
 
-let print_context() = ref []
-
-let is_closed a = !(a.a_status) <> Opened
-
-let rec s_type ctx t =
-	match t with
-	| TMono r ->
-		(match !r with
-		| None -> Printf.sprintf "Unknown<%d>" (try List.assq t (!ctx) with Not_found -> let n = List.length !ctx in ctx := (t,n) :: !ctx; n)
-		| Some t -> s_type ctx t)
-	| TEnum (e,tl) ->
-		Ast.s_type_path e.e_path ^ s_type_params ctx tl
-	| TInst (c,tl) ->
-		Ast.s_type_path c.cl_path ^ s_type_params ctx tl
-	| TType (t,tl) ->
-		Ast.s_type_path t.t_path ^ s_type_params ctx tl
-	| TAbstract (a,tl) ->
-		Ast.s_type_path a.a_path ^ s_type_params ctx tl
-	| TFun ([],t) ->
-		"Void -> " ^ s_fun ctx t false
-	| TFun (l,t) ->
-		String.concat " -> " (List.map (fun (s,b,t) ->
-			(if b then "?" else "") ^ (if s = "" then "" else s ^ " : ") ^ s_fun ctx t true
-		) l) ^ " -> " ^ s_fun ctx t false
-	| TAnon a ->
-		let fl = PMap.fold (fun f acc -> ((if Meta.has Meta.Optional f.cf_meta then " ?" else " ") ^ f.cf_name ^ " : " ^ s_type ctx f.cf_type) :: acc) a.a_fields [] in
-		"{" ^ (if not (is_closed a) then "+" else "") ^  String.concat "," fl ^ " }"
-	| TDynamic t2 ->
-		"Dynamic" ^ s_type_params ctx (if t == t2 then [] else [t2])
-	| TLazy f ->
-		s_type ctx (!f())
-
-and s_fun ctx t void =
-	match t with
-	| TFun _ ->
-		"(" ^ s_type ctx t ^ ")"
-	| TAbstract ({ a_path = ([],"Void") },[]) when void ->
-		"(" ^ s_type ctx t ^ ")"
-	| TMono r ->
-		(match !r with
-		| None -> s_type ctx t
-		| Some t -> s_fun ctx t void)
-	| TLazy f ->
-		s_fun ctx (!f()) void
-	| _ ->
-		s_type ctx t
-
-and s_type_params ctx = function
-	| [] -> ""
-	| l -> "<" ^ String.concat ", " (List.map (s_type ctx) l) ^ ">"
-
-let s_access is_read = function
-	| AccNormal -> "default"
-	| AccNo -> "null"
-	| AccNever -> "never"
-	| AccResolve -> "resolve"
-	| AccCall -> if is_read then "get" else "set"
-	| AccInline	-> "inline"
-	| AccRequire (n,_) -> "require " ^ n
-
-let s_kind = function
-	| Var { v_read = AccNormal; v_write = AccNormal } -> "var"
-	| Var v -> "(" ^ s_access true v.v_read ^ "," ^ s_access false v.v_write ^ ")"
-	| Method m ->
-		match m with
-		| MethNormal -> "method"
-		| MethDynamic -> "dynamic method"
-		| MethInline -> "inline method"
-		| MethMacro -> "macro method"
-
 let rec is_parent csup c =
 	if c == csup || List.exists (fun (i,_) -> is_parent csup i) c.cl_implements then
 		true
@@ -610,6 +532,9 @@ let apply_params cparams params t =
 	in
 	loop t
 
+let monomorphs eparams t =
+	apply_params eparams (List.map (fun _ -> mk_mono()) eparams) t
+
 let rec follow t =
 	match t with
 	| TMono r ->
@@ -675,6 +600,130 @@ let rec has_mono t = match t with
 	| TLazy r ->
 		has_mono (!r())
 
+(* ======= Field utility ======= *)
+
+let field_name f =
+	match f with
+	| FAnon f | FInstance (_,f) | FStatic (_,f) | FClosure (_,f) -> f.cf_name
+	| FEnum (_,f) -> f.ef_name
+	| FDynamic n -> n
+
+let extract_field = function
+	| FAnon f | FInstance (_,f) | FStatic (_,f) | FClosure (_,f) -> Some f
+	| _ -> None
+
+let is_extern_field f =
+	match f.cf_kind with
+	| Method _ -> false
+	| Var { v_read = AccNormal | AccInline | AccNo } | Var { v_write = AccNormal | AccNo } -> false
+	| _ -> not (Meta.has Meta.IsVar f.cf_meta)
+
+let field_type f =
+	match f.cf_params with
+	| [] -> f.cf_type
+	| l -> monomorphs l f.cf_type
+
+let rec raw_class_field build_type c i =
+	try
+		let f = PMap.find i c.cl_fields in
+		Some c, build_type f , f
+	with Not_found -> try (match c.cl_constructor with
+		| Some ctor when i = "new" -> Some c, build_type ctor,ctor
+		| _ -> raise Not_found)
+	with Not_found -> try
+		match c.cl_super with
+		| None ->
+			raise Not_found
+		| Some (c,tl) ->
+			let c2 , t , f = raw_class_field build_type c i in
+			c2, apply_params c.cl_types tl t , f
+	with Not_found ->
+		match c.cl_kind with
+		| KTypeParameter tl ->
+			let rec loop = function
+				| [] ->
+					raise Not_found
+				| t :: ctl ->
+					match follow t with
+					| TAnon a ->
+						(try
+							let f = PMap.find i a.a_fields in
+							None, build_type f, f
+						with
+							Not_found -> loop ctl)
+					| TInst (c,pl) ->
+						(try
+							let c2, t , f = raw_class_field build_type c i in
+							c2, apply_params c.cl_types pl t, f
+						with
+							Not_found -> loop ctl)
+					| _ ->
+						loop ctl
+			in
+			loop tl
+		| _ ->
+			if not c.cl_interface then raise Not_found;
+			(*
+				an interface can implements other interfaces without
+				having to redeclare its fields
+			*)
+			let rec loop = function
+				| [] ->
+					raise Not_found
+				| (c,tl) :: l ->
+					try
+						let c2, t , f = raw_class_field build_type c i in
+						c2, apply_params c.cl_types tl t, f
+					with
+						Not_found -> loop l
+			in
+			loop c.cl_implements
+
+let class_field = raw_class_field field_type
+
+let quick_field t n =
+	match follow t with
+	| TInst (c,_) ->
+		let c, _, f = raw_class_field (fun f -> f.cf_type) c n in
+		(match c with None -> FAnon f | Some c -> FInstance (c,f))
+	| TAnon a ->
+		(match !(a.a_status) with
+		| EnumStatics e ->
+			let ef = PMap.find n e.e_constrs in
+			FEnum(e,ef)
+		| Statics c ->
+			FStatic (c,PMap.find n c.cl_statics)
+		| AbstractStatics a ->
+			begin match a.a_impl with
+				| Some c ->
+					let cf = PMap.find n c.cl_statics in
+					FStatic(c,cf) (* is that right? *)
+				| _ ->
+					raise Not_found
+			end
+		| _ ->
+			FAnon (PMap.find n a.a_fields))
+	| TDynamic _ ->
+		FDynamic n
+	| TEnum _  | TMono _ | TAbstract _ | TFun _ ->
+		raise Not_found
+	| TLazy _ | TType _ ->
+		assert false
+
+let quick_field_dynamic t s =
+	try quick_field t s
+	with Not_found -> FDynamic s
+
+let rec get_constructor build_type c =
+	match c.cl_constructor, c.cl_super with
+	| Some c, _ -> build_type c, c
+	| None, None -> raise Not_found
+	| None, Some (csup,cparams) ->
+		let t, c = get_constructor build_type csup in
+		apply_params csup.cl_types cparams t, c
+
+(* ======= Unification ======= *)
+
 let rec link e a b =
 	(* tell if setting a == b will create a type-loop *)
 	let rec loop t =
@@ -709,9 +758,6 @@ let rec link e a b =
 		true
 	end
 
-let monomorphs eparams t =
-	apply_params eparams (List.map (fun _ -> mk_mono()) eparams) t
-
 let rec fast_eq a b =
 	if a == b then
 		true
@@ -805,6 +851,8 @@ type eq_kind =
 	| EqRightDynamic
 	| EqBothDynamic
 
+let is_closed a = !(a.a_status) <> Opened
+
 let rec type_eq param a b =
 	if a == b then
 		()
@@ -899,116 +947,6 @@ let type_iseq a b =
 let unify_stack = ref []
 let abstract_cast_stack = ref []
 
-let is_extern_field f =
-	match f.cf_kind with
-	| Method _ -> false
-	| Var { v_read = AccNormal | AccInline | AccNo } | Var { v_write = AccNormal | AccNo } -> false
-	| _ -> not (Meta.has Meta.IsVar f.cf_meta)
-
-let field_type f =
-	match f.cf_params with
-	| [] -> f.cf_type
-	| l -> monomorphs l f.cf_type
-
-let rec raw_class_field build_type c i =
-	try
-		let f = PMap.find i c.cl_fields in
-		Some c, build_type f , f
-	with Not_found -> try (match c.cl_constructor with
-		| Some ctor when i = "new" -> Some c, build_type ctor,ctor
-		| _ -> raise Not_found)
-	with Not_found -> try
-		match c.cl_super with
-		| None ->
-			raise Not_found
-		| Some (c,tl) ->
-			let c2 , t , f = raw_class_field build_type c i in
-			c2, apply_params c.cl_types tl t , f
-	with Not_found ->
-		match c.cl_kind with
-		| KTypeParameter tl ->
-			let rec loop = function
-				| [] ->
-					raise Not_found
-				| t :: ctl ->
-					match follow t with
-					| TAnon a ->
-						(try
-							let f = PMap.find i a.a_fields in
-							None, build_type f, f
-						with
-							Not_found -> loop ctl)
-					| TInst (c,pl) ->
-						(try
-							let c2, t , f = raw_class_field build_type c i in
-							c2, apply_params c.cl_types pl t, f
-						with
-							Not_found -> loop ctl)
-					| _ ->
-						loop ctl
-			in
-			loop tl
-		| _ ->
-			if not c.cl_interface then raise Not_found;
-			(*
-				an interface can implements other interfaces without
-				having to redeclare its fields
-			*)
-			let rec loop = function
-				| [] ->
-					raise Not_found
-				| (c,tl) :: l ->
-					try
-						let c2, t , f = raw_class_field build_type c i in
-						c2, apply_params c.cl_types tl t, f
-					with
-						Not_found -> loop l
-			in
-			loop c.cl_implements
-
-let class_field = raw_class_field field_type
-
-let quick_field t n =
-	match follow t with
-	| TInst (c,_) ->
-		let c, _, f = raw_class_field (fun f -> f.cf_type) c n in
-		(match c with None -> FAnon f | Some c -> FInstance (c,f))
-	| TAnon a ->
-		(match !(a.a_status) with
-		| EnumStatics e ->
-			let ef = PMap.find n e.e_constrs in
-			FEnum(e,ef)
-		| Statics c ->
-			FStatic (c,PMap.find n c.cl_statics)
-		| AbstractStatics a ->
-			begin match a.a_impl with
-				| Some c ->
-					let cf = PMap.find n c.cl_statics in
-					FStatic(c,cf) (* is that right? *)
-				| _ ->
-					raise Not_found
-			end
-		| _ ->
-			FAnon (PMap.find n a.a_fields))
-	| TDynamic _ ->
-		FDynamic n
-	| TEnum _  | TMono _ | TAbstract _ | TFun _ ->
-		raise Not_found
-	| TLazy _ | TType _ ->
-		assert false
-
-let quick_field_dynamic t s =
-	try quick_field t s
-	with Not_found -> FDynamic s
-
-let rec get_constructor build_type c =
-	match c.cl_constructor, c.cl_super with
-	| Some c, _ -> build_type c, c
-	| None, None -> raise Not_found
-	| None, Some (csup,cparams) ->
-		let t, c = get_constructor build_type csup in
-		apply_params csup.cl_types cparams t, c
-
 let rec unify a b =
 	if a == b then
 		()
@@ -1346,6 +1284,8 @@ and unify_with_access t1 f2 =
 	(* read/write *)
 	| _ -> type_eq EqBothDynamic t1 f2.cf_type
 
+(* ======= Mapping and iterating ======= *)
+
 let iter_dt f dt = match dt with
 	| DTBind(_,dt) -> f dt
 	| DTSwitch(_,cl,dto) ->
@@ -1591,6 +1531,76 @@ let map_expr_type f ft fv e =
 	| TMeta (m,e1) ->
 		{e with eexpr = TMeta(m, f e1); etype = ft e.etype }
 
+(* ======= Printing ======= *)
+
+let print_context() = ref []
+
+let rec s_type ctx t =
+	match t with
+	| TMono r ->
+		(match !r with
+		| None -> Printf.sprintf "Unknown<%d>" (try List.assq t (!ctx) with Not_found -> let n = List.length !ctx in ctx := (t,n) :: !ctx; n)
+		| Some t -> s_type ctx t)
+	| TEnum (e,tl) ->
+		Ast.s_type_path e.e_path ^ s_type_params ctx tl
+	| TInst (c,tl) ->
+		Ast.s_type_path c.cl_path ^ s_type_params ctx tl
+	| TType (t,tl) ->
+		Ast.s_type_path t.t_path ^ s_type_params ctx tl
+	| TAbstract (a,tl) ->
+		Ast.s_type_path a.a_path ^ s_type_params ctx tl
+	| TFun ([],t) ->
+		"Void -> " ^ s_fun ctx t false
+	| TFun (l,t) ->
+		String.concat " -> " (List.map (fun (s,b,t) ->
+			(if b then "?" else "") ^ (if s = "" then "" else s ^ " : ") ^ s_fun ctx t true
+		) l) ^ " -> " ^ s_fun ctx t false
+	| TAnon a ->
+		let fl = PMap.fold (fun f acc -> ((if Meta.has Meta.Optional f.cf_meta then " ?" else " ") ^ f.cf_name ^ " : " ^ s_type ctx f.cf_type) :: acc) a.a_fields [] in
+		"{" ^ (if not (is_closed a) then "+" else "") ^  String.concat "," fl ^ " }"
+	| TDynamic t2 ->
+		"Dynamic" ^ s_type_params ctx (if t == t2 then [] else [t2])
+	| TLazy f ->
+		s_type ctx (!f())
+
+and s_fun ctx t void =
+	match t with
+	| TFun _ ->
+		"(" ^ s_type ctx t ^ ")"
+	| TAbstract ({ a_path = ([],"Void") },[]) when void ->
+		"(" ^ s_type ctx t ^ ")"
+	| TMono r ->
+		(match !r with
+		| None -> s_type ctx t
+		| Some t -> s_fun ctx t void)
+	| TLazy f ->
+		s_fun ctx (!f()) void
+	| _ ->
+		s_type ctx t
+
+and s_type_params ctx = function
+	| [] -> ""
+	| l -> "<" ^ String.concat ", " (List.map (s_type ctx) l) ^ ">"
+
+let s_access is_read = function
+	| AccNormal -> "default"
+	| AccNo -> "null"
+	| AccNever -> "never"
+	| AccResolve -> "resolve"
+	| AccCall -> if is_read then "get" else "set"
+	| AccInline	-> "inline"
+	| AccRequire (n,_) -> "require " ^ n
+
+let s_kind = function
+	| Var { v_read = AccNormal; v_write = AccNormal } -> "var"
+	| Var v -> "(" ^ s_access true v.v_read ^ "," ^ s_access false v.v_write ^ ")"
+	| Method m ->
+		match m with
+		| MethNormal -> "method"
+		| MethDynamic -> "dynamic method"
+		| MethInline -> "inline method"
+		| MethMacro -> "macro method"
+
 let s_expr_kind e =
 	match e.eexpr with
 	| TConst _ -> "Const"