Bladeren bron

removed tmatch part of type_switch_old

Simon Krajewski 12 jaren geleden
bovenliggende
commit
d1dd858f60
2 gewijzigde bestanden met toevoegingen van 23 en 183 verwijderingen
  1. 2 0
      matcher.ml
  2. 21 183
      typer.ml

+ 2 - 0
matcher.ml

@@ -936,6 +936,8 @@ let match_expr ctx e cases def with_type p =
 			begin match follow e.etype with
 			| TEnum(en,_) when PMap.is_empty en.e_constrs || Meta.has Meta.FakeEnum en.e_meta ->
 				raise Exit
+			| TAbstract({a_path=[],("Int" | "Float" | "Bool")},_) | TInst({cl_path = [],"String"},_) when (Common.defined ctx.com Common.Define.NoPatternMatching) ->
+				raise Exit;
 			| _ ->
 				()
 			end;

+ 21 - 183
typer.ml

@@ -1876,102 +1876,6 @@ and type_unop ctx op flag e p =
 
 and type_switch_old ctx e cases def with_type p =
 	let eval = type_expr ctx e Value in
-	let old_m = ctx.m in
-	let enum = ref None in
-	let used_cases = Hashtbl.create 0 in
-	let is_fake_enum e =
-		e.e_path = ([],"Bool") || Meta.has Meta.FakeEnum e.e_meta
-	in
-	(match follow eval.etype with
-	| TEnum (e,_) when is_fake_enum e -> ()
-	| TEnum (e,params) ->
-		enum := Some (Some (e,params));
-		(* hack to prioritize enum lookup *)
-		ctx.m <- { ctx.m with module_types = TEnumDecl e :: ctx.m.module_types }
-	| TMono _ ->
-		enum := Some None;
-	| t ->
-		if t == t_dynamic then enum := Some None
-	);
-	let case_expr c =
-		enum := None;
-		(* this inversion is needed *)
-		unify ctx eval.etype c.etype c.epos;
-		CExpr c
-	in
-	let type_match e en s pl =
-		let p = e.epos in
-		let params = (match !enum with
-			| None ->
-				assert false
-			| Some None when is_fake_enum en ->
-				raise Exit
-			| Some None ->
-				let params = List.map (fun _ -> mk_mono()) en.e_types in
-				enum := Some (Some (en,params));
-				unify ctx eval.etype (TEnum (en,params)) p;
-				params
-			| Some (Some (en2,params)) ->
-				if en != en2 then error ("This constructor is part of enum " ^ s_type_path en.e_path ^ " but is matched with enum " ^ s_type_path en2.e_path) p;
-				params
-		) in
-		if Hashtbl.mem used_cases s then error "This constructor has already been used" p;
-		Hashtbl.add used_cases s ();
-		let cst = (try PMap.find s en.e_constrs with Not_found -> assert false) in
-		let et = apply_params en.e_types params (monomorphs cst.ef_params cst.ef_type) in
-		let pl, rt = (match et with
-		| TFun (l,rt) ->
-			let pl = (if List.length l = List.length pl then pl else
-				match pl with
-				| [None] -> List.map (fun _ -> None) l
-				| _ -> error ("This constructor requires " ^ string_of_int (List.length l) ^ " arguments") p
-			) in
-			Some (List.map2 (fun p (_,_,t) -> match p with None -> None | Some p -> Some (p, t)) pl l), rt
-		| TEnum _ ->
-			if pl <> [] then error "This constructor does not require any argument" p;
-			None, et
-		| _ -> assert false
-		) in
-		unify ctx rt eval.etype p;
-		CMatch (cst,pl,p)
-	in
-	let type_case efull e pl p =
-		try
-			let e = (match !enum, e with
-			| None, _ -> raise Exit
-			| Some (Some (en,params)), (EConst (Ident i),p) ->
-				let ef = (try
-					PMap.find i en.e_constrs
-				with Not_found ->
-					display_error ctx ("This constructor is not part of the enum " ^ s_type_path en.e_path) p;
-					raise Exit
-				) in
-				mk (fast_enum_field en ef p) (apply_params en.e_types params ef.ef_type) (snd e)
-			| _ ->
-				type_expr ctx e Value
-			) in
-			let pl = List.map (fun e ->
-				match fst e with
-				| EConst (Ident "_") -> None
-				| EConst (Ident i) -> Some i
-				| _ -> raise Exit
-			) pl in
-			(match e.eexpr with
-			| TField (_,FEnum (en,c)) -> type_match e en c.ef_name pl
-			| _ -> if pl = [] then case_expr e else raise Exit)
-		with Exit ->
-			case_expr (type_expr ctx efull Value)
-	in
-	let cases = List.map (fun (el,eg,e2) ->
-		if el = [] then error "Case must match at least one expression" (punion_el el);
-		let el = List.map (fun e ->
-			match e with
-			| (ECall (c,pl),p) -> type_case e c pl p
-			| e -> type_case e e [] (snd e)
-		) el in
-		el, e2
-	) cases in
-	ctx.m <- old_m;
 	let el = ref [] in
 	let type_case_code e =
 		let e = (match e with
@@ -1981,6 +1885,23 @@ and type_switch_old ctx e cases def with_type p =
 		el := e :: !el;
 		e
 	in
+	let consts = Hashtbl.create 0 in
+	let exprs (el,_,e) =
+		let el = List.map (fun e ->
+			match type_expr ctx e (WithType eval.etype) with
+			| { eexpr = TConst c } as e ->
+				if Hashtbl.mem consts c then error "Duplicate constant in switch" e.epos;
+				Hashtbl.add consts c true;
+				e
+			| e ->
+				e
+		) el in
+		let locals = save_locals ctx in
+		let e = type_case_code e in
+		locals();
+		el, e
+	in
+	let cases = List.map exprs cases in
 	let def() = (match def with
 		| None -> None
 		| Some e ->
@@ -1989,95 +1910,12 @@ and type_switch_old ctx e cases def with_type p =
 			locals();
 			Some e
 	) in
-	match !enum with
-	| Some (Some (enum,enparams)) ->
-		let same_params p1 p2 =
-			let l1 = (match p1 with None -> [] | Some l -> l) in
-			let l2 = (match p2 with None -> [] | Some l -> l) in
-			let rec loop = function
-				| [] , [] -> true
-				| None :: l , [] | [] , None :: l -> loop (l,[])
-				| None :: l1, None :: l2 -> loop (l1,l2)
-				| Some (n1,t1) :: l1, Some (n2,t2) :: l2 ->
-					n1 = n2 && type_iseq t1 t2 && loop (l1,l2)
-				| _ -> false
-			in
-			loop (l1,l2)
-		in
-		let matchs (el,e) =
-			match el with
-			| CMatch (c,params,p1) :: l ->
-				let params = ref params in
-				let cl = List.map (fun c ->
-					match c with
-					| CMatch (c,p,p2) ->
-						if not (same_params p !params) then display_error ctx "Constructors parameters differs : should be same name, same type, and same position" p2;
-						if p <> None then params := p;
-						c
-					| _ -> assert false
-				) l in
-				let locals = save_locals ctx in
-				let params = (match !params with
-					| None -> None
-					| Some l ->
-						let has = ref false in
-						let l = List.map (fun v ->
-							match v with
-							| None -> None
-							| Some (v,t) -> has := true; Some (add_local ctx v t)
-						) l in
-						if !has then Some l else None
-				) in
-				let e = type_case_code e in
-				locals();
-				(c :: cl) , params, e
-			| _ ->
-				assert false
-		in
-		let indexes (el,vars,e) =
-			List.map (fun c -> c.ef_index) el, vars, e
-		in
-		let cases = List.map matchs cases in
-		let def = def() in
-		(match def with
-		| Some _ -> ()
-		| None ->
-			let tenum = TEnum(enum,enparams) in
-			let l = PMap.fold (fun c acc ->
-				let t = monomorphs enum.e_types (monomorphs c.ef_params (match c.ef_type with TFun (_,t) -> t | t -> t)) in
-				if Hashtbl.mem used_cases c.ef_name || not (try unify_raise ctx t tenum c.ef_pos; true with Error (Unify _,_) -> false) then acc else c.ef_name :: acc
-			) enum.e_constrs [] in
-			match l with
-			| [] -> ()
-			| _ -> display_error ctx ("Some constructors are not matched : " ^ String.concat "," l) p
-		);
-		let t = if with_type = NoValue then (mk_mono()) else unify_min ctx (List.rev !el) in
-		mk (TMatch (eval,(enum,enparams),List.map indexes cases,def)) t p
-	| _ ->
-		let consts = Hashtbl.create 0 in
-		let exprs (el,e) =
-			let el = List.map (fun c ->
-				match c with
-				| CExpr (({ eexpr = TConst c }) as e) ->
-					if Hashtbl.mem consts c then error "Duplicate constant in switch" e.epos;
-					Hashtbl.add consts c true;
-					e
-				| CExpr c -> c
-				| CMatch (_,_,p) -> error "You cannot use a normal switch on an enum constructor" p
-			) el in
-			let locals = save_locals ctx in
-			let e = type_case_code e in
-			locals();
-			el, e
-		in
-		let cases = List.map exprs cases in
-		let def = def() in
-		let t = if with_type = NoValue then (mk_mono()) else unify_min ctx (List.rev !el) in
-		mk (TSwitch (eval,cases,def)) t p
+	let def = def() in
+	let t = if with_type = NoValue then (mk_mono()) else unify_min ctx (List.rev !el) in
+	mk (TSwitch (eval,cases,def)) t p
 
-and type_switch ctx e cases def (with_type:with_type) p =
+and type_switch ctx e cases def with_type p =
 	try
-		if (Common.defined ctx.com Common.Define.NoPatternMatching) then raise Exit;
 		let dt = match_expr ctx e cases def with_type p in
 		if not ctx.in_macro && not (Common.defined ctx.com Define.Interp) && ctx.com.config.pf_pattern_matching then mk (TPatMatch dt) dt.dt_type p else Codegen.PatternMatchConversion.to_typed_ast ctx dt p
 	with Exit ->