Merge pull request #3309 from Simn/eval_command_line

add `--eval "module code"`

main.ml

@@ -965,6 +965,7 @@ try
 	let pre_compilation = ref [] in
 	let interp = ref false in
 	let swf_version = ref false in
+	let evals = ref [] in
 	Common.define_value com Define.HaxeVer (float_repres (float_of_int version /. 1000.));
 	Common.define_value com Define.HxcppApiLevel "312";
 	Common.raw_define com "haxe3";
@@ -1238,6 +1239,10 @@ try
 			force_typing := true;
 			config_macros := e :: !config_macros
 		)," : call the given macro before typing anything else");
+		("--eval", Arg.String (fun s ->
+			force_typing := true;
+			evals := s :: !evals;
+		), " : evaluates argument as Haxe module code");
 		("--wait", Arg.String (fun hp ->
 			let host, port = (try ExtString.String.split hp ":" with _ -> "127.0.0.1", hp) in
 			wait_loop com host (try int_of_string port with _ -> raise (Arg.Bad "Invalid port"))
@@ -1433,6 +1438,7 @@ try
 		Typecore.type_expr_ref := (fun ctx e with_type -> Typer.type_expr ctx e with_type);
 		let tctx = Typer.create com in
 		List.iter (Typer.call_init_macro tctx) (List.rev !config_macros);
+		List.iter (Typer.eval tctx) !evals;
 		List.iter (fun cpath -> ignore(tctx.Typecore.g.Typecore.do_load_module tctx cpath Ast.null_pos)) (List.rev !classes);
 		Typer.finalize tctx;
 		t();

typer.ml

@@ -330,7 +330,7 @@ let prepare_using_field cf = match cf.cf_type with
 		{cf with cf_overloads = loop [] cf.cf_overloads; cf_type = TFun(args,ret)}
 	| _ -> cf
 
-let parse_string ctx s p inlined =
+let parse_string com s p inlined =
 	let old = Lexer.save() in
 	let old_file = (try Some (Hashtbl.find Lexer.all_files p.pfile) with Not_found -> None) in
 	let old_display = !Parser.resume_display in
@@ -346,8 +346,8 @@ let parse_string ctx s p inlined =
 	Lexer.init p.pfile (ExtString.String.ends_with p.pfile ".hx");
 	Parser.display_error := (fun e p -> raise (Parser.Error (e,p)));
 	if not inlined then Parser.resume_display := null_pos;
-	let _, decls = try
-		Parser.parse ctx.com (Lexing.from_string s)
+	let pack, decls = try
+		Parser.parse com (Lexing.from_string s)
 	with Parser.Error (e,pe) ->
 		restore();
 		error (Parser.error_msg e) (if inlined then pe else p)
@@ -356,16 +356,42 @@ let parse_string ctx s p inlined =
 		error (Lexer.error_msg e) (if inlined then pe else p)
 	in
 	restore();
-	match decls with
-	| [(d,_)] -> d
-	| _ -> assert false
+	pack,decls
+
+let eval ctx s =
+	let p = { pfile = "--eval"; pmin = 0; pmax = String.length s; } in
+	let pack,decls = parse_string ctx.com s p false in
+	let rec find_main current decls = match decls with
+		| (EClass c,_) :: decls ->
+			let path = pack,c.d_name in
+			begin try
+				let cff = List.find (fun cff -> cff.cff_name = "main") c.d_data in
+				if ctx.com.main_class <> None then error "Multiple main" cff.cff_pos;
+				ctx.com.main_class <- Some path;
+				Some path
+			with Not_found ->
+				find_main (if current = None then Some path else current) decls
+			end
+		| ((EEnum {d_name = s} | ETypedef {d_name = s} | EAbstract {d_name = s}),_) :: decls when current = None ->
+			find_main (Some (pack,s)) decls
+		| _ :: decls ->
+			find_main current decls
+		| [] ->
+			current
+	in
+	let path_module = match find_main None decls with
+		| None -> error "Evaluated string did not define any types" p
+		| Some path -> path
+	in
+	ignore(Typeload.type_module ctx path_module "eval" decls p);
+	flush_pass ctx PBuildClass "load_module"
 
 let parse_expr_string ctx s p inl =
 	let head = "class X{static function main() " in
 	let head = (if p.pmin > String.length head then head ^ String.make (p.pmin - String.length head) ' ' else head) in
 	let rec loop e = let e = Ast.map_expr loop e in (fst e,p) in
-	match parse_string ctx (head ^ s ^ ";}") p inl with
-	| EClass { d_data = [{ cff_name = "main"; cff_kind = FFun { f_expr = Some e } }]} -> if inl then e else loop e
+	match parse_string ctx.com (head ^ s ^ ";}") p inl with
+	| _,[EClass { d_data = [{ cff_name = "main"; cff_kind = FFun { f_expr = Some e } }]},_] -> if inl then e else loop e
 	| _ -> raise Interp.Invalid_expr
 
 let collect_toplevel_identifiers ctx =
@@ -3479,7 +3505,6 @@ and handle_display ctx e_ast iscall p =
 	in
 	match ctx.com.display with
 	| DMUsage | DMPosition ->
-		(* print_endline (s_expr (s_type (print_context())) e); *)
 		begin match e.eexpr with
 		| TField(_,FEnum(_,ef)) ->
 			if ctx.com.display = DMPosition then
@@ -4198,8 +4223,8 @@ let make_macro_api ctx p =
 		Interp.type_patch = (fun t f s v ->
 			typing_timer ctx (fun() ->
 				let v = (match v with None -> None | Some s ->
-					match parse_string ctx ("typedef T = " ^ s) null_pos false with
-					| ETypedef { d_data = ct } -> Some ct
+					match parse_string ctx.com ("typedef T = " ^ s) null_pos false with
+					| _,[ETypedef { d_data = ct },_] -> Some ct
 					| _ -> assert false
 				) in
 				let tp = get_type_patch ctx t (Some (f,s)) in
@@ -4209,8 +4234,8 @@ let make_macro_api ctx p =
 			);
 		);
 		Interp.meta_patch = (fun m t f s ->
-			let m = (match parse_string ctx (m ^ " typedef T = T") null_pos false with
-				| ETypedef t -> t.d_meta
+			let m = (match parse_string ctx.com (m ^ " typedef T = T") null_pos false with
+				| _,[ETypedef t,_] -> t.d_meta
 				| _ -> assert false
 			) in
 			let tp = get_type_patch ctx t (match f with None -> None | Some f -> Some (f,s)) in