Some more random changes (#6250)

* ignore mandelbrot benchmark output

* use Ptmap instead of a Map specialization

Also install rope while we're at it.

* add an argument to Interp.create to distinguish macro/interp contexts

* rewrite --times again, sort descending

* fix bytes/string-related signature

* remove macro finalize timer because all that does is type the leftover stuff

* add haxe.macro.Context.storeExpr

* fix more string/bytes signature

.gitignore

@@ -101,5 +101,6 @@ Makefile.modules
 /tests/unit/compiler_loops/All.n
 
 /tests/unit/compiler_loops/log.txt
+tests/benchs/mandelbrot/bin/
 tests/server/test/cases/
 tests/server/test.js

.merlin

@@ -3,6 +3,8 @@ B _build/src/**
 S libs/**
 B libs/**
 B +threads
+PKG rope
+PKG ptmap
 PKG sedlex
 PKG extlib
 PKG camlzip

.travis.yml

@@ -35,7 +35,7 @@ install_linux: &install_linux
       camlp4
   - wget https://raw.github.com/ocaml/opam/master/shell/opam_installer.sh -O - | sh -s /usr/local/bin system
   - export OPAMYES=1
-  - opam install sedlex camlzip xml-light extlib
+  - opam install sedlex camlzip xml-light extlib rope ptmap
   # Setup database
   - travis_retry sudo apt-get install mysql-server-5.6 -y
   - mysql -u root -e "create user travis@localhost identified by '';"
@@ -59,7 +59,7 @@ install_osx: &install_osx
   - travis_retry brew install opam;
   - export OPAMYES=1
   - opam init
-  - opam install camlp4 sedlex ocamlfind camlzip xml-light extlib
+  - opam install camlp4 sedlex ocamlfind camlzip xml-light extlib rope ptmap
   - eval `opam config env`
   # Install neko
   - travis_retry brew install neko --HEAD;

Makefile

@@ -29,7 +29,7 @@ STATICLINK?=0
 
 HAXE_DIRECTORIES=compiler context generators generators/gencommon macro filters optimization syntax typing display
 EXTLIB_LIBS=extlib-leftovers extc neko javalib swflib ttflib ilib objsize pcre
-FINDLIB_LIBS=unix str threads sedlex camlzip xml-light extlib
+FINDLIB_LIBS=unix str threads sedlex camlzip xml-light extlib rope ptmap
 
 # Includes, packages and compiler
 

appveyor.yml

@@ -19,7 +19,7 @@ services:
 skip_tags: true
 
 cache:
-    - opam32.tar.xz -> appveyor.yml
+    - opam64.tar.xz -> appveyor.yml
 
 install:
     - 'git submodule update --init --recursive'
@@ -28,13 +28,13 @@ install:
     # Install ocaml
     - curl -fsSL -o cygwin-setup.exe --retry 3 https://cygwin.com/setup-x86.exe
     - 'cygwin-setup.exe -g -q -R "%CYG_ROOT%" -P make -P git -P mingw64-i686-zlib -P rsync -P patch -P diffutils -P curl -P unzip -P m4 -P perl -P mingw64-i686-gcc-core -P mingw64-i686-pcre'
-    - if not exist "opam32.tar.xz" (
-        curl -fsSL -o opam32.tar.xz --retry 3 https://github.com/fdopen/opam-repository-mingw/releases/download/0.0.0.1/opam32.tar.xz
+    - if not exist "opam64.tar.xz" (
+        curl -fsSL -o opam64.tar.xz --retry 3 https://github.com/fdopen/opam-repository-mingw/releases/download/0.0.0.1/opam64.tar.xz
       )
-    - 7z x "opam32.tar.xz" -so | 7z x -aoa -si -ttar
-    - '%CYG_ROOT%/bin/bash -lc "cd \"$OLDPWD\" && bash opam32/install.sh"'
+    - 7z x "opam64.tar.xz" -so | 7z x -aoa -si -ttar
+    - '%CYG_ROOT%/bin/bash -lc "cd \"$OLDPWD\" && bash opam64/install.sh"'
     - '%CYG_ROOT%/bin/bash -lc "opam init mingw \"https://github.com/fdopen/opam-repository-mingw.git\" --comp 4.02.3+mingw32c --switch 4.02.3+mingw32c --auto-setup --yes"'
-    - '%CYG_ROOT%/bin/bash -lc "opam install camlp4 sedlex ocamlfind camlzip xml-light extlib --yes"'
+    - '%CYG_ROOT%/bin/bash -lc "opam install camlp4 sedlex ocamlfind camlzip xml-light extlib rope ptmap --yes"'
     # Install neko
     - choco install neko --prerelease --ignore-dependencies -s 'https://ci.appveyor.com/nuget/neko' -y
     - choco install chocolatey-core.extension php --ignore-dependencies -y

src/compiler/globals.ml

@@ -4,7 +4,7 @@ type pos = {
 	pmax : int;
 }
 
-module IntMap = Map.Make(struct type t = int let compare a b = a - b end)
+module IntMap = Ptmap
 module StringMap = Map.Make(struct type t = string let compare = String.compare end)
 
 type platform =

src/compiler/server.ml

@@ -38,58 +38,99 @@ type server_message =
 let s_version =
 	Printf.sprintf "%d.%d.%d%s" version_major version_minor version_revision (match Version.version_extra with None -> "" | Some v -> " " ^ v)
 
+type timer_node = {
+	name : string;
+	path : string;
+	parent : timer_node;
+	info : string;
+	mutable time : float;
+	mutable num_calls : int;
+	mutable children : timer_node list;
+}
+
 let report_times print =
-	let tot = ref 0. in
-	Hashtbl.iter (fun _ t -> tot := !tot +. t.total) Common.htimers;
-	if !tot > 0. then begin
-		let buckets = Hashtbl.create 0 in
-		let add id time calls =
-			try
-				let time',calls' = Hashtbl.find buckets id in
-				Hashtbl.replace buckets id (time' +. time,calls' + calls)
-			with Not_found ->
-				Hashtbl.add buckets id (time,calls)
-		in
-		Hashtbl.iter (fun _ t ->
-			let rec loop acc ids = match ids with
-				| id :: ids ->
-					add (List.rev (id :: acc)) t.total t.calls;
-					loop (id :: acc) ids
-				| [] ->
-					()
-			in
-			loop [] t.id
-		) Common.htimers;
-		let max_name = ref 0 in
-		let max_calls = ref 0 in
-		let timers = Hashtbl.fold (fun id t acc ->
-			let name,indent = match List.rev id with
-				| [] -> assert false
-				| name :: l -> name,(String.make (List.length l * 2) ' ')
-			in
-			let name,info = try
-				let i = String.rindex name '.' in
-				String.sub name (i + 1) (String.length name - i - 1),String.sub name 0 i
-			with Not_found ->
-				name,""
-			in
-			let name = indent ^ name in
-			if String.length name > !max_name then max_name := String.length name;
-			if snd t > !max_calls then max_calls := snd t;
-			(id,name,info,t) :: acc
-		) buckets [] in
-		let max_calls = String.length (string_of_int !max_calls) in
-		print (Printf.sprintf "%-*s | %7s |   %% | %*s | info" !max_name "name" "time(s)" max_calls "#");
-		let sep = String.make (!max_name + max_calls + 21) '-' in
-		print sep;
-		let timers = List.sort (fun (id1,_,_,_) (id2,_,_,_) -> compare id1 id2) timers in
-		let print_timer id name info (time,calls) =
-			print (Printf.sprintf "%-*s | %7.3f | %3.0f | %*i | %s" !max_name name time (time *. 100. /. !tot) max_calls calls info)
+	let nodes = Hashtbl.create 0 in
+	let rec root = {
+		name = "";
+		path = "";
+		parent = root;
+		info = "";
+		time = 0.;
+		num_calls = 0;
+		children = [];
+	} in
+	Hashtbl.iter (fun _ timer ->
+		let rec loop parent sl = match sl with
+			| [] -> assert false
+			| s :: sl ->
+				let path = (match parent.path with "" -> "" | _ -> parent.path ^ ".") ^ s in
+				let node = try
+					let node = Hashtbl.find nodes path in
+					node.num_calls <- node.num_calls + timer.calls;
+					node.time <- node.time +. timer.total;
+					node
+				with Not_found ->
+					let name,info = try
+						let i = String.rindex s '.' in
+						String.sub s (i + 1) (String.length s - i - 1),String.sub s 0 i
+					with Not_found ->
+						s,""
+					in
+					let node = {
+						name = name;
+						path = path;
+						parent = parent;
+						info = info;
+						time = timer.total;
+						num_calls = timer.calls;
+						children = [];
+					} in
+					Hashtbl.add nodes path node;
+					node
+				in
+				begin match sl with
+					| [] -> ()
+					| _ ->
+						let child = loop node sl in
+						if not (List.memq child node.children) then
+							node.children <- child :: node.children;
+				end;
+				node
 		in
-		List.iter (fun (id,name,info,t) -> print_timer id name info t) timers;
-		print sep;
-		print_timer ["total"] "total" "" (!tot,0)
-	end
+		let node = loop root timer.id in
+		if not (List.memq node root.children) then
+			root.children <- node :: root.children
+	) Common.htimers;
+	let max_name = ref 0 in
+	let max_calls = ref 0 in
+	let rec loop depth node =
+		let l = (String.length node.name) + 2 * depth in
+		if l > !max_name then max_name := l;
+		List.iter (fun child ->
+			node.num_calls <- node.num_calls + child.num_calls;
+			node.time <- node.time +. child.time;
+			loop (depth + 1) child;
+		) node.children;
+		node.children <- List.sort (fun node1 node2 -> compare node2.time node1.time) node.children;
+		if node.num_calls > !max_calls then max_calls := node.num_calls;
+	in
+	loop 0 root;
+	let max_calls = String.length (string_of_int !max_calls) in
+	print (Printf.sprintf "%-*s | %7s |   %% |  p%% | %*s | info" !max_name "name" "time(s)" max_calls "#");
+	let sep = String.make (!max_name + max_calls + 27) '-' in
+	print sep;
+	let print_time name node =
+		if node.time > 0.0009 then
+			print (Printf.sprintf "%-*s | %7.3f | %3.0f | %3.0f | %*i | %s" !max_name name node.time (node.time *. 100. /. root.time) (node.time *. 100. /. node.parent.time) max_calls node.num_calls node.info)
+	in
+	let rec loop depth node =
+		let name = (String.make (depth * 2) ' ') ^ node.name in
+		print_time name node;
+		List.iter (loop (depth + 1)) node.children
+	in
+	List.iter (loop 0) root.children;
+	print sep;
+	print_time "total" root
 
 let default_flush ctx =
 	List.iter prerr_endline (List.rev ctx.messages);

src/macro/hlmacro.ml

@@ -77,7 +77,7 @@ let error_handler ctx v stack =
 	| _ -> ());*)
 	raise (Error (Hlinterp.vstr ctx.interp v Hlcode.HDyn,List.map make_pos stack))
 
-let create com api =
+let create com api _ =
 	let ctx = {
 		com = com;
 		gen = None;

src/macro/interp.ml

@@ -2653,7 +2653,7 @@ let load_prim ctx f n =
 	| _ ->
 		exc (VString (value_match_failure "Invalid call" ["VString";"VInt"] [f;n]))
 
-let create com api =
+let create com api _ =
 	let loader = obj hash [
 		"args",VArray (Array.of_list (List.map (fun s -> VString s) com.sys_args));
 		"loadprim",VFunction (Fun2 (fun a b -> (get_ctx()).do_loadprim a b));
@@ -2807,7 +2807,7 @@ let decode_string v =
 
 let decode_bytes v =
 	match field v "b" with
-	| VString s -> s
+	| VString s -> (Bytes.unsafe_of_string s)
 	| _ -> raise Invalid_expr
 
 let decode_array v =
@@ -2867,8 +2867,8 @@ let encode_string s =
 
 let encode_bytes s =
 	encode_inst ["haxe";"io";"Bytes"] [
-		"b", VString s;
-		"length", VInt (String.length s)
+		"b", VString (Bytes.unsafe_to_string s);
+		"length", VInt (Bytes.length s)
 	]
 
 let encode_hash h =

src/macro/macroApi.ml

@@ -176,8 +176,8 @@ module type InterpApi = sig
 	val value_to_expr : value -> Globals.pos -> Ast.expr
 	val value_signature : value -> string
 
-	val encode_bytes : string -> value
-	val decode_bytes : value -> string (* haxe.io.Bytes *)
+	val encode_bytes : bytes -> value
+	val decode_bytes : value -> bytes (* haxe.io.Bytes *)
 
 	val prepare_callback : value -> int -> (value list -> value)
 
@@ -1654,14 +1654,15 @@ let macro_api ccom get_api =
 		"add_resource", vfun2 (fun name data ->
 			let name = decode_string name in
 			let data = decode_bytes data in
+			let data = Bytes.unsafe_to_string data in
 			if name = "" then failwith "Empty resource name";
 			Hashtbl.replace (ccom()).resources name data;
 			let m = if name.[0] = '$' then (get_api()).current_macro_module() else (get_api()).current_module() in
 			m.m_extra.m_binded_res <- PMap.add name data m.m_extra.m_binded_res;
 			vnull
 		);
 		"get_resources", vfun0 (fun() ->
-			encode_string_map encode_bytes (Hashtbl.fold (fun k v acc -> PMap.add k v acc) (ccom()).resources PMap.empty)
+			encode_string_map encode_string (Hashtbl.fold (fun k v acc -> PMap.add k v acc) (ccom()).resources PMap.empty)
 		);
 		"get_local_module", vfun0 (fun() ->
 			let m = (get_api()).current_module() in
@@ -1795,6 +1796,11 @@ let macro_api ccom get_api =
 			let e = decode_texpr e in
 			encode_expr (TExprToExpr.convert_expr e)
 		);
+		"store_expr", vfun1 (fun e ->
+			let api = get_api() in
+			let te = (api.type_expr (decode_expr e)) in
+			encode_expr (api.store_typed_expr te)
+		);
 		"store_typed_expr", vfun1 (fun e ->
 			let e = decode_texpr e in
 			encode_expr ((get_api()).store_typed_expr e)

src/macro/macroContext.ml

@@ -390,7 +390,7 @@ and flush_macro_context mint ctx =
 	(* if one of the type we are using has been modified, we need to create a new macro context from scratch *)
 	let mint = if not (Interp.can_reuse mint types && check_reuse()) then begin
 		let com2 = mctx.com in
-		let mint = Interp.create com2 (make_macro_api ctx Globals.null_pos) in
+		let mint = Interp.create com2 (make_macro_api ctx Globals.null_pos) true in
 		let macro = ((fun() -> Interp.select mint), mctx) in
 		ctx.g.macros <- Some macro;
 		mctx.g.macros <- Some macro;
@@ -431,7 +431,8 @@ let create_macro_interp ctx mctx =
 	let com2 = mctx.com in
 	let mint, init = (match !macro_interp_cache with
 		| None ->
-			let mint = Interp.create com2 (make_macro_api ctx null_pos) in
+			let mint = Interp.create com2 (make_macro_api ctx null_pos) true in
+			Interp.select mint;
 			mint, (fun() -> init_macro_interp ctx mctx mint)
 		| Some mint ->
 			macro_interp_reused := false;
@@ -503,9 +504,7 @@ let load_macro ctx display cpath f p =
 		let mt = Typeload.load_type_def mctx p { tpackage = fst cpath; tname = snd cpath; tparams = []; tsub = sub } in
 		let cl, meth = (match mt with
 			| TClassDecl c ->
-				let t = macro_timer ctx ["finalize"] in
 				mctx.g.do_finalize mctx;
-				t();
 				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
@@ -755,7 +754,7 @@ let call_init_macro ctx e =
 		error "Invalid macro call" p
 
 let interpret ctx =
-	let mctx = Interp.create ctx.com (make_macro_api ctx null_pos) in
+	let mctx = Interp.create ctx.com (make_macro_api ctx null_pos) false in
 	Interp.add_types mctx ctx.com.types (fun t -> ());
 	match ctx.com.main with
 	| None -> ()

std/haxe/macro/Context.hx

@@ -516,6 +516,26 @@ class Context {
 		return load("store_typed_expr",1)(t);
 	}
 
+	/**
+		Types expression `e`, stores the resulting typed expression internally and 
+		returns a syntax-level expression that can be returned from a macro and 
+		will be replaced by the stored typed expression.
+
+		If `e` is null or invalid, an exception is thrown.
+
+		A call to `storeExpr(e)` is equivalent to `storeTypedExpr(typeExpr(e))` without
+		the overhead of encoding and decoding between regular and macro runtime.
+
+		NOTE: the returned value references an internally stored typed expression
+		that is reset between compilations, so care should be taken when storing
+		the expression returned by this method in a static variable and using the
+		compilation server.
+	**/
+	@:require(haxe_ver >= 4.0)
+	public static function storeExpr( e : Expr ) : Expr {
+		return load("store_expr",1)(e);
+	}
+
 	/**
 		Evaluates `e` as macro code.