Eta contraction is now performed all the time during rewriting.
authornipkow
Thu, 29 Apr 1999 18:33:31 +0200
changeset 6539 2e7d2fba9f6c
parent 6538 d575fb1edabf
child 6540 eaf90f6806df
Eta contraction is now performed all the time during rewriting.
src/Pure/net.ML
src/Pure/pattern.ML
src/Pure/thm.ML
--- a/src/Pure/net.ML	Thu Apr 29 15:35:40 1999 +0200
+++ b/src/Pure/net.ML	Thu Apr 29 18:33:31 1999 +0200
@@ -195,16 +195,14 @@
      case net of
 	 Leaf _ => nets
        | Net{var,...} =>
-	     let val etat = Pattern.eta_contract_atom t
-	     in case (head_of etat) of
+	     case head_of t of
 		 Var _ => if unif then net_skip (net,nets)
 			  else var::nets	   (*only matches Var in net*)
   (*If "unif" then a var instantiation in the abstraction could allow
     an eta-reduction, so regard the abstraction as a wildcard.*)
 	       | Abs _ => if unif then net_skip (net,nets)
 			  else var::nets	   (*only a Var can match*)
-	       | _ => rands etat (net, var::nets)  (*var could match also*)
-	     end
+	       | _ => rands t (net, var::nets)  (*var could match also*)
   end;
 
 fun extract_leaves l = List.concat (map (fn Leaf(xs) => xs) l);
--- a/src/Pure/pattern.ML	Thu Apr 29 15:35:40 1999 +0200
+++ b/src/Pure/pattern.ML	Thu Apr 29 18:33:31 1999 +0200
@@ -271,7 +271,9 @@
 
 end; *)
 
-(*Eta-contract a term from outside: just enough to reduce it to an atom*)
+(*Eta-contract a term from outside: just enough to reduce it to an atom
+DOESN'T QUITE WORK!
+*)
 fun eta_contract_atom (t0 as Abs(a, T, body)) = 
       (case  eta_contract2 body  of
         body' as (f $ Bound 0) => 
--- a/src/Pure/thm.ML	Thu Apr 29 15:35:40 1999 +0200
+++ b/src/Pure/thm.ML	Thu Apr 29 18:33:31 1999 +0200
@@ -1987,6 +1987,7 @@
              (mss as Mss{rules, procs, termless, prems, congs, ...}) 
              (t:term,etc as (shypst,hypst,ders)) =
   let
+    val eta_t = Pattern.eta_contract t;
     val signt = Sign.deref sign_reft;
     val tsigt = Sign.tsig_of signt;
     fun rew{thm as Thm{sign_ref,der,shyps,hyps,prop,maxidx,...},
@@ -1997,10 +1998,10 @@
                       raise Pattern.MATCH);
         val rprop = if maxt = ~1 then prop
                     else Logic.incr_indexes([],maxt+1) prop;
-        val insts = if fo then Pattern.first_order_match tsigt (elhs,t)
-                          else Pattern.match             tsigt (elhs,t);
+        val insts = if fo then Pattern.first_order_match tsigt (elhs,eta_t)
+                          else Pattern.match             tsigt (elhs,eta_t);
         val insts = if maxt = ~1 then insts else incr_insts (maxt+1) insts
-        val prop' = ren_inst(insts,rprop,lhs,t);
+        val prop' = ren_inst(insts,rprop,lhs,eta_t);
         val hyps' = union_term(hyps,hypst);
         val shyps' = add_insts_sorts (insts, union_sort(shyps,shypst));
         val unconditional = (Logic.count_prems(prop',0) = 0);
@@ -2049,23 +2050,22 @@
                                      else sort rrs (re1,rr::re2)
     in sort rrs ([],[]) end
 
-    fun proc_rews _ ([]:simproc list) = None
-      | proc_rews eta_t ({name, proc, lhs = Cterm {t = plhs, ...}, ...} :: ps) =
+    fun proc_rews ([]:simproc list) = None
+      | proc_rews ({name, proc, lhs = Cterm {t = plhs, ...}, ...} :: ps) =
           if Pattern.matches tsigt (plhs, t) then
             (trace_term false ("Trying procedure " ^ quote name ^ " on:") signt eta_t;
              case proc signt prems eta_t of
-               None => (trace false "FAILED"; proc_rews eta_t ps)
+               None => (trace false "FAILED"; proc_rews ps)
              | Some raw_thm =>
                  (trace_thm false ("Procedure " ^ quote name ^ " produced rewrite rule:") raw_thm;
                   (case rews (mk_procrule raw_thm) of
-                    None => (trace false "IGNORED"; proc_rews eta_t ps)
+                    None => (trace false "IGNORED"; proc_rews ps)
                   | some => some)))
-          else proc_rews eta_t ps;
-  in case t of
+          else proc_rews ps;
+  in case eta_t of
        Abs (_, _, body) $ u => Some ((subst_bound (u, body), etc),skel0)
-     | _ => (case rews (sort_rrules (Net.match_term rules t)) of
-               None => proc_rews (Pattern.eta_contract t)
-                                 (Net.match_term procs t)
+     | _ => (case rews (sort_rrules (Net.match_term rules eta_t)) of
+               None => proc_rews (Net.match_term procs eta_t)
              | some => some)
   end;