Skip to content

Commit

Permalink
make class field handling less clunky
Browse files Browse the repository at this point in the history
  • Loading branch information
@Simn
Simn committed Jul 20, 2023
1 parent d43a74b commit e0e4074
Show file tree
Hide file tree
Showing 2 changed files with 45 additions and 77 deletions.
73 changes: 20 additions & 53 deletions src/compiler/hxb/hxbReader.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand All @@ -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;
Expand All @@ -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
Expand All @@ -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) =
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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 =
Expand All @@ -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;
Expand Down
49 changes: 25 additions & 24 deletions src/compiler/hxb/hxbWriter.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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;
Expand All @@ -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
Expand All @@ -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) =
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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 ->
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -1509,17 +1512,15 @@ 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)) ->
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 { cf with cf_params = (cf.cf_params @ ftp) };
self#write_class_field_data { cf with cf_params = (cf.cf_params @ ftp) };
);
end;

Expand Down

0 comments on commit e0e4074

Please sign in to comment.