new discrimination tree instantiation with

[helm.git] / helm / software / components / ng_tactics / nTacStatus.ml

diff --git a/helm/software/components/ng_tactics/nTacStatus.ml b/helm/software/components/ng_tactics/nTacStatus.ml
index dc059d50d9c6106a76e1873ae2a7bc5bcedfa0b6..d55f7439f385c847370433ed570e594c7b6dc3cf 100644 (file)
--- a/helm/software/components/ng_tactics/nTacStatus.ml
+++ b/helm/software/components/ng_tactics/nTacStatus.ml
@@ -375,3 +375,66 @@ class type tac_status = [Continuationals.Stack.t] status
 
 type 'status tactic = #tac_status as 'status -> 'status
 
+module NCicInverseRelIndexable : Discrimination_tree.Indexable
+with type input = cic_term and type constant_name = NUri.uri = struct
+
+open Discrimination_tree
+
+type input = cic_term
+type constant_name = NUri.uri
+
+let ppelem = function
+  | Constant (uri,arity) -> 
+      "("^NUri.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 (ctx,t) =
+  let len_ctx = List.length ctx in
+  let rec aux arity = function
+    | NCic.Appl ((NCic.Meta _|NCic.Implicit _)::_) -> [Variable]
+    | NCic.Appl (NCic.Lambda _ :: _) -> [Variable] (* maybe we should b-reduce *)
+    | NCic.Appl [] -> assert false
+    | NCic.Appl (hd::tl) ->
+        aux (List.length tl) hd @ List.flatten (List.map (aux 0) tl) 
+    | NCic.Lambda _ | NCic.Prod _ -> [Variable]
+        (* I think we should CicSubstitution.subst Implicit t *)
+    | NCic.LetIn _ -> [Variable] (* z-reduce? *)
+    | NCic.Meta _ | NCic.Implicit _ -> assert (arity = 0); [Variable]
+    | NCic.Rel i -> [Bound (len_ctx - i, arity)]
+    | NCic.Sort (NCic.Prop) -> assert (arity=0); [Proposition]
+    | NCic.Sort _ -> assert (arity=0); [Datatype]
+    | NCic.Const (NReference.Ref (u,_)) -> [Constant (u, arity)]
+    | NCic.Match _ -> [Dead]
+  in 
+    aux 0 t
+;;
+
+let compare e1 e2 =
+  match e1,e2 with
+  | Constant (u1,a1),Constant (u2,a2) -> 
+       let x = NUri.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
+
+module Ncic_termOT : Set.OrderedType with type t = cic_term =
+ struct
+   type t = cic_term
+   let compare = Pervasives.compare
+ end
+
+module Ncic_termSet : Set.S with type elt = cic_term = Set.Make(Ncic_termOT)
+
+module InvRelDiscriminationTree = 
+   Discrimination_tree.Make(NCicInverseRelIndexable)(Ncic_termSet)
+