瀏覽代碼

[typer] add switch_exhaustive, remove internal Meta.Exhaustive usage

still encode it like that to macros for backward compat
Simon Krajewski 2 年之前
父節點
當前提交
3b86489118

+ 1 - 5
src/codegen/gencommon/closuresToClass.ml

@@ -1151,11 +1151,7 @@ struct
 						epos = pos;
 					} in
 
-					let switch = {
-						switch_subject = switch_cond;
-						switch_cases = loop_cases api !max_arity [];
-						switch_default = Some(make_throw (mk_arg_exception "Too many arguments" pos) pos);
-					} in
+					let switch = mk_switch switch_cond (loop_cases api !max_arity []) (Some(make_throw (mk_arg_exception "Too many arguments" pos) pos)) true in
 					{
 						eexpr = TSwitch switch;
 						etype = basic.tvoid;

+ 1 - 5
src/codegen/gencommon/realTypeParams.ml

@@ -572,11 +572,7 @@ struct
 							let edef = gen.gtools.r_set_field basic.tvoid local_new_me local_field (gen.gtools.r_field false basic.tvoid this local_field) in
 							if fields <> [] then begin
 								(* switch(field) { ... } *)
-								let switch = {
-									switch_subject = local_field;
-									switch_cases = fields_to_cases fields;
-									switch_default = Some edef
-								} in
+								let switch = mk_switch local_field (fields_to_cases fields) (Some edef) true in
 								mk (TSwitch switch) basic.tvoid pos
 							end else
 								edef;

+ 2 - 10
src/codegen/gencommon/reflectionCFs.ml

@@ -1006,11 +1006,7 @@ let implement_get_set ctx cl =
 				}
 			) fields in
 			let default = Some(do_default()) in
-			let switch = {
-				switch_subject = local_switch_var;
-				switch_cases = cases;
-				switch_default = default;
-			} in
+			let switch = mk_switch local_switch_var cases default true in
 			mk_block { eexpr = TSwitch switch; etype = basic.tvoid; epos = pos }
 		in
 
@@ -1246,11 +1242,7 @@ let implement_invokeField ctx slow_invoke cl =
 				epos = pos
 			} )
 		in
-		let switch = {
-			switch_subject = mk_local switch_var pos;
-			switch_cases = cases;
-			switch_default = Some default;
-		} in
+		let switch = mk_switch (mk_local switch_var pos) cases (Some default) true in
 		{
 			eexpr = TSwitch switch;
 			etype = basic.tvoid;

+ 2 - 6
src/codegen/gencommon/switchToIf.ml

@@ -125,7 +125,7 @@ let configure gen (should_convert:texpr->bool) =
 			`switch e { case MyEnum.A: ...; case MyEnum.B: ...; }`, which is supported natively
 			by some target languages like Java and C#.
 		*)
-		| TSwitch {switch_subject = cond;switch_cases = cases;switch_default = default}  ->
+		| TSwitch ({switch_subject = cond;switch_cases = cases;switch_default = default} as switch)  ->
 			begin
 				try
 					match (simplify_expr cond).eexpr with
@@ -155,11 +155,7 @@ let configure gen (should_convert:texpr->bool) =
 							let body = run body in
 							{ case_patterns = patterns;case_expr = body}
 						) cases in
-						let switch = {
-							switch_subject = enum;
-							switch_cases = cases;
-							switch_default = Option.map run default;
-						} in
+						let switch = mk_switch enum cases (Option.map run default) switch.switch_exhaustive in
 						{ e with eexpr = TSwitch switch }
 					| _ ->
 						raise Not_found

+ 1 - 0
src/core/tType.ml

