2
0
Эх сурвалжийг харах

added --macro and haxe.macro.Compiler
added type patches
fixes for SWF/SWC class extraction

Nicolas Cannasse 14 жил өмнө
parent
commit
e5f8ab0597
11 өөрчлөгдсөн 652 нэмэгдсэн , 57 устгасан
  1. 6 0
      doc/extract.hxml
  2. 290 0
      doc/extract.patch
  3. 68 22
      genswf.ml
  4. 37 3
      genxml.ml
  5. 34 3
      interp.ml
  6. 6 1
      main.ml
  7. 89 0
      std/haxe/macro/Compiler.hx
  8. 2 2
      std/haxe/macro/Context.hx
  9. 1 0
      typecore.ml
  10. 40 0
      typeload.ml
  11. 79 26
      typer.ml

+ 6 - 0
doc/extract.hxml

@@ -0,0 +1,6 @@
+-debug
+-swf-lib library.swf
+-swf9 test.swf
+-swf-version 10
+--macro patchTypes("patches.txt")
+--gen-hx-classes

+ 290 - 0
doc/extract.patch

@@ -0,0 +1,290 @@
+// types patches configuration for playerglobal.swc
+
+// MANUAL =
+// 	flash.display.BitmapDataChannel
+//	flash.display.GraphicsPathCommand
+//	MovieClip : #if !flash_strict , implements Dynamic #end
+
+-flash.accessibility.Accessibility.new
+
+-flash.desktop.Clipboard.new
+flash.desktop.Clipboard.formats : Array<ClipboardFormats>;
+flash.desktop.Clipboard.$format : ClipboardFormats;
+flash.desktop.Clipboard.$transferMode : ClipboardTransferMode;
+
+flash.display.Bitmap.pixelSnapping : PixelSnapping;
+flash.display.Bitmap.$pixelSnapping : PixelSnapping;
+flash.display.BitmapData.$blendMode : BlendMode;
+flash.display.BitmapData.$redArray : Array<Int>;
+flash.display.BitmapData.$greenArray : Array<Int>;
+flash.display.BitmapData.$blueArray : Array<Int>;
+flash.display.BitmapData.$alphaArray : Array<Int>;
+flash.display.BitmapData.$offsets : Array<flash.geom.Point>;
+// @:require(flash10) flash.display.BitmapData.setVector
+// @:require(flash10) flash.display.BitmapData.getVector
+// @:require(flash10) flash.display.BitmapData.histogram
+
+// @:require(flash10) flash.display.DisplayObject.blendShader
+// @:require(flash10) flash.display.DisplayObject.rotationX
+// @:require(flash10) flash.display.DisplayObject.rotationY
+// @:require(flash10) flash.display.DisplayObject.rotationZ
+// @:require(flash10) flash.display.DisplayObject.scaleZ
+// @:require(flash10) flash.display.DisplayObject.z
+// @:require(flash10) flash.display.DisplayObject.globalToLocal3D
+// @:require(flash10) flash.display.DisplayObject.local3DToGlobal
+-flash.display.DisplayObject.new
+flash.display.DisplayObject.blendMode : BlendMode;
+flash.display.DisplayObject.opaqueBackground : Null<UInt>;
+
+flash.display.DisplayObjectContainer.getObjectsUnderPoint : Array<DisplayObject>;
+
+flash.display.Graphics.$type : GradientType;
+flash.display.Graphics.$colors : Array<UInt>;
+flash.display.Graphics.$spreadMethod : SpreadMethod;
+flash.display.Graphics.$interpolationMethod : InterpolationMethod;
+flash.display.Graphics.$scaleMode : LineScaleMode;
+flash.display.Graphics.$caps : CapsStyle;
+flash.display.Graphics.$joints : JointStyle;
+flash.display.Graphics.$winding : GraphicsPathWinding;
+flash.display.Graphics.$culling : TriangleCulling;
+// flash10 : beginShaderFill,copyFrom,drawGraphicsData,drawPath,drawTriangles,lineBitmapStyle
+
+flash.display.GraphicsGradientFill.type : GradientType;
+flash.display.GraphicsGradientFill.colors : Array<UInt>;
+flash.display.GraphicsGradientFill.spreadMethod : SpreadMethod;
+flash.display.GraphicsGradientFill.interpolationMethod : InterpolationMethod;
+flash.display.GraphicsGradientFill.alphas : Array<Float>;
+flash.display.GraphicsGradientFill.ratios : Array<Float>;
+flash.display.GraphicsGradientFill.$type : GradientType;
+flash.display.GraphicsGradientFill.$colors : Array<UInt>;
+flash.display.GraphicsGradientFill.$spreadMethod : SpreadMethod;
+flash.display.GraphicsGradientFill.$interpolationMethod : InterpolationMethod;
+flash.display.GraphicsGradientFill.$alphas : Array<Float>;
+flash.display.GraphicsGradientFill.$ratios : Array<Float>;
+flash.display.GraphicsGradientFill.$matrix : flash.geom.Matrix;
+
+flash.display.GraphicsPath.winding : GraphicsPathWinding;
+flash.display.GraphicsPath.$winding : GraphicsPathWinding;
+
+flash.display.GraphicsStroke.scaleMode : LineScaleMode;
+flash.display.GraphicsStroke.caps : CapsStyle;
+flash.display.GraphicsStroke.joints : JointStyle;
+flash.display.GraphicsStroke.$scaleMode : LineScaleMode;
+flash.display.GraphicsStroke.$caps : CapsStyle;
+flash.display.GraphicsStroke.$joints : JointStyle;
+
+flash.display.GraphicsTrianglePath.culling : TriangleCulling;
+flash.display.GraphicsTrianglePath.$culling : TriangleCulling;
+
+
+// flash.10  flash.display.Loader.unloadAndStop, 10.1 = uncaughtErrorEvents
+
+-flash.display.LoaderInfo.new
+flash.display.LoaderInfo.parameters : Dynamic<String>;
+flash.display.LoaderInfo.actionScriptVersion : ActionScriptVersion;
+flash.display.LoaderInfo.swfVersion : SWFVersion;
+
+// flash 10.1 : uncaughtErrorEvents, ?isURLInaccessible
+
+-flash.display.MorphShape.new
+
+// flash 10 flash.display.MovieClip.currentFrameLabel
+flash.display.MovieClip.currentLabels : Array<FrameLabel>;
+flash.display.MovieClip.scenes : Array<Scene>;
+
+flash.display.Scene.labels : Array<FrameLabel>;
+flash.display.Scene.$labels : Array<FrameLabel>;
+
+flash.display.Shader.precisionHint : ShaderPrecision;
+
+-flash.display.ShaderParameter.new
+flash.display.ShaderParameter.type : ShaderParameterType;
+
+// flash.display.Sprite : startTouchDrag stopTouchDrag = FP 10.1
+
+-flash.display.Stage.new
+flash.display.Stage.align : StageAlign;
+flash.display.Stage.quality : StageQuality;
+flash.display.Stage.scaleMode : StageScaleMode;
+flash.display.Stage.colorCorrection : ColorCorrection;
+flash.display.Stage.colorCorrectionSupport : ColorCorrectionSupport;
+flash.display.Stage.displayState : StageDisplayState;
+flash.display.Stage.displayState : StageDisplayState;
+
+// flash.display.Stage : stageVideos, wmodeGPU, color* = FP 10.1
+
+flash.events.Event.eventPhase : EventPhase;
+flash.events.KeyboardEvent.keyLocation : flash.ui.KeyLocation;
+flash.events.KeyboardEvent.$keyLocation : flash.ui.KeyLocation;
+
+-flash.external.ExternalInterface.new
+
+flash.filters.BevelFilter.type : BitmapFilterType;
+flash.filters.BevelFilter.$type : BitmapFilterType;
+
+flash.filters.DisplacementMapFilter.mode : DisplacementMapFilterMode;
+flash.filters.DisplacementMapFilter.$mode : DisplacementMapFilterMode;
+
+flash.filters.GradientGlowFilter.type : BitmapFilterType;
+flash.filters.GradientGlowFilter.$type : BitmapFilterType;
+
+flash.geom.Matrix3D.$orientationStyle : Orientation3D;
+
+// flash.geom.Transform : matrix3D, perspectiveProjection, getRelativeMatrix3D : FP10
+
+-flash.geom.Utils3D.new
+
+flash.media.Microphone.codec : SoundCodec;
+
+-flash.media.SoundMixer.new
+
+flash.net.FileReference.$typeFilter : Array<FileFilter>;
+flash.net.FileReferenceList.fileList : Array<FileReference>;
+flash.net.FileReferenceList.$typeFilter : Array<FileFilter>;
+
+flash.net.NetStreamPlayOptions.transition : NetStreamPlayTransitions;
+
+-flash.net.ObjectEncoding.new
+
+flash.net.Socket.endian : flash.utils.Endian;
+flash.net.URLLoader.dataFormat : URLLoaderDataFormat;
+flash.net.URLRequest.requestHeaders : Array<URLRequestHeader>;
+
+flash.net.URLStream.endian : flash.utils.Endian;
+
+flash.printing.PrintJob.orientation : PrintJobOrientation;
+
+-flash.sampler.DeleteObjectSample.new
+-flash.sampler.NewObjectSample.new
+-flash.sampler.Sample.new
+flash.sampler.Sample.stack : Array<StackFrame>;
+-flash.sampler.StackFrame.new
+
+-flash.system.Capabilities.new
+-flash.system.IME.new
+flash.system.IME.conversionMode : IMEConversionMode
+
+-flash.system.Security.new
+flash.system.Security.$panel : SecurityPanel
+-flash.system.SecurityDomain.new
+-flash.system.System.new
+flash.system.SystemUpdater.$typer : SystemAdapterType;
+
+flash.text.Font.fontStyle : FontStyle;
+flash.text.Font.fontType : FontType;
+flash.text.TextField.autoSize : TextFieldAutoSize;
+flash.text.TextField.antiAliasType : AntiAliasType;
+flash.text.TextField.gridFitType : GridFitType;
+flash.text.TextField.type : TextFieldType;
+
+flash.text.TextFormat.align : TextFormatAlign;
+flash.text.TextFormat.blockIndent : Null<Float>
+flash.text.TextFormat.bold : Null<Bool>;
+flash.text.TextFormat.bullet : Null<Bool>;
+flash.text.TextFormat.color : Null<UInt>;
+flash.text.TextFormat.display : TextFormatDisplay;
+flash.text.TextFormat.indent : Null<Float>;
+flash.text.TextFormat.italic : Null<Bool>;
+flash.text.TextFormat.kerning : Null<Bool>;
+flash.text.TextFormat.leading : Null<Float>;
+flash.text.TextFormat.leftMargin : Null<Float>;
+flash.text.TextFormat.letterSpacing : Null<Float>;
+flash.text.TextFormat.rightMargin : Null<Float>;
+flash.text.TextFormat.size : Null<Float>;
+flash.text.TextFormat.tabStops : Array<UInt>;
+flash.text.TextFormat.underline : Null<Bool>;
+flash.text.TextFormat.$size : Null<Float>;
+flash.text.TextFormat.$color : Null<UInt>;
+flash.text.TextFormat.$bold : Null<Bool>;
+flash.text.TextFormat.$italic : Null<Bool>;
+flash.text.TextFormat.$underline : Null<Bool>;
+flash.text.TextFormat.$align : TextFormatAlign;
+flash.text.TextFormat.$leftMargin : Null<Float>;
+flash.text.TextFormat.$rightMargin : Null<Float>;
+flash.text.TextFormat.$indent : Null<Float>;
+flash.text.TextFormat.$leading : Null<Float>;
+
+-flash.text.TextRenderer.new
+flash.text.TextRenderer.antiAliasType : AntiAliasType;
+flash.text.TextRenderer.displayMode : TextDisplayMode;
+flash.text.TextRenderer.$fontStyle : FontStyle;
+flash.text.TextRenderer.$colorType : TextColorType;
+
+flash.text.engine.ContentElement.textRotation : TextRotation;
+flash.text.engine.ContentElement.$textRotation : TextRotation;
+
+flash.text.engine.EastAsianJustifier.justificationStyle : JustificationStyle;
+flash.text.engine.EastAsianJustifier.$justificationStyle : JustificationStyle;
+flash.text.engine.EastAsianJustifier.$lineJustification : LineJustification;
+
+flash.text.engine.ElementFormat.alignmentBaseline : TextBaseline;
+flash.text.engine.ElementFormat.breakOpportunity : BreakOpportunity;
+flash.text.engine.ElementFormat.digitCase : DigitCase;
+flash.text.engine.ElementFormat.digitWidth : DigitWidth;
+flash.text.engine.ElementFormat.dominantBaseline : TextBaseline;
+flash.text.engine.ElementFormat.kerning : Kerning;
+flash.text.engine.ElementFormat.ligatureLevel : LigatureLevel;
+flash.text.engine.ElementFormat.textRotation : TextRotation;
+flash.text.engine.ElementFormat.typographicCase : TypographicCase;
+flash.text.engine.ElementFormat.$alignmentBaseline : TextBaseline;
+flash.text.engine.ElementFormat.$breakOpportunity : BreakOpportunity;
+flash.text.engine.ElementFormat.$digitCase : DigitCase;
+flash.text.engine.ElementFormat.$digitWidth : DigitWidth;
+flash.text.engine.ElementFormat.$dominantBaseline : TextBaseline;
+flash.text.engine.ElementFormat.$kerning : Kerning;
+flash.text.engine.ElementFormat.$ligatureLevel : LigatureLevel;
+flash.text.engine.ElementFormat.$textRotation : TextRotation;
+flash.text.engine.ElementFormat.$typographicCase : TypographicCase;
+
+flash.text.engine.FontDescription.cffHinting : CFFHinting;
+flash.text.engine.FontDescription.fontLookup : FontLookup;
+flash.text.engine.FontDescription.fontPosture : FontPosture;
+flash.text.engine.FontDescription.fontWeight : FontWeight;
+flash.text.engine.FontDescription.renderingMode : RenderingMode;
+flash.text.engine.FontDescription.$cffHinting : CFFHinting;
+flash.text.engine.FontDescription.$fontLookup : FontLookup;
+flash.text.engine.FontDescription.$fontPosture : FontPosture;
+flash.text.engine.FontDescription.$fontWeight : FontWeight;
+flash.text.engine.FontDescription.$renderingMode : RenderingMode;
+
+flash.text.engine.GraphicElement.$textRotation : TextRotation;
+flash.text.engine.GroupElement.$textRotation : TextRotation;
+flash.text.engine.SpaceJustifier.$lineJustification : LineJustification;
+flash.text.engine.TabStop.alignment : TabAlignment;
+flash.text.engine.TabStop.$alignment : TabAlignment;
+
+flash.text.engine.TextBlock.baselineZero : TextBaseline;
+flash.text.engine.TextBlock.lineRotation : TextRotation;
+flash.text.engine.TextBlock.textLineCreationResult : TextLineCreationResult;
+flash.text.engine.TextBlock.$baselineZero : TextBaseline;
+flash.text.engine.TextBlock.$lineRotation : TextRotation;
+flash.text.engine.TextBlock.$textLineCreationResult : TextLineCreationResult;
+
+flash.text.engine.TextElement.$textRotation : TextRotation;
+
+flash.text.engine.TextJustifier.lineJustification : LineJustification;
+flash.text.engine.TextJustifier.$lineJustification : LineJustification;
+
+flash.text.engine.TextLine.baseline : TextBaseline;
+
+-flash.trace.Trace.new
+
+-static flash.xml.XMLList.length
+-static flash.xml.XML.length
+-flash.text.engine.TextElement.text
+
+-flash.ui.Keyboard.new
+-flash.ui.Mouse.new
+flash.ui.Mouse.cursor : MouseCursor;
+
+-flash.ui.Multitouch.new
+flash.ui.Multitouch.inputMode : MultitouchInputMode;
+
+flash.utils.ObjectInput.endian : Endian;
+flash.utils.ObjectOutput.endian : Endian;
+flash.utils.ByteArray.endian : Endian;
+flash.utils.IDataInput.endian : Endian;
+flash.utils.IDataOutput.endian : Endian;
+
+flash.xml.XMLNode.nodeType : XMLNodeType;
+flash.xml.XMLNode.$type : XMLNodeType;

