|
@@ -56,41 +56,6 @@ module StringHashtbl = Hashtbl.Make(struct
|
|
Hashtbl.hash s
|
|
Hashtbl.hash s
|
|
end)
|
|
end)
|
|
|
|
|
|
-module StringPool = struct
|
|
|
|
- type t = {
|
|
|
|
- lut : int StringHashtbl.t;
|
|
|
|
- items : string DynArray.t;
|
|
|
|
- mutable closed : bool;
|
|
|
|
- }
|
|
|
|
-
|
|
|
|
- let create () = {
|
|
|
|
- lut = StringHashtbl.create 16;
|
|
|
|
- items = DynArray.create ();
|
|
|
|
- closed = false;
|
|
|
|
- }
|
|
|
|
-
|
|
|
|
- let add sp s =
|
|
|
|
- assert (not sp.closed);
|
|
|
|
- let index = DynArray.length sp.items in
|
|
|
|
- StringHashtbl.add sp.lut s index;
|
|
|
|
- DynArray.add sp.items s;
|
|
|
|
- index
|
|
|
|
-
|
|
|
|
- let get sp s =
|
|
|
|
- StringHashtbl.find sp.lut s
|
|
|
|
-
|
|
|
|
- let get_or_add sp s =
|
|
|
|
- try
|
|
|
|
- get sp s
|
|
|
|
- with Not_found ->
|
|
|
|
- add sp s
|
|
|
|
-
|
|
|
|
- let finalize sp =
|
|
|
|
- assert (not sp.closed);
|
|
|
|
- sp.closed <- true;
|
|
|
|
- DynArray.to_list sp.items,DynArray.length sp.items
|
|
|
|
-end
|
|
|
|
-
|
|
|
|
module Pool = struct
|
|
module Pool = struct
|
|
type ('key,'value) t = {
|
|
type ('key,'value) t = {
|
|
lut : ('key,int) Hashtbl.t;
|
|
lut : ('key,int) Hashtbl.t;
|
|
@@ -445,10 +410,14 @@ type hxb_writer = {
|
|
anon_id : Type.t Tanon_identification.tanon_identification;
|
|
anon_id : Type.t Tanon_identification.tanon_identification;
|
|
mutable current_module : module_def;
|
|
mutable current_module : module_def;
|
|
chunks : Chunk.t DynArray.t;
|
|
chunks : Chunk.t DynArray.t;
|
|
|
|
+ has_own_string_pool : bool;
|
|
cp : StringPool.t;
|
|
cp : StringPool.t;
|
|
docs : StringPool.t;
|
|
docs : StringPool.t;
|
|
mutable chunk : Chunk.t;
|
|
mutable chunk : Chunk.t;
|
|
|
|
|
|
|
|
+ mutable in_expr : bool;
|
|
|
|
+ mutable sig_deps : module_def list;
|
|
|
|
+
|
|
classes : (path,tclass) Pool.t;
|
|
classes : (path,tclass) Pool.t;
|
|
enums : (path,tenum) Pool.t;
|
|
enums : (path,tenum) Pool.t;
|
|
typedefs : (path,tdef) Pool.t;
|
|
typedefs : (path,tdef) Pool.t;
|
|
@@ -469,11 +438,25 @@ type hxb_writer = {
|
|
mutable local_type_parameters : (typed_type_param,unit) IdentityPool.t;
|
|
mutable local_type_parameters : (typed_type_param,unit) IdentityPool.t;
|
|
mutable field_stack : unit list;
|
|
mutable field_stack : unit list;
|
|
mutable wrote_local_type_param : bool;
|
|
mutable wrote_local_type_param : bool;
|
|
|
|
+ mutable needs_local_context : bool;
|
|
unbound_ttp : (typed_type_param,unit) IdentityPool.t;
|
|
unbound_ttp : (typed_type_param,unit) IdentityPool.t;
|
|
t_instance_chunk : Chunk.t;
|
|
t_instance_chunk : Chunk.t;
|
|
}
|
|
}
|
|
|
|
|
|
module HxbWriter = struct
|
|
module HxbWriter = struct
|
|
|
|
+ let get_backtrace () = Printexc.get_raw_backtrace ()
|
|
|
|
+ let get_callstack () = Printexc.get_callstack 200
|
|
|
|
+
|
|
|
|
+ let failwith writer msg backtrace =
|
|
|
|
+ let msg =
|
|
|
|
+ (Printf.sprintf "Compiler failure while writing hxb chunk %s of %s: %s\n" (string_of_chunk_kind writer.chunk.kind) (s_type_path writer.current_module.m_path) (msg))
|
|
|
|
+ ^ "Please submit an issue at https://github.com/HaxeFoundation/haxe/issues/new\n"
|
|
|
|
+ ^ "Attach the following information:"
|
|
|
|
+ in
|
|
|
|
+ let backtrace = Printexc.raw_backtrace_to_string backtrace in
|
|
|
|
+ let s = Printf.sprintf "%s\nHaxe: %s\n%s" msg s_version_full backtrace in
|
|
|
|
+ failwith s
|
|
|
|
+
|
|
let in_nested_scope writer = match writer.field_stack with
|
|
let in_nested_scope writer = match writer.field_stack with
|
|
| [] -> false (* can happen for cl_init and in EXD *)
|
|
| [] -> false (* can happen for cl_init and in EXD *)
|
|
| [_] -> false
|
|
| [_] -> false
|
|
@@ -485,7 +468,7 @@ module HxbWriter = struct
|
|
let initial_size = match kind with
|
|
let initial_size = match kind with
|
|
| EOT | EOF | EOM -> 0
|
|
| EOT | EOF | EOM -> 0
|
|
| MDF -> 16
|
|
| MDF -> 16
|
|
- | MTF | MDR | CLR | END | ABD | ENR | ABR | TDR | EFR | CFR | AFD -> 64
|
|
|
|
|
|
+ | MTF | IMP | CLR | END | ABD | ENR | ABR | TDR | EFR | CFR | AFD -> 64
|
|
| OFR | OFD | OBD | CLD | TDD | EFD -> 128
|
|
| OFR | OFD | OBD | CLD | TDD | EFD -> 128
|
|
| STR | DOC -> 256
|
|
| STR | DOC -> 256
|
|
| CFD | EXD -> 512
|
|
| CFD | EXD -> 512
|
|
@@ -527,7 +510,7 @@ module HxbWriter = struct
|
|
let write_full_path writer (pack : string list) (mname : string) (tname : string) =
|
|
let write_full_path writer (pack : string list) (mname : string) (tname : string) =
|
|
Chunk.write_list writer.chunk pack (Chunk.write_string writer.chunk);
|
|
Chunk.write_list writer.chunk pack (Chunk.write_string writer.chunk);
|
|
if mname = "" || tname = "" then
|
|
if mname = "" || tname = "" then
|
|
- die (Printf.sprintf "write_full_path: pack = %s, mname = %s, tname = %s" (String.concat "." pack) mname tname) __LOC__;
|
|
|
|
|
|
+ failwith writer (Printf.sprintf "write_full_path: pack = %s, mname = %s, tname = %s" (String.concat "." pack) mname tname) (get_callstack ());
|
|
Chunk.write_string writer.chunk mname;
|
|
Chunk.write_string writer.chunk mname;
|
|
Chunk.write_string writer.chunk tname
|
|
Chunk.write_string writer.chunk tname
|
|
|
|
|
|
@@ -886,20 +869,28 @@ module HxbWriter = struct
|
|
|
|
|
|
(* References *)
|
|
(* References *)
|
|
|
|
|
|
|
|
+ let maybe_add_sig_dep writer m =
|
|
|
|
+ if not writer.in_expr && m.m_path <> writer.current_module.m_path && not (List.exists (fun m' -> m'.m_path = m.m_path) writer.sig_deps) then
|
|
|
|
+ writer.sig_deps <- m :: writer.sig_deps
|
|
|
|
+
|
|
let write_class_ref writer (c : tclass) =
|
|
let write_class_ref writer (c : tclass) =
|
|
let i = Pool.get_or_add writer.classes c.cl_path c in
|
|
let i = Pool.get_or_add writer.classes c.cl_path c in
|
|
|
|
+ maybe_add_sig_dep writer c.cl_module;
|
|
Chunk.write_uleb128 writer.chunk i
|
|
Chunk.write_uleb128 writer.chunk i
|
|
|
|
|
|
let write_enum_ref writer (en : tenum) =
|
|
let write_enum_ref writer (en : tenum) =
|
|
let i = Pool.get_or_add writer.enums en.e_path en in
|
|
let i = Pool.get_or_add writer.enums en.e_path en in
|
|
|
|
+ maybe_add_sig_dep writer en.e_module;
|
|
Chunk.write_uleb128 writer.chunk i
|
|
Chunk.write_uleb128 writer.chunk i
|
|
|
|
|
|
let write_typedef_ref writer (td : tdef) =
|
|
let write_typedef_ref writer (td : tdef) =
|
|
let i = Pool.get_or_add writer.typedefs td.t_path td in
|
|
let i = Pool.get_or_add writer.typedefs td.t_path td in
|
|
|
|
+ maybe_add_sig_dep writer td.t_module;
|
|
Chunk.write_uleb128 writer.chunk i
|
|
Chunk.write_uleb128 writer.chunk i
|
|
|
|
|
|
let write_abstract_ref writer (a : tabstract) =
|
|
let write_abstract_ref writer (a : tabstract) =
|
|
let i = Pool.get_or_add writer.abstracts a.a_path a in
|
|
let i = Pool.get_or_add writer.abstracts a.a_path a in
|
|
|
|
+ maybe_add_sig_dep writer a.a_module;
|
|
Chunk.write_uleb128 writer.chunk i
|
|
Chunk.write_uleb128 writer.chunk i
|
|
|
|
|
|
let write_tmono_ref writer (mono : tmono) =
|
|
let write_tmono_ref writer (mono : tmono) =
|
|
@@ -980,20 +971,22 @@ module HxbWriter = struct
|
|
Chunk.write_uleb128 writer.chunk (Pool.add writer.enum_fields key (en,ef))
|
|
Chunk.write_uleb128 writer.chunk (Pool.add writer.enum_fields key (en,ef))
|
|
|
|
|
|
let write_var_kind writer vk =
|
|
let write_var_kind writer vk =
|
|
- let b = match vk with
|
|
|
|
- | VUser TVOLocalVariable -> 0
|
|
|
|
- | VUser TVOArgument -> 1
|
|
|
|
- | VUser TVOForVariable -> 2
|
|
|
|
- | VUser TVOPatternVariable -> 3
|
|
|
|
- | VUser TVOCatchVariable -> 4
|
|
|
|
- | VUser TVOLocalFunction -> 5
|
|
|
|
- | VGenerated -> 6
|
|
|
|
- | VInlined -> 7
|
|
|
|
- | VInlinedConstructorVariable -> 8
|
|
|
|
- | VExtractorVariable -> 9
|
|
|
|
- | VAbstractThis -> 10
|
|
|
|
- in
|
|
|
|
- Chunk.write_u8 writer.chunk b
|
|
|
|
|
|
+ let b,sl = match vk with
|
|
|
|
+ | VUser TVOLocalVariable -> 0, []
|
|
|
|
+ | VUser TVOArgument -> 1, []
|
|
|
|
+ | VUser TVOForVariable -> 2, []
|
|
|
|
+ | VUser TVOPatternVariable -> 3, []
|
|
|
|
+ | VUser TVOCatchVariable -> 4, []
|
|
|
|
+ | VUser TVOLocalFunction -> 5, []
|
|
|
|
+ | VGenerated -> 6, []
|
|
|
|
+ | VInlined -> 7, []
|
|
|
|
+ | VInlinedConstructorVariable sl -> 8, sl
|
|
|
|
+ | VExtractorVariable -> 9, []
|
|
|
|
+ | VAbstractThis -> 10, []
|
|
|
|
+ in begin
|
|
|
|
+ Chunk.write_u8 writer.chunk b;
|
|
|
|
+ if (b == 8) then Chunk.write_list writer.chunk sl (Chunk.write_string writer.chunk);
|
|
|
|
+ end
|
|
|
|
|
|
let write_var writer fctx v =
|
|
let write_var writer fctx v =
|
|
Chunk.write_uleb128 writer.chunk v.v_id;
|
|
Chunk.write_uleb128 writer.chunk v.v_id;
|
|
@@ -1004,12 +997,11 @@ module HxbWriter = struct
|
|
write_pos writer v.v_pos
|
|
write_pos writer v.v_pos
|
|
|
|
|
|
let rec write_anon writer (an : tanon) =
|
|
let rec write_anon writer (an : tanon) =
|
|
- let needs_local_context = ref false in
|
|
|
|
let write_fields () =
|
|
let write_fields () =
|
|
let restore = start_temporary_chunk writer 256 in
|
|
let restore = start_temporary_chunk writer 256 in
|
|
let i = ref 0 in
|
|
let i = ref 0 in
|
|
PMap.iter (fun _ cf ->
|
|
PMap.iter (fun _ cf ->
|
|
- write_anon_field_ref writer needs_local_context cf;
|
|
|
|
|
|
+ write_anon_field_ref writer cf;
|
|
incr i;
|
|
incr i;
|
|
) an.a_fields;
|
|
) an.a_fields;
|
|
let bytes = restore (fun new_chunk -> Chunk.get_bytes new_chunk) in
|
|
let bytes = restore (fun new_chunk -> Chunk.get_bytes new_chunk) in
|
|
@@ -1033,8 +1025,7 @@ module HxbWriter = struct
|
|
assert false
|
|
assert false
|
|
| AbstractStatics _ ->
|
|
| AbstractStatics _ ->
|
|
assert false
|
|
assert false
|
|
- end;
|
|
|
|
- !needs_local_context
|
|
|
|
|
|
+ end
|
|
|
|
|
|
and write_anon_ref writer (an : tanon) =
|
|
and write_anon_ref writer (an : tanon) =
|
|
let pfm = Option.get (writer.anon_id#identify_anon ~strict:true an) in
|
|
let pfm = Option.get (writer.anon_id#identify_anon ~strict:true an) in
|
|
@@ -1044,9 +1035,10 @@ module HxbWriter = struct
|
|
Chunk.write_uleb128 writer.chunk index
|
|
Chunk.write_uleb128 writer.chunk index
|
|
with Not_found ->
|
|
with Not_found ->
|
|
let restore = start_temporary_chunk writer 256 in
|
|
let restore = start_temporary_chunk writer 256 in
|
|
- let needs_local_context = write_anon writer an in
|
|
|
|
|
|
+ writer.needs_local_context <- false;
|
|
|
|
+ write_anon writer an;
|
|
let bytes = restore (fun new_chunk -> Chunk.get_bytes new_chunk) in
|
|
let bytes = restore (fun new_chunk -> Chunk.get_bytes new_chunk) in
|
|
- if needs_local_context then begin
|
|
|
|
|
|
+ if writer.needs_local_context then begin
|
|
let index = Pool.add writer.anons pfm.pfm_path None in
|
|
let index = Pool.add writer.anons pfm.pfm_path None in
|
|
Chunk.write_u8 writer.chunk 1;
|
|
Chunk.write_u8 writer.chunk 1;
|
|
Chunk.write_uleb128 writer.chunk index;
|
|
Chunk.write_uleb128 writer.chunk index;
|
|
@@ -1057,7 +1049,7 @@ module HxbWriter = struct
|
|
Chunk.write_uleb128 writer.chunk index;
|
|
Chunk.write_uleb128 writer.chunk index;
|
|
end
|
|
end
|
|
|
|
|
|
- and write_anon_field_ref writer needs_local_context cf =
|
|
|
|
|
|
+ and write_anon_field_ref writer cf =
|
|
try
|
|
try
|
|
let index = HashedIdentityPool.get writer.anon_fields cf.cf_name cf in
|
|
let index = HashedIdentityPool.get writer.anon_fields cf.cf_name cf in
|
|
Chunk.write_u8 writer.chunk 0;
|
|
Chunk.write_u8 writer.chunk 0;
|
|
@@ -1067,14 +1059,12 @@ module HxbWriter = struct
|
|
let old = writer.wrote_local_type_param in
|
|
let old = writer.wrote_local_type_param in
|
|
writer.wrote_local_type_param <- false;
|
|
writer.wrote_local_type_param <- false;
|
|
ignore(write_class_field_and_overloads_data writer true cf);
|
|
ignore(write_class_field_and_overloads_data writer true cf);
|
|
- let wrote_local_type_param = writer.wrote_local_type_param in
|
|
|
|
- writer.wrote_local_type_param <- old;
|
|
|
|
let bytes = restore (fun new_chunk -> Chunk.get_bytes new_chunk) in
|
|
let bytes = restore (fun new_chunk -> Chunk.get_bytes new_chunk) in
|
|
- if wrote_local_type_param then begin
|
|
|
|
|
|
+ if writer.needs_local_context || writer.wrote_local_type_param then begin
|
|
(* If we access something from the method scope, we have to write the anon field immediately.
|
|
(* If we access something from the method scope, we have to write the anon field immediately.
|
|
This should be fine because in such cases the field cannot be referenced elsewhere. *)
|
|
This should be fine because in such cases the field cannot be referenced elsewhere. *)
|
|
let index = HashedIdentityPool.add writer.anon_fields cf.cf_name cf None in
|
|
let index = HashedIdentityPool.add writer.anon_fields cf.cf_name cf None in
|
|
- needs_local_context := true;
|
|
|
|
|
|
+ writer.needs_local_context <- true;
|
|
Chunk.write_u8 writer.chunk 1;
|
|
Chunk.write_u8 writer.chunk 1;
|
|
Chunk.write_uleb128 writer.chunk index;
|
|
Chunk.write_uleb128 writer.chunk index;
|
|
Chunk.write_bytes writer.chunk bytes
|
|
Chunk.write_bytes writer.chunk bytes
|
|
@@ -1082,7 +1072,8 @@ module HxbWriter = struct
|
|
let index = HashedIdentityPool.add writer.anon_fields cf.cf_name cf (Some bytes) in
|
|
let index = HashedIdentityPool.add writer.anon_fields cf.cf_name cf (Some bytes) in
|
|
Chunk.write_u8 writer.chunk 0;
|
|
Chunk.write_u8 writer.chunk 0;
|
|
Chunk.write_uleb128 writer.chunk index;
|
|
Chunk.write_uleb128 writer.chunk index;
|
|
- end
|
|
|
|
|
|
+ end;
|
|
|
|
+ writer.wrote_local_type_param <- old
|
|
|
|
|
|
(* Type instances *)
|
|
(* Type instances *)
|
|
|
|
|
|
@@ -1105,14 +1096,18 @@ module HxbWriter = struct
|
|
writer.wrote_local_type_param <- true;
|
|
writer.wrote_local_type_param <- true;
|
|
Chunk.write_u8 writer.chunk 3;
|
|
Chunk.write_u8 writer.chunk 3;
|
|
Chunk.write_uleb128 writer.chunk index;
|
|
Chunk.write_uleb128 writer.chunk index;
|
|
|
|
+ | TPHUnbound ->
|
|
|
|
+ raise Not_found
|
|
end with Not_found ->
|
|
end with Not_found ->
|
|
(try ignore(IdentityPool.get writer.unbound_ttp ttp) with Not_found -> begin
|
|
(try ignore(IdentityPool.get writer.unbound_ttp ttp) with Not_found -> begin
|
|
ignore(IdentityPool.add writer.unbound_ttp ttp ());
|
|
ignore(IdentityPool.add writer.unbound_ttp ttp ());
|
|
- let p = { null_pos with pfile = (Path.UniqueKey.lazy_path writer.current_module.m_extra.m_file) } in
|
|
|
|
|
|
+ let p = file_pos (Path.UniqueKey.lazy_path writer.current_module.m_extra.m_file) in
|
|
let msg = Printf.sprintf "Unbound type parameter %s" (s_type_path ttp.ttp_class.cl_path) in
|
|
let msg = Printf.sprintf "Unbound type parameter %s" (s_type_path ttp.ttp_class.cl_path) in
|
|
writer.warn WUnboundTypeParameter msg p
|
|
writer.warn WUnboundTypeParameter msg p
|
|
end);
|
|
end);
|
|
- Chunk.write_u8 writer.chunk 4; (* TDynamic None *)
|
|
|
|
|
|
+ writer.wrote_local_type_param <- true;
|
|
|
|
+ Chunk.write_u8 writer.chunk 5;
|
|
|
|
+ write_path writer ttp.ttp_class.cl_path;
|
|
end
|
|
end
|
|
|
|
|
|
(*
|
|
(*
|
|
@@ -1564,7 +1559,7 @@ module HxbWriter = struct
|
|
| TField(e1,FAnon cf) ->
|
|
| TField(e1,FAnon cf) ->
|
|
Chunk.write_u8 writer.chunk 104;
|
|
Chunk.write_u8 writer.chunk 104;
|
|
loop e1;
|
|
loop e1;
|
|
- write_anon_field_ref writer (ref false) cf;
|
|
|
|
|
|
+ write_anon_field_ref writer cf;
|
|
true;
|
|
true;
|
|
| TField(e1,FClosure(Some(c,tl),cf)) ->
|
|
| TField(e1,FClosure(Some(c,tl),cf)) ->
|
|
Chunk.write_u8 writer.chunk 105;
|
|
Chunk.write_u8 writer.chunk 105;
|
|
@@ -1576,7 +1571,7 @@ module HxbWriter = struct
|
|
| TField(e1,FClosure(None,cf)) ->
|
|
| TField(e1,FClosure(None,cf)) ->
|
|
Chunk.write_u8 writer.chunk 106;
|
|
Chunk.write_u8 writer.chunk 106;
|
|
loop e1;
|
|
loop e1;
|
|
- write_anon_field_ref writer (ref false) cf;
|
|
|
|
|
|
+ write_anon_field_ref writer cf;
|
|
true;
|
|
true;
|
|
| TField(e1,FEnum(en,ef)) ->
|
|
| TField(e1,FEnum(en,ef)) ->
|
|
Chunk.write_u8 writer.chunk 107;
|
|
Chunk.write_u8 writer.chunk 107;
|
|
@@ -1670,6 +1665,7 @@ module HxbWriter = struct
|
|
| TPHEnumConstructor -> 3
|
|
| TPHEnumConstructor -> 3
|
|
| TPHAnonField -> 4
|
|
| TPHAnonField -> 4
|
|
| TPHLocal -> 5
|
|
| TPHLocal -> 5
|
|
|
|
+ | TPHUnbound -> 6
|
|
in
|
|
in
|
|
Chunk.write_u8 writer.chunk i
|
|
Chunk.write_u8 writer.chunk i
|
|
in
|
|
in
|
|
@@ -1766,11 +1762,11 @@ module HxbWriter = struct
|
|
write_type_parameters writer ltp
|
|
write_type_parameters writer ltp
|
|
end;
|
|
end;
|
|
Chunk.write_option writer.chunk fctx.texpr_this (fun e -> write_type_instance writer e.etype);
|
|
Chunk.write_option writer.chunk fctx.texpr_this (fun e -> write_type_instance writer e.etype);
|
|
- let items,length = StringPool.finalize fctx.t_pool in
|
|
|
|
- Chunk.write_uleb128 writer.chunk length;
|
|
|
|
- List.iter (fun bytes ->
|
|
|
|
|
|
+ let a = StringPool.finalize fctx.t_pool in
|
|
|
|
+ Chunk.write_uleb128 writer.chunk a.length;
|
|
|
|
+ StringDynArray.iter a (fun bytes ->
|
|
Chunk.write_bytes writer.chunk (Bytes.unsafe_of_string bytes)
|
|
Chunk.write_bytes writer.chunk (Bytes.unsafe_of_string bytes)
|
|
- ) items;
|
|
|
|
|
|
+ );
|
|
Chunk.write_uleb128 writer.chunk (DynArray.length fctx.vars);
|
|
Chunk.write_uleb128 writer.chunk (DynArray.length fctx.vars);
|
|
DynArray.iter (fun (v,v_id) ->
|
|
DynArray.iter (fun (v,v_id) ->
|
|
v.v_id <- v_id;
|
|
v.v_id <- v_id;
|
|
@@ -1805,15 +1801,21 @@ module HxbWriter = struct
|
|
| Some e when not write_expr_immediately ->
|
|
| Some e when not write_expr_immediately ->
|
|
Chunk.write_u8 writer.chunk 2;
|
|
Chunk.write_u8 writer.chunk 2;
|
|
let fctx,close = start_texpr writer e.epos in
|
|
let fctx,close = start_texpr writer e.epos in
|
|
|
|
+ let old = writer.in_expr in
|
|
|
|
+ writer.in_expr <- true;
|
|
write_texpr writer fctx e;
|
|
write_texpr writer fctx e;
|
|
Chunk.write_option writer.chunk cf.cf_expr_unoptimized (write_texpr writer fctx);
|
|
Chunk.write_option writer.chunk cf.cf_expr_unoptimized (write_texpr writer fctx);
|
|
|
|
+ writer.in_expr <- old;
|
|
let expr_chunk = close() in
|
|
let expr_chunk = close() in
|
|
Some expr_chunk
|
|
Some expr_chunk
|
|
| Some e ->
|
|
| Some e ->
|
|
Chunk.write_u8 writer.chunk 1;
|
|
Chunk.write_u8 writer.chunk 1;
|
|
let fctx,close = start_texpr writer e.epos in
|
|
let fctx,close = start_texpr writer e.epos in
|
|
|
|
+ let old = writer.in_expr in
|
|
|
|
+ writer.in_expr <- true;
|
|
write_texpr writer fctx e;
|
|
write_texpr writer fctx e;
|
|
Chunk.write_option writer.chunk cf.cf_expr_unoptimized (write_texpr writer fctx);
|
|
Chunk.write_option writer.chunk cf.cf_expr_unoptimized (write_texpr writer fctx);
|
|
|
|
+ writer.in_expr <- old;
|
|
let expr_pre_chunk,expr_chunk = close() in
|
|
let expr_pre_chunk,expr_chunk = close() in
|
|
Chunk.export_data expr_pre_chunk writer.chunk;
|
|
Chunk.export_data expr_pre_chunk writer.chunk;
|
|
Chunk.export_data expr_chunk writer.chunk;
|
|
Chunk.export_data expr_chunk writer.chunk;
|
|
@@ -1911,6 +1913,7 @@ module HxbWriter = struct
|
|
end;
|
|
end;
|
|
Chunk.write_list writer.chunk a.a_from (write_type_instance writer);
|
|
Chunk.write_list writer.chunk a.a_from (write_type_instance writer);
|
|
Chunk.write_list writer.chunk a.a_to (write_type_instance writer);
|
|
Chunk.write_list writer.chunk a.a_to (write_type_instance writer);
|
|
|
|
+ Chunk.write_bool writer.chunk a.a_extern;
|
|
Chunk.write_bool writer.chunk a.a_enum
|
|
Chunk.write_bool writer.chunk a.a_enum
|
|
|
|
|
|
let write_abstract_fields writer (a : tabstract) =
|
|
let write_abstract_fields writer (a : tabstract) =
|
|
@@ -1947,7 +1950,7 @@ module HxbWriter = struct
|
|
let write_enum writer (e : tenum) =
|
|
let write_enum writer (e : tenum) =
|
|
select_type writer e.e_path;
|
|
select_type writer e.e_path;
|
|
write_common_module_type writer (Obj.magic e);
|
|
write_common_module_type writer (Obj.magic e);
|
|
- Chunk.write_bool writer.chunk e.e_extern;
|
|
|
|
|
|
+ Chunk.write_uleb128 writer.chunk e.e_flags;
|
|
Chunk.write_list writer.chunk e.e_names (Chunk.write_string writer.chunk)
|
|
Chunk.write_list writer.chunk e.e_names (Chunk.write_string writer.chunk)
|
|
|
|
|
|
let write_typedef writer (td : tdef) =
|
|
let write_typedef writer (td : tdef) =
|
|
@@ -2028,13 +2031,21 @@ module HxbWriter = struct
|
|
Chunk.write_list writer.chunk (PMap.foldi (fun s f acc -> (s,f) :: acc) e.e_constrs []) (fun (s,ef) ->
|
|
Chunk.write_list writer.chunk (PMap.foldi (fun s f acc -> (s,f) :: acc) e.e_constrs []) (fun (s,ef) ->
|
|
Chunk.write_string writer.chunk s;
|
|
Chunk.write_string writer.chunk s;
|
|
write_pos_pair writer ef.ef_pos ef.ef_name_pos;
|
|
write_pos_pair writer ef.ef_pos ef.ef_name_pos;
|
|
- Chunk.write_u8 writer.chunk ef.ef_index
|
|
|
|
|
|
+ Chunk.write_uleb128 writer.chunk ef.ef_index
|
|
);
|
|
);
|
|
| TAbstractDecl a ->
|
|
| TAbstractDecl a ->
|
|
()
|
|
()
|
|
| TTypeDecl t ->
|
|
| TTypeDecl t ->
|
|
()
|
|
()
|
|
|
|
|
|
|
|
+ let write_string_pool writer kind a =
|
|
|
|
+ start_chunk writer kind;
|
|
|
|
+ Chunk.write_uleb128 writer.chunk a.StringDynArray.length;
|
|
|
|
+ StringDynArray.iter a (fun s ->
|
|
|
|
+ let b = Bytes.unsafe_of_string s in
|
|
|
|
+ Chunk.write_bytes_length_prefixed writer.chunk b;
|
|
|
|
+ )
|
|
|
|
+
|
|
let write_module writer (m : module_def) =
|
|
let write_module writer (m : module_def) =
|
|
writer.current_module <- m;
|
|
writer.current_module <- m;
|
|
|
|
|
|
@@ -2234,43 +2245,49 @@ module HxbWriter = struct
|
|
end;
|
|
end;
|
|
|
|
|
|
begin
|
|
begin
|
|
- let deps = DynArray.create () in
|
|
|
|
|
|
+ let imports = DynArray.create () in
|
|
PMap.iter (fun _ mdep ->
|
|
PMap.iter (fun _ mdep ->
|
|
- match mdep.md_kind with
|
|
|
|
- | MCode | MExtern when mdep.md_sign = m.m_extra.m_sign ->
|
|
|
|
- DynArray.add deps mdep.md_path;
|
|
|
|
|
|
+ match mdep.md_kind, mdep.md_origin with
|
|
|
|
+ | (MCode | MExtern), MDepFromImport when mdep.md_sign = m.m_extra.m_sign ->
|
|
|
|
+ DynArray.add imports mdep.md_path;
|
|
| _ ->
|
|
| _ ->
|
|
()
|
|
()
|
|
) m.m_extra.m_deps;
|
|
) m.m_extra.m_deps;
|
|
- if DynArray.length deps > 0 then begin
|
|
|
|
- start_chunk writer MDR;
|
|
|
|
- Chunk.write_uleb128 writer.chunk (DynArray.length deps);
|
|
|
|
|
|
+
|
|
|
|
+ if DynArray.length imports > 0 then begin
|
|
|
|
+ start_chunk writer IMP;
|
|
|
|
+ Chunk.write_uleb128 writer.chunk (DynArray.length imports);
|
|
DynArray.iter (fun path ->
|
|
DynArray.iter (fun path ->
|
|
write_path writer path
|
|
write_path writer path
|
|
- ) deps
|
|
|
|
- end
|
|
|
|
|
|
+ ) imports
|
|
|
|
+ end;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+ (* Note: this is only a start, and is still including a lot of dependencies *)
|
|
|
|
+ (* that are not actually needed for signature only. *)
|
|
|
|
+ let sig_deps = ref PMap.empty in
|
|
|
|
+ List.iter (fun mdep ->
|
|
|
|
+ let dep = {md_sign = mdep.m_extra.m_sign; md_path = mdep.m_path; md_kind = mdep.m_extra.m_kind; md_origin = MDepFromTyping} in
|
|
|
|
+ sig_deps := PMap.add mdep.m_id dep !sig_deps;
|
|
|
|
+ ) writer.sig_deps;
|
|
|
|
+ PMap.iter (fun id mdep -> match mdep.md_kind, mdep.md_origin with
|
|
|
|
+ | (MCode | MExtern), MDepFromMacro when mdep.md_sign = m.m_extra.m_sign -> sig_deps := PMap.add id mdep !sig_deps;
|
|
|
|
+ | _ -> ()
|
|
|
|
+ ) m.m_extra.m_deps;
|
|
|
|
+ m.m_extra.m_sig_deps <- Some !sig_deps;
|
|
|
|
+
|
|
start_chunk writer EOT;
|
|
start_chunk writer EOT;
|
|
start_chunk writer EOF;
|
|
start_chunk writer EOF;
|
|
start_chunk writer EOM;
|
|
start_chunk writer EOM;
|
|
|
|
|
|
- let finalize_string_pool kind items length =
|
|
|
|
- start_chunk writer kind;
|
|
|
|
- Chunk.write_uleb128 writer.chunk length;
|
|
|
|
- List.iter (fun s ->
|
|
|
|
- let b = Bytes.unsafe_of_string s in
|
|
|
|
- Chunk.write_bytes_length_prefixed writer.chunk b;
|
|
|
|
- ) items
|
|
|
|
- in
|
|
|
|
- begin
|
|
|
|
- let items,length = StringPool.finalize writer.cp in
|
|
|
|
- finalize_string_pool STR items length
|
|
|
|
|
|
+ if writer.has_own_string_pool then begin
|
|
|
|
+ let a = StringPool.finalize writer.cp in
|
|
|
|
+ write_string_pool writer STR a
|
|
end;
|
|
end;
|
|
begin
|
|
begin
|
|
- let items,length = StringPool.finalize writer.docs in
|
|
|
|
- if length > 0 then
|
|
|
|
- finalize_string_pool DOC items length
|
|
|
|
|
|
+ let a = StringPool.finalize writer.docs in
|
|
|
|
+ if a.length > 0 then
|
|
|
|
+ write_string_pool writer DOC a
|
|
end
|
|
end
|
|
|
|
|
|
let get_sorted_chunks writer =
|
|
let get_sorted_chunks writer =
|
|
@@ -2281,8 +2298,13 @@ module HxbWriter = struct
|
|
l
|
|
l
|
|
end
|
|
end
|
|
|
|
|
|
-let create config warn anon_id =
|
|
|
|
- let cp = StringPool.create () in
|
|
|
|
|
|
+let create config string_pool warn anon_id =
|
|
|
|
+ let cp,has_own_string_pool = match string_pool with
|
|
|
|
+ | None ->
|
|
|
|
+ StringPool.create(),true
|
|
|
|
+ | Some pool ->
|
|
|
|
+ pool,false
|
|
|
|
+ in
|
|
{
|
|
{
|
|
config;
|
|
config;
|
|
warn;
|
|
warn;
|
|
@@ -2290,6 +2312,9 @@ let create config warn anon_id =
|
|
current_module = null_module;
|
|
current_module = null_module;
|
|
chunks = DynArray.create ();
|
|
chunks = DynArray.create ();
|
|
cp = cp;
|
|
cp = cp;
|
|
|
|
+ has_own_string_pool;
|
|
|
|
+ sig_deps = [];
|
|
|
|
+ in_expr = false;
|
|
docs = StringPool.create ();
|
|
docs = StringPool.create ();
|
|
chunk = Obj.magic ();
|
|
chunk = Obj.magic ();
|
|
classes = Pool.create ();
|
|
classes = Pool.create ();
|
|
@@ -2311,6 +2336,7 @@ let create config warn anon_id =
|
|
local_type_parameters = IdentityPool.create ();
|
|
local_type_parameters = IdentityPool.create ();
|
|
field_stack = [];
|
|
field_stack = [];
|
|
wrote_local_type_param = false;
|
|
wrote_local_type_param = false;
|
|
|
|
+ needs_local_context = false;
|
|
unbound_ttp = IdentityPool.create ();
|
|
unbound_ttp = IdentityPool.create ();
|
|
t_instance_chunk = Chunk.create EOM cp 32;
|
|
t_instance_chunk = Chunk.create EOM cp 32;
|
|
}
|
|
}
|