add field contexts, hashcons expression type instances

src/compiler/hxb/hxbReader.ml

@@ -22,6 +22,16 @@ let print_stacktrace () =
 		| (_ :: (_ :: lines)) -> prerr_endline (Printf.sprintf "%s" (ExtString.String.join "\n" lines))
 		| _ -> die "" __LOC__
 
+type field_reader_context = {
+	t_pool : Type.t DynArray.t;
+	pos : pos ref;
+}
+
+let create_field_reader_context p = {
+	t_pool = DynArray.create ();
+	pos = ref p;
+}
+
 class hxb_reader
 	(api : HxbReaderApi.hxb_reader_api)
 = object(self)
@@ -823,7 +833,7 @@ class hxb_reader
 			| 10 -> VAbstractThis
 			| _ -> assert false
 
-	method read_var =
+	method read_var fctx =
 		let id = IO.read_i32 ch in
 		let name = self#read_string in
 		let extra = self#read_option (fun () ->
@@ -831,7 +841,7 @@ class hxb_reader
 				let i = self#read_uleb128 in
 				local_type_parameters.(i)
 			) in
-			let vexpr = self#read_option (fun () -> self#read_texpr) in
+			let vexpr = self#read_option (fun () -> self#read_texpr fctx) in
 			{
 				v_params = params;
 				v_expr = vexpr;
@@ -855,10 +865,18 @@ class hxb_reader
 		Hashtbl.add vars id v;
 		v
 
-	method read_texpr =
-		let pos = ref self#read_pos in
+	method read_texpr fctx =
 		let rec loop () =
-			let t = self#read_type_instance in
+			let t = match self#read_u8 with
+				| 0 ->
+					DynArray.get fctx.t_pool self#read_uleb128
+				| 1 ->
+					let t = self#read_type_instance in
+					DynArray.add fctx.t_pool t;
+					t
+				| _ ->
+					die "" __LOC__
+			in
 			let rec loop2 () =
 				match IO.read_byte ch with
 					(* values 0-19 *)
@@ -874,10 +892,10 @@ class hxb_reader
 					(* vars 20-29 *)
 					| 20 -> TLocal (Hashtbl.find vars (IO.read_i32 ch))
 					| 21 ->
-						let v = self#read_var in
+						let v = self#read_var fctx in
 						TVar (v,None)
 					| 22 ->
-							let v = self#read_var in
+							let v = self#read_var fctx in
 							let e = loop () in
 							TVar (v, Some e)
 
@@ -903,7 +921,7 @@ class hxb_reader
 					(* function 50-59 *)
 					| 50 ->
 						let read_tfunction_arg () =
-							let v = self#read_var in
+							let v = self#read_var fctx in
 							let cto = self#read_option loop in
 							(v,cto)
 						in
@@ -973,7 +991,7 @@ class hxb_reader
 					| 83 ->
 						let e1 = loop () in
 						let catches = self#read_list (fun () ->
-							let v = self#read_var in
+							let v = self#read_var fctx in
 							let e = loop () in
 							(v,e)
 						) in
@@ -987,7 +1005,7 @@ class hxb_reader
 						let e2 = loop () in
 						TWhile(e1,e2,DoWhile)
 					| 86 ->
-						let v  = self#read_var in
+						let v  = self#read_var fctx in
 						let e1 = loop () in
 						let e2 = loop () in
 						TFor(v,e1,e2)
@@ -1084,18 +1102,18 @@ class hxb_reader
 						TBinop(op,e1,e2)
 					(* pos 241-244*)
 					| 241 ->
