1. new implementation of normalize to have a speed up in case of fully applicative...

2. all reduction tactics used to end with instatiate that re-checked the conversion using
   unification (!!!); added a new flag ?(refine=false) to instantiate to avoid this expensive
   check when we know it is useless

diff --git a/helm/software/components/ng_kernel/nCicReduction.ml b/helm/software/components/ng_kernel/nCicReduction.ml
index 8fc58f4c9c27002fe81b8c9930e455e9ba9212f1..236f5778e86394317930eababfede4aaedc8fb3e 100644 (file)
--- a/helm/software/components/ng_kernel/nCicReduction.ml
+++ b/helm/software/components/ng_kernel/nCicReduction.ml
@@ -61,7 +61,7 @@ module CallByValueByNameForUnwind' : Strategy = struct
    lazy (fst (reduce ~delta:0 c)), 
    (fun delta -> fst (reduce ~delta c)),
    lazy (unwind c)
-  let from_stack ~delta (c0,c,_) = if delta = 0 then Lazy.force c0 else c delta 
+  let from_stack ~delta (c0,c,_) = if delta = 0 then Lazy.force c0 else c delta
   let from_stack_list_for_unwind ~unwind:_ l = 
    List.map (fun (_,_,c) -> Lazy.force c) l
   let from_env ~delta (c0,c,_) = if delta = 0 then Lazy.force c0 else c delta
@@ -433,6 +433,7 @@ type machine = int * environment_item list * NCic.term * stack_item list
 
 let reduce_machine = R.reduce
 let from_stack = RS.from_stack
+let from_env = RS.from_env
 let unwind = R.unwind
 
 let _ = 

diff --git a/helm/software/components/ng_kernel/nCicReduction.mli b/helm/software/components/ng_kernel/nCicReduction.mli
index 713edd1705050d14fe6ee2d1fee270a71f7fd713..35159fc1c9d07c0346c368ae12946b59ea030ecc 100644 (file)
--- a/helm/software/components/ng_kernel/nCicReduction.mli
+++ b/helm/software/components/ng_kernel/nCicReduction.mli
@@ -44,6 +44,7 @@ val reduce_machine :
      delta:int -> ?subst:NCic.substitution -> NCic.context -> machine -> 
       machine * bool
 val from_stack : delta:int -> stack_item -> machine
+val from_env : delta:int -> environment_item -> machine
 val unwind : machine -> NCic.term
 
 val split_prods:

diff --git a/helm/software/components/ng_tactics/nCicTacReduction.ml b/helm/software/components/ng_tactics/nCicTacReduction.ml
index 3236956fd26e1c92dcbc36f6bb90fa1ab39b28cc..bc756a9ffffdb9b56b9b03937b7e22e028eb48b4 100644 (file)
--- a/helm/software/components/ng_tactics/nCicTacReduction.ml
+++ b/helm/software/components/ng_tactics/nCicTacReduction.ml
@@ -12,13 +12,28 @@
 (* $Id: nCic.ml 9058 2008-10-13 17:42:30Z tassi $ *)
  
 let rec normalize ?(delta=0) ~subst ctx t =
- let aux = normalize ~delta ~subst in
-  match NCicReduction.whd ~delta ~subst ctx t with
+ normalize_machine ~delta ~subst ctx
+  (fst (NCicReduction.reduce_machine ~delta ~subst ctx (0,[],t,[])))
+and normalize_machine ?(delta=0) ~subst ctx (k,e,t,s) =
+ assert (delta=0);
+ let t = 
+   if k = 0 then t
+   else
+     NCicSubstitution.psubst ~avoid_beta_redexes:true  
+       (fun e -> normalize_machine ~delta ~subst ctx (NCicReduction.from_env ~delta e)) e t in
+ let t =
+  match t with
      NCic.Meta (n,(s,lc)) ->
       let l = NCicUtils.expand_local_context lc in
-      let l' = List.map (aux ctx) l in
+      let l' = List.map (normalize ~delta ~subst ctx) l in
        if l = l' then t
        else
         NCic.Meta (n,(s,NCic.Ctx l))
-   | t -> NCicUtils.map (fun h ctx -> h::ctx) ctx aux t
+   | t -> NCicUtils.map (fun h ctx -> h::ctx) ctx (normalize ~delta ~subst) t
+ in
+ if s = [] then t 
+ else
+  NCic.Appl
+   (t::
+    (List.map (fun i -> normalize_machine ~delta ~subst ctx (NCicReduction.from_stack ~delta i)) s))
 ;;

diff --git a/helm/software/components/ng_tactics/nTacStatus.ml b/helm/software/components/ng_tactics/nTacStatus.ml
index 1aaeb50f6367ea58863034b8d12af18981203101..4a7f9819650b0efa11954f27017129a1b43aefa5 100644 (file)
--- a/helm/software/components/ng_tactics/nTacStatus.ml
+++ b/helm/software/components/ng_tactics/nTacStatus.ml
@@ -249,11 +249,15 @@ let to_subst status i entry =
   status#set_obj (name,height,metasenv,subst,obj)
 ;;
 
-let instantiate status i t =
+let instantiate status ?refine:(dorefine=false) i t =
  let _,_,metasenv,_,_ = status#obj in
  let gname, context, gty = List.assoc i metasenv in
- let status, (_,t), (_,ty) = refine status context t (Some (context,gty)) in
-  to_subst status i (gname,context,t,ty)
+  if dorefine then
+   let status, (_,t), (_,ty) = refine status context t (Some (context,gty)) in
+    to_subst status i (gname,context,t,ty)
+  else
+   let status,(_,ty) = typeof status context t in
+    to_subst status i (gname,context,snd t,ty)
 ;;
 
 let instantiate_with_ast status i t =

diff --git a/helm/software/components/ng_tactics/nTacStatus.mli b/helm/software/components/ng_tactics/nTacStatus.mli
index 5616794573ed830c42ab14913de5a61501f90d78..edaf40b6cf2578697ad3534a2a797934c22bb8cf 100644 (file)
--- a/helm/software/components/ng_tactics/nTacStatus.mli
+++ b/helm/software/components/ng_tactics/nTacStatus.mli
@@ -76,7 +76,10 @@ val mk_meta:
  #pstatus as 'status -> ?attrs:NCic.meta_attrs -> NCic.context ->
    [ `Decl of cic_term | `Def of cic_term ] -> NCicUntrusted.meta_kind ->
      'status * cic_term
-val instantiate: #pstatus as 'status -> int -> cic_term -> 'status
+
+(* default value for refine: false; you can use true if the term has already been refined with
+   the expected type for the meta (e.g. after a reduction tactic) *)
+val instantiate: #pstatus as 'status -> ?refine:bool -> int -> cic_term -> 'status
 val instantiate_with_ast: #pstatus as 'status -> int -> tactic_term -> 'status
 
 val select_term:

diff --git a/helm/software/components/ng_tactics/nTactics.ml b/helm/software/components/ng_tactics/nTactics.ml
index 86b42f66190403dc2630ec8ebe941cb66db75dec..d1e6dc781824d3d894379fe9083ed09c11f22504 100644 (file)
--- a/helm/software/components/ng_tactics/nTactics.ml
+++ b/helm/software/components/ng_tactics/nTactics.ml
@@ -371,7 +371,7 @@ let select0_tac ~where:(wanted,hyps,where) ~job  =
    let status, instance = 
      mk_meta status newgoalctx (`Decl newgoalty) `IsTerm
    in
-   instantiate status goal instance)
+   instantiate ~refine:false status goal instance)
 ;;
 
 let select_tac ~where ~job move_down_hyps =