Browse Source

keep source of complex switches in @:ast meta

Simon Krajewski 12 years ago
parent
commit
87c19fb9ed
4 changed files with 14 additions and 31 deletions
  1. 1 0
      ast.ml
  2. 1 0
      common.ml
  3. 5 25
      interp.ml
  4. 7 6
      typer.ml

+ 1 - 0
ast.ml

@@ -33,6 +33,7 @@ module Meta = struct
 		| Allow
 		| Annotation
 		| ArrayAccess
+		| Ast
 		| AutoBuild
 		| Bind
 		| Bitmap

+ 1 - 0
common.ml

@@ -292,6 +292,7 @@ module MetaInfo = struct
 		| Allow -> ":allow",("Allows private access from package, type or field",[HasParam "Target path";UsedOnEither [TClass;TClassField]])
 		| Annotation -> ":annotation",("Annotation (@interface) definitions on -java-lib imports will be annotated with this metadata. Has no effect on types compiled by Haxe",[Platform Java; UsedOn TClass])
 		| ArrayAccess -> ":arrayAccess",("Allows [] access on an abstract",[UsedOnEither [TAbstract;TAbstractField]])
+		| Ast -> ":ast",("Internally used to pass the AST source into the typed AST",[Internal])
 		| AutoBuild -> ":autoBuild",("Extends @:build metadata to all extending and implementing classes",[HasParam "Build macro call";UsedOn TClass])
 		| Bind -> ":bind",("Override Swf class declaration",[Platform Flash;UsedOn TClass])
 		| Bitmap -> ":bitmap",("Embeds given bitmap data into the class (must extend flash.display.BitmapData)",[HasParam "Bitmap file path";UsedOn TClass;Platform Flash])

+ 5 - 25
interp.ml

@@ -4490,7 +4490,6 @@ let rec make_ast e =
 	| TLocal v -> EConst (mk_ident v.v_name)
 	| TArray (e1,e2) -> EArray (make_ast e1,make_ast e2)
 	| TBinop (op,e1,e2) -> EBinop (op, make_ast e1, make_ast e2)
-	| TEnumParameter (e,_,i) -> assert false
 	| TField (e,f) -> EField (make_ast e, Type.field_name f)
 	| TTypeExpr t -> fst (mk_path (full_type_path t) e.epos)
 	| TParenthesis e -> EParenthesis (make_ast e)
@@ -4516,30 +4515,10 @@ let rec make_ast e =
 		) cases in
 		let def = match eopt def with None -> None | Some (EBlock [],_) -> Some None | e -> Some e in
 		ESwitch (make_ast e,cases,def)
-(* 	| TMatch (e,(en,_),cases,def) ->
-		let scases (idx,args,e) =
-			let p = e.epos in
-			let unused = (EConst (Ident "_"),p) in
-			let args = (match args with
-				| None -> None
-				| Some l -> Some (List.map (function None -> unused | Some v -> (EConst (Ident v.v_name),p)) l)
-			) in
-			let mk_args n =
-				match args with
-				| None -> [unused]
-				| Some args ->
-					args @ Array.to_list (Array.make (n - List.length args) unused)
-			in
-			List.map (fun i ->
-				let c = (try List.nth en.e_names i with _ -> assert false) in
-				let cfield = (try PMap.find c en.e_constrs with Not_found -> assert false) in
-				let c = (EConst (Ident c),p) in
-				(match follow cfield.ef_type with TFun (eargs,_) -> (ECall (c,mk_args (List.length eargs)),p) | _ -> c)
-			) idx, None, (match e.eexpr with TBlock [] -> None | _ -> Some (make_ast e))
-		in
-		let def = match eopt def with None -> None | Some (EBlock [],_) -> Some None | e -> Some e in
-		ESwitch (make_ast e,List.map scases cases,def) *)
-	| TPatMatch dt -> assert false
+	| TPatMatch _
+	| TEnumParameter _ ->
+		(* these are considered complex, so the AST is handled in TMeta(Meta.Ast) *)
+		assert false
 	| TTry (e,catches) -> ETry (make_ast e,List.map (fun (v,e) -> v.v_name, (try make_type v.v_type with Exit -> assert false), make_ast e) catches)
 	| TReturn e -> EReturn (eopt e)
 	| TBreak -> EBreak
@@ -4553,6 +4532,7 @@ let rec make_ast e =
 				Some (try make_type t with Exit -> assert false)
 		) in
 		ECast (make_ast e,t)
+	| TMeta ((Meta.Ast,[e1,_],_),_) -> e1
 	| TMeta (m,e) -> EMeta(m,make_ast e))
 	,e.epos)
 

+ 7 - 6
typer.ml

@@ -2581,15 +2581,16 @@ and type_expr ctx (e,p) (with_type:with_type) =
 		let cond = type_expr ctx cond Value in
 		unify ctx cond.etype ctx.t.tbool cond.epos;
 		mk (TWhile (cond,e,DoWhile)) ctx.t.tvoid p
-	| ESwitch (e,cases,def) ->
+	| ESwitch (e1,cases,def) ->
 		begin try
-			let dt = match_expr ctx e cases def with_type p in
-			if not ctx.in_macro && not (Common.defined ctx.com Define.Interp) && ctx.com.config.pf_pattern_matching then
-				mk (TPatMatch dt) dt.dt_type p
+			let dt = match_expr ctx e1 cases def with_type p in
+			let wrap e1 = if not dt.dt_is_complex then e1 else mk (TMeta((Meta.Ast,[e,p],p),e1)) e1.etype e1.epos in
+			if not ctx.in_macro && not (Common.defined ctx.com Define.Interp) && ctx.com.config.pf_pattern_matching && dt.dt_is_complex then
+				wrap (mk (TPatMatch dt) dt.dt_type p)
 			else
-				Codegen.PatternMatchConversion.to_typed_ast ctx dt p
+				wrap (Codegen.PatternMatchConversion.to_typed_ast ctx dt p)
 		with Exit ->
-			type_switch_old ctx e cases def with_type p
+			type_switch_old ctx e1 cases def with_type p
 		end	
 	| EReturn e ->
 		let e , t = (match e with