]> matita.cs.unibo.it Git - helm.git/commitdiff
nrewrite now uses the appropriate principle when going from right to left
authorClaudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>
Mon, 20 Jul 2009 19:43:42 +0000 (19:43 +0000)
committerClaudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>
Mon, 20 Jul 2009 19:43:42 +0000 (19:43 +0000)
helm/software/components/ng_tactics/nTactics.ml

index 4c5b38369e986e80034f5a1f345004a445240987..16602ac9f6202276e623c7e206df3289c03c79a9 100644 (file)
@@ -494,16 +494,33 @@ let elim_tac ~what ~where =
      exact_tac ("",0,eliminator) status) ]) 
 ;;
 
-let rewrite_tac ~dir ~what:(_,_,what) ~where =
+let sort_of_goal_tac sortref = distribute_tac (fun status goal ->
+  let goalty = get_goalty status goal in
+  let status,sort = typeof status (ctx_of goalty) goalty in
+  let status,sort = term_of_cic_term status sort (ctx_of goalty) in
+   sortref := sort;
+   status)
+;;
+
+let rewrite_tac ~dir ~what:(_,_,what) ~where status =
+ let sortref = ref (NCic.Rel 1) in
+ let status = sort_of_goal_tac sortref status in
+ let suffix =
+  match !sortref with
+   | NCic.Sort NCic.Prop -> "_ind"
+   | NCic.Sort NCic.Type u ->
+      "_rect_" ^ NCicPp.ppterm ~metasenv:[] ~subst:[] ~context:[] !sortref
+   | _ -> assert false 
+ in
  let name =
-  match dir with `LeftToRight -> "eq_elim_r" | `RightToLeft -> "eq_ind"
+  match dir with `LeftToRight -> "eq_elim_r" | `RightToLeft -> "eq" ^ suffix
  in
   block_tac
    [ select_tac ~where ~job:(`Substexpand 1) true;
      exact_tac
       ("",0,
        Ast.Appl(Ast.Ident(name,None)::HExtlib.mk_list Ast.Implicit 5 @
-        [what]))]
+        [what]))] status
 ;;
 
 let intro_tac name =