-						pos := {!pos with pmin = self#read_leb128};
+						fctx.pos := {!(fctx.pos) with pmin = self#read_leb128};
 						loop2 ()
 					| 242 ->
-						pos := {!pos with pmax = self#read_leb128};
+						fctx.pos := {!(fctx.pos) with pmax = self#read_leb128};
 						loop2 ()
 					| 243 ->
 						let pmin = self#read_leb128 in
 						let pmax = self#read_leb128 in
-						pos := {!pos with pmin; pmax};
+						fctx.pos := {!(fctx.pos) with pmin; pmax};
 						loop2 ()
 					| 244 ->
-						pos := self#read_pos;
+						fctx.pos := self#read_pos;
 						loop2 ()
 					(* rest 250-254 *)
 					| 250 ->
@@ -1110,7 +1128,7 @@ class hxb_reader
 				let e = {
 					eexpr = e;
 					etype = t;
-					epos = !pos;
+					epos = !(fctx.pos);
 				} in
 				e
 		and loop_el () =
@@ -1150,8 +1168,9 @@ class hxb_reader
 			| 0 ->
 				None,None
 			| _ ->
-				let e = self#read_texpr in
-				let e_unopt = self#read_option (fun () -> self#read_texpr) in
+				let fctx = create_field_reader_context self#read_pos in
+				let e = self#read_texpr fctx in
+				let e_unopt = self#read_option (fun () -> self#read_texpr fctx) in
 				(Some e,e_unopt)
 		in
 
@@ -1208,7 +1227,7 @@ class hxb_reader
 		in
 		loop CfrMember (self#read_uleb128) c.cl_ordered_fields;
 		loop CfrStatic (self#read_uleb128) c.cl_ordered_statics;
-		c.cl_init <- self#read_option (fun () -> self#read_texpr);
+		c.cl_init <- self#read_option (fun () -> self#read_texpr (create_field_reader_context self#read_pos));
 		(match c.cl_kind with KModuleFields md -> md.m_statics <- Some c; | _ -> ());
 
 	method read_enum_fields (e : tenum) =

src/compiler/hxb/hxbWriter.ml

@@ -13,6 +13,12 @@ let c_dim = if no_color then "" else "\x1b[2m"
 let todo = "\x1b[33m[TODO]" ^ c_reset
 let todo_error = "\x1b[31m[TODO] error:" ^ c_reset
 
+let unopt_write_counter = ref 0
+let unopt_skip_counter = ref 0
+
+let t_pool_hits = ref 0
+let t_pool_misses = ref 0
+
 let rec binop_index op = match op with
 	| OpAdd -> 0
 	| OpMult -> 1
@@ -247,22 +253,21 @@ end
 class pos_writer
 	(chunk : chunk)
 	(p_initial : pos)
-	(offset : int)
 	(write_equal : bool)
 = object(self)
 
 	val mutable p_cur = p_initial
 
-	method private do_write_pos (p : pos) =
+	method private do_write_pos (chunk : chunk) (p : pos) =
 		chunk#write_string p.pfile;
 		chunk#write_leb128 p.pmin;
 		chunk#write_leb128 p.pmax;
 
-	method write_pos (p : pos) =
+	method write_pos (chunk : chunk) (offset : int) (p : pos) =
 		if p.pfile <> p_cur.pfile then begin
 			(* File changed, write full pos *)
 			chunk#write_u8 (4 + offset);
-			self#do_write_pos p;
+			self#do_write_pos chunk p;
 		end else if p.pmin <> p_cur.pmin then begin
 			if p.pmax <> p_cur.pmax then begin
 				(* pmin and pmax changed *)
@@ -281,8 +286,21 @@ class pos_writer
 		end else if write_equal then
 			chunk#write_u8 offset;
 		p_cur <- p
+
+	initializer
+		self#do_write_pos chunk p_initial
 end
 
+type field_writer_context = {
+	t_pool : (bytes,unit) pool;
+	pos_writer : pos_writer;
+}
+
+let create_field_writer_context pos_writer = {
+	t_pool = new pool;
+	pos_writer = pos_writer;
+}
+
 class ['a] hxb_writer
 	(display_source_at : Globals.pos -> unit)
 	(anon_id : Type.t Tanon_identification.tanon_identification)
@@ -926,7 +944,7 @@ class ['a] hxb_writer
 		in
 		chunk#write_byte b
 
-	method write_var v =
+	method write_var fctx v =
 		chunk#write_i32 v.v_id;
 		chunk#write_string v.v_name;
 		chunk#write_option v.v_extra (fun ve ->
@@ -934,7 +952,7 @@ class ['a] hxb_writer
 				let index = local_type_parameters#add ttp () in
 				chunk#write_uleb128 index
 			);
-			chunk#write_option ve.v_expr self#write_texpr;
+			chunk#write_option ve.v_expr (self#write_texpr fctx);
 		);
 		self#write_type_instance v.v_type;
 		self#write_var_kind v.v_kind;
@@ -942,12 +960,23 @@ class ['a] hxb_writer
 		self#write_metadata v.v_meta;
 		self#write_pos v.v_pos
 
-	method write_texpr (e : texpr) =
-		let pos_writer = new pos_writer chunk e.epos 240 false in
-		self#write_pos e.epos;
+	method write_texpr fctx (e : texpr) =
 		let rec loop e =
+			let restore = self#start_temporary_chunk in
 			self#write_type_instance e.etype;
-			pos_writer#write_pos e.epos;
+			let t_bytes = restore (fun chunk new_chunk ->
+				new_chunk#get_bytes
+			) in
+			begin try
+				let index = fctx.t_pool#get t_bytes in
+				chunk#write_byte 0;
+				chunk#write_uleb128 index
+			with Not_found ->
+				chunk#write_byte 1;
+				ignore(fctx.t_pool#add t_bytes ());
+				IO.nwrite chunk#ch t_bytes
+			end;
+			fctx.pos_writer#write_pos chunk 240 e.epos;
 
 			match e.eexpr with
 			(* values 0-19 *)
@@ -979,10 +1008,10 @@ class ['a] hxb_writer
 				chunk#write_i32 v.v_id;
 			| TVar(v,None) ->
 				chunk#write_byte 21;
-				self#write_var v
+				self#write_var fctx v
 			| TVar(v,Some e1) ->
 				chunk#write_byte 22;
-				self#write_var v;
+				self#write_var fctx v;
 				loop e1;
 			(* blocks 30-49 *)
 			| TBlock [] ->
@@ -1012,7 +1041,7 @@ class ['a] hxb_writer
 			| TFunction tf ->
 				chunk#write_byte 50;
 				chunk#write_list tf.tf_args (fun (v,eo) ->
-					self#write_var v;
+					self#write_var fctx v;
 					chunk#write_option eo loop;
 				);
 				self#write_type_instance tf.tf_type;
@@ -1069,7 +1098,7 @@ class ['a] hxb_writer
 				chunk#write_byte 83;
 				loop e1;
 				chunk#write_list catches  (fun (v,e) ->
-					self#write_var v;
+					self#write_var fctx v;
 					loop e
 				);
 			| TWhile(e1,e2,flag) ->
@@ -1078,7 +1107,7 @@ class ['a] hxb_writer
 				loop e2;
 			| TFor(v,e1,e2) ->
 				chunk#write_byte 86;
-				self#write_var v;
+				self#write_var fctx v;
 				loop e1;
 				loop e2;
 			(* control flow 90-99 *)
@@ -1290,8 +1319,9 @@ class ['a] hxb_writer
 				chunk#write_byte 0
 			| Some e ->
 				chunk#write_byte 1;
+				let fctx = create_field_writer_context (new pos_writer chunk e.epos false) in
 				let flush_texpr = self#start_temporary_chunk in
-				self#write_texpr e;
+				self#write_texpr fctx e;
 				let texpr_bytes = flush_texpr (fun chunk new_chunk ->
 					new_chunk#get_bytes
 				) in
@@ -1301,7 +1331,7 @@ class ['a] hxb_writer
 						chunk#write_byte 0
 					| Some e ->
 						let flush_texpr = self#start_temporary_chunk in
-						self#write_texpr e;
+						self#write_texpr fctx e;
 						let texpr_unoptimized_bytes = flush_texpr (fun chunk new_chunk ->
 							new_chunk#get_bytes
 						) in
@@ -1573,7 +1603,7 @@ class ['a] hxb_writer
 				chunk#write_option c.cl_constructor (write_field CfrConstructor);
 				chunk#write_list c.cl_ordered_fields (write_field CfrMember);
 				chunk#write_list c.cl_ordered_statics (write_field CfrStatic);
-				chunk#write_option c.cl_init self#write_texpr;
+				chunk#write_option c.cl_init (fun e -> self#write_texpr (create_field_writer_context (new pos_writer chunk e.epos false)) e);
 			)
 		end;
 		begin match own_enums#to_list with