Browse Source

make class field handling less clunky

Simon Krajewski 2 years ago
parent
commit
0d7cceccbd
2 changed files with 45 additions and 77 deletions
  1. 20 53
      src/compiler/hxb/hxbReader.ml
  2. 25 24
      src/compiler/hxb/hxbWriter.ml

+ 20 - 53
src/compiler/hxb/hxbReader.ml

@@ -1064,7 +1064,14 @@ class hxb_reader
 		let len = IO.read_ui16 ch in
 		let len = IO.read_ui16 ch in
 		List.init len (fun _ -> self#read_texpr);
 		List.init len (fun _ -> self#read_texpr);
 
 
-	method read_class_field (cf : tclass_field) : unit =
+	method read_class_field_forward =
+		let name = self#read_string in
+		let pos = self#read_pos in
+		let name_pos = self#read_pos in
+		(* TODO overloads *)
+		{ null_field with cf_name = name; cf_pos = pos; cf_name_pos = name_pos }
+
+	method read_class_field_data (cf : tclass_field) : unit =
 		let name = cf.cf_name in
 		let name = cf.cf_name in
 		(* Printf.eprintf "  Read class field %s\n" name; *)
 		(* Printf.eprintf "  Read class field %s\n" name; *)
 		self#read_type_parameters ([],name) (fun a -> field_type_parameters <- a);
 		self#read_type_parameters ([],name) (fun a -> field_type_parameters <- a);
@@ -1080,7 +1087,7 @@ class hxb_reader
 
 
 		let expr = self#read_option (fun () -> self#read_texpr) in
 		let expr = self#read_option (fun () -> self#read_texpr) in
 		let expr_unoptimized = self#read_option (fun () -> self#read_texpr) in
 		let expr_unoptimized = self#read_option (fun () -> self#read_texpr) in
-		let overloads = self#read_list (fun () -> self#read_class_field') in
+		let overloads = self#read_list (fun () -> self#read_class_field) in
 
 
 		cf.cf_type <- t;
 		cf.cf_type <- t;
 		cf.cf_doc <- doc;
 		cf.cf_doc <- doc;
@@ -1092,41 +1099,10 @@ class hxb_reader
 		cf.cf_overloads <- overloads;
 		cf.cf_overloads <- overloads;
 		cf.cf_flags <- flags;
 		cf.cf_flags <- flags;
 
 
-	(* TODO merge with above *)
-	method read_class_field' : tclass_field =
-		let name = self#read_string in
-		(* Printf.eprintf "  Read class field %s\n" name; *)
-		self#read_type_parameters ([],name) (fun a -> field_type_parameters <- a);
-		(* TODO: The name is wrong, we might have to encode the local name here or something *)
-		self#read_type_parameters ([],name) (fun a -> local_type_parameters <- a);
-		let params = Array.to_list field_type_parameters in
-		let t = self#read_type_instance in
-		let flags = IO.read_i32 ch in
-		let pos = self#read_pos in
-		let name_pos = self#read_pos in
-
-		let doc = self#read_option (fun () -> self#read_documentation) in
-		let meta = self#read_metadata in
-		let kind = self#read_field_kind in
-
-		let expr = self#read_option (fun () -> self#read_texpr) in
-		let expr_unoptimized = self#read_option (fun () -> self#read_texpr) in
-		let overloads = self#read_list (fun () -> self#read_class_field') in
-
-		{
-			cf_name = name;
-			cf_type = t;
-			cf_pos = pos;
-			cf_name_pos = name_pos;
-			cf_doc = doc;
-			cf_meta = meta;
-			cf_kind = kind;
-			cf_expr = expr;
-			cf_expr_unoptimized = expr_unoptimized;
-			cf_params = params;
-			cf_overloads = overloads;
-			cf_flags = flags;
-		}
+	method read_class_field =
+		let cf = self#read_class_field_forward in
+		self#read_class_field_data cf;
+		cf
 
 
 	method read_class_fields (c : tclass) =
 	method read_class_fields (c : tclass) =
 		begin match c.cl_kind with
 		begin match c.cl_kind with
@@ -1138,17 +1114,16 @@ class hxb_reader
 		(* Printf.eprintf "  read class fields with type parameters for %s: %d\n" (s_type_path c.cl_path) (Array.length type_type_parameters); *)
 		(* Printf.eprintf "  read class fields with type parameters for %s: %d\n" (s_type_path c.cl_path) (Array.length type_type_parameters); *)
 		(* Printf.eprintf "    own class params: %d\n" (List.length c.cl_params); *)
 		(* Printf.eprintf "    own class params: %d\n" (List.length c.cl_params); *)
 		let _ = self#read_option (fun f ->
 		let _ = self#read_option (fun f ->
-			let _ = self#read_string in
-			self#read_class_field (Option.get c.cl_constructor)
+			self#read_class_field_data (Option.get c.cl_constructor)
 		) in
 		) in
