Skip to content

Commit

Permalink
[hxb] WIP invalidate
Browse files Browse the repository at this point in the history
  • Loading branch information
@kLabz
kLabz committed Jul 26, 2023
1 parent efa0c0d commit 710c3e7
Show file tree
Hide file tree
Showing 5 changed files with 87 additions and 71 deletions.
8 changes: 5 additions & 3 deletions src/compiler/compilationCache.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -105,7 +105,8 @@ class context_cache (index : int) (sign : string) = object(self)
method get_modules = modules

(* TODO rename all this to something that makes sense *)
method get_hxb path = Hashtbl.find_opt binary_cache path
method get_hxb = binary_cache
method get_hxb_module path = Hashtbl.find_opt binary_cache path

(* TODO handle hxb cache there too *)
method get_removed_files = removed_files
Expand Down Expand Up @@ -213,8 +214,9 @@ class cache = object(self)
method taint_modules file_key reason =
Hashtbl.iter (fun _ cc ->
Hashtbl.iter (fun _ m ->
if Path.UniqueKey.lazy_key m.m_extra.m_file = file_key then m.m_extra.m_cache_state <- MSBad (Tainted reason)
) cc#get_modules
if Path.UniqueKey.lazy_key m.mc_extra.m_file = file_key then m.mc_extra.m_cache_state <- MSBad (Tainted reason)
) cc#get_hxb
(* ) cc#get_modules *)
) contexts

(* haxelibs *)
Expand Down
74 changes: 42 additions & 32 deletions src/compiler/hxb/hxbReader.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,12 +11,20 @@ let c_dim = if no_color then "" else "\x1b[2m"
let todo = "\x1b[33m[TODO]" ^ c_reset
let todo_error = "\x1b[31m[TODO] error:" ^ c_reset

let print_stacktrace () =
let stack = Printexc.get_callstack 10 in
let lines = Printf.sprintf "%s\n" (Printexc.raw_backtrace_to_string stack) in
match (ExtString.String.split_on_char '\n' lines) with
| (_ :: (_ :: lines)) -> ServerMessage.debug_msg (Printf.sprintf "%s" (ExtString.String.join "\n" lines))
| _ -> die "" __LOC__

class hxb_reader
(* (com : Common.context) *)
(* (file_ch : IO.input) *)
(make_module : path -> string -> module_def)
(add_module : module_def -> unit)
(resolve_type : string list -> string -> string -> module_type)
(flush_fields : unit -> unit)
= object(self)

val mutable m = null_module
Expand Down Expand Up @@ -92,7 +100,7 @@ class hxb_reader
method read_from_string_pool pool =
let l = self#read_uleb128 in
try pool.(l) with e ->
print_endline (Printf.sprintf " Failed getting string #%d\n" l);
print_endline (Printf.sprintf " Failed getting string #%d" l);
raise e

method read_string =
Expand Down Expand Up @@ -125,7 +133,7 @@ class hxb_reader
let pack = self#read_list (fun () -> self#read_string) in
let mname = self#read_string in
let tname = self#read_string in
(* ServerMessage.debug_msg (Printf.sprintf " Read full path %s\n" (ExtString.String.join "." (pack @ [mname; tname]))); *)
(* ServerMessage.debug_msg (Printf.sprintf " Read full path %s" (ExtString.String.join "." (pack @ [mname; tname]))); *)
(pack,mname,tname)

method read_documentation =
Expand All @@ -146,7 +154,7 @@ class hxb_reader
pmin = min;
pmax = max;
} in
(* ServerMessage.debug_msg (Printf.sprintf "Read pos: %s\n" (Printer.s_pos pos)); *)
(* ServerMessage.debug_msg (Printf.sprintf "Read pos: %s" (Printer.s_pos pos)); *)
(* MessageReporting.display_source_at com pos; *)
pos