+ 68 - 22
genswf.ml

@@ -167,9 +167,11 @@ let rec make_tpath = function
 			tparams = if !pdyn then [TPType (CTPath { tpackage = []; tname = "Dynamic"; tparams = []; tsub = None; })] else[];
 			tsub = None;
 		}
-	| HMName (id,_) ->
+	| HMName (id,ns) ->
 		{
-			tpackage = [];
+			tpackage = (match ns with
+				| HNInternal (Some ns) -> ExtString.String.nsplit ns "."
+				| _ -> []);
 			tname = id;
 			tparams = [];
 			tsub = None;
@@ -195,12 +197,7 @@ let make_topt = function
 	| None -> { tpackage = []; tname = "Dynamic"; tparams = []; tsub = None }
 	| Some t -> make_tpath t
 
-let make_type f t =
-	CTPath (match f, t with
-	| "opaqueBackground", Some (HMPath ([],"Object")) -> make_param ([],"Null") ([],"UInt")
-	| "getObjectsUnderPoint", Some (HMPath ([],"Array")) -> make_param ([],"Array") (["flash";"display"],"DisplayObject")
-	| "blendMode", Some (HMPath ([],"String")) -> { tpackage = ["flash";"display"]; tname = "BlendMode"; tparams = []; tsub = None }
-	| _ -> make_topt t)
+let make_type t = CTPath (make_topt t)
 
 let build_class com c file =
 	let path = make_tpath c.hlc_name in
@@ -231,45 +228,47 @@ let build_class com c file =
 	let setters = Hashtbl.create 0 in
 	let as3_native = Common.defined com "as3_native" in
 	let make_field stat acc f =
-		let meta = ref None in
+		let meta = ref [] in
 		let flags = (match f.hlf_name with
 			| HMPath _ -> [APublic]
 			| HMName (_,ns) ->
 				(match ns with
 				| HNPrivate _ | HNNamespace "http://www.adobe.com/2006/flex/mx/internal" -> []
 				| HNNamespace ns ->
-					meta := Some (":ns",[String ns]);
+					meta := (":ns",[String ns]) :: !meta;
 					[APublic]
 				| HNExplicit _ | HNInternal _ | HNPublic _ ->
 					[APublic]
 				| HNStaticProtected _ | HNProtected _ ->
-					if as3_native then meta := Some (":protected",[]);
+					if as3_native then meta := (":protected",[]) :: !meta;
 					[APrivate])
 			| _ -> []
 		) in
 		if flags = [] then acc else
 		let flags = if stat then AStatic :: flags else flags in
-		let meta = (match !meta with None -> [] | Some (s,cl) -> [s,List.map (fun c -> EConst c,pos) cl]) in
+		let mk_meta() =
+			List.map (fun (s,cl) -> s, List.map (fun c -> EConst c,pos) cl) (!meta)
+		in
 		let name = (make_tpath f.hlf_name).tname in
 		match f.hlf_kind with
 		| HFVar v ->
 			let v = if v.hlv_const then
-				FProp (name,None,meta,flags,"default","never",make_type name v.hlv_type)
+				FProp (name,None,mk_meta(),flags,"default","never",make_type v.hlv_type)
 			else
-				FVar (name,None,meta,flags,Some (make_type name v.hlv_type),None)
+				FVar (name,None,mk_meta(),flags,Some (make_type v.hlv_type),None)
 			in
 			v :: acc
 		| HFMethod m when not m.hlm_override ->
 			(match m.hlm_kind with
 			| MK3Normal ->
 				let t = m.hlm_type in
-				let p = ref 0 in
+				let p = ref 0 and pn = ref 0 in
 				let args = List.map (fun at ->
 					let aname = (match t.hlmt_pnames with
-						| None -> "p" ^ string_of_int !p
+						| None -> incr pn; "p" ^ string_of_int !pn
 						| Some l ->
 							match List.nth l !p with
-							| None -> "p" ^ string_of_int !p
+							| None -> incr pn; "p" ^ string_of_int !pn
 							| Some i -> i
 					) in
 					let opt_val = (match t.hlmt_dparams with
@@ -280,15 +279,37 @@ let build_class com c file =
 							with
 								_ -> None
 					) in
-					incr p;
-					(aname,opt_val <> None,Some (make_type name at),None)
+					incr p;					
+					let t = make_type at in
+					let def_val = match opt_val with
+						| None -> None
+						| Some v ->							
+							let v = (match v with
+							| HVNone | HVNull | HVNamespace _ | HVString _ -> None
+							| HVBool b ->								
+								Some (Ident (if b then "true" else "false"))
+							| HVInt i | HVUInt i -> 
+								Some (Int (Int32.to_string i))
+							| HVFloat f -> 
+								Some (Float (string_of_float f))
+							) in
+							match v with
+							| None -> None
+							| Some v -> 
+								meta := (":defparam",[String aname;v]) :: !meta;
+								Some (EConst v,pos)
+					in
+					(aname,opt_val <> None,Some t,def_val)					
 				) t.hlmt_args in
+				let args = if t.hlmt_var_args then 
+					args @ List.map (fun _ -> incr pn; ("p" ^ string_of_int !pn,true,Some (make_type None),None)) [1;2;3;4;5]
+				else args in
 				let f = {
 					f_args = args;
-					f_type = Some (make_type name t.hlmt_ret);
+					f_type = Some (make_type t.hlmt_ret);
 					f_expr = (EBlock [],pos)
 				} in
-				FFun (name,None,meta,flags,[],f) :: acc
+				FFun (name,None,mk_meta(),flags,[],f) :: acc
 			| MK3Getter ->
 				Hashtbl.add getters (name,stat) m.hlm_type.hlmt_ret;
 				acc
@@ -320,7 +341,7 @@ let build_class com c file =
 		) in
 		let flags = [APublic] in
 		let flags = if stat then AStatic :: flags else flags in
-		FProp (name,None,[],flags,(if get then "default" else "never"),(if set then "default" else "never"),make_type name t)
+		FProp (name,None,[],flags,(if get then "default" else "never"),(if set then "default" else "never"),make_type t)
 	in
 	let fields = Hashtbl.fold (fun (name,stat) t acc ->
 		make_get_set name stat (Some t) (try Some (Hashtbl.find setters (name,stat)) with Not_found -> None) :: acc
@@ -331,6 +352,31 @@ let build_class com c file =
 		else
 			make_get_set name stat None (Some t) :: acc
 	) setters fields in
+	try
+		(*
+			If the class only contains static String constants, make it an enum
+		*)
+		let rec loop = function
+			| [] -> []
+			| f :: l ->
+				match f with
+				| FVar (name,doc,_,access,Some (CTPath { tpackage = []; tname = "String" | "Int" | "UInt" }),None) when List.mem AStatic access -> (name,doc,[],[],pos) :: loop l
+				| FFun ("new",_,_,_,_,{ f_args = [] }) -> loop l
+				| _ -> raise Exit
+		in
+		if fields = [] then raise Exit;
+		List.iter (function HExtends _ | HImplements _ -> raise Exit | _ -> ()) flags;			
+		let constr = loop fields in
+		let enum_data = {
+			d_name = path.tname;
+			d_doc = None;
+			d_params = [];
+			d_meta = [];
+			d_flags = [EExtern];
+			d_data = constr;
+		} in
+		(path.tpackage, [(EEnum enum_data,pos)])
+	with Exit ->
 	let class_data = {
 		d_name = path.tname;
 		d_doc = None;

+ 37 - 3
genxml.ml

@@ -263,6 +263,15 @@ let generate_type com t =
 		| _ ->
 			stype t
 	in
+	let sparam (n,v,t) =
+		match v with
+		| None ->
+			n ^ " : " ^ stype t
+		| Some (Ident "null") ->
+			"?" ^ n ^ " : " ^ stype (notnull t)
+		| Some v ->
+			n ^ " : " ^ stype t ^ " = " ^ (s_constant v)
+	in
 	let print_field stat f =
 		p "\t";
 		if stat then p "static ";
@@ -272,9 +281,20 @@ let generate_type com t =
 			if v.v_read <> AccNormal || v.v_write <> AccNormal then p "(%s,%s)" (s_access v.v_read) (s_access (if v.v_write = AccNever && (match pack with "flash" :: _ -> true | _ -> false) then AccNo else v.v_write));
 			p " : %s" (stype f.cf_type);
 		| Method m ->
-			let params, ret = (match follow f.cf_type with TFun (args,ret) -> args, ret | _ -> assert false) in
-			let params = List.map (fun (n,opt,t) -> (if opt then "?" else "") ^ n ^ " : " ^ stype (if opt then notnull t else t)) params in
-			p "function %s(%s) : %s" f.cf_name (String.concat ", " params) (stype ret);
+			let params, ret = (match follow f.cf_type with
+				| TFun (args,ret) -> 
+					List.map (fun (a,o,t) ->
+						let rec loop = function
+							| [] -> Ident "null"
+							| (":defparam",[(EConst (String p),_);(EConst v,_)]) :: _ when p = a -> v
+							| _ :: l -> loop l
+						in
+						a,(if o then Some (loop f.cf_meta) else None ),t
+					) args, ret
+				| _ -> 
+					assert false
+			) in				
+			p "function %s(%s) : %s" f.cf_name (String.concat ", " (List.map sparam params)) (stype ret);
 		);
 		p ";\n"
 	in
@@ -286,6 +306,7 @@ let generate_type com t =
 		| Some (c,pl) -> [" extends " ^ stype (TInst (c,pl))]
 		) in
 		let ext = List.fold_left (fun acc (i,pl) -> (" implements " ^ stype (TInst (i,pl))) :: acc) ext c.cl_implements in
