Explorar o código

add pf_pattern_matching config

Simon Krajewski %!s(int64=12) %!d(string=hai) anos
pai
achega
107a814b17
Modificáronse 5 ficheiros con 20 adicións e 7 borrados
  1. 1 2
      codegen.ml
  2. 12 0
      common.ml
  3. 2 3
      matcher.ml
  4. 2 1
      typecore.ml
  5. 3 1
      typer.ml

+ 1 - 2
codegen.ml

@@ -1762,8 +1762,7 @@ module PatternMatchConversion = struct
 			| CConst c ->
 			| CConst c ->
 				mk_const cctx.ctx con.c_pos c
 				mk_const cctx.ctx con.c_pos c
 			| CType mt ->
 			| CType mt ->
-				(* Typer.type_module_type cctx.ctx mt None con.c_pos *)
-				assert false
+				(!type_module_type_ref) cctx.ctx mt None con.c_pos
 			| CExpr e ->
 			| CExpr e ->
 				e
 				e
 			| _ ->
 			| _ ->

+ 12 - 0
common.ml

@@ -93,6 +93,8 @@ type platform_config = {
 	pf_add_final_return : bool;
 	pf_add_final_return : bool;
 	(** does the platform natively support overloaded functions *)
 	(** does the platform natively support overloaded functions *)
 	pf_overload : bool;
 	pf_overload : bool;
+	(** does the platform generator handle pattern matching *)
+	pf_pattern_matching : bool;
 }
 }
 
 
 type context = {
 type context = {
@@ -432,6 +434,7 @@ let default_config =
 		pf_pad_nulls = false;
 		pf_pad_nulls = false;
 		pf_add_final_return = false;
 		pf_add_final_return = false;
 		pf_overload = false;
 		pf_overload = false;
+		pf_pattern_matching = false;
 	}
 	}
 
 
 let get_config com =
 let get_config com =
@@ -451,6 +454,7 @@ let get_config com =
 			pf_pad_nulls = false;
 			pf_pad_nulls = false;
 			pf_add_final_return = false;
 			pf_add_final_return = false;
 			pf_overload = false;
 			pf_overload = false;
+			pf_pattern_matching = false;
 		}
 		}
 	| Js ->
 	| Js ->
 		{
 		{
@@ -464,6 +468,7 @@ let get_config com =
 			pf_pad_nulls = false;
 			pf_pad_nulls = false;
 			pf_add_final_return = false;
 			pf_add_final_return = false;
 			pf_overload = false;
 			pf_overload = false;
+			pf_pattern_matching = false;
 		}
 		}
 	| Neko ->
 	| Neko ->
 		{
 		{
@@ -477,6 +482,7 @@ let get_config com =
 			pf_pad_nulls = true;
 			pf_pad_nulls = true;
 			pf_add_final_return = false;
 			pf_add_final_return = false;
 			pf_overload = false;
 			pf_overload = false;
+			pf_pattern_matching = false;
 		}
 		}
 	| Flash when defined Define.As3 ->
 	| Flash when defined Define.As3 ->
 		{
 		{
@@ -490,6 +496,7 @@ let get_config com =
 			pf_pad_nulls = false;
 			pf_pad_nulls = false;
 			pf_add_final_return = true;
 			pf_add_final_return = true;
 			pf_overload = false;
 			pf_overload = false;
+			pf_pattern_matching = false;
 		}
 		}
 	| Flash ->
 	| Flash ->
 		{
 		{
@@ -503,6 +510,7 @@ let get_config com =
 			pf_pad_nulls = false;
 			pf_pad_nulls = false;
 			pf_add_final_return = false;
 			pf_add_final_return = false;
 			pf_overload = false;
 			pf_overload = false;
+			pf_pattern_matching = false;
 		}
 		}
 	| Php ->
 	| Php ->
 		{
 		{
@@ -521,6 +529,7 @@ let get_config com =
 			pf_pad_nulls = true;
 			pf_pad_nulls = true;
 			pf_add_final_return = false;
 			pf_add_final_return = false;
 			pf_overload = false;
 			pf_overload = false;
+			pf_pattern_matching = false;
 		}
 		}
 	| Cpp ->
 	| Cpp ->
 		{
 		{
@@ -534,6 +543,7 @@ let get_config com =
 			pf_pad_nulls = true;
 			pf_pad_nulls = true;
 			pf_add_final_return = true;
 			pf_add_final_return = true;
 			pf_overload = false;
 			pf_overload = false;
+			pf_pattern_matching = false;
 		}
 		}
 	| Cs ->
 	| Cs ->
 		{
 		{
@@ -547,6 +557,7 @@ let get_config com =
 			pf_pad_nulls = true;
 			pf_pad_nulls = true;
 			pf_add_final_return = false;
 			pf_add_final_return = false;
 			pf_overload = true;
 			pf_overload = true;
+			pf_pattern_matching = false;
 		}
 		}
 	| Java ->
 	| Java ->
 		{
 		{
@@ -560,6 +571,7 @@ let get_config com =
 			pf_pad_nulls = true;
 			pf_pad_nulls = true;
 			pf_add_final_return = false;
 			pf_add_final_return = false;
 			pf_overload = true;
 			pf_overload = true;
+			pf_pattern_matching = false;
 		}
 		}
 
 
 let create v args =
 let create v args =

