(* $Id$ *)
-type path_string_elem =
- | Constant of UriManager.uri * int (* name, arity *)
+type 'a path_string_elem =
+ | Constant of 'a * int (* name, arity *)
| Bound of int * int (* rel, arity *)
| Variable (* arity is 0 *)
| Proposition (* arity is 0 *)
| Datatype (* arity is 0 *)
| Dead (* arity is 0 *)
;;
-
+
+type 'a path = ('a path_string_elem) list;;
+
+module type Indexable = sig
+ type input
+ type constant_name
+ val compare:
+ constant_name path_string_elem ->
+ constant_name path_string_elem -> int
+ val string_of_path : constant_name path -> string
+ val path_string_of : input -> constant_name path
+end
+
+module CicIndexable : Indexable
+with type input = Cic.term and type constant_name = UriManager.uri
+= struct
+
+ type input = Cic.term
+ type constant_name = UriManager.uri
+
+ let ppelem = function
+ | Constant (uri,arity) ->
+ "("^UriManager.name_of_uri uri ^ "," ^ string_of_int arity^")"
+ | Bound (i,arity) ->
+ "("^string_of_int i ^ "," ^ string_of_int arity^")"
+ | Variable -> "?"
+ | Proposition -> "Prop"
+ | Datatype -> "Type"
+ | Dead -> "Dead"
+ ;;
+
+ let path_string_of =
+ let rec aux arity = function
+ | Cic.Appl ((Cic.Meta _|Cic.Implicit _)::_) -> [Variable]
+ | Cic.Appl (Cic.Lambda _ :: _) ->
+ [Variable] (* maybe we should b-reduce *)
+ | Cic.Appl [] -> assert false
+ | Cic.Appl (hd::tl) ->
+ aux (List.length tl) hd @ List.flatten (List.map (aux 0) tl)
+ | Cic.Cast (t,_) -> aux arity t
+ | Cic.Lambda (_,s,t) | Cic.Prod (_,s,t) -> [Variable]
+ (* I think we should CicSubstitution.subst Implicit t *)
+ | Cic.LetIn (_,s,_,t) -> [Variable] (* z-reduce? *)
+ | Cic.Meta _ | Cic.Implicit _ -> assert (arity = 0); [Variable]
+ | Cic.Rel i -> [Bound (i, arity)]
+ | Cic.Sort (Cic.Prop) -> assert (arity=0); [Proposition]
+ | Cic.Sort _ -> assert (arity=0); [Datatype]
+ | Cic.Const _ | Cic.Var _
+ | Cic.MutInd _ | Cic.MutConstruct _ as t ->
+ [Constant (CicUtil.uri_of_term t, arity)]
+ | Cic.MutCase _ | Cic.Fix _ | Cic.CoFix _ -> [Dead]
+ in
+ aux 0
+ ;;
+
+ let compare e1 e2 =
+ match e1,e2 with
+ | Constant (u1,a1),Constant (u2,a2) ->
+ let x = UriManager.compare u1 u2 in
+ if x = 0 then Pervasives.compare a1 a2 else x
+ | e1,e2 -> Pervasives.compare e1 e2
+ ;;
+
+ let string_of_path l = String.concat "." (List.map ppelem l) ;;
+end
+
let arity_of = function
| Constant (_,a)
| Bound (_,a) -> a
| _ -> 0
;;
-type path = path_string_elem list;;
-
-let ppelem = function
- | Constant (uri,arity) ->
- "("^UriManager.name_of_uri uri ^ "," ^ string_of_int arity^")"
- | Bound (i,arity) ->
- "("^string_of_int i ^ "," ^ string_of_int arity^")"
- | Variable -> "?"
- | Proposition -> "Prop"
- | Datatype -> "Type"
- | Dead -> "Dead"
-;;
-
-let path_string_of_term_with_jl =
- let rec aux arity = function
- | Cic.Appl ((Cic.Meta _|Cic.Implicit _)::_) -> [Variable]
- | Cic.Appl (Cic.Lambda _ :: _) -> [Variable] (* maybe we should b-reduce *)
- | Cic.Appl [] -> assert false
- | Cic.Appl (hd::tl) ->
- aux (List.length tl) hd @ List.flatten (List.map (aux 0) tl)
- | Cic.Cast (t,_) -> aux arity t
- | Cic.Lambda (_,s,t) | Cic.Prod (_,s,t) -> [Variable]
- (* I think we should CicSubstitution.subst Implicit t *)
- | Cic.LetIn (_,s,_,t) -> [Variable] (* z-reduce? *)
- | Cic.Meta _ | Cic.Implicit _ -> assert (arity = 0); [Variable]
- | Cic.Rel i -> [Bound (i, arity)]
- | Cic.Sort (Cic.Prop) -> assert (arity=0); [Proposition]
- | Cic.Sort _ -> assert (arity=0); [Datatype]
- | Cic.Const _ | Cic.Var _ | Cic.MutInd _ | Cic.MutConstruct _ as t ->
- [Constant (CicUtil.uri_of_term t, arity)]
- | Cic.MutCase _ | Cic.Fix _ | Cic.CoFix _ -> [Dead]
- in
- aux 0
-;;
-
-let compare_elem e1 e2 =
- match e1,e2 with
- | Constant (u1,a1),Constant (u2,a2) ->
- let x = UriManager.compare u1 u2 in
- if x = 0 then Pervasives.compare a1 a2 else x
- | e1,e2 -> Pervasives.compare e1 e2
-;;
-
-let string_of_path l = String.concat "." (List.map ppelem l) ;;
-
module DiscriminationTreeIndexing =
+ functor (I:Indexable) ->
functor (A:Set.S) ->
struct
module OrderedPathStringElement = struct
- type t = path_string_elem
- let compare = compare_elem
+ type t = I.constant_name path_string_elem
+ let compare = I.compare
end
module PSMap = Map.Make(OrderedPathStringElement);;
let iter dt f = DiscriminationTree.iter (fun p x -> f p x) dt;;
let index tree term info =
- let ps = path_string_of_term_with_jl term in
+ let ps = I.path_string_of term in
let ps_set =
try DiscriminationTree.find ps tree with Not_found -> A.empty
in
;;
let remove_index tree term info =
- let ps = path_string_of_term_with_jl term in
+ let ps = I.path_string_of term in
try
let ps_set = A.remove info (DiscriminationTree.find ps tree) in
if A.is_empty ps_set then DiscriminationTree.remove ps tree
;;
let in_index tree term test =
- let ps = path_string_of_term_with_jl term in
+ let ps = I.path_string_of term in
try
let ps_set = DiscriminationTree.find ps tree in
A.exists test ps_set
;;
let retrieve unif tree term =
- let path = path_string_of_term_with_jl term in
+ let path = I.path_string_of term in
let rec retrieve path tree =
match tree, path with
| DiscriminationTree.Node (Some s, _), [] -> s
projects / helm.git / blobdiff