+		let ext = (match c.cl_dynamic with None -> ext | Some t -> (" implements " ^ stype t) :: ext) in
 		p "%s" (String.concat "," (List.rev ext));
 		p " {\n";
 		let sort l =
@@ -304,6 +325,19 @@ let generate_type com t =
 		p "}\n";
 	| TEnumDecl e ->
 		p "extern enum %s {\n" (stype (TEnum(e,List.map snd e.e_types)));
+		let sort l = 
+			let a = Array.of_list l in
+			Array.sort compare a;
+			Array.to_list a
+		in
+		List.iter (fun n ->
+			let c = PMap.find n e.e_constrs in
+			p "\t%s" c.ef_name;
+			(match follow c.ef_type with
+			| TFun (args,_) -> p "(%s)" (String.concat ", " (List.map sparam (List.map (fun (a,o,t) -> a,(if o then Some (Ident "null") else None),t) args)))
+			| _ -> ());
+			p ";\n";
+		) (sort e.e_names);
 		p "}\n"
 	| TTypeDecl t ->
 		p "extern typedef %s = " (stype (TType (t,List.map snd t.t_types)));

+ 34 - 3
interp.ml

@@ -87,7 +87,8 @@ type extern_api = {
 	pos : Ast.pos;
 	get_type : string -> Type.t option;
 	parse_string : string -> Ast.pos -> Ast.expr;
-	eval : Ast.expr -> Type.t;
+	typeof : Ast.expr -> Type.t;
+	type_patch : string -> string -> bool -> string option -> unit;
 }
 
 type context = {
@@ -1581,8 +1582,16 @@ let macro_lib =
 			let v = loop v in
 			VString (Digest.to_hex (Digest.string (Marshal.to_string v [Marshal.Closures])))
 		);
