From e0e4074215edcd708ad308abea80acaeccf0a4e5 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 20 Jul 2023 20:56:19 +0200 Subject: [PATCH] make class field handling less clunky --- src/compiler/hxb/hxbReader.ml | 73 ++++++++++------------------------- src/compiler/hxb/hxbWriter.ml | 49 +++++++++++------------ 2 files changed, 45 insertions(+), 77 deletions(-) diff --git a/src/compiler/hxb/hxbReader.ml b/src/compiler/hxb/hxbReader.ml index 42e37221007..de7129ead6b 100644 --- a/src/compiler/hxb/hxbReader.ml +++ b/src/compiler/hxb/hxbReader.ml @@ -1064,7 +1064,14 @@ class hxb_reader let len = IO.read_ui16 ch in 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 (* Printf.eprintf " Read class field %s\n" name; *) 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_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_doc <- doc; @@ -1092,41 +1099,10 @@ class hxb_reader cf.cf_overloads <- overloads; 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) = 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 " own class params: %d\n" (List.length c.cl_params); *) 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 - c.cl_init <- self#read_option (fun () -> self#read_texpr); let f fields = let name = self#read_string in let cf = PMap.find name fields in - self#read_class_field cf + self#read_class_field_data cf in let _ = self#read_list (fun () -> f c.cl_fields) 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; | _ -> ()); method read_enum_fields (e : tenum) = @@ -1308,7 +1283,7 @@ class hxb_reader let an = anons.(i) in 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; in @@ -1339,8 +1314,7 @@ class hxb_reader for i = 0 to l - 1 do let cf = anon_fields.(i) in 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 method read_tpdd = @@ -1402,10 +1376,7 @@ class hxb_reader method read_anfr = let l = self#read_uleb128 in 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 = @@ -1422,11 +1393,7 @@ class hxb_reader classes <- Array.append classes (Array.make 1 c); 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 c.cl_constructor <- self#read_option read_field; diff --git a/src/compiler/hxb/hxbWriter.ml b/src/compiler/hxb/hxbWriter.ml index 3ae5c1a78da..2797c41dd2e 100644 --- a/src/compiler/hxb/hxbWriter.ml +++ b/src/compiler/hxb/hxbWriter.ml @@ -1166,7 +1166,12 @@ class ['a] hxb_writer f r; 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; local_type_parameters <- new identity_pool; let restore = self#start_temporary_chunk in @@ -1177,10 +1182,6 @@ class ['a] hxb_writer raise e end); 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; self#write_metadata cf.cf_meta; self#write_field_kind cf.cf_kind; @@ -1190,9 +1191,8 @@ class ['a] hxb_writer raise e end); 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 -> - 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_data; let ltp = List.map snd local_type_parameters#to_list in @@ -1201,6 +1201,10 @@ class ['a] hxb_writer 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 *) method select_type (path : path) = @@ -1331,7 +1335,7 @@ class ['a] hxb_writer let write_fields () = 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 @@ -1403,15 +1407,9 @@ class ['a] hxb_writer (* Forward declare fields *) match mt with | 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 -> (match e.e_type.t_type with | TAnon an when PMap.is_empty an.a_fields -> @@ -1467,10 +1465,15 @@ class ['a] hxb_writer self#select_type c.cl_path; 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_list c.cl_ordered_fields self#write_class_field; - chunk#write_list c.cl_ordered_statics self#write_class_field; ) end; begin match own_enums#to_list with @@ -1509,9 +1512,7 @@ class ['a] hxb_writer self#start_chunk ANFR; chunk#write_list l (fun (cf,(_,_)) -> (* 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; chunk#write_list l (fun (cf,(ttp,ftp)) -> @@ -1519,7 +1520,7 @@ class ['a] hxb_writer 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_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;