eliminated redundant parameters;
authorwenzelm
Wed, 30 Sep 2009 22:24:57 +0200
changeset 32785 ec5292653aff
parent 32784 1a5dde5079ac
child 32786 f1ac4b515af9
eliminated redundant parameters;
src/Pure/Isar/expression.ML
src/Pure/Isar/theory_target.ML
src/Pure/Syntax/syn_ext.ML
src/Pure/defs.ML
src/Pure/proofterm.ML
--- a/src/Pure/Isar/expression.ML	Wed Sep 30 22:20:58 2009 +0200
+++ b/src/Pure/Isar/expression.ML	Wed Sep 30 22:24:57 2009 +0200
@@ -311,7 +311,7 @@
   | finish_primitive _ close (Defines defs) = close (Defines defs)
   | finish_primitive _ _ (Notes facts) = Notes facts;
 
-fun finish_inst ctxt parms do_close (loc, (prfx, inst)) =
+fun finish_inst ctxt (loc, (prfx, inst)) =
   let
     val thy = ProofContext.theory_of ctxt;
     val (parm_names, parm_types) = Locale.params_of thy loc |> map #1 |> split_list;
@@ -323,7 +323,7 @@
 
 fun finish ctxt parms do_close insts elems =
   let
-    val deps = map (finish_inst ctxt parms do_close) insts;
+    val deps = map (finish_inst ctxt) insts;
     val elems' = map (finish_elem ctxt parms do_close) elems;
   in (deps, elems') end;
 
--- a/src/Pure/Isar/theory_target.ML	Wed Sep 30 22:20:58 2009 +0200
+++ b/src/Pure/Isar/theory_target.ML	Wed Sep 30 22:24:57 2009 +0200
@@ -45,7 +45,7 @@
 
 (* pretty *)
 
-fun pretty_thy ctxt target is_locale is_class =
+fun pretty_thy ctxt target is_class =
   let
     val thy = ProofContext.theory_of ctxt;
     val target_name = (if is_class then "class " else "locale ") ^ Locale.extern thy target;
@@ -63,12 +63,12 @@
       (map (Pretty.chunks o Element.pretty_ctxt ctxt) elems)]
   end;
 
-fun pretty (Target {target, is_locale, is_class, instantiation, overloading, ...}) ctxt =
+fun pretty (Target {target, is_class, instantiation, overloading, ...}) ctxt =
   Pretty.block [Pretty.str "theory", Pretty.brk 1,
       Pretty.str (Context.theory_name (ProofContext.theory_of ctxt))] ::
     (if not (null overloading) then [Overloading.pretty ctxt]
      else if not (null (#1 instantiation)) then [Class_Target.pretty_instantiation ctxt]
-     else pretty_thy ctxt target is_locale is_class);
+     else pretty_thy ctxt target is_class);
 
 
 (* target declarations *)
@@ -260,8 +260,7 @@
 
 (* define *)
 
-fun define (ta as Target {target, is_locale, is_class, ...})
-    kind ((b, mx), ((name, atts), rhs)) lthy =
+fun define ta kind ((b, mx), ((name, atts), rhs)) lthy =
   let
     val thy = ProofContext.theory_of lthy;
     val thy_ctxt = ProofContext.init thy;
--- a/src/Pure/Syntax/syn_ext.ML	Wed Sep 30 22:20:58 2009 +0200
+++ b/src/Pure/Syntax/syn_ext.ML	Wed Sep 30 22:24:57 2009 +0200
@@ -270,9 +270,9 @@
     fun rem_pri (Argument (s, _)) = Argument (s, chain_pri)
       | rem_pri sym = sym;
 
-    fun logify_types copy_prod (a as (Argument (s, p))) =
+    fun logify_types (a as (Argument (s, p))) =
           if s <> "prop" andalso is_logtype s then Argument (logic, p) else a
-      | logify_types _ a = a;
+      | logify_types a = a;
 
 
     val raw_symbs = read_mfix sy handle ERROR msg => err_in_mfix msg mfix;
@@ -305,7 +305,7 @@
       if convert andalso not copy_prod then
        (if lhs = "prop" then sprop else if is_logtype lhs then logic else lhs)
       else lhs;
-    val symbs' = map (logify_types copy_prod) symbs;
+    val symbs' = map logify_types symbs;
     val xprod = XProd (lhs', symbs', const', pri);
 
     val _ = (List.app check_pri pris; check_pri pri; check_blocks symbs');
--- a/src/Pure/defs.ML	Wed Sep 30 22:20:58 2009 +0200
+++ b/src/Pure/defs.ML	Wed Sep 30 22:24:57 2009 +0200
@@ -123,7 +123,7 @@
 fun contained (U as TVar _) (Type (_, Ts)) = exists (fn T => T = U orelse contained U T) Ts
   | contained _ _ = false;
 
-fun acyclic pp defs (c, args) (d, Us) =
+fun acyclic pp (c, args) (d, Us) =
   c <> d orelse
   exists (fn U => exists (contained U) args) Us orelse
   is_none (match_args (args, Us)) orelse
@@ -150,7 +150,7 @@
       if forall (is_none o #1) reds then NONE
       else SOME (fold_rev
         (fn (NONE, dp) => insert (op =) dp | (SOME dps, _) => fold (insert (op =)) dps) reds []);
-    val _ = forall (acyclic pp defs const) (the_default deps deps');
+    val _ = forall (acyclic pp const) (the_default deps deps');
   in deps' end;
 
 in
@@ -163,8 +163,7 @@
           (args, perhaps (reduction pp defs (c, args)) deps));
       in
         if reducts = reducts' then (changed, defs)
-        else (true, defs |> map_def c (fn (specs, restricts, reducts) =>
-          (specs, restricts, reducts')))
+        else (true, defs |> map_def c (fn (specs, restricts, _) => (specs, restricts, reducts')))
       end;
     fun norm_all defs =
       (case Symtab.fold norm_update defs (false, defs) of
@@ -206,7 +205,7 @@
   let
     val restr =
       if plain_args args orelse
-        (case args of [Type (a, rec_args)] => plain_args rec_args | _ => false)
+        (case args of [Type (_, rec_args)] => plain_args rec_args | _ => false)
       then [] else [(args, name)];
     val spec =
       (serial (), {is_def = is_def, name = name, lhs = args, rhs = deps});
--- a/src/Pure/proofterm.ML	Wed Sep 30 22:20:58 2009 +0200
+++ b/src/Pure/proofterm.ML	Wed Sep 30 22:24:57 2009 +0200
@@ -959,7 +959,7 @@
   if ! proofs = 0 then ((name, dummy), Oracle (name, dummy, NONE))
   else ((name, prop), gen_axm_proof Oracle name prop);
 
-fun shrink_proof thy =
+val shrink_proof =
   let
     fun shrink ls lev (prf as Abst (a, T, body)) =
           let val (b, is, ch, body') = shrink ls (lev+1) body
@@ -1319,7 +1319,7 @@
 
     val proof0 =
       if ! proofs = 2 then
-        #4 (shrink_proof thy [] 0 (rew_proof thy (fold_rev implies_intr_proof hyps prf)))
+        #4 (shrink_proof [] 0 (rew_proof thy (fold_rev implies_intr_proof hyps prf)))
       else MinProof;
     val body0 = PBody {oracles = oracles0, thms = thms0, proof = proof0};