Expand All @@ -164,53 +172,54 @@ class hxb_reader
method read_class_ref =
let i = self#read_uleb128 in
try classes.(i) with e ->
print_endline (Printf.sprintf "[%s] %s reading class ref %i\n" (s_type_path m.m_path) todo_error i);
print_endline (Printf.sprintf "[%s] %s reading class ref %i" (s_type_path m.m_path) todo_error i);
raise e

method read_abstract_ref =
let i = self#read_uleb128 in
try abstracts.(i) with e ->
print_endline (Printf.sprintf "[%s] %s reading abstract ref %i\n" (s_type_path m.m_path) todo_error i);
print_endline (Printf.sprintf "[%s] %s reading abstract ref %i" (s_type_path m.m_path) todo_error i);
raise e

method read_enum_ref =
let i = self#read_uleb128 in
try enums.(i) with e ->
print_endline (Printf.sprintf "[%s] %s reading enum ref %i\n" (s_type_path m.m_path) todo_error i);
print_endline (Printf.sprintf "[%s] %s reading enum ref %i" (s_type_path m.m_path) todo_error i);
raise e

method read_typedef_ref =
let i = self#read_uleb128 in
try typedefs.(i) with e ->
print_endline (Printf.sprintf "[%s] %s reading typedef ref %i\n" (s_type_path m.m_path) todo_error i);
print_endline (Printf.sprintf "[%s] %s reading typedef ref %i" (s_type_path m.m_path) todo_error i);
raise e

method read_anon_ref =
let i = self#read_uleb128 in
try anons.(i) with e ->
print_endline (Printf.sprintf "[%s] %s reading anon ref %i\n" (s_type_path m.m_path) todo_error i);
print_endline (Printf.sprintf "[%s] %s reading anon ref %i" (s_type_path m.m_path) todo_error i);
raise e

method read_field_ref fields =
let name = self#read_string in
try PMap.find name fields with e ->
print_endline (Printf.sprintf "[%s] %s reading field %s\n" (s_type_path m.m_path) todo_error name);
ServerMessage.debug_msg (Printf.sprintf " Available fields: %s\n" (PMap.fold (fun f acc -> acc ^ " " ^ f.cf_name) fields ""));
print_endline (Printf.sprintf "[%s] %s reading field %s" (s_type_path m.m_path) todo_error name);
ServerMessage.debug_msg (Printf.sprintf " Available fields: %s" (PMap.fold (fun f acc -> acc ^ " " ^ f.cf_name) fields ""));
print_stacktrace ();
null_field

method read_enum_field_ref en =
let name = self#read_string in
try PMap.find name en.e_constrs with e ->
print_endline (Printf.sprintf " %s reading enum field ref for %s.%s\n" todo_error (s_type_path en.e_path) name);
ServerMessage.debug_msg (Printf.sprintf " Available fields: %s\n" (PMap.fold (fun ef acc -> acc ^ " " ^ ef.ef_name) en.e_constrs ""));
print_endline (Printf.sprintf " %s reading enum field ref for %s.%s" todo_error (s_type_path en.e_path) name);
ServerMessage.debug_msg (Printf.sprintf " Available fields: %s" (PMap.fold (fun ef acc -> acc ^ " " ^ ef.ef_name) en.e_constrs ""));
null_enum_field

method read_anon_field_ref =
match IO.read_byte ch with
| 0 ->
let index = self#read_uleb128 in
(try anon_fields.(index) with e ->
print_endline (Printf.sprintf "[%s] %s reading anon field (0) ref %i\n" (s_type_path m.m_path) todo_error index);
print_endline (Printf.sprintf "[%s] %s reading anon field (0) ref %i" (s_type_path m.m_path) todo_error index);
raise e
)
| 1 ->
Expand All @@ -220,7 +229,7 @@ class hxb_reader
anon_fields.(index) <- cf;
cf
end with e ->
print_endline (Printf.sprintf "[%s] %s reading anon field (1) ref %i\n" (s_type_path m.m_path) todo_error index);
print_endline (Printf.sprintf "[%s] %s reading anon field (1) ref %i" (s_type_path m.m_path) todo_error index);
raise e
)
| _ ->
Expand Down Expand Up @@ -619,14 +628,14 @@ class hxb_reader

