Browse Source

group match cases again

Simon Krajewski 12 years ago
parent
commit
254d037bde
1 changed files with 26 additions and 4 deletions
  1. 26 4
      codegen.ml

+ 26 - 4
codegen.ml

@@ -1598,6 +1598,26 @@ module PatternMatchConversion = struct
 		in
 		loop e
 
+	let group_cases cases =
+		let dt_eq dt1 dt2 = match dt1,dt2 with
+			| Goto i1, Goto i2 when i1 = i2 -> true
+			(* TODO equal bindings *)
+			| _ -> false
+		in
+		match List.rev cases with
+		| [] -> []
+		| [con,dt] -> [[con],dt]
+		| (con,dt) :: cases ->
+			let tmp,ldt,cases = List.fold_left (fun (tmp,ldt,acc) (con,dt) ->
+				if dt_eq dt ldt then
+					(con :: tmp,dt,acc)
+				else
+					([con],dt,(tmp,ldt) :: acc)
+			) ([con],dt,[]) cases in
+			match tmp with
+			| [] -> cases
+			| tmp -> ((tmp,ldt) :: cases)
+
 	let rec convert_dt cctx dt =
 		match dt with
 		| Bind (bl,dt) ->
@@ -1628,17 +1648,19 @@ module PatternMatchConversion = struct
 			in
 			let def = ref None in
 			let null = ref None in
-			let cases = ExtList.List.filter_map (fun (con,dt) ->
+			let cases = List.filter (fun (con,dt) ->
 				match con.c_def with
 				| CAny ->
 					def := Some (convert_dt cctx dt);
-					None
+					false
 				| CConst (TNull) ->
 					null := Some (convert_dt cctx dt);
-					None
+					false
 				| _ ->
-					Some ([convert_con cctx con],convert_dt cctx dt)
+					true
 			) cl in
+			let cases = group_cases cases in
+			let cases = List.map (fun (cl,dt) -> List.map (convert_con cctx) cl,convert_dt cctx dt) cases in
 			let e_subject = if exh then mk (TMeta((Meta.Exhaustive,[],p), e_subject)) e_subject.etype e_subject.epos else e_subject in
 			let e = mk (TSwitch(e_subject,cases,!def)) (mk_mono()) (p) in
 			match !null with