diff --git a/src/compiler/hxb/hxbData.ml b/src/compiler/hxb/hxbData.ml index bfff82e3ace..835ee4d8462 100644 --- a/src/compiler/hxb/hxbData.ml +++ b/src/compiler/hxb/hxbData.ml @@ -10,7 +10,6 @@ type chunk_kind = | ABSR (* abstract reference array *) | TPDR (* typedef reference array *) | ENMR (* enum reference array *) - | ANFR (* anon field reference array *) | CLSD (* class definition *) | ABSD (* abstract definition *) | CFLD (* class fields *) @@ -18,7 +17,6 @@ type chunk_kind = | ENMD (* enum definition *) | EFLD (* enum fields *) | ANND (* anon definition *) - | ANFD (* anon fields *) | HEND (* the end *) let string_of_chunk_kind = function @@ -31,7 +29,6 @@ let string_of_chunk_kind = function | ABSR -> "ABSR" | ENMR -> "ENMR" | TPDR -> "TPDR" - | ANFR -> "ANFR" | ANND -> "ANND" | CLSD -> "CLSD" | CFLD -> "CFLD" @@ -39,7 +36,6 @@ let string_of_chunk_kind = function | ENMD -> "ENMD" | EFLD -> "EFLD" | TPDD -> "TPDD" - | ANFD -> "ANFD" | HEND -> "HEND" let chunk_kind_of_string = function @@ -52,14 +48,12 @@ let chunk_kind_of_string = function | "ABSR" -> ABSR | "ENMR" -> ENMR | "TPDR" -> TPDR - | "ANFR" -> ANFR | "ANND" -> ANND | "CLSD" -> CLSD | "CFLD" -> CFLD | "ABSD" -> ABSD | "ENMD" -> ENMD | "EFLD" -> EFLD - | "ANFD" -> ANFD | "TPDD" -> TPDD | "HEND" -> HEND | name -> raise (HxbFailure ("Invalid chunk name: " ^ name)) diff --git a/src/compiler/hxb/hxbReader.ml b/src/compiler/hxb/hxbReader.ml index de7129ead6b..b778eefa7ab 100644 --- a/src/compiler/hxb/hxbReader.ml +++ b/src/compiler/hxb/hxbReader.ml @@ -197,8 +197,17 @@ class hxb_reader null_enum_field method read_anon_field_ref = - let i = self#read_uleb128 in - anon_fields.(i) + match IO.read_byte ch with + | 0 -> + let index = self#read_uleb128 in + anon_fields.(index) + | 1 -> + let index = self#read_uleb128 in + let cf = self#read_class_field true in + anon_fields.(index) <- cf; + cf + | _ -> + assert false (* Expr *) @@ -1071,11 +1080,15 @@ class hxb_reader (* 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 = + method read_class_field_data (nested : bool) (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); - self#read_type_parameters ([],name) (fun a -> local_type_parameters <- a); + self#read_type_parameters ([],name) (fun a -> + field_type_parameters <- if nested then Array.append field_type_parameters a else a + ); + self#read_type_parameters ([],name) (fun a -> + local_type_parameters <- if nested then Array.append local_type_parameters a else a + ); let params = Array.to_list field_type_parameters in let t = self#read_type_instance in @@ -1087,7 +1100,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 false) in cf.cf_type <- t; cf.cf_doc <- doc; @@ -1099,9 +1112,9 @@ class hxb_reader cf.cf_overloads <- overloads; cf.cf_flags <- flags; - method read_class_field = + method read_class_field (nested : bool) = let cf = self#read_class_field_forward in - self#read_class_field_data cf; + self#read_class_field_data nested cf; cf method read_class_fields (c : tclass) = @@ -1114,12 +1127,12 @@ 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 -> - self#read_class_field_data (Option.get c.cl_constructor) + self#read_class_field_data false (Option.get c.cl_constructor) ) in let f fields = let name = self#read_string in let cf = PMap.find name fields in - self#read_class_field_data cf + self#read_class_field_data false cf in let _ = self#read_list (fun () -> f c.cl_fields) in let _ = self#read_list (fun () -> f c.cl_statics) in @@ -1283,7 +1296,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 false) in List.iter (fun cf -> an.a_fields <- PMap.add cf.cf_name cf an.a_fields;) fields; in @@ -1309,14 +1322,6 @@ class hxb_reader end; done - method read_anfd = - let l = self#read_uleb128 in - for i = 0 to l - 1 do - let cf = anon_fields.(i) in - self#read_type_parameters ([],"") (fun a -> type_type_parameters <- a); - self#read_class_field_data cf; - done - method read_tpdd = let l = self#read_uleb128 in for i = 0 to l - 1 do @@ -1373,12 +1378,6 @@ class hxb_reader (* Printf.eprintf "ANNR - %d\n" l; *) anons <- Array.init l (fun _ -> { a_fields = PMap.empty; a_status = ref Closed }); - method read_anfr = - let l = self#read_uleb128 in - anon_fields <- (Array.init l (fun i -> - self#read_class_field_forward - )) - method read_typf = self#read_list (fun () -> let kind = self#read_u8 in @@ -1445,6 +1444,7 @@ class hxb_reader method read_hhdr = let path = self#read_path in let file = self#read_string in + anon_fields <- Array.make (self#read_uleb128) null_field; make_module path file method read (debug : bool) (p : pos) = @@ -1503,8 +1503,6 @@ class hxb_reader self#read_tpdr; | ANNR -> self#read_annr; - | ANFR -> - self#read_anfr; | ABSD -> self#read_absd; | CLSD -> @@ -1517,8 +1515,6 @@ class hxb_reader self#read_efld; | ANND -> self#read_annd; - | ANFD -> - self#read_anfd; | TPDD -> self#read_tpdd; | _ -> diff --git a/src/compiler/hxb/hxbWriter.ml b/src/compiler/hxb/hxbWriter.ml index 2797c41dd2e..d105d1ea202 100644 --- a/src/compiler/hxb/hxbWriter.ml +++ b/src/compiler/hxb/hxbWriter.ml @@ -355,24 +355,19 @@ class ['a] hxb_writer chunk#write_string ef.ef_name method write_anon_field_ref cf = - let ftp = field_type_parameters#to_list in - let ttp = type_type_parameters#to_list in - - (* if (snd current_module.m_path) = "Main" then begin *) - (* List.iter (fun ttp -> Printf.eprintf "[%s] Anon field TTP %s for %s\n" (s_type_path current_module.m_path) ttp.ttp_name cf.cf_name) cf.cf_params; *) - (* List.iter (fun ttp -> Printf.eprintf "TTP %s %s for %s\n" ttp.ttp_name (s_type_kind ttp.ttp_type) cf.cf_name) ttp; *) - (* List.iter (fun ttp -> Printf.eprintf "FTP %s %s for %s\n" ttp.ttp_name (s_type_kind ttp.ttp_type) cf.cf_name) ftp; *) - - (* if anon_fields#has cf then Printf.eprintf "Anon %s was already in anon_fields\n" cf.cf_name *) - (* else Printf.eprintf "Adding anon %s in anon_fields\n" cf.cf_name; *) - (* end; *) - - let i = try - anon_fields#get cf + try + let index = anon_fields#get cf in + chunk#write_byte 0; + chunk#write_uleb128 index with Not_found -> - anon_fields#add cf (ttp,ftp) - in - chunk#write_uleb128 i + let index = anon_fields#add cf () in + chunk#write_byte 1; + chunk#write_uleb128 index; + List.iter (fun ttp -> + ignore(field_type_parameters#add ttp.ttp_name ttp); + ) cf.cf_params; + self#write_class_field_forward cf; + self#write_class_field_data cf; (* Type instances *) @@ -1166,14 +1161,22 @@ class ['a] hxb_writer f r; f w; + method open_field_scope (cf : tclass_field) = + let old_field_params = field_type_parameters in + let old_local_params = local_type_parameters in + local_type_parameters <- new identity_pool; + self#set_field_type_parameters cf.cf_params; + (fun () -> + field_type_parameters <- old_field_params; + local_type_parameters <- old_local_params; + ) + 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 (* if (snd current_module.m_path) = "Main" then *) (* Printf.eprintf " (1) Write class field %s\n" cf.cf_name; *) @@ -1202,8 +1205,10 @@ class ['a] hxb_writer ) method write_class_field cf = + let close = self#open_field_scope cf in self#write_class_field_forward cf; self#write_class_field_data cf; + close() (* Module types *) @@ -1465,14 +1470,16 @@ class ['a] hxb_writer self#select_type c.cl_path; end; - let write_field cf = - chunk#write_string cf.cf_name; + let write_field with_name cf = + if with_name then chunk#write_string cf.cf_name; + let close = self#open_field_scope cf in self#write_class_field_data cf; + close(); 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_constructor (write_field false); + chunk#write_list c.cl_ordered_fields (write_field true); + chunk#write_list c.cl_ordered_statics (write_field true); chunk#write_option c.cl_init self#write_texpr; ) end; @@ -1505,25 +1512,6 @@ class ['a] hxb_writer chunk#write_list own_typedefs self#write_typedef; end; - begin match anon_fields#to_list with - | [] -> - () - | l -> - self#start_chunk ANFR; - chunk#write_list l (fun (cf,(_,_)) -> - (* Printf.eprintf "Write anon field %s\n" cf.cf_name; *) - self#write_class_field_forward cf; - ); - self#start_chunk ANFD; - chunk#write_list l (fun (cf,(ttp,ftp)) -> - type_type_parameters <- new pool; - 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_data { cf with cf_params = (cf.cf_params @ ftp) }; - ); - end; - begin match anons#to_list with | [] -> () @@ -1594,6 +1582,7 @@ class ['a] hxb_writer self#start_chunk HHDR; self#write_path m.m_path; chunk#write_string (Path.UniqueKey.lazy_path m.m_extra.m_file); + chunk#write_uleb128 (DynArray.length anon_fields#items); self#start_chunk HEND; (* Export *)