2
0
Эх сурвалжийг харах

check enum and enum field constraints (closes #2018)

Simon Krajewski 12 жил өмнө
parent
commit
309dc8aeb2
1 өөрчлөгдсөн 27 нэмэгдсэн , 2 устгасан
  1. 27 2
      typer.ml

+ 27 - 2
typer.ml

@@ -166,6 +166,28 @@ let rec is_pos_infos = function
 	| _ ->
 		false
 
+let check_constraints ctx tname tpl tl map p =
+	List.iter2 (fun m (name,t) ->
+		match follow t with
+		| TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] ->
+			delay ctx PCheckConstraint (fun() ->
+				List.iter (fun ct ->
+					try
+						Type.unify (map m) (map ct)
+					with Unify_error l ->
+						display_error ctx (error_msg (Unify (Constraint_failure (tname ^ "." ^ name) :: l))) p;
+				) constr
+			);
+		| _ ->
+			()
+	) tl tpl
+
+let enum_field_type ctx en ef tl_en tl_ef p =
+	let map t = apply_params en.e_types tl_en (apply_params ef.ef_params tl_ef t) in
+	check_constraints ctx (s_type_path en.e_path) en.e_types tl_en map p;
+	check_constraints ctx ef.ef_name ef.ef_params tl_ef map p;
+	map ef.ef_type
+
 let add_constraint_checks ctx ctypes pl f tl p =
 	List.iter2 (fun m (name,t) ->
 		match follow t with
@@ -1068,7 +1090,9 @@ let rec type_ident_raise ?(imported_enums=true) ctx i p mode =
 					try
 						let ef = PMap.find i e.e_constrs in
 						let et = type_module_type ctx t None p in
-						mk (TField (et,FEnum (e,ef))) (monomorphs ef.ef_params (monomorphs e.e_types ef.ef_type)) p
+						let monos = List.map (fun _ -> mk_mono()) e.e_types in
+						let monos2 = List.map (fun _ -> mk_mono()) ef.ef_params in
+						mk (TField (et,FEnum (e,ef))) (enum_field_type ctx e ef monos monos2 p) p
 					with
 						Not_found -> loop l
 		in
@@ -2287,7 +2311,8 @@ and type_expr ctx (e,p) (with_type:with_type) =
 				| TEnum (e,pl) ->
 					(try
 						let ef = PMap.find s e.e_constrs in
-						mk (fast_enum_field e ef p) (apply_params e.e_types pl (monomorphs ef.ef_params ef.ef_type)) p
+						let monos = List.map (fun _ -> mk_mono()) ef.ef_params in
+						mk (fast_enum_field e ef p) (enum_field_type ctx e ef pl monos p) p
 					with Not_found ->
 						if ctx.untyped then raise Not_found;
 						with_type_error ctx with_type (string_error s e.e_names ("Identifier '" ^ s ^ "' is not part of enum " ^ s_type_path e.e_path)) p;