-		"eval", Fun1 (fun v ->
-			encode_type ((get_ctx()).curapi.eval (decode_expr v))
+		"typeof", Fun1 (fun v ->
+			encode_type ((get_ctx()).curapi.typeof (decode_expr v))
+		);
+		"type_patch", Fun4 (fun t f s v ->
+			let p = (get_ctx()).curapi.type_patch in
+			(match t, f, s, v with
+			| VString t, VString f, VBool s, VString v -> p t f s (Some v)
+			| VString t, VString f, VBool s, VNull -> p t f s None
+			| _ -> error());
+			VNull
 		);
 	]
 
@@ -2876,6 +2885,28 @@ and encode_type t =
 	let tag, pl = loop t in
 	enc_enum IType tag pl
 
+(* ---------------------------------------------------------------------- *)
+(* VALUE-TO-CONSTANT *)
+
+let rec make_const e =
+	match e.eexpr with
+	| TConst c ->
+		(match c with
+		| TInt i -> (try VInt (Int32.to_int i) with _ -> raise Exit)
+		| TFloat s -> VFloat (float_of_string s)
+		| TString s -> enc_string s
+		| TBool b -> VBool b
+		| TNull -> VNull
+		| TThis | TSuper -> raise Exit)
+	| TParenthesis e ->
+		make_const e
+	| TObjectDecl el ->
+		VObject (obj (List.map (fun (f,e) -> f, make_const e) el))
+	| TArrayDecl al ->
+		enc_array (List.map make_const al)
+	| _ ->
+		raise Exit
+
 ;;
 encode_type_ref := encode_type;
 encode_expr_ref := encode_expr;

