drop precomputed_signature: quadratic in size

Author: gares

dune

@@ -6,6 +6,13 @@
   (modules elpi_REPL)
   (package elpi)
 )
+
+(executable
+  (name elpi_inspect)
+  (libraries elpi elpi.parser ;memtrace
+  )
+  (modules elpi_inspect)
+)
 (env
   (dev
     (flags (:standard -w -9 -w -27 -warn-error -A))))

elpi_inspect.ml

@@ -0,0 +1,5 @@
+open Elpi.API
+
+let () = 
+  let u : Compile.compilation_unit = Marshal.from_channel (open_in_bin Sys.argv.(1)) in
+  Format.printf "%a" Compile.pp_compilation_unit u

src/API.ml

@@ -148,6 +148,7 @@ module Compile = struct
   type executable = ED.executable
   type scoped_program = Compiler.scoped_program * int
   type compilation_unit = Compiler.checked_compilation_unit
+  let pp_compilation_unit = Compiler.pp_checked_compilation_unit
   type compilation_unit_signature = Compiler.checked_compilation_unit_signature
   exception CompileError = Compiler_data.CompileError
 

src/API.mli

@@ -293,6 +293,8 @@ module Compile : sig
   val scope : ?flags:flags -> elpi:Setup.elpi -> ?builtins:Setup.builtins -> Ast.program -> scoped_program
 
   type compilation_unit
+  val pp_compilation_unit : Format.formatter -> compilation_unit -> unit
+  
   type compilation_unit_signature
   val empty_base : elpi:Setup.elpi -> program
   val unit : ?flags:flags -> elpi:Setup.elpi -> base:program -> ?builtins:Setup.builtins -> scoped_program -> compilation_unit

src/compiler/compiler.ml

@@ -419,7 +419,6 @@ type checked_compilation_unit = {
   version : string;
   checked_code : CheckedFlat.program;
   base_hash : string;
-  precomputed_signature : Assembled.signature;
   type_checking_time : float;
   det_checking_time : float;
 }
@@ -1571,15 +1570,12 @@ end = struct
 
     let more_types = time_this type_check_time (fun () -> Type_checker.check_undeclared ~unknown ~type_abbrevs) in
     let u_types = Flatten.merge_type_assignments u_types more_types in
-    let types = Flatten.merge_type_assignments types more_types in
 
     let signature = { signature with types = u_types } in
-    let precomputed_signature = { precomputed_signature with types } in
 
     let checked_code = { CheckedFlat.signature; clauses; chr; builtins } in
 
   { version; checked_code; base_hash = hash_base base;
-    precomputed_signature;
     type_checking_time = if flags.time_typechecking then !type_check_time +. check_sig else 0.0;
     det_checking_time = if flags.time_typechecking then !det_check_time else 0.0;
 }
@@ -2158,10 +2154,7 @@ let allocate_new_symbols state ~symbols ~new_defined_symbols =
 
 let extend1 flags (state, base) unit =
 
-  let signature =
-    if hash_base base = unit.base_hash
-    then unit.precomputed_signature
-    else extend1_signature base.Assembled.signature unit.checked_code.CheckedFlat.signature in
+  let signature = extend1_signature base.Assembled.signature unit.checked_code.CheckedFlat.signature in
 
   let { Assembled.hash; clauses = cl; symbols; prolog_program; indexing; signature = bsig; chr = ochr; builtins = ob; total_type_checking_time; total_det_checking_time } = base in
   let { version; base_hash; checked_code = { CheckedFlat.clauses; chr; builtins; signature = { types = new_types } }; type_checking_time; det_checking_time } = unit in
@@ -2684,5 +2677,6 @@ let info_of_clause ~types { Ast.Clause.body } =
 
 let hover (u : checked_compilation_unit) =
   let { CheckedFlat.clauses } = u.checked_code in
-  List.map (info_of_clause ~types:u.precomputed_signature.Assembled.types) clauses |> List.flatten
+  (* This signature does not contain all types ... *)
+  List.map (info_of_clause ~types:u.checked_code.signature.Assembled.types) clauses |> List.flatten
 

src/compiler/compiler.mli

@@ -34,6 +34,7 @@ type scoped_program
 val scoped_of_ast : flags:flags -> header:header -> ?calc:CalcHooks.descriptor -> ?builtins:declared_builtins list -> Ast.Program.t -> scoped_program
 
 type checked_compilation_unit
+val pp_checked_compilation_unit : Format.formatter -> checked_compilation_unit -> unit
 type unchecked_compilation_unit
 val empty_base : header:header -> program
 val unit_of_scoped : flags:flags -> header:header -> ?builtins:declared_builtins list -> scoped_program -> unchecked_compilation_unit