method read_type_instance =
let kind = self#read_u8 in
(* ServerMessage.debug_msg (Printf.sprintf " Read type instance %d\n" kind); *)
(* ServerMessage.debug_msg (Printf.sprintf " Read type instance %d" kind); *)

match kind with
| 0 ->
(* ServerMessage.debug_msg (Printf.sprintf " %s identity\n" todo); *)
(* ServerMessage.debug_msg (Printf.sprintf " %s identity" todo); *)
mk_mono() (* TODO: identity *)
| 1 ->
(* ServerMessage.debug_msg (Printf.sprintf " %s TMono Some\n" todo); *)
(* ServerMessage.debug_msg (Printf.sprintf " %s TMono Some" todo); *)
let t = self#read_type_instance in
let tmono = !monomorph_create_ref () in (* TODO identity *)
tmono.tm_type <- Some t;
Expand Down Expand Up @@ -681,7 +690,7 @@ class hxb_reader
| 31 ->
let f () =
let name = self#read_string in
(* ServerMessage.debug_msg (Printf.sprintf " Read type instance for %s\n" name); *)
(* ServerMessage.debug_msg (Printf.sprintf " Read type instance for %s" name); *)
let opt = self#read_bool in
let t = self#read_type_instance in
(name,opt,t)
Expand All @@ -691,13 +700,13 @@ class hxb_reader
| 32 ->
let f () =
let name = self#read_string in
(* ServerMessage.debug_msg (Printf.sprintf " Read type instance for %s\n" name); *)
(* ServerMessage.debug_msg (Printf.sprintf " Read type instance for %s" name); *)
let opt = self#read_bool in
let t = self#read_type_instance in
(name,opt,t)
in
let args = self#read_list f in
(* ServerMessage.debug_msg (Printf.sprintf " Read type instance for TFun\n"); *)
(* ServerMessage.debug_msg (Printf.sprintf " Read type instance for TFun"); *)
let ret = self#read_type_instance in
TFun(args,ret)
| 33 ->
Expand Down Expand Up @@ -725,8 +734,8 @@ class hxb_reader
let a = Array.init l (fun _ ->
let name = self#read_string in
let pos = self#read_pos in
(* ServerMessage.debug_msg (Printf.sprintf " Read ttp pos for %s: %s\n" name (Printer.s_pos pos)); *)
(* ServerMessage.debug_msg (Printf.sprintf " - Path was %s\n" (s_type_path path)); *)
(* ServerMessage.debug_msg (Printf.sprintf " Read ttp pos for %s: %s" name (Printer.s_pos pos)); *)
(* ServerMessage.debug_msg (Printf.sprintf " - Path was %s" (s_type_path path)); *)
let c = mk_class m (fst path @ [snd path],name) pos pos in
mk_type_param name (TInst(c,[])) None
) in
Expand Down Expand Up @@ -850,7 +859,7 @@ class hxb_reader
let pos = self#read_pos in