+ 6 - 1
main.ml

@@ -226,6 +226,7 @@ try
 	let excludes = ref [] in
 	let included_packages = ref [] in
 	let excluded_packages = ref [] in
+	let config_macros = ref [] in
 	let libs = ref [] in
 	let has_error = ref false in
 	let gen_as3 = ref false in
@@ -458,6 +459,9 @@ try
 			no_output := true;
 			interp := true;
 		),": interpret the program using internal macro system");
+		("--macro", Arg.String (fun e ->
+			config_macros := e :: !config_macros
+		)," : call the given macro before typing anything else");
 	] in
 	let current = ref 0 in
 	let args = Array.of_list ("" :: params) in
@@ -547,13 +551,14 @@ try
 		to accidentaly delete a source file. *)
 	if not !no_output && file_extension com.file = ext then delete_file com.file;
 	List.iter (fun f -> f()) (List.rev (!pre_compilation));
-	if !classes = [([],"Std")] then begin
+	if !classes = [([],"Std")] && !config_macros = [] then begin
 		if !cmds = [] && not !did_something then Arg.usage basic_args_spec usage;
 	end else begin
 		if com.verbose then print_endline ("Classpath : " ^ (String.concat ";" com.class_path));
 		let t = Common.timer "typing" in
 		Typecore.type_expr_ref := (fun ctx e need_val -> Typer.type_expr ~need_val ctx e);
 		let ctx = Typer.create com in
