diff options
Diffstat (limited to 'checker/check.ml')
| -rw-r--r-- | checker/check.ml | 53 |
1 files changed, 22 insertions, 31 deletions
diff --git a/checker/check.ml b/checker/check.ml index 3e22c4b1..21c8f1c5 100644 --- a/checker/check.ml +++ b/checker/check.ml @@ -46,7 +46,7 @@ type library_t = { library_opaques : Cic.opaque_table; library_deps : Cic.library_deps; library_digest : Cic.vodigest; - library_extra_univs : Univ.constraints } + library_extra_univs : Univ.ContextSet.t } module LibraryOrdered = struct @@ -97,7 +97,7 @@ let access_opaque_univ_table dp i = let t = LibraryMap.find dp !opaque_univ_tables in assert (i < Array.length t); Future.force t.(i) - with Not_found -> Univ.empty_constraint + with Not_found -> Univ.ContextSet.empty let _ = Declarations.indirect_opaque_access := access_opaque_table @@ -271,32 +271,22 @@ let try_locate_qualified_library qid = | LibNotFound -> error_lib_not_found qid (************************************************************************) -(*s Low-level interning/externing of libraries to files *) +(*s Low-level interning of libraries from files *) -(*s Loading from disk to cache (preparation phase) *) - -let raw_intern_library = - snd (System.raw_extern_intern Coq_config.vo_magic_number) - -let with_magic_number_check f a = - try f a - with System.Bad_magic_number fname -> - errorlabstrm "with_magic_number_check" - (str"file " ++ str fname ++ spc () ++ str"has bad magic number." ++ - spc () ++ str"It is corrupted" ++ spc () ++ - str"or was compiled with another version of Coq.") +let raw_intern_library f = + System.raw_intern_state Coq_config.vo_magic_number f (************************************************************************) (* Internalise libraries *) open Cic -let mk_library md f table digest cst = { - library_name = md.md_name; +let mk_library sd md f table digest cst = { + library_name = sd.md_name; library_filename = f; library_compiled = md.md_compiled; library_opaques = table; - library_deps = md.md_deps; + library_deps = sd.md_deps; library_digest = digest; library_extra_univs = cst } @@ -310,10 +300,11 @@ let depgraph = ref LibraryMap.empty let intern_from_file (dir, f) = Flags.if_verbose pp (str"[intern "++str f++str" ..."); pp_flush (); - let (md,table,opaque_csts,digest) = + let (sd,md,table,opaque_csts,digest) = try - let ch = with_magic_number_check raw_intern_library f in - let (md:Cic.library_disk), _, digest = System.marshal_in_segment f ch in + let ch = System.with_magic_number_check raw_intern_library f in + let (sd:Cic.summary_disk), _, digest = System.marshal_in_segment f ch in + let (md:Cic.library_disk), _, _ = System.marshal_in_segment f ch in let (opaque_csts:'a option), _, udg = System.marshal_in_segment f ch in let (discharging:'a option), _, _ = System.marshal_in_segment f ch in let (tasks:'a option), _, _ = System.marshal_in_segment f ch in @@ -325,9 +316,9 @@ let intern_from_file (dir, f) = if not (String.equal (Digest.channel ch pos) checksum) then errorlabstrm "intern_from_file" (str "Checksum mismatch"); let () = close_in ch in - if dir <> md.md_name then + if dir <> sd.md_name then errorlabstrm "intern_from_file" - (name_clash_message dir md.md_name f); + (name_clash_message dir sd.md_name f); if tasks <> None || discharging <> None then errorlabstrm "intern_from_file" (str "The file "++str f++str " contains unfinished tasks"); @@ -340,25 +331,25 @@ let intern_from_file (dir, f) = Validate.validate !Flags.debug Values.v_univopaques opaque_csts; end; (* Verification of the unmarshalled values *) + Validate.validate !Flags.debug Values.v_libsum sd; Validate.validate !Flags.debug Values.v_lib md; Validate.validate !Flags.debug Values.v_opaques table; Flags.if_verbose ppnl (str" done]"); pp_flush (); let digest = if opaque_csts <> None then Cic.Dviovo (digest,udg) else (Cic.Dvo digest) in - md,table,opaque_csts,digest + sd,md,table,opaque_csts,digest with e -> Flags.if_verbose ppnl (str" failed!]"); raise e in - depgraph := LibraryMap.add md.md_name md.md_deps !depgraph; - opaque_tables := LibraryMap.add md.md_name table !opaque_tables; + depgraph := LibraryMap.add sd.md_name sd.md_deps !depgraph; + opaque_tables := LibraryMap.add sd.md_name table !opaque_tables; Option.iter (fun (opaque_csts,_,_) -> opaque_univ_tables := - LibraryMap.add md.md_name opaque_csts !opaque_univ_tables) + LibraryMap.add sd.md_name opaque_csts !opaque_univ_tables) opaque_csts; let extra_cst = - Option.default Univ.empty_constraint - (Option.map (fun (_,cs,_) -> - Univ.ContextSet.constraints cs) opaque_csts) in - mk_library md f table digest extra_cst + Option.default Univ.ContextSet.empty + (Option.map (fun (_,cs,_) -> cs) opaque_csts) in + mk_library sd md f table digest extra_cst let get_deps (dir, f) = try LibraryMap.find dir !depgraph |