blob: 41680036c32bdd6e92de31ab9ac02f2dafb80e46 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
(* <O___,, * INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010 *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
open Term
open Summary
open Libobject
open Libnames
open Names
(*
* Module construction
*)
(* let reduce c = Reductionops.head_unfold_under_prod *)
(* (Auto.Hint_db.transparent_state (Auto.searchtable_map "typeclass_instances")) *)
(* (Global.env()) Evd.empty c *)
let reduce c = c
module TypeDnet = Term_dnet.Make
(struct
type t = Libnames.global_reference
let compare = RefOrdered.compare
let subst s gr = fst (Libnames.subst_global s gr)
let constr_of = Global.type_of_global
end)
(struct let reduce = reduce
let direction = false
end)
type result = Libnames.global_reference * (constr*existential_key) * Termops.subst
let all_types = ref TypeDnet.empty
let defined_types = ref TypeDnet.empty
(*
* Bookeeping & States
*)
let freeze () =
(!all_types,!defined_types)
let unfreeze (lt,dt) =
all_types := lt;
defined_types := dt
let init () =
all_types := TypeDnet.empty;
defined_types := TypeDnet.empty
let _ =
declare_summary "type-library-state"
{ freeze_function = freeze;
unfreeze_function = unfreeze;
init_function = init }
let load (_,d) =
(* Profile.print_logical_stats !all_types;
Profile.print_logical_stats d;*)
all_types := TypeDnet.union d !all_types
let subst s t = TypeDnet.subst s t
(*
let subst_key = Profile.declare_profile "subst"
let subst a b = Profile.profile2 subst_key TypeDnet.subst a b
let load_key = Profile.declare_profile "load"
let load a = Profile.profile1 load_key load a
*)
let (input,output) =
declare_object
{ (default_object "LIBTYPES") with
load_function = (fun _ -> load);
subst_function = (fun (s,t) -> subst s t);
classify_function = (fun x -> Substitute x)
}
let update () = Lib.add_anonymous_leaf (input !defined_types)
(*
* Search interface
*)
let search_pattern pat = TypeDnet.search_pattern !all_types pat
let search_concl pat = TypeDnet.search_concl !all_types pat
let search_head_concl pat = TypeDnet.search_head_concl !all_types pat
let search_eq_concl eq pat = TypeDnet.search_eq_concl !all_types eq pat
let add typ gr =
defined_types := TypeDnet.add typ gr !defined_types;
all_types := TypeDnet.add typ gr !all_types
(*
let add_key = Profile.declare_profile "add"
let add a b = Profile.profile1 add_key add a b
*)
(*
* Hooks declaration
*)
let _ = Declare.add_cache_hook
( fun sp ->
let gr = Nametab.global_of_path sp in
let ty = Global.type_of_global gr in
add ty gr )
let _ = Declaremods.set_end_library_hook update
|
