wip: feat(leancheck): store intermediate objects of the proof

This commit is contained in:
Simon Cruanes 2023-03-01 22:37:04 -05:00
parent 39aa3d7f64
commit 75e42072f4
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 72 additions and 4 deletions

View file

@ -1,7 +1,71 @@
module T = Sidekick_core_logic.Term module T = Sidekick_core_logic.Term
module Level = Sidekick_core_logic.Level
let ( let@ ) = ( @@ ) let ( let@ ) = ( @@ )
type obj =
| O_level of Level.t
| O_name of string
| O_term of T.t
| O_ind of string * T.t
(** Intermediate objects in a proof *)
module Obj = struct
type t = obj
let pp out = function
| O_level lvl -> Level.pp out lvl
| O_name n -> Fmt.fprintf out "#name %S" n
| O_term t -> T.pp_debug out t
| O_ind (n, _) -> Fmt.fprintf out "#ind %s" n
let dummy : t = O_name ""
end
(** Map indexes to objects *)
module Idx = struct
type t = { obj: obj Vec.t }
(* create. The slot 0 is already filled with name "" *)
let create () : t = { obj = Vec.make 1 Obj.dummy }
(** ensure that index [n] is valid *)
let ensure_size (self : t) (n : int) : unit =
if n >= Vec.size self.obj then Vec.ensure_size self.obj ~elt:Obj.dummy n
let[@inline] get (self : t) (i : int) : obj = Vec.get self.obj i
let[@inline] set (self : t) (i : int) o : unit =
ensure_size self i;
Vec.set self.obj i o
let[@inline] set_name self i n : unit = set self i (O_name n)
let[@inline] set_level self i l : unit = set self i (O_level l)
let[@inline] set_term self i t : unit = set self i (O_term t)
let get_name self i : string =
match get self i with
| O_name s -> s
| _o -> Error.errorf "expected a name at %d, got %a" i Obj.pp _o
let get_level self i : Level.t =
match get self i with
| O_level l -> l
| _o -> Error.errorf "expected a level at %d, got %a" i Obj.pp _o
let get_term self i : T.t =
match get self i with
| O_term t -> t
| _o -> Error.errorf "expected a term at %d, got %a" i Obj.pp _o
end
(** Join two names with "." *)
let name_join a b =
if a = "" then
b
else
a ^ "." ^ b
let process_files (files : string list) : unit = let process_files (files : string list) : unit =
let start = Mtime_clock.now () in let start = Mtime_clock.now () in
let st = T.Store.create ~size:1024 () in let st = T.Store.create ~size:1024 () in
@ -12,11 +76,15 @@ let process_files (files : string list) : unit =
let proc_file (file : string) : unit = let proc_file (file : string) : unit =
let@ ic = CCIO.with_in file in let@ ic = CCIO.with_in file in
let idx = Idx.create () in
Parse.parse (`In ic) Parse.parse (`In ic)
(module struct (module struct
let line _ = incr n_lines let line _ = incr n_lines
let ns _ _ = () let ns ~at i s = Idx.set_name idx at (name_join (Idx.get_name idx i) s)
let ni _ _ = ()
let ni ~at i n =
Idx.set_name idx at (name_join (Idx.get_name idx i) (string_of_int n))
end) end)
in in

View file

@ -1,5 +1,5 @@
module type CALLBACK = sig module type CALLBACK = sig
val line : string -> unit val line : string -> unit
val ns : int -> string -> unit val ns : at:int -> int -> string -> unit
val ni : int -> int -> unit val ni : at:int -> int -> int -> unit
end end