@@ -193,6 +193,7 @@ and tswitch = {
 	switch_subject : texpr;
 	switch_cases : switch_case list;
 	switch_default: texpr option;
+	switch_exhaustive : bool;
 }
 
 and switch_case = {

+ 10 - 8
src/core/texpr.ml

@@ -851,13 +851,15 @@ let punion_el default_pos el =
 		else
 			punion first last
 
-let is_exhaustive e1 def =
-	let rec loop e1 = match e1.eexpr with
-		| TMeta((Meta.Exhaustive,_,_),_) -> true
-		| TMeta(_, e1) | TParenthesis e1 -> loop e1
-		| _ -> false
-	in
-	def <> None || loop e1
+let is_exhaustive switch =
+	switch.switch_exhaustive
+
+let mk_switch subject cases default exhaustive = {
+	switch_subject = subject;
+	switch_cases = cases;
+	switch_default = default;
+	switch_exhaustive = exhaustive;
+}
 
 let rec is_true_expr e1 = match e1.eexpr with
 	| TConst(TBool true) -> true
@@ -900,7 +902,7 @@ module DeadEnd = struct
 				loop cond
 			| TSwitch switch ->
 				let check_exhaustive () =
-					(is_exhaustive switch.switch_subject switch.switch_default) && List.for_all (fun case ->
+					(is_exhaustive switch) && List.for_all (fun case ->
 						List.exists loop case.case_patterns ||
 						loop case.case_expr
 					) switch.switch_cases &&

+ 2 - 2
src/filters/filters.ml

@@ -221,7 +221,7 @@ let check_local_vars_init ctx e =
 			) catches in
 			loop vars e;
 			join vars cvars;
-		| TSwitch {switch_subject = e;switch_cases = cases;switch_default = def} ->
+		| TSwitch ({switch_subject = e;switch_cases = cases;switch_default = def} as switch) ->
 			loop vars e;
 			let cvars = List.map (fun {case_patterns = ec;case_expr = e} ->
 				let old = !vars in
@@ -233,7 +233,7 @@ let check_local_vars_init ctx e =
 				v
 			) cases in
 			(match def with
-			| None when (match e.eexpr with TMeta((Meta.Exhaustive,_,_),_) | TParenthesis({eexpr = TMeta((Meta.Exhaustive,_,_),_)}) -> true | _ -> false) ->
+			| None when switch.switch_exhaustive ->
 				(match cvars with
 				| cv :: cvars ->
 					PMap.iter (fun i b -> if b then vars := PMap.add i b !vars) cv;

+ 1 - 5
src/generators/genjava.ml

@@ -579,11 +579,7 @@ struct
 
 		let is_not_null_check = mk (TBinop (OpNotEq, local, { local with eexpr = TConst TNull })) basic.tbool local.epos in
 		let if_not_null e = { e with eexpr = TIf (is_not_null_check, e, None) } in
-		let switch = {
-			switch_subject = !local_hashcode;
-			switch_cases = List.map change_case (reorder_cases ecases []);
-			switch_default = None
-		} in
+		let switch = mk_switch !local_hashcode (List.map change_case (reorder_cases ecases [])) None false (* idk *) in
 		let switch = if_not_null { eswitch with
 			eexpr = TSwitch switch;
 		} in

+ 1 - 5
src/generators/genpy.ml

@@ -472,11 +472,7 @@ module Transformer = struct
 			let res_var = alloc_var (ae.a_next_id()) ef.etype ef.epos in
 			let res_local = {ef with eexpr = TLocal res_var} in
 			let var_expr = {ef with eexpr = TVar(res_var,Some ef)} in
-			let switch = {
-				switch_subject = res_local;
-				switch_cases = cases;
-				switch_default = edef
-			} in
+			let switch = mk_switch res_local cases edef (edef <> None) in
 			let e = mk (TBlock [
 				var_expr;
 				mk (TSwitch switch) ae.a_expr.etype e1.epos

+ 25 - 10
src/macro/macroApi.ml

@@ -1363,10 +1363,17 @@ and encode_texpr e =
 			| TFor(v,e1,e2) -> 15,[encode_tvar v;loop e1;loop e2]
 			| TIf(eif,ethen,eelse) -> 16,[loop eif;loop ethen;vopt encode_texpr eelse]
 			| TWhile(econd,e1,flag) -> 17,[loop econd;loop e1;vbool (flag = NormalWhile)]
-			| TSwitch switch -> 18,[
-				loop switch.switch_subject;
-				encode_array (List.map (fun case -> encode_obj ["values",encode_texpr_list case.case_patterns;"expr",loop case.case_expr]) switch.switch_cases);
-				vopt encode_texpr switch.switch_default
+			| TSwitch switch ->
+				let switch_subject = if switch.switch_exhaustive then
+					let meta = (Meta.Exhaustive,[],null_pos) in
+					{switch.switch_subject with eexpr = (TMeta(meta,switch.switch_subject))}
+				else
+					switch.switch_subject
+				in
+				18,[
+					loop switch_subject;
+					encode_array (List.map (fun case -> encode_obj ["values",encode_texpr_list case.case_patterns;"expr",loop case.case_expr]) switch.switch_cases);
+					vopt encode_texpr switch.switch_default
 				]
 			| TTry(e1,catches) -> 19,[
 				loop e1;
@@ -1540,14 +1547,22 @@ and decode_texpr v =
 		| 16, [vif;vthen;velse] -> TIf(loop vif,loop vthen,opt loop velse)
 		| 17, [vcond;v1;b] -> TWhile(loop vcond,loop v1,if decode_bool b then NormalWhile else DoWhile)
 		| 18, [v1;cl;vdef] ->
-			let switch = {
-				switch_subject = loop v1;
-				switch_cases = List.map (fun v -> {
+			let is_exhaustive e1 def =
+				let rec loop e1 = match e1.eexpr with
+					| TMeta((Meta.Exhaustive,_,_),_) -> true
+					| TMeta(_, e1) | TParenthesis e1 -> loop e1
+					| _ -> false
+				in
+				def <> None || loop e1
+			in
+			let subject = loop v1 in
+			let cases = List.map (fun v -> {
 					case_patterns = List.map loop (decode_array (field v "values"));
 					case_expr = loop (field v "expr")
-				}) (decode_array cl);
-				switch_default = opt loop vdef;
-			} in
+				}) (decode_array cl)
+			in
+			let default = opt loop vdef in
+			let switch = mk_switch subject cases default (is_exhaustive subject default) in
 			TSwitch switch
 		| 19, [v1;cl] -> TTry(loop v1,List.map (fun v -> decode_tvar (field v "v"),loop (field v "expr")) (decode_array cl))
 		| 20, [vo] -> TReturn(opt loop vo)

+ 4 - 4
src/optimization/analyzer.ml

@@ -795,10 +795,10 @@ module Debug = struct
 			edge bb_next "next";
 		| SEMerge bb_next ->
 			edge bb_next "merge"
-		| SESwitch(bbl,bo,bb_next,_) ->
-			List.iter (fun (el,bb) -> edge bb ("case " ^ (String.concat " | " (List.map s_expr_pretty el)))) bbl;
-			(match bo with None -> () | Some bb -> edge bb "default");
-			edge bb_next "next";
+		| SESwitch ss ->
+			List.iter (fun (el,bb) -> edge bb ("case " ^ (String.concat " | " (List.map s_expr_pretty el)))) ss.ss_cases;
+			(match ss.ss_default with None -> () | Some bb -> edge bb "default");
+			edge ss.ss_next "next";
 		| SETry(bb_try,_,bbl,bb_next,_) ->
 			edge bb_try "try";
 			List.iter (fun (_,bb_catch) -> edge bb_catch "catch") bbl;

+ 11 - 13
src/optimization/analyzerTexprTransformer.ml

@@ -432,7 +432,7 @@ let rec func ctx bb tf t p =
 				end
 			end
 		| TSwitch switch ->
-			let is_exhaustive = is_exhaustive switch.switch_subject switch.switch_default in
+			let is_exhaustive = is_exhaustive switch in
 			let bb,e1 = bind_to_temp bb switch.switch_subject in
 			bb.bb_terminator <- TermCondBranch e1;
 			let reachable = ref [] in
@@ -457,15 +457,16 @@ let rec func ctx bb tf t p =
 					add_cfg_edge bb bb_case (CFGCondElse);
 					Some (bb_case)
 			in
+			let ss = { ss_cases = cases;ss_default = def;ss_pos = e.epos;ss_next = g.g_unreachable; ss_exhaustive = is_exhaustive} in
 			if is_exhaustive && !reachable = [] then begin
-				set_syntax_edge bb (SESwitch(cases,def,g.g_unreachable,e.epos));
+				set_syntax_edge bb (SESwitch ss);
 				close_node bb;
 				g.g_unreachable;
 			end else begin
 				let bb_next = create_node BKNormal bb.bb_type bb.bb_pos in
 				if not is_exhaustive then add_cfg_edge bb bb_next CFGGoto;
 				List.iter (fun bb -> add_cfg_edge bb bb_next CFGGoto) !reachable;
-				set_syntax_edge bb (SESwitch(cases,def,bb_next,e.epos));
+				set_syntax_edge bb (SESwitch {ss with ss_next = bb_next});
 				close_node bb;
 				bb_next
 			end
@@ -707,16 +708,13 @@ let rec block_to_texpr_el ctx bb =
 			| SEWhile(bb_body,bb_next,p) ->
 				let e2 = block bb_body in
 				if_live bb_next,Some (mk (TWhile(get_terminator(),e2,NormalWhile)) ctx.com.basic.tvoid p)
-			| SESwitch(bbl,bo,bb_next,p) ->
-				let switch = {
-					switch_subject = get_terminator();
-					switch_cases = List.map (fun (el,bb) -> {
-						case_patterns = el;
-						case_expr = block bb
-					}) bbl;
-					switch_default = Option.map block bo;
-				} in
-				Some bb_next,Some (mk (TSwitch switch) ctx.com.basic.tvoid p)
+			| SESwitch ss ->
+				let cases = List.map (fun (el,bb) -> {
+					case_patterns = el;
+					case_expr = block bb
+				}) ss.ss_cases in
+				let switch = mk_switch (get_terminator()) cases (Option.map block ss.ss_default) ss.ss_exhaustive in
+				Some ss.ss_next,Some (mk (TSwitch switch) ctx.com.basic.tvoid ss.ss_pos)
 		in
 		let bb_next,e_term = loop bb bb.bb_syntax_edge in
 		let el = DynArray.to_list bb.bb_el in

+ 13 - 5
src/optimization/analyzerTypes.ml

@@ -68,13 +68,21 @@ module BasicBlock = struct
 	and syntax_edge =
 		| SEIfThen of t * t * pos                                (* `if` with "then" and "next" *)
 		| SEIfThenElse of t * t * t * Type.t * pos               (* `if` with "then", "else" and "next" *)
-		| SESwitch of (texpr list * t) list * t option * t * pos (* `switch` with cases, "default" and "next" *)
+		| SESwitch of syntax_switch                              (* `switch` with cases, "default" and "next" *)
 		| SETry of t * t * (tvar * t) list * t *  pos            (* `try` with "exc", catches and "next" *)
 		| SEWhile of t * t * pos                                 (* `while` with "body" and "next" *)
 		| SESubBlock of t * t                                    (* "sub" with "next" *)
 		| SEMerge of t                                           (* Merge to same block *)
 		| SENone                                                 (* No syntax exit *)
 
+	and syntax_switch = {
+		ss_cases : (texpr list * t) list;
+		ss_default : t option;
+		ss_next : t;
+		ss_pos : pos;
+		ss_exhaustive : bool;
+	}
+
 	and suspend_call = {
 		efun : texpr;      (* coroutine function expression *)
 		args : texpr list; (* call arguments without the continuation *)
@@ -563,10 +571,10 @@ module Graph = struct
 					loop (next_scope scopes) bb_then;
 					loop (next_scope scopes) bb_else;
 					loop scopes bb_next
-				| SESwitch(cases,bbo,bb_next,_) ->
-					List.iter (fun (_,bb_case) -> loop (next_scope scopes) bb_case) cases;
-					(match bbo with None -> () | Some bb -> loop (next_scope scopes) bb);
-					loop scopes bb_next;
+				| SESwitch ss ->
+					List.iter (fun (_,bb_case) -> loop (next_scope scopes) bb_case) ss.ss_cases;
+					(match ss.ss_default with None -> () | Some bb -> loop (next_scope scopes) bb);
+					loop scopes ss.ss_next;
 				| SETry(bb_try,bb_exc,catches,bb_next,_) ->
 					let scopes' = next_scope scopes in
 					loop scopes' bb_try;

+ 1 - 1
src/optimization/inline.ml

@@ -735,7 +735,7 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f
 			in_loop := old;
 			{ e with eexpr = TWhile (cond,eloop,flag) }
 		| TSwitch switch when term ->
-			let term = term && (is_exhaustive switch.switch_subject switch.switch_default) in
+			let term = term && (is_exhaustive switch) in
 			let cases = List.map (fun case ->
 				let el = List.map (map false false) case.case_patterns in
 				{

+ 4 - 9
src/typing/matcher/texprConverter.ml

@@ -292,18 +292,13 @@ let to_texpr ctx t_switch with_type dt =
 						| [{case_patterns = [{eexpr = TConst (TBool false)}];case_expr = e2};{case_patterns = [{eexpr = TConst (TBool true)}];case_expr = e1}],None,_ ->
 							mk (TIf(e_subject,e1,Some e2)) t_switch dt.dt_pos
 						| _ ->
-							let e_subject = match finiteness with
+							let is_exhaustive = match finiteness with
 								| RunTimeFinite | CompileTimeFinite when e_default = None ->
-									let meta = (Meta.Exhaustive,[],dt.dt_pos) in
-									mk (TMeta(meta,e_subject)) e_subject.etype e_subject.epos
+									true
 								| _ ->
-									e_subject
+									false
 							in
-							let switch = {
-								switch_subject = e_subject;
-								switch_cases = cases;
-								switch_default = e_default;
-							} in
+							let switch = mk_switch e_subject cases e_default is_exhaustive in
 							mk (TSwitch switch) t_switch dt.dt_pos
 					in
 					Some e

+ 1 - 1
src/typing/typeloadCheck.ml

@@ -290,7 +290,7 @@ let rec return_flow ctx e =
 	| TSwitch ({switch_default = Some e} as switch) ->
 		List.iter (fun case -> return_flow case.case_expr) switch.switch_cases;
 		return_flow e
-	| TSwitch ({switch_subject = {eexpr = TMeta((Meta.Exhaustive,_,_),_)}} as switch) ->
+	| TSwitch ({switch_exhaustive = true} as switch) ->
 		List.iter (fun case -> return_flow case.case_expr) switch.switch_cases;
 	| TTry (e,cases) ->
 		return_flow e;