-		c.cl_init <- self#read_option (fun () -> self#read_texpr);
 		let f fields =
 		let f fields =
 			let name = self#read_string in
 			let name = self#read_string in
 			let cf = PMap.find name fields in
 			let cf = PMap.find name fields in
-			self#read_class_field cf
+			self#read_class_field_data cf
 		in
 		in
 		let _ = self#read_list (fun () -> f c.cl_fields) in
 		let _ = self#read_list (fun () -> f c.cl_fields) in
 		let _ = self#read_list (fun () -> f c.cl_statics) in
 		let _ = self#read_list (fun () -> f c.cl_statics) in
+		c.cl_init <- self#read_option (fun () -> self#read_texpr);
 		(match c.cl_kind with KModuleFields md -> md.m_statics <- Some c; | _ -> ());
 		(match c.cl_kind with KModuleFields md -> md.m_statics <- Some c; | _ -> ());
 
 
 	method read_enum_fields (e : tenum) =
 	method read_enum_fields (e : tenum) =
@@ -1308,7 +1283,7 @@ class hxb_reader
 
 
 			let an = anons.(i) in
 			let an = anons.(i) in
 			let read_fields () =
 			let read_fields () =
-				let fields = self#read_list (fun () -> self#read_class_field') in
+				let fields = self#read_list (fun () -> self#read_class_field) in
 				List.iter (fun cf -> an.a_fields <- PMap.add cf.cf_name cf an.a_fields;) fields;
 				List.iter (fun cf -> an.a_fields <- PMap.add cf.cf_name cf an.a_fields;) fields;
 			in
 			in
 
 
@@ -1339,8 +1314,7 @@ class hxb_reader
 		for i = 0 to l - 1 do
 		for i = 0 to l - 1 do
 			let cf = anon_fields.(i) in
 			let cf = anon_fields.(i) in
 			self#read_type_parameters ([],"") (fun a -> type_type_parameters <- a);
 			self#read_type_parameters ([],"") (fun a -> type_type_parameters <- a);
-			let _ = self#read_string in
-			self#read_class_field cf;
+			self#read_class_field_data cf;
 		done
 		done
 
 
 	method read_tpdd =
 	method read_tpdd =
@@ -1402,10 +1376,7 @@ class hxb_reader
 	method read_anfr =
 	method read_anfr =
 		let l = self#read_uleb128 in
 		let l = self#read_uleb128 in
 		anon_fields <- (Array.init l (fun i ->
 		anon_fields <- (Array.init l (fun i ->
-			let name = self#read_string in
-			let pos = self#read_pos in
-			let name_pos = self#read_pos in
-			{ null_field with cf_name = name; cf_pos = pos; cf_name_pos = name_pos }
+			self#read_class_field_forward
 		))
 		))
 
 
 	method read_typf =
 	method read_typf =
@@ -1422,11 +1393,7 @@ class hxb_reader
 				classes <- Array.append classes (Array.make 1 c);
 				classes <- Array.append classes (Array.make 1 c);
 
 
 				let read_field () =
 				let read_field () =
