Skip to content

Commit

Permalink
[hxb] handle more type parameter cases
Browse files Browse the repository at this point in the history 
Note: still fails with some @:generic cases for example
  • Loading branch information
@kLabz
kLabz committed Jul 4, 2023
1 parent 1e4e2b8 commit 33ac0d2
Show file tree
Hide file tree
Showing 2 changed files with 23 additions and 38 deletions.
32 changes: 6 additions & 26 deletions src/compiler/hxb/hxbReader.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1011,9 +1011,7 @@ class hxb_reader
method read_class_field (m : module_def) (cf : tclass_field) : unit =
let name = cf.cf_name in
(* Printf.eprintf " Read class field %s\n" name; *)
self#read_type_parameters m ([],name) (fun a ->
field_type_parameters <- a
);
self#read_type_parameters m ([],name) (fun a -> field_type_parameters <- a);
let params = Array.to_list field_type_parameters in
let t = self#read_type_instance in

Expand Down Expand Up @@ -1041,9 +1039,7 @@ class hxb_reader
method read_class_field' (m : module_def) : tclass_field =
let name = self#read_string in
(* Printf.eprintf " Read class field %s\n" name; *)
self#read_type_parameters m ([],name) (fun a ->
field_type_parameters <- a
);
self#read_type_parameters m ([],name) (fun a -> field_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
Expand Down Expand Up @@ -1169,9 +1165,7 @@ class hxb_reader
a.a_from <- self#read_list (fun () -> self#read_type_instance);
a.a_from_field <- self#read_list (fun () ->
let name = self#read_string in
self#read_type_parameters m ([],name) (fun a ->
field_type_parameters <- a
);
self#read_type_parameters m ([],name) (fun a -> field_type_parameters <- a);
let t = self#read_type_instance in
let impl = Option.get a.a_impl in
(* Printf.eprintf " Read field ref for abstract from field %s (a = %s)\n" name (s_type_path a.a_path); *)
Expand All @@ -1182,9 +1176,7 @@ class hxb_reader
a.a_to <- self#read_list (fun () -> self#read_type_instance);
a.a_to_field <- self#read_list (fun () ->
let name = self#read_string in
self#read_type_parameters m ([],name) (fun a ->
field_type_parameters <- a
);
self#read_type_parameters m ([],name) (fun a -> field_type_parameters <- a);
let t = self#read_type_instance in
let impl = Option.get a.a_impl in
(* Printf.eprintf " Read field ref for abstract to field %s (a = %s)\n" name (s_type_path a.a_path); *)
Expand Down Expand Up @@ -1269,20 +1261,7 @@ class hxb_reader
method read_annd (m : module_def) =
let l = self#read_uleb128 in
for i = 0 to l - 1 do
let tname = self#read_option (fun () -> self#read_string) in
match tname with
| None -> ()
| Some tname ->
(match List.find_opt (fun t -> snd (t_path t) = tname) m.m_types with
| None -> ()
| Some parent ->
begin match parent with
| TClassDecl c -> type_type_parameters <- Array.of_list c.cl_params;
| TEnumDecl en -> type_type_parameters <- Array.of_list en.e_params;
| TTypeDecl td -> type_type_parameters <- Array.of_list td.t_params;
| TAbstractDecl a -> type_type_parameters <- Array.of_list a.a_params;
end
);
self#read_type_parameters m ([],"") (fun a -> type_type_parameters <- a);

let an = anons.(i) in
let read_fields () =
Expand Down Expand Up @@ -1316,6 +1295,7 @@ class hxb_reader
let l = self#read_uleb128 in
for i = 0 to l - 1 do
let cf = anon_fields.(i) in
self#read_type_parameters m ([],"") (fun a -> type_type_parameters <- a);
let _ = self#read_string in
self#read_class_field m cf;
done
Expand Down
29 changes: 17 additions & 12 deletions src/compiler/hxb/hxbWriter.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -294,7 +294,7 @@ class ['a] hxb_writer

method write_anon_ref (an : tanon) =
let pfm = Option.get (anon_id#identify true (TAnon an)) in
let i = anons#get_or_add pfm.pfm_path (an,ttp_key) in
let i = anons#get_or_add pfm.pfm_path (an,type_type_parameters,field_type_parameters) in
(* Printf.eprintf " Write anon ref %d for %s\n" i (s_type_path pfm.pfm_path); *)
chunk#write_uleb128 i

Expand Down Expand Up @@ -928,7 +928,7 @@ class ['a] hxb_writer
| TField(e1,FAnon cf) ->
chunk#write_byte 104;
loop e1;
chunk#write_uleb128 (anon_fields#get_or_add cf cf);
chunk#write_uleb128 (anon_fields#get_or_add cf (cf,type_type_parameters,field_type_parameters));
| TField(e1,FClosure(Some(c,tl),cf)) ->
chunk#write_byte 105;
loop e1;
Expand All @@ -938,7 +938,7 @@ class ['a] hxb_writer
| TField(e1,FClosure(None,cf)) ->
chunk#write_byte 106;
loop e1;
chunk#write_uleb128 (anon_fields#get_or_add cf cf);
chunk#write_uleb128 (anon_fields#get_or_add cf (cf,type_type_parameters,field_type_parameters));
| TField(e1,FEnum(en,ef)) ->
chunk#write_byte 107;
loop e1;
Expand Down Expand Up @@ -1196,15 +1196,15 @@ class ['a] hxb_writer
self#write_common_module_type (Obj.magic td);
self#write_type_instance td.t_type;

method write_anon (m : module_def) ((an : tanon), (ttp_key : path option)) =
chunk#write_option ttp_key (fun (_,k) -> chunk#write_string k);
match ttp_key with
| None -> ()
| Some ttp_key -> self#select_type ttp_key;
method write_anon (m : module_def) ((an : tanon), (ttp : (string, typed_type_param) pool), (ftp : (string, typed_type_param) pool)) =
type_type_parameters <- ttp;
let ttp = ttp#to_list in
chunk#write_list ttp self#write_type_parameter_forward;
chunk#write_list ttp self#write_type_parameter_data;

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;
self#write_class_field ~with_pos:true { cf with cf_params = (cf.cf_params @ ftp#to_list) };
)
in

Expand Down Expand Up @@ -1391,15 +1391,20 @@ class ['a] hxb_writer
()
| l ->
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; *)
chunk#write_string cf.cf_name;
self#write_pos cf.cf_pos;
self#write_pos cf.cf_name_pos;
);
self#start_chunk ANFD;
chunk#write_list l (fun cf ->
self#write_class_field cf;
chunk#write_list l (fun (cf,ttp,ftp) ->
(* Printf.eprintf "Write anon field def %s\n" cf.cf_name; *)
type_type_parameters <- ttp;
let ttp = ttp#to_list in
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#to_list) };
);
end;

Expand Down

0 comments on commit 33ac0d2

Please sign in to comment.