+ 2 - 3
matcher.ml

@@ -1028,13 +1028,12 @@ let match_expr ctx e cases def with_type p =
 		| Some (WithTypeResume t2) -> (try unify_raise ctx t2 t p with Error (Unify l,p) -> raise (Typer.WithTypeError (l,p)))
 		| Some (WithTypeResume t2) -> (try unify_raise ctx t2 t p with Error (Unify l,p) -> raise (Typer.WithTypeError (l,p)))
 		| _ -> assert false
 		| _ -> assert false
 	end;
 	end;
-	let dt = {
+	{
 		dt_first = (match dt with Goto i -> i | _ -> Hashtbl.find mctx.dt_cache dt);
 		dt_first = (match dt with Goto i -> i | _ -> Hashtbl.find mctx.dt_cache dt);
 		dt_dt_lookup = DynArray.to_array mctx.dt_lut;
 		dt_dt_lookup = DynArray.to_array mctx.dt_lut;
 		dt_type = t;
 		dt_type = t;
 		dt_var_init = List.rev !var_inits;
 		dt_var_init = List.rev !var_inits;
-	} in
-	mk (TPatMatch dt) t p
+	}
 ;;
 ;;
 match_expr_ref := match_expr;
 match_expr_ref := match_expr;
 get_pattern_locals_ref := get_pattern_locals
 get_pattern_locals_ref := get_pattern_locals

+ 2 - 1
typecore.ml

@@ -138,8 +138,9 @@ exception DisplayPosition of Ast.pos list
 
 
 let make_call_ref : (typer -> texpr -> texpr list -> t -> pos -> texpr) ref = ref (fun _ _ _ _ _ -> assert false)
 let make_call_ref : (typer -> texpr -> texpr list -> t -> pos -> texpr) ref = ref (fun _ _ _ _ _ -> assert false)
 let type_expr_ref : (typer -> Ast.expr -> with_type -> texpr) ref = ref (fun _ _ _ -> assert false)
 let type_expr_ref : (typer -> Ast.expr -> with_type -> texpr) ref = ref (fun _ _ _ -> assert false)
+let type_module_type_ref : (typer -> module_type -> t list option -> pos -> texpr) ref = ref (fun _ _ _ _ -> assert false)
 let unify_min_ref : (typer -> texpr list -> t) ref = ref (fun _ _ -> assert false)
 let unify_min_ref : (typer -> texpr list -> t) ref = ref (fun _ _ -> assert false)
-let match_expr_ref : (typer -> Ast.expr -> (Ast.expr list * Ast.expr option * Ast.expr option) list -> Ast.expr option option -> with_type -> Ast.pos -> texpr) ref = ref (fun _ _ _ _ _ _ -> assert false)
+let match_expr_ref : (typer -> Ast.expr -> (Ast.expr list * Ast.expr option * Ast.expr option) list -> Ast.expr option option -> with_type -> Ast.pos -> decision_tree) ref = ref (fun _ _ _ _ _ _ -> assert false)
 let get_pattern_locals_ref : (typer -> Ast.expr -> Type.t -> (string, tvar) PMap.t) ref = ref (fun _ _ _ -> assert false)
 let get_pattern_locals_ref : (typer -> Ast.expr -> Type.t -> (string, tvar) PMap.t) ref = ref (fun _ _ _ -> assert false)
 let get_constructor_ref : (typer -> tclass -> t list -> Ast.pos -> (t * tclass_field)) ref = ref (fun _ _ _ _ -> assert false)
 let get_constructor_ref : (typer -> tclass -> t list -> Ast.pos -> (t * tclass_field)) ref = ref (fun _ _ _ _ -> assert false)
 let check_abstract_cast_ref : (typer -> t -> texpr -> Ast.pos -> texpr) ref = ref (fun _ _ _ _ -> assert false)
 let check_abstract_cast_ref : (typer -> t -> texpr -> Ast.pos -> texpr) ref = ref (fun _ _ _ _ -> assert false)

+ 3 - 1
typer.ml

@@ -2078,7 +2078,8 @@ and type_switch_old ctx e cases def with_type p =
 and type_switch ctx e cases def (with_type:with_type) p =
 and type_switch ctx e cases def (with_type:with_type) p =
 	try
 	try
 		if (Common.defined ctx.com Common.Define.NoPatternMatching) then raise Exit;
 		if (Common.defined ctx.com Common.Define.NoPatternMatching) then raise Exit;
-		match_expr ctx e cases def with_type p
+		let dt = match_expr ctx e cases def with_type p in
+		if 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 ->
 	with Exit ->
 		type_switch_old ctx e cases def with_type p
 		type_switch_old ctx e cases def with_type p
 
 
@@ -4158,3 +4159,4 @@ unify_min_ref := unify_min;
 make_call_ref := make_call;
 make_call_ref := make_call;
 get_constructor_ref := get_constructor;
 get_constructor_ref := get_constructor;
 check_abstract_cast_ref := Codegen.Abstract.check_cast;
 check_abstract_cast_ref := Codegen.Abstract.check_cast;
+type_module_type_ref := type_module_type;