-					let name = self#read_string in
-					let pos = self#read_pos in
-					let name_pos = self#read_pos in
-					(* TODO overloads *)
-					{ null_field with cf_name = name; cf_pos = pos; cf_name_pos = name_pos }
+					self#read_class_field_forward;
 				in
 				in
 
 
 				c.cl_constructor <- self#read_option read_field;
 				c.cl_constructor <- self#read_option read_field;

+ 25 - 24
src/compiler/hxb/hxbWriter.ml

@@ -1167,7 +1167,12 @@ class ['a] hxb_writer
 			f r;
 			f r;
 			f w;
 			f w;
 
 
-	method write_class_field ?(with_pos = false) cf =
+	method write_class_field_forward cf =
+		chunk#write_string cf.cf_name;
+		self#write_pos cf.cf_pos;
+		self#write_pos cf.cf_name_pos;
+
+	method write_class_field_data cf =
 		self#set_field_type_parameters cf.cf_params;
 		self#set_field_type_parameters cf.cf_params;
 		local_type_parameters <- new identity_pool;
 		local_type_parameters <- new identity_pool;
 		let restore = self#start_temporary_chunk in
 		let restore = self#start_temporary_chunk in
@@ -1178,10 +1183,6 @@ class ['a] hxb_writer
 			raise e
 			raise e
 		end);
 		end);
 		chunk#write_i32 cf.cf_flags;
 		chunk#write_i32 cf.cf_flags;
-		if with_pos then begin
-			self#write_pos cf.cf_pos;
-			self#write_pos cf.cf_name_pos;
-		end;
 		chunk#write_option cf.cf_doc self#write_documentation;
 		chunk#write_option cf.cf_doc self#write_documentation;
 		self#write_metadata cf.cf_meta;
 		self#write_metadata cf.cf_meta;
 		self#write_field_kind cf.cf_kind;
 		self#write_field_kind cf.cf_kind;
@@ -1191,9 +1192,8 @@ class ['a] hxb_writer
 			raise e
 			raise e
 		end);
 		end);
 		chunk#write_option cf.cf_expr_unoptimized self#write_texpr;
 		chunk#write_option cf.cf_expr_unoptimized self#write_texpr;
-		chunk#write_list cf.cf_overloads (self#write_class_field ~with_pos:true);
+		chunk#write_list cf.cf_overloads (self#write_class_field);
 		restore (fun chunk new_chunk ->
 		restore (fun chunk new_chunk ->
-			chunk#write_string cf.cf_name;
 			chunk#write_list cf.cf_params self#write_type_parameter_forward;
 			chunk#write_list cf.cf_params self#write_type_parameter_forward;
 			chunk#write_list cf.cf_params self#write_type_parameter_data;
 			chunk#write_list cf.cf_params self#write_type_parameter_data;
 			let ltp = List.map snd local_type_parameters#to_list in
 			let ltp = List.map snd local_type_parameters#to_list in
@@ -1202,6 +1202,10 @@ class ['a] hxb_writer
 			new_chunk#export_data chunk#ch
 			new_chunk#export_data chunk#ch
 		)
 		)
 
 
+	method write_class_field cf =
+		self#write_class_field_forward cf;
+		self#write_class_field_data cf;
+
 	(* Module types *)
 	(* Module types *)
 
 
 	method select_type (path : path) =
 	method select_type (path : path) =
@@ -1332,7 +1336,7 @@ class ['a] hxb_writer
 
 
 		let write_fields () =
 		let write_fields () =
 			chunk#write_list (PMap.foldi (fun s f acc -> (s,f) :: acc) an.a_fields []) (fun (_,cf) ->
 			chunk#write_list (PMap.foldi (fun s f acc -> (s,f) :: acc) an.a_fields []) (fun (_,cf) ->
-				self#write_class_field ~with_pos:true { cf with cf_params = (cf.cf_params @ ftp) };
+				self#write_class_field { cf with cf_params = (cf.cf_params @ ftp) };
 			)
 			)
 		in
 		in
 
 