let i = IO.read_byte ch in
(* ServerMessage.debug_msg (Printf.sprintf " -- texpr [%d] --\n" i); *)
(* ServerMessage.debug_msg (Printf.sprintf " -- texpr [%d] --" i); *)
let e = match i with
(* values 0-19 *)
| 0 -> TConst TNull
Expand Down Expand Up @@ -1068,12 +1077,12 @@ class hxb_reader
| 250 -> TIdent (self#read_string)

| i ->
print_endline (Printf.sprintf " [ERROR] Unhandled texpr %d at:\n" i);
print_endline (Printf.sprintf " [ERROR] Unhandled texpr %d at:" i);
(* MessageReporting.display_source_at com pos; *)
assert false
in

(* ServerMessage.debug_msg (Printf.sprintf " Done reading texpr at:\n"); *)
(* ServerMessage.debug_msg (Printf.sprintf " Done reading texpr at:"); *)
(* MessageReporting.display_source_at com pos; *)

{
Expand All @@ -1095,7 +1104,7 @@ class hxb_reader

method read_class_field_data (nested : bool) (cf : tclass_field) : unit =
let name = cf.cf_name in
(* ServerMessage.debug_msg (Printf.sprintf " Read class field %s\n" name); *)
(* ServerMessage.debug_msg (Printf.sprintf " Read class field %s" name); *)
self#read_type_parameters ([],name) (fun a ->
field_type_parameters <- if nested then Array.append field_type_parameters a else a
);
Expand Down Expand Up @@ -1146,8 +1155,8 @@ class hxb_reader
| _ ->
type_type_parameters <- Array.of_list c.cl_params
end;
(* ServerMessage.debug_msg (Printf.sprintf " read class fields with type parameters for %s: %d\n" (s_type_path c.cl_path) (Array.length type_type_parameters); *)
(* ServerMessage.debug_msg (Printf.sprintf " own class params: %d\n" (List.length c.cl_params); *)
(* ServerMessage.debug_msg (Printf.sprintf " read class fields with type parameters for %s: %d" (s_type_path c.cl_path) (Array.length type_type_parameters); *)
(* ServerMessage.debug_msg (Printf.sprintf " own class params: %d" (List.length c.cl_params); *)
let _ = self#read_option (fun f ->
self#read_class_field_data false (Option.get c.cl_constructor)
) in
Expand Down Expand Up @@ -1178,7 +1187,7 @@ class hxb_reader

method read_common_module_type (infos : tinfos) =
(* if (snd m.m_path) = "Issue9149" then *)
(* ServerMessage.debug_msg (Printf.sprintf "[%s] Read module type %s\n" (s_type_path m.m_path) (s_type_path infos.mt_path)); *)
(* ServerMessage.debug_msg (Printf.sprintf "[%s] Read module type %s" (s_type_path m.m_path) (s_type_path infos.mt_path)); *)
infos.mt_private <- self#read_bool;
infos.mt_doc <- self#read_option (fun () -> self#read_documentation);
infos.mt_meta <- self#read_metadata;
Expand Down Expand Up @@ -1261,7 +1270,7 @@ class hxb_reader

method read_string_pool =
let l = self#read_uleb128 in
(* ServerMessage.debug_msg (Printf.sprintf " Read string pool of size %d\n" l); *)
(* ServerMessage.debug_msg (Printf.sprintf " Read string pool of size %d" l); *)
Array.init l (fun i ->
self#read_raw_string;
);
Expand All @@ -1272,7 +1281,7 @@ class hxb_reader
let data = IO.nread ch size in
let crc = self#read_u32 in
ignore(crc); (* TODO *)
(* ServerMessage.debug_msg (Printf.sprintf "%s check crc (%d)\n" todo (Int32.to_int crc)); *)
(* ServerMessage.debug_msg (Printf.sprintf "%s check crc (%d)" todo (Int32.to_int crc)); *)
let kind = chunk_kind_of_string name in
(kind,data)

Expand Down Expand Up @@ -1509,7 +1518,7 @@ class hxb_reader
let chunks = pass_0 chunks in
assert(m != null_module);
List.iter (fun (kind,data) ->
(* ServerMessage.debug_msg (Printf.sprintf " Reading chunk %s\n" (string_of_chunk_kind kind)); *)
(* ServerMessage.debug_msg (Printf.sprintf " Reading chunk %s" (string_of_chunk_kind kind)); *)
ch <- IO.input_bytes data;
match kind with
| TYPF ->
Expand All @@ -1530,6 +1539,7 @@ class hxb_reader
| CLSD ->
self#read_clsd;
| CFLD ->
flush_fields ();
self#read_cfld;
| ENMD ->
self#read_enmd;
Expand Down
Loading

0 comments on commit 710c3e7

Please sign in to comment.