(un)fold: no raw flag;
authorwenzelm
Tue, 31 Jan 2006 18:19:30 +0100
changeset 18875 853fa34047a4
parent 18874 05585eee8d74
child 18876 ddb6803da197
(un)fold: no raw flag; tuned;
src/Pure/Isar/local_defs.ML
--- a/src/Pure/Isar/local_defs.ML	Tue Jan 31 18:19:29 2006 +0100
+++ b/src/Pure/Isar/local_defs.ML	Tue Jan 31 18:19:30 2006 +0100
@@ -7,9 +7,9 @@
 
 signature LOCAL_DEFS =
 sig
-  val mk_def: ProofContext.context -> (string * term) list -> term list
   val cert_def: ProofContext.context -> term -> string * term
   val abs_def: term -> (string * typ) * term
+  val mk_def: ProofContext.context -> (string * term) list -> term list
   val def_export: ProofContext.export
   val add_def: string * term -> ProofContext.context ->
     ((string * typ) * thm) * ProofContext.context
@@ -17,11 +17,11 @@
   val defn_add: attribute
   val defn_del: attribute
   val meta_rewrite_rule: Context.generic -> thm -> thm
-  val unfold: ProofContext.context -> bool -> thm list -> thm -> thm
-  val unfold_goals: ProofContext.context -> bool -> thm list -> thm -> thm
-  val unfold_tac: ProofContext.context -> bool -> thm list -> tactic
-  val fold: ProofContext.context -> bool -> thm list -> thm -> thm
-  val fold_tac: ProofContext.context -> bool -> thm list -> tactic
+  val unfold: ProofContext.context -> thm list -> thm -> thm
+  val unfold_goals: ProofContext.context -> thm list -> thm -> thm
+  val unfold_tac: ProofContext.context -> thm list -> tactic
+  val fold: ProofContext.context -> thm list -> thm -> thm
+  val fold_tac: ProofContext.context -> thm list -> tactic
   val derived_def: ProofContext.context -> term ->
     ((string * typ) * term) * (ProofContext.context -> term -> thm -> thm)
 end;
@@ -33,13 +33,7 @@
 
 (* prepare defs *)
 
-fun mk_def ctxt args =
-  let
-    val (xs, rhss) = split_list args;
-    val (bind, _) = ProofContext.bind_fixes xs ctxt;
-    val lhss = map (fn (x, rhs) => bind (Free (x, Term.fastype_of rhs))) args;
-  in map Logic.mk_equals (lhss ~~ rhss) end;
-
+(*c x == t[x] to !!x. c x == t[x]*)
 fun cert_def ctxt eq =
   let
     fun err msg = cat_error msg
@@ -54,15 +48,14 @@
     fun check_arg (Bound _) = true
       | check_arg (Free (x, _)) = not (ProofContext.is_fixed ctxt x)
       | check_arg t = (case try Logic.dest_type t of SOME (TFree _) => true | _ => false);
-    fun close_arg (Free (x, T)) t = Term.all T $ Term.absfree (x, T, t)
-      | close_arg (Const ("TYPE", T)) t = Term.all T $ Term.absdummy (T, t)
-      | close_arg _ t = t;
+    fun close_arg (Bound _) t = t
+      | close_arg x t = Term.all (Term.fastype_of x) $ lambda x t;
 
     val extra_frees = Term.fold_aterms (fn v as Free (x, _) =>
       if ProofContext.is_fixed ctxt x orelse member (op aconv) xs v then I
       else insert (op =) x | _ => I) rhs [];
   in
-    if not (forall check_arg xs) orelse has_duplicates (op =) xs then
+    if not (forall check_arg xs) orelse has_duplicates (op aconv) xs then
       err "Arguments of lhs must be distinct free/bound variables"
     else if not (null extra_frees) then
       err ("Extra free variables on rhs: " ^ commas_quote extra_frees)
@@ -71,6 +64,7 @@
     else (c, fold_rev close_arg xs eq)
   end;
 
+(*!!x. c x == t[x] to c == %x. t[x]*)
 fun abs_def eq =
   let
     val body = Term.strip_all_body eq;
@@ -80,6 +74,14 @@
     val eq' = Term.list_abs_free (map Term.dest_Free xs, rhs);
   in (Term.dest_Free f, eq') end;
 
+(*c == t*)
+fun mk_def ctxt args =
+  let
+    val (xs, rhss) = split_list args;
+    val (bind, _) = ProofContext.bind_fixes xs ctxt;
+    val lhss = map (fn (x, rhs) => bind (Free (x, Term.fastype_of rhs))) args;
+  in map Logic.mk_equals (lhss ~~ rhss) end;
+
 
 (* export defs *)
 
@@ -87,6 +89,14 @@
   #1 (Term.strip_comb (#1 (Logic.dest_equals (Term.strip_all_body (Thm.term_of cprop)))))
   |> Thm.cterm_of (Thm.theory_of_cterm cprop);
 
+(*
+  [x]
+  [x == t]
+     :
+    B x
+  --------
+    B t
+*)
 fun def_export _ cprops thm =
   thm
   |> Drule.implies_intr_list cprops
@@ -134,7 +144,7 @@
 val defn_del = Thm.declaration_attribute (Rules.map o Drule.del_rule);
 
 
-(* transform rewrite rules *)
+(* meta rewrite rules *)
 
 val equals_ss =
   MetaSimplifier.theory_context ProtoPure.thy MetaSimplifier.empty_ss
@@ -149,14 +159,16 @@
 fun meta_rewrite_tac ctxt i =
   PRIMITIVE (Drule.fconv_rule (Drule.goals_conv (equal i) (meta_rewrite (Context.Proof ctxt))));
 
-fun transformed f _ false = f
-  | transformed f ctxt true = f o map (meta_rewrite_rule (Context.Proof ctxt));
+
+(* rewriting with object-level rules *)
+
+fun meta f ctxt = f o map (meta_rewrite_rule (Context.Proof ctxt));
 
-val unfold       = transformed Tactic.rewrite_rule;
-val unfold_goals = transformed Tactic.rewrite_goals_rule;
-val unfold_tac   = transformed Tactic.rewrite_goals_tac;
-val fold         = transformed Tactic.fold_rule;
-val fold_tac     = transformed Tactic.fold_goals_tac;
+val unfold       = meta Tactic.rewrite_rule;
+val unfold_goals = meta Tactic.rewrite_goals_rule;
+val unfold_tac   = meta Tactic.rewrite_goals_tac;
+val fold         = meta Tactic.fold_rule;
+val fold_tac     = meta Tactic.fold_goals_tac;
 
 
 (* derived defs -- potentially within the object-logic *)