Partial porting to V8 URIs.

[helm.git] / helm / ocaml / tactics / equalityTactics.ml

diff --git a/helm/ocaml/tactics/equalityTactics.ml b/helm/ocaml/tactics/equalityTactics.ml
index 48d5ea9a63e705780a49784989a59148d852c0b6..232911450400654bed1c31db192f100e4303f0f1 100644 (file)
--- a/helm/ocaml/tactics/equalityTactics.ml
+++ b/helm/ocaml/tactics/equalityTactics.ml
@@ -32,19 +32,12 @@ let rewrite_tac ~term:equality ~status:(proof,goal) =
    let eq_ind_r,ty,t1,t2 =
     match CicTypeChecker.type_of_aux' metasenv context equality with
        C.Appl [C.MutInd (uri,0,[]) ; ty ; t1 ; t2]
-        when U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind") ->
+        when U.eq uri HelmLibraryObjects.Logic.eq_URI ->
          let eq_ind_r =
           C.Const
-           (U.uri_of_string "cic:/Coq/Init/Logic/eq_ind_r.con",[])
+           (HelmLibraryObjects.Logic.eq_ind_r_URI,[])
          in
           eq_ind_r,ty,t1,t2
-     | C.Appl [C.MutInd (uri,0,[]) ; ty ; t1 ; t2]
-        when U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind") ->
-         let eqT_ind_r =
-          C.Const
-           (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT_ind_r.con",[])
-         in
-          eqT_ind_r,ty,t1,t2
      | _ ->
        raise
         (ProofEngineTypes.Fail
@@ -59,7 +52,8 @@ let rewrite_tac ~term:equality ~status:(proof,goal) =
        ~what:[t1'] ~with_what:[C.Rel 1] ~where:gty'
      in
       C.Lambda
-       (ProofEngineHelpers.mk_fresh_name context C.Anonymous ty, ty, gty'')
+       (FreshNamesGenerator.mk_fresh_name metasenv context C.Anonymous ty,
+         ty, gty'')
     in
     let fresh_meta = ProofEngineHelpers.new_meta_of_proof proof in
     let irl = CicMkImplicit.identity_relocation_list_for_metavariable context in
@@ -93,19 +87,11 @@ let rewrite_back_tac ~term:equality ~status:(proof,goal) =
    let eq_ind_r,ty,t1,t2 =
     match CicTypeChecker.type_of_aux' metasenv context equality with
        C.Appl [C.MutInd (uri,0,[]) ; ty ; t1 ; t2]
-        when U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind") ->
+        when U.eq uri HelmLibraryObjects.Logic.eq_URI ->
          let eq_ind_r =
-          C.Const
-           (U.uri_of_string "cic:/Coq/Init/Logic/eq_ind.con",[])
+          C.Const (HelmLibraryObjects.Logic.eq_ind_URI,[])
          in
           eq_ind_r,ty,t2,t1
-     | C.Appl [C.MutInd (uri,0,[]) ; ty ; t1 ; t2]
-        when U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind") ->
-         let eqT_ind_r =
-          C.Const
-           (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT_ind.con",[])
-         in
-          eqT_ind_r,ty,t2,t1
      | _ ->
        raise
         (ProofEngineTypes.Fail
@@ -120,7 +106,8 @@ let rewrite_back_tac ~term:equality ~status:(proof,goal) =
        ~what:[t1'] ~with_what:[C.Rel 1] ~where:gty'
      in
       C.Lambda
-       (ProofEngineHelpers.mk_fresh_name context C.Anonymous ty, ty, gty'')
+       (FreshNamesGenerator.mk_fresh_name metasenv context C.Anonymous ty,
+         ty, gty'')
     in
     let fresh_meta = ProofEngineHelpers.new_meta_of_proof proof in
     let irl =
@@ -159,19 +146,11 @@ let replace_tac ~what ~with_what ~status:((proof, goal) as status) =
       try
       if (wty = (CicTypeChecker.type_of_aux' metasenv context with_what))
        then
-        let equality =
-         match CicTypeChecker.type_of_aux' metasenv context wty with
-            C.Sort C.Set -> "cic:/Coq/Init/Logic/eq.ind"
-          | C.Sort C.Type
-         | C.Sort C.CProp
-          | C.Sort C.Prop -> "cic:/Coq/Init/Logic_Type/eqT.ind"
-          | _ -> assert false
-        in
          T.thens
           ~start:(
             P.cut_tac 
              (C.Appl [
-               (C.MutInd ((U.uri_of_string equality), 0, [])) ;
+               (C.MutInd (HelmLibraryObjects.Logic.eq_URI, 0, [])) ;
                  wty ; 
                  what ; 
                  with_what]))
@@ -202,13 +181,9 @@ let symmetry_tac ~status:(proof, goal) =
    let (_,metasenv,_,_) = proof in
     let metano,context,ty = CicUtil.lookup_meta goal metasenv in
      match (R.whd context ty) with
-        (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind")) ->
-         PrimitiveTactics.apply_tac ~status:(proof,goal)
-          ~term: (C.Const (U.uri_of_string "cic:/Coq/Init/Logic/sym_eq.con", []))
-
-      | (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (U.eq uri (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind")) ->
+        (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (U.eq uri HelmLibraryObjects.Logic.eq_URI) ->
          PrimitiveTactics.apply_tac ~status:(proof,goal)
-          ~term: (C.Const (U.uri_of_string "cic:/Coq/Init/Logic_Type/sym_eqT.con", []))
+          ~term: (C.Const (HelmLibraryObjects.Logic.sym_eq_URI, []))
 
       | _ -> raise (ProofEngineTypes.Fail "Symmetry failed")
 ;;
@@ -222,22 +197,14 @@ let transitivity_tac ~term ~status:((proof, goal) as status) =
    let (_,metasenv,_,_) = proof in
     let metano,context,ty = CicUtil.lookup_meta goal metasenv in
      match (R.whd context ty) with
-        (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (uri = (U.uri_of_string "cic:/Coq/Init/Logic/eq.ind")) ->
+        (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (uri = HelmLibraryObjects.Logic.eq_URI) ->
          T.thens
           ~start:(PrimitiveTactics.apply_tac
-            ~term: (C.Const (U.uri_of_string "cic:/Coq/Init/Logic/trans_eq.con", [])))
+            ~term: (C.Const (HelmLibraryObjects.Logic.trans_eq_URI, [])))
           ~continuations:
             [PrimitiveTactics.exact_tac ~term ; T.id_tac ; T.id_tac]
           ~status
 
-      | (C.Appl [(C.MutInd (uri, 0, [])); _; _; _]) when (uri = (U.uri_of_string "cic:/Coq/Init/Logic_Type/eqT.ind")) ->
-         T.thens
-          ~start:(PrimitiveTactics.apply_tac
-            ~term: (C.Const (U.uri_of_string "cic:/Coq/Init/Logic_Type/trans_eqT.con", [])))
-          ~continuations:
-            [T.id_tac ; T.id_tac ; PrimitiveTactics.exact_tac ~term]
-          ~status
-
       | _ -> raise (ProofEngineTypes.Fail "Transitivity failed")
 ;;