Browse Source

enable pattern matching by default

Simon Krajewski 12 years ago
parent
commit
e2e2bff8a8
5 changed files with 17 additions and 14 deletions
  1. 2 2
      common.ml
  2. 0 1
      doc/all.hxml
  3. 14 9
      matcher.ml
  4. 0 1
      tests/unit/compile.hxml
  5. 1 1
      typer.ml

+ 2 - 2
common.ml

@@ -170,10 +170,10 @@ module Define = struct
 		| NoCOpt
 		| NoInline
 		| NoOpt
+		| NoPatternMatching
 		| NoRoot
 		| NoSwfCompress
 		| NoTraces
-		| PatternMatching
 		| PhpPrefix
 		| ReplaceFiles
 		| Scriptable
@@ -225,11 +225,11 @@ module Define = struct
 		| NoCompilation -> ("no-compilation","Disable CPP final compilation")
 		| NoCOpt -> ("no_copt","Disable completion optimization (for debug purposes)")
 		| NoOpt -> ("no_opt","Disable optimizations")
+		| NoPatternMatching -> ("no_pattern_matching","Disable pattern matching")
 		| NoInline -> ("no_inline","Disable inlining")
 		| NoRoot -> ("no_root","GenCS internal")
 		| NoSwfCompress -> ("no_swf_compress","Disable SWF output compression")
 		| NoTraces -> ("no_traces","Disable all trace calls")
-		| PatternMatching -> ("pattern_matching","Allow pattern matching")
 		| PhpPrefix -> ("php_prefix","Compiled with --php-prefix")
 		| ReplaceFiles -> ("replace_files","GenCommon internal")
 		| Scriptable -> ("scriptable","GenCPP internal")

+ 0 - 1
doc/all.hxml

@@ -2,7 +2,6 @@
 --macro ImportAll.run()
 -D haxe3
 -D doc-gen
--D pattern_matching
 --each
 
 -neko all.n

+ 14 - 9
matcher.ml

@@ -324,16 +324,21 @@ let to_pattern ctx e t =
 			| TTypeExpr mt -> mk_con_pat (CType mt) [] t p
 			| _ -> error "Constant expression expected" p)
 		| ((EConst(Ident s),p) as ec) -> (try
-				(* HACK so type_ident via type_field does not cause display errors *)
-				let old = ctx.untyped in
-				ctx.untyped <- true;
 				let tc = monomorphs ctx.type_params t in
-				let ec = try type_expr_with_type ctx ec (Some tc) true with _ -> raise Not_found in
-				ctx.untyped <- old;
-				(* we might have found the wrong thing entirely *)
-				(match tc with
-					| TMono _ -> ()
-					| _ -> try unify_raise ctx ec.etype tc ec.epos with Error (Unify _,_) -> raise Not_found);
+				let ec = match tc with
+					| TEnum(en,pl) ->
+						let ef = PMap.find s en.e_constrs in
+						mk (TEnumField (en,s)) (apply_params en.e_types pl ef.ef_type) p
+					| _ ->
+						let old = ctx.untyped in
+						ctx.untyped <- true;
+						let e = try type_expr_with_type ctx ec (Some tc) true with _ -> ctx.untyped <- old; raise Not_found in
+						ctx.untyped <- old;
+						(match tc with
+							| TMono _ -> ()
+							| _ -> try unify_raise ctx e.etype tc e.epos with Error (Unify _,_) -> raise Not_found);
+						e 
+				in
 				(match ec.eexpr with
 					| TEnumField(en,s)
 					| TField ({ eexpr = TTypeExpr (TEnumDecl en) },s) ->

+ 0 - 1
tests/unit/compile.hxml

@@ -22,7 +22,6 @@
 -resource res2.bin
 --no-opt
 --dce full
--D pattern_matching
 --each
 
 #flash8

+ 1 - 1
typer.ml

@@ -1597,7 +1597,7 @@ and type_switch_old ctx e cases def need_val with_type p =
 
 and type_switch ctx e cases def need_val with_type p =
 	try
-		if not (Common.defined ctx.com Common.Define.PatternMatching) then raise Exit;
+		if (Common.defined ctx.com Common.Define.NoPatternMatching) then raise Exit;
 		match_expr ctx e cases def need_val with_type p
 	with Exit ->
 		type_switch_old ctx e cases def need_val with_type p