@@ -1404,15 +1408,9 @@ class ['a] hxb_writer
 		(* Forward declare fields *)
 		(* Forward declare fields *)
 		match mt with
 		match mt with
 		| TClassDecl c ->
 		| TClassDecl c ->
-			(* Write minimal data to be able to create refs *)
-			let write_field cf =
-				chunk#write_string cf.cf_name;
-				self#write_pos cf.cf_pos;
-				self#write_pos cf.cf_name_pos
-			in
-			chunk#write_option c.cl_constructor write_field;
-			chunk#write_list c.cl_ordered_fields write_field;
-			chunk#write_list c.cl_ordered_statics write_field;
+			chunk#write_option c.cl_constructor self#write_class_field_forward;
+			chunk#write_list c.cl_ordered_fields self#write_class_field_forward;
+			chunk#write_list c.cl_ordered_statics self#write_class_field_forward;
 		| TEnumDecl e ->
 		| TEnumDecl e ->
 			(match e.e_type.t_type with
 			(match e.e_type.t_type with
 			| TAnon an when PMap.is_empty an.a_fields ->
 			| TAnon an when PMap.is_empty an.a_fields ->
@@ -1468,10 +1466,15 @@ class ['a] hxb_writer
 					self#select_type c.cl_path;
 					self#select_type c.cl_path;
 				end;
 				end;
 
 
-				chunk#write_option c.cl_constructor self#write_class_field;
+				let write_field cf =
+					chunk#write_string cf.cf_name;
+					self#write_class_field_data cf;
+				in
+
+				chunk#write_option c.cl_constructor self#write_class_field_data;
+				chunk#write_list c.cl_ordered_fields write_field;
+				chunk#write_list c.cl_ordered_statics write_field;
 				chunk#write_option c.cl_init self#write_texpr;
 				chunk#write_option c.cl_init self#write_texpr;
-				chunk#write_list c.cl_ordered_fields self#write_class_field;
-				chunk#write_list c.cl_ordered_statics self#write_class_field;
 			)
 			)
 		end;
 		end;
 		begin match own_enums#to_list with
 		begin match own_enums#to_list with
@@ -1510,9 +1513,7 @@ class ['a] hxb_writer
 			self#start_chunk ANFR;
 			self#start_chunk ANFR;
 			chunk#write_list l (fun (cf,(_,_)) ->
 			chunk#write_list l (fun (cf,(_,_)) ->
 				(* Printf.eprintf "Write anon field %s\n" cf.cf_name; *)
 				(* Printf.eprintf "Write anon field %s\n" cf.cf_name; *)
-				chunk#write_string cf.cf_name;
-				self#write_pos cf.cf_pos;
-				self#write_pos cf.cf_name_pos;
+				self#write_class_field_forward cf;
 			);
 			);
 			self#start_chunk ANFD;
 			self#start_chunk ANFD;
 			chunk#write_list l (fun (cf,(ttp,ftp)) ->
 			chunk#write_list l (fun (cf,(ttp,ftp)) ->
@@ -1520,7 +1521,7 @@ class ['a] hxb_writer
 				List.iter (fun ttp -> ignore(type_type_parameters#add ttp.ttp_name ttp)) ttp;
 				List.iter (fun ttp -> ignore(type_type_parameters#add ttp.ttp_name ttp)) ttp;
 				chunk#write_list ttp self#write_type_parameter_forward;
 				chunk#write_list ttp self#write_type_parameter_forward;
 				chunk#write_list ttp self#write_type_parameter_data;
 				chunk#write_list ttp self#write_type_parameter_data;
-				self#write_class_field { cf with cf_params = (cf.cf_params @ ftp) };
+				self#write_class_field_data { cf with cf_params = (cf.cf_params @ ftp) };
 			);
 			);
 		end;
 		end;