+		List.iter (Typer.call_init_macro ctx) (List.rev !config_macros);
 		List.iter (fun cpath -> ignore(ctx.Typecore.g.Typecore.do_load_module ctx cpath Ast.null_pos)) (List.rev !classes);
 		Typer.finalize ctx;
 		t();

+ 89 - 0
std/haxe/macro/Compiler.hx

@@ -0,0 +1,89 @@
+/*
+ * Copyright (c) 2005-2010, The haXe Project Contributors
+ * All rights reserved.
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ *   - Redistributions of source code must retain the above copyright
+ *     notice, this list of conditions and the following disclaimer.
+ *   - Redistributions in binary form must reproduce the above copyright
+ *     notice, this list of conditions and the following disclaimer in the
+ *     documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE HAXE PROJECT CONTRIBUTORS "AS IS" AND ANY
+ * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+ * DISCLAIMED. IN NO EVENT SHALL THE HAXE PROJECT CONTRIBUTORS BE LIABLE FOR
+ * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+ * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+ * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+ * DAMAGE.
+ */
+package haxe.macro;
+import haxe.macro.Expr;
+
+/**
+	All these methods can be called for compiler configuration macros.
+**/
+class Compiler {
+
+#if neko
+
+	public static function removeField( className : String, field : String, ?isStatic : Bool ) {
+		untyped load("type_patch",4)(className.__s,field.__s,isStatic == true,null);
+	}
+
+	public static function setFieldType( className : String, field : String, type : String, ?isStatic : Bool ) {
+		untyped load("type_patch",4)(className.__s,field.__s,isStatic == true,type.__s);
+	}
+
+	/**
+		Evaluate the type a given expression would have in the context of the current macro call.
+	**/
+	public static function patchTypes( file : String ) : Void {
+		var file = Context.resolvePath(file);
+		var f = neko.io.File.read(file, true);
+		try {
+			while( true ) {
+				var r = StringTools.trim(f.readLine());
+				if( r == "" || r.substr(0,2) == "//" ) continue;
+				if( StringTools.endsWith(r,";") ) r = r.substr(0,-1);
+				if( r.charAt(0) == "-" ) {
+					r = r.substr(1);
+					var isStatic = StringTools.startsWith(r,"static ");
+					if( isStatic ) r = r.substr(7);
+					var p = r.split(".");
+					var field = p.pop();
+					removeField(p.join("."),field,isStatic);
+					continue;
+				}
+				var rp = r.split(" : ");
+				if( rp.length > 1 ) {
+					r = rp.shift();
+					var isStatic = StringTools.startsWith(r,"static ");
+					if( isStatic ) r = r.substr(7);
+					var p = r.split(".");
+					var field = p.pop();
+					setFieldType(p.join("."),field,rp.join(" : "),isStatic);
+					continue;
+				}
+				throw "Invalid type patch "+r;
+			}
+		} catch( e : haxe.io.Eof ) {
+		}
+	}
+
+	static function load( f, nargs ) : Dynamic {
+		#if macro
+		return neko.Lib.load("macro", f, nargs);
+		#else
+		return Reflect.makeVarArgs(function(_) throw "Can't be called outside of macro");
+		#end
+	}
+
+#end
+
+}

+ 2 - 2
std/haxe/macro/Context.hx

@@ -101,8 +101,8 @@ class Context {
 	/**
 		Evaluate the type a given expression would have in the context of the current macro call.
 	**/
-	public static function eval( e : Expr ) : Type {
-		return load("eval", 1)(e);
+	public static function typeof( e : Expr ) : Type {
+		return load("typeof", 1)(e);
 	}
 	
 	static function load( f, nargs ) : Dynamic {

+ 1 - 0
typecore.ml

@@ -29,6 +29,7 @@ type typer_globals = {
 	mutable macros : ((unit -> unit) * typer) option;
 	mutable std : module_def;
 	mutable hook_generate : (unit -> unit) list;
+	type_patches : (path, (string * bool, Ast.complex_type option) Hashtbl.t) Hashtbl.t;
 	(* api *)
 	do_inherit : typer -> Type.tclass -> Ast.pos -> Ast.class_flag -> bool;
 	do_create : Common.context -> typer;

+ 40 - 0
typeload.ml

@@ -586,7 +586,47 @@ let init_core_api ctx c =
 		check_fields ccore.cl_statics c.cl_statics;
 	| _ -> assert false
 
+let patch_class ctx c fields =
+	let h = (try Some (Hashtbl.find ctx.g.type_patches c.cl_path) with Not_found -> None) in
+	match h with
+	| None -> fields
+	| Some h ->
+		let rec loop acc = function
+			| [] -> List.rev acc
+			| (f,p) :: l ->
+				let acc = (try
+					match f with
+					| FVar (name,doc,meta,access,t,e) ->
+						(match Hashtbl.find h (name,List.mem AStatic access) with
+						| None -> acc
+						| Some t -> (FVar (name,doc,meta,access,Some t,e),p) :: acc)
+					| FProp (name,doc,meta,access,get,set,t) ->
+						(match Hashtbl.find h (name,List.mem AStatic access) with
+						| None -> acc
+						| Some t -> (FProp (name,doc,meta,access,get,set,t),p) :: acc)
+					| FFun (name,doc,meta,access,pl,f) ->
+						(match Hashtbl.find h (name,List.mem AStatic access) with
+						| None -> acc
+						| Some t -> (FFun (name,doc,meta,access,pl,{ f with f_type = Some t }),p) :: acc)
+				with Not_found ->
+					let f = (match f with
+					| FFun (name,doc,meta,access,params,f) ->
+						let param ((n,opt,t,e) as p) =
+							try
+								n, opt, Hashtbl.find h (("$" ^ n),false), e
+							with Not_found ->
+								p
+						in
+						FFun (name,doc,meta,access,params,{ f with f_args = List.map param f.f_args })
+					| _ -> f) in
+					(f,p) :: acc
+				) in
+				loop acc l
+		in
+		List.rev (loop [] fields)
+
 let init_class ctx c p herits fields meta =
+	let fields = patch_class ctx c fields in
 	ctx.type_params <- c.cl_types;
 	c.cl_extern <- List.mem HExtern herits;
 	c.cl_interface <- List.mem HInterface herits;

+ 79 - 26
typer.ml

@@ -1834,13 +1834,31 @@ let make_macro_api ctx p =
 			| [EClass { d_data = [FFun ("main",_,_,_,_,{ f_expr = e }),_] },_] -> e
 			| _ -> assert false
 		);
-		Interp.eval = (fun e ->
+		Interp.typeof = (fun e ->
 			let e = (try type_expr ctx ~need_val:true e with Error (msg,_) -> failwith (error_msg msg)) in
 			e.etype
 		);
+		Interp.type_patch = (fun t f s v ->
+			let v = (match v with None -> None | Some s -> 
+				let old = Lexer.save() in
+				let head = "typedef T = " in
+				let _, decls = Parser.parse ctx.com (Lexing.from_string (head ^ s)) in
+				Lexer.restore old;
+				match decls with
+				| [ETypedef { d_data = ct },_] -> Some ct
+				| _ -> assert false
+			) in
+			let path = Ast.parse_path t in
+			let h = (try Hashtbl.find ctx.g.type_patches path with Not_found ->
+				let h = Hashtbl.create 0 in
+				Hashtbl.add ctx.g.type_patches path h;
+				h
+			) in
+			Hashtbl.replace h (f,s) v			
+		);
 	}
 
-let type_macro ctx cpath f el p =
+let load_macro ctx cpath f p =
 	let t = Common.timer "macro execution" in
 	let api = make_macro_api ctx p in
 	let ctx2 = (match ctx.g.macros with
@@ -1879,30 +1897,44 @@ let type_macro ctx cpath f el p =
 		| TInst (c,_) -> (try PMap.find f c.cl_statics with Not_found -> error ("Method " ^ f ^ " not found on class " ^ s_type_path cpath) p)
 		| _ -> error "Macro should be called on a class" p
 	) in
+	let meth = (match follow meth.cf_type with TFun (args,ret) -> args,ret | _ -> error "Macro call should be a method" p) in
+	let in_macro = ctx.in_macro in
+	if not in_macro then begin
+		finalize ctx2;
+		let types, modules = generate ctx2 None [] in
+		ctx2.com.types <- types;
+		ctx2.com.Common.modules <- modules;
+		Interp.add_types mctx types;
+	end else t();
+	let call args =
+		let r = Interp.call_path mctx ((fst cpath) @ [snd cpath]) f args api in
+		if not in_macro then t();
+		r
+	in	
+	ctx2, meth, call
+
+let type_macro ctx cpath f el p =
+	let ctx2, (margs,mret), call_macro = load_macro ctx cpath f p in
 	let expr = Typeload.load_instance ctx2 { tpackage = ["haxe";"macro"]; tname = "Expr"; tparams = []; tsub = None} p false in
-	let nargs = (match follow meth.cf_type with
-		| TFun (args,ret) ->
-			unify ctx2 ret expr p;
-			(match args with
-			| [(_,_,t)] ->
-				(try
-					unify_raise ctx2 t expr p;
-					Some 1
-				with Error (Unify _,_) ->
-					unify ctx2 t (ctx2.t.tarray expr) p;
-					None)
-			| _ ->
-				List.iter (fun (_,_,t) -> unify ctx2 t expr p) args;
-				Some (List.length args))
+	unify ctx2 mret expr p;
+	let nargs = (match margs with
+		| [(_,_,t)] ->
+			(try
+				unify_raise ctx2 t expr p;
+				Some 1
+			with Error (Unify _,_) ->
+				unify ctx2 t (ctx2.t.tarray expr) p;
+				None)
 		| _ ->
-			assert false
+			List.iter (fun (_,_,t) -> unify ctx2 t expr p) margs;
+			Some (List.length margs)
 	) in
 	(match nargs with
 	| Some n -> if List.length el <> n then error ("This macro requires " ^ string_of_int n ^ " arguments") p
 	| None -> ());
 	let call() =
 		let el = List.map Interp.encode_expr el in
-		match Interp.call_path mctx ((fst cpath) @ [snd cpath]) f (if nargs = None then [Interp.enc_array el] else el) api with
+		match call_macro (if nargs = None then [Interp.enc_array el] else el) with
 		| None -> None
 		| Some v -> Some (try Interp.decode_expr v with Interp.Invalid_expr -> error "The macro didn't return a valid expression" p)
 	in
@@ -1918,6 +1950,7 @@ let type_macro ctx cpath f el p =
 		let ctx = {
 			ctx with locals = ctx.locals;
 		} in
+		let mctx = Interp.get_ctx() in
 		let pos = Interp.alloc_delayed mctx (fun() ->
 			(* remove $delay_call calls from the stack *)
 			Interp.unwind_stack mctx;
@@ -1927,17 +1960,36 @@ let type_macro ctx cpath f el p =
 		) in
 		let e = (EConst (Ident "__dollar__delay_call"),p) in
 		Some (EUntyped (ECall (e,[EConst (Int (string_of_int pos)),p]),p),p)
-	end else begin
-		finalize ctx2;
-		let types, modules = generate ctx2 None [] in
-		ctx2.com.types <- types;
-		ctx2.com.Common.modules <- modules;
-		Interp.add_types mctx types;
+	end else
 		call()
-	end) in
-	t();
+	) in
 	e
 
+let call_macro ctx path meth args p =
+	let ctx2, (margs,_), call = load_macro ctx path meth p in
+	let el = unify_call_params ctx2 (Some meth) args margs p false in
+	call (List.map (fun e -> try Interp.make_const e with Exit -> error "Parameter should be a constant" e.epos) el)
+
+let call_init_macro ctx e =
+	let p = { pfile = "--macro"; pmin = 0; pmax = 0 } in
+	let api = make_macro_api ctx p in
+	let e = api.Interp.parse_string e p in
+	match fst e with
+	| ECall (e,args) ->
+		let rec loop e =
+			match fst e with
+			| EField (e,f) | EType (e,f) -> f :: loop e
+			| EConst (Ident i | Type i) -> [i]
+			| _ -> error "Invalid macro call" p
+		in
+		let path, meth = (match loop e with
+		| [meth] -> (["haxe";"macro"],"Compiler"), meth
+		| meth :: cl :: path -> (List.rev path,cl), meth
+		| _ -> error "Invalid macro call" p) in
+		ignore(call_macro ctx path meth args p);
+	| _ ->
+		error "Invalid macro call" p
+
 (* ---------------------------------------------------------------------- *)
 (* TYPER INITIALIZATION *)
 
@@ -1955,6 +2007,7 @@ let rec create com =
 			modules = Hashtbl.create 0;
 			types_module = Hashtbl.create 0;
 			constructs = Hashtbl.create 0;
+			type_patches = Hashtbl.create 0;
 			delayed = [];
 			doinline = not (Common.defined com "no_inline");
 			hook_generate = [];