Selaa lähdekoodia

fix pattern resolution order

Simon Krajewski 9 vuotta sitten
vanhempi
commit
b19efd61fa
2 muutettua tiedostoa jossa 31 lisäystä ja 7 poistoa
  1. 22 4
      matcher.ml
  2. 9 3
      typecore.ml

+ 22 - 4
matcher.ml

@@ -416,10 +416,28 @@ let to_pattern ctx e t =
 			end
 		| EConst(Ident s) ->
 			begin try
-				let old = ctx.in_call_args in
-				ctx.in_call_args <- true; (* Not really, but it does exactly what we want here. *)
-				let ec = try type_expr ctx e (WithType t) with _ -> ctx.in_call_args <- old; raise Not_found in
-				ctx.in_call_args <- old;
+				let rec loop t = match follow t with
+					| TEnum (en,tl) ->
+						let ef = PMap.find s en.e_constrs in
+						let et = mk (TTypeExpr (TEnumDecl en)) (TAnon { a_fields = PMap.empty; a_status = ref (EnumStatics en) }) p in
+						mk (TField (et,FEnum (en,ef))) (apply_params en.e_params tl ef.ef_type) p
+					| TAbstract ({a_impl = Some c} as a,_) when has_meta Meta.Enum a.a_meta ->
+						let cf = PMap.find s c.cl_statics in
+						Type.unify (follow cf.cf_type) t;
+						let e = begin match cf.cf_expr with
+							| Some ({eexpr = TConst c | TCast({eexpr = TConst c},None)} as e) -> e
+							| None when c.cl_extern -> make_static_field_access c cf cf.cf_type p
+							| _ -> raise Not_found
+						end in
+						e
+					| _ ->
+						let old = ctx.in_call_args in
+						ctx.in_call_args <- true; (* Not really, but it does exactly what we want here. *)
+						let ec = try type_expr ctx e (WithType t) with _ -> ctx.in_call_args <- old; raise Not_found in
+						ctx.in_call_args <- old;
+						ec
+				in
+				let ec = loop t in
 				let ec = match Optimizer.make_constant_expression ctx ~concat_strings:true ec with Some e -> e | None -> ec in
 				(match ec.eexpr with
 					| TField (_,FEnum (en,ef)) ->

+ 9 - 3
typecore.ml

@@ -291,12 +291,18 @@ let unify_min ctx el = (!unify_min_ref) ctx el
 
 let match_expr ctx e cases def with_type p = !match_expr_ref ctx e cases def with_type p
 
-let make_static_call ctx c cf map args t p =
+let make_static_this c p =
 	let ta = TAnon { a_fields = c.cl_statics; a_status = ref (Statics c) } in
-	let ethis = mk (TTypeExpr (TClassDecl c)) ta p in
+	mk (TTypeExpr (TClassDecl c)) ta p
+
+let make_static_field_access c cf t p =
+	let ethis = make_static_this c p in
+	mk (TField (ethis,(FStatic (c,cf)))) t p
+
+let make_static_call ctx c cf map args t p =
 	let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
 	let map t = map (apply_params cf.cf_params monos t) in
-	let ef = mk (TField (ethis,(FStatic (c,cf)))) (map cf.cf_type) p in
+	let ef = make_static_field_access c cf (map cf.cf_type) p in
 	make_call ctx ef args (map t) p
 
 let raise_or_display ctx l p =