merged
authorwenzelm
Tue, 24 Mar 2015 23:39:42 +0100
changeset 59804 db0b87085c16
parent 59794 39442248a027 (current diff)
parent 59803 88a89f01fc27 (diff)
child 59805 a162f779925a
child 59851 43b1870b3e61
merged
src/HOL/Tools/BNF/bnf_gfp_rec_sugar.ML
--- a/NEWS	Tue Mar 24 18:10:56 2015 +0100
+++ b/NEWS	Tue Mar 24 23:39:42 2015 +0100
@@ -66,6 +66,10 @@
 these variables become schematic in the instantiated theorem. This
 behaviour is analogous to 'for' in attributes "where" and "of".
 
+* Explicit instantiation via attributes "where", "of", and proof methods
+"rule_tac" with derivatives like "subgoal_tac" etc. admit dummy patterns
+("_") that stand for anonymous local variables.
+
 * Command "class_deps" takes optional sort arguments constraining
 the search space.
 
--- a/src/HOL/HOLCF/Compact_Basis.thy	Tue Mar 24 18:10:56 2015 +0100
+++ b/src/HOL/HOLCF/Compact_Basis.thy	Tue Mar 24 23:39:42 2015 +0100
@@ -16,7 +16,7 @@
 
 typedef 'a pd_basis = "pd_basis :: 'a compact_basis set set"
   unfolding pd_basis_def
-  apply (rule_tac x="{a}" for a in exI)
+  apply (rule_tac x="{_}" in exI)
   apply simp
   done
 
--- a/src/HOL/MicroJava/J/JTypeSafe.thy	Tue Mar 24 18:10:56 2015 +0100
+++ b/src/HOL/MicroJava/J/JTypeSafe.thy	Tue Mar 24 23:39:42 2015 +0100
@@ -244,7 +244,7 @@
        THEN_ALL_NEW (full_simp_tac @{context}), REPEAT o (etac conjE), hyp_subst_tac @{context}] 3*})
 
 -- "for if"
-apply( tactic {* (Induct_Tacs.case_tac @{context} "the_Bool v" THEN_ALL_NEW
+apply( tactic {* (Induct_Tacs.case_tac @{context} "the_Bool v" [] THEN_ALL_NEW
   (asm_full_simp_tac @{context})) 7*})
 
 apply (tactic "forward_hyp_tac @{context}")
--- a/src/HOL/Nominal/nominal_atoms.ML	Tue Mar 24 18:10:56 2015 +0100
+++ b/src/HOL/Nominal/nominal_atoms.ML	Tue Mar 24 23:39:42 2015 +0100
@@ -131,7 +131,7 @@
                   (HOLogic.mk_exists ("x",@{typ nat},HOLogic.mk_eq (y,Const (ak_sign,inj_type) $ Bound 0)))
 
               val proof2 = fn {prems, context = ctxt} =>
-                Induct_Tacs.case_tac ctxt "y" 1 THEN
+                Induct_Tacs.case_tac ctxt "y" [] 1 THEN
                 asm_simp_tac (put_simpset HOL_basic_ss ctxt addsimps simp1) 1 THEN
                 rtac @{thm exI} 1 THEN
                 rtac @{thm refl} 1
--- a/src/HOL/TLA/Memory/MemoryImplementation.thy	Tue Mar 24 18:10:56 2015 +0100
+++ b/src/HOL/TLA/Memory/MemoryImplementation.thy	Tue Mar 24 23:39:42 2015 +0100
@@ -798,7 +798,7 @@
 fun split_idle_tac ctxt =
   SELECT_GOAL
    (TRY (rtac @{thm actionI} 1) THEN
-    Induct_Tacs.case_tac ctxt "(s,t) |= unchanged (e p, c p, r p, m p, rmhist!p)" 1 THEN
+    Induct_Tacs.case_tac ctxt "(s,t) |= unchanged (e p, c p, r p, m p, rmhist!p)" [] 1 THEN
     rewrite_goals_tac ctxt @{thms action_rews} THEN
     forward_tac ctxt [temp_use ctxt @{thm Step1_4_7}] 1 THEN
     asm_full_simp_tac ctxt 1);
--- a/src/HOL/Tools/BNF/bnf_gfp_rec_sugar.ML	Tue Mar 24 18:10:56 2015 +0100
+++ b/src/HOL/Tools/BNF/bnf_gfp_rec_sugar.ML	Tue Mar 24 23:39:42 2015 +0100
@@ -609,10 +609,13 @@
 fun is_free_in frees (Free (v, _)) = member (op =) frees v
   | is_free_in _ _ = false;
 
+fun is_catch_all_prem (Free (v, _)) = v = Name.uu_
+  | is_catch_all_prem _ = false;
+
 fun add_extra_frees ctxt frees names =
   fold_aterms (fn x as Free (v, _) =>
     (not (member (op =) frees x) andalso not (member (op =) names v) andalso
-     not (Variable.is_fixed ctxt v) andalso v <> Name.uu_)
+     not (Variable.is_fixed ctxt v) andalso not (is_catch_all_prem x))
     ? cons x | _ => I);
 
 fun check_extra_frees ctxt frees names t =
@@ -679,9 +682,6 @@
     val ctr_no = if not_disc then 1 - ctr_no' else ctr_no';
     val {ctr, disc, ...} = nth basic_ctr_specs ctr_no;
 
-    fun is_catch_all_prem (Free (s, _)) = s = Name.uu_
-      | is_catch_all_prem _ = false;
-
     val catch_all =
       (case prems0 of
         [prem] => is_catch_all_prem prem
--- a/src/Pure/Isar/proof_context.ML	Tue Mar 24 18:10:56 2015 +0100
+++ b/src/Pure/Isar/proof_context.ML	Tue Mar 24 23:39:42 2015 +0100
@@ -412,7 +412,7 @@
 
 fun read_class ctxt text =
   let
-    val source = Syntax.read_token text;
+    val source = Syntax.read_input text;
     val (c, reports) = check_class ctxt (Input.source_content source, Input.pos_of source);
     val _ = Position.reports reports;
   in c end;
@@ -480,7 +480,7 @@
 
 fun read_type_name ctxt flags text =
   let
-    val source = Syntax.read_token text;
+    val source = Syntax.read_input text;
     val (T, reports) =
       check_type_name ctxt flags (Input.source_content source, Input.pos_of source);
     val _ = Position.reports reports;
@@ -530,7 +530,7 @@
 
 fun read_const ctxt flags text =
   let
-    val source = Syntax.read_token text;
+    val source = Syntax.read_input text;
     val (t, reports) = check_const ctxt flags (Input.source_content source, [Input.pos_of source]);
     val _ = Position.reports reports;
   in t end;
@@ -945,7 +945,7 @@
 fun retrieve pick context (Facts.Fact s) =
       let
         val ctxt = Context.the_proof context;
-        val pos = Syntax.read_token_pos s;
+        val pos = Syntax.read_input_pos s;
         val prop =
           Syntax.read_prop (ctxt |> set_mode mode_default |> allow_dummies) s
           |> singleton (Variable.polymorphic ctxt);
--- a/src/Pure/Isar/token.ML	Tue Mar 24 18:10:56 2015 +0100
+++ b/src/Pure/Isar/token.ML	Tue Mar 24 23:39:42 2015 +0100
@@ -55,9 +55,9 @@
   val is_space: T -> bool
   val is_blank: T -> bool
   val is_newline: T -> bool
-  val inner_syntax_of: T -> string
+  val content_of: T -> string
   val source_position_of: T -> Input.source
-  val content_of: T -> string
+  val inner_syntax_of: T -> string
   val keyword_markup: bool * Markup.T -> string -> Markup.T
   val completion_report: T -> Position.report_text list
   val reports: Keyword.keywords -> T -> Position.report_text list
@@ -279,18 +279,14 @@
 
 (* token content *)
 
-fun inner_syntax_of (Token ((source, (pos, _)), (kind, x), _)) =
-  if YXML.detect x then x
-  else
-    let
-      val delimited = delimited_kind kind;
-      val tree = XML.Elem (Markup.token delimited (Position.properties_of pos), [XML.Text source]);
-    in YXML.string_of tree end;
+fun content_of (Token (_, (_, x), _)) = x;
 
 fun source_position_of (Token ((source, range), (kind, _), _)) =
   Input.source (delimited_kind kind) source range;
 
-fun content_of (Token (_, (_, x), _)) = x;
+fun inner_syntax_of tok =
+  let val x = content_of tok
+  in if YXML.detect x then x else Syntax.implode_input (source_position_of tok) end;
 
 
 (* markup reports *)
--- a/src/Pure/PIDE/markup.ML	Tue Mar 24 18:10:56 2015 +0100
+++ b/src/Pure/PIDE/markup.ML	Tue Mar 24 23:39:42 2015 +0100
@@ -114,13 +114,13 @@
   val document_antiquotation_optionN: string
   val paragraphN: string val paragraph: T
   val text_foldN: string val text_fold: T
+  val inputN: string val input: bool -> Properties.T -> T
   val commandN: string val command: T
   val stringN: string val string: T
   val alt_stringN: string val alt_string: T
   val verbatimN: string val verbatim: T
   val cartoucheN: string val cartouche: T
   val commentN: string val comment: T
-  val tokenN: string val token: bool -> Properties.T -> T
   val keyword1N: string val keyword1: T
   val keyword2N: string val keyword2: T
   val keyword3N: string val keyword3: T
@@ -456,6 +456,12 @@
 val (text_foldN, text_fold) = markup_elem "text_fold";
 
 
+(* formal input *)
+
+val inputN = "input";
+fun input delimited props = (inputN, (delimitedN, print_bool delimited) :: props);
+
+
 (* outer syntax *)
 
 val (commandN, command) = markup_elem "command";
@@ -471,9 +477,6 @@
 val (cartoucheN, cartouche) = markup_elem "cartouche";
 val (commentN, comment) = markup_elem "comment";
 
-val tokenN = "token";
-fun token delimited props = (tokenN, (delimitedN, print_bool delimited) :: props);
-
 
 (* timing *)
 
--- a/src/Pure/Syntax/syntax.ML	Tue Mar 24 18:10:56 2015 +0100
+++ b/src/Pure/Syntax/syntax.ML	Tue Mar 24 23:39:42 2015 +0100
@@ -14,9 +14,11 @@
   val ambiguity_warning: bool Config.T
   val ambiguity_limit_raw: Config.raw
   val ambiguity_limit: int Config.T
-  val read_token_pos: string -> Position.T
-  val read_token: string -> Input.source
-  val parse_token: Proof.context -> (XML.tree list -> 'a) ->
+  val encode_input: Input.source -> XML.tree
+  val implode_input: Input.source -> string
+  val read_input_pos: string -> Position.T
+  val read_input: string -> Input.source
+  val parse_input: Proof.context -> (XML.tree list -> 'a) ->
     (bool -> Markup.T) -> (Symbol_Pos.T list * Position.T -> 'a) -> string -> 'a
   val parse_sort: Proof.context -> string -> sort
   val parse_typ: Proof.context -> string -> typ
@@ -159,33 +161,42 @@
 val ambiguity_limit = Config.int ambiguity_limit_raw;
 
 
-(* outer syntax token -- with optional YXML content *)
+(* formal input *)
+
+fun encode_input source =
+  let
+    val delimited = Input.is_delimited source;
+    val pos = Input.pos_of source;
+    val text = Input.text_of source;
+  in XML.Elem (Markup.input delimited (Position.properties_of pos), [XML.Text text]) end;
+
+val implode_input = encode_input #> YXML.string_of;
 
 local
 
-fun token_range (XML.Elem ((name, props), _)) =
-      if name = Markup.tokenN
+fun input_range (XML.Elem ((name, props), _)) =
+      if name = Markup.inputN
       then (Markup.is_delimited props, Position.range_of_properties props)
       else (false, Position.no_range)
-  | token_range (XML.Text _) = (false, Position.no_range);
+  | input_range (XML.Text _) = (false, Position.no_range);
 
-fun token_source tree : Input.source =
+fun input_source tree =
   let
     val text = XML.content_of [tree];
-    val (delimited, range) = token_range tree;
+    val (delimited, range) = input_range tree;
   in Input.source delimited text range end;
 
 in
 
-fun read_token_pos str = #1 (#2 (token_range (YXML.parse str handle Fail msg => error msg)));
+fun read_input_pos str = #1 (#2 (input_range (YXML.parse str handle Fail msg => error msg)));
 
-fun read_token str = token_source (YXML.parse str handle Fail msg => error msg);
+fun read_input str = input_source (YXML.parse str handle Fail msg => error msg);
 
-fun parse_token ctxt decode markup parse str =
+fun parse_input ctxt decode markup parse str =
   let
     fun parse_tree tree =
       let
-        val source = token_source tree;
+        val source = input_source tree;
         val syms = Input.source_explode source;
         val pos = Input.pos_of source;
         val _ = Context_Position.report ctxt pos (markup (Input.is_delimited source));
@@ -193,7 +204,7 @@
   in
     (case YXML.parse_body str handle Fail msg => error msg of
       body as [tree as XML.Elem ((name, _), _)] =>
-        if name = Markup.tokenN then parse_tree tree else decode body
+        if name = Markup.inputN then parse_tree tree else decode body
     | [tree as XML.Text _] => parse_tree tree
     | body => decode body)
   end;
--- a/src/Pure/Syntax/syntax_phases.ML	Tue Mar 24 18:10:56 2015 +0100
+++ b/src/Pure/Syntax/syntax_phases.ML	Tue Mar 24 23:39:42 2015 +0100
@@ -365,7 +365,7 @@
     Markup.markup_report (Context_Position.reported_text ctxt pos Markup.bad ""));
 
 fun parse_sort ctxt =
-  Syntax.parse_token ctxt Term_XML.Decode.sort Markup.language_sort
+  Syntax.parse_input ctxt Term_XML.Decode.sort Markup.language_sort
     (fn (syms, pos) =>
       parse_tree ctxt "sort" (syms, pos)
       |> uncurry (report_result ctxt pos)
@@ -374,7 +374,7 @@
       handle ERROR msg => parse_failed ctxt pos msg "sort");
 
 fun parse_typ ctxt =
-  Syntax.parse_token ctxt Term_XML.Decode.typ Markup.language_type
+  Syntax.parse_input ctxt Term_XML.Decode.typ Markup.language_type
     (fn (syms, pos) =>
       parse_tree ctxt "type" (syms, pos)
       |> uncurry (report_result ctxt pos)
@@ -389,7 +389,7 @@
       else (Markup.language_term, "term", Config.get ctxt Syntax.root, I);
     val decode = constrain o Term_XML.Decode.term;
   in
-    Syntax.parse_token ctxt decode markup
+    Syntax.parse_input ctxt decode markup
       (fn (syms, pos) =>
         let
           val (ambig_msgs, results) = parse_tree ctxt root (syms, pos) ||> map (decode_term ctxt);
@@ -463,7 +463,7 @@
           else decode_appl ps asts
       | decode ps (Ast.Appl asts) = decode_appl ps asts;
 
-    val source = Syntax.read_token str;
+    val source = Syntax.read_input str;
     val pos = Input.pos_of source;
     val syms = Input.source_explode source;
     val ast =
--- a/src/Pure/Thy/thy_syntax.scala	Tue Mar 24 18:10:56 2015 +0100
+++ b/src/Pure/Thy/thy_syntax.scala	Tue Mar 24 23:39:42 2015 +0100
@@ -147,8 +147,8 @@
     : (List[Command], List[(Command.Blobs_Info, Command_Span.Span)]) =
   {
     (cmds, blobs_spans) match {
-      case (cmd :: cmds, (blobs, span) :: rest) if cmd.blobs == blobs && cmd.span == span =>
-        chop_common(cmds, rest)
+      case (cmd :: cmds, (blobs_info, span) :: rest)
+      if cmd.blobs_info == blobs_info && cmd.span == span => chop_common(cmds, rest)
       case _ => (cmds, blobs_spans)
     }
   }
--- a/src/Pure/Tools/rule_insts.ML	Tue Mar 24 18:10:56 2015 +0100
+++ b/src/Pure/Tools/rule_insts.ML	Tue Mar 24 23:39:42 2015 +0100
@@ -13,6 +13,7 @@
     (binding * string option * mixfix) list -> thm -> thm
   val read_instantiate: Proof.context ->
     ((indexname * Position.T) * string) list -> string list -> thm -> thm
+  val schematic: bool Config.T
   val res_inst_tac: Proof.context ->
     ((indexname * Position.T) * string) list -> (binding * string option * mixfix) list -> thm ->
     int -> tactic
@@ -68,18 +69,18 @@
     else error_var "Bad sort for instantiation of type variable: " (xi, pos)
   end;
 
-fun read_terms ctxt ss Ts =
+fun read_terms ss Ts ctxt =
   let
     fun parse T = if T = propT then Syntax.parse_prop ctxt else Syntax.parse_term ctxt;
-    val ts = map2 parse Ts ss;
+    val (ts, ctxt') = fold_map Variable.fix_dummy_patterns (map2 parse Ts ss) ctxt;
     val ts' =
       map2 (Type.constraint o Type_Infer.paramify_vars) Ts ts
-      |> Syntax.check_terms ctxt
-      |> Variable.polymorphic ctxt;
+      |> Syntax.check_terms ctxt'
+      |> Variable.polymorphic ctxt';
     val Ts' = map Term.fastype_of ts';
     val tyenv = fold Type.raw_match (Ts ~~ Ts') Vartab.empty;
     val tyenv' = Vartab.fold (fn (xi, (S, T)) => cons ((xi, S), T)) tyenv [];
-  in (ts', tyenv') end;
+  in ((ts', tyenv'), ctxt') end;
 
 fun make_instT f v =
   let
@@ -95,7 +96,7 @@
 
 in
 
-fun read_insts ctxt mixed_insts thm =
+fun read_insts thm mixed_insts ctxt =
   let
     val (type_insts, term_insts) =
       List.partition (fn (((x, _), _), _) => String.isPrefix "'" x) mixed_insts;
@@ -110,7 +111,7 @@
     (*term instantiations*)
     val (xs, ss) = split_list term_insts;
     val Ts = map (the_type vars1) xs;
-    val (ts, inferred) = read_terms ctxt ss Ts;
+    val ((ts, inferred), ctxt') = read_terms ss Ts ctxt;
 
     (*implicit type instantiations*)
     val instT2 = Term_Subst.instantiateT inferred;
@@ -121,7 +122,7 @@
 
     val inst_tvars = map_filter (make_instT (instT2 o instT1)) tvars;
     val inst_vars = map_filter (make_inst inst2) vars2;
-  in (inst_tvars, inst_vars) end;
+  in ((inst_tvars, inst_vars), ctxt') end;
 
 end;
 
@@ -134,13 +135,13 @@
     val ctxt' = ctxt
       |> Variable.declare_thm thm
       |> Proof_Context.read_vars fixes |-> Proof_Context.add_fixes |> #2;
-    val (inst_tvars, inst_vars) = read_insts ctxt' mixed_insts thm;
+    val ((inst_tvars, inst_vars), ctxt'') = read_insts thm mixed_insts ctxt';
   in
     thm
     |> Drule.instantiate_normalize
-      (map (apply2 (Thm.ctyp_of ctxt) o apfst TVar) inst_tvars,
-       map (apply2 (Thm.cterm_of ctxt) o apfst Var) inst_vars)
-    |> singleton (Variable.export ctxt' ctxt)
+      (map (apply2 (Thm.ctyp_of ctxt'') o apfst TVar) inst_tvars,
+       map (apply2 (Thm.cterm_of ctxt'') o apfst Var) inst_vars)
+    |> singleton (Variable.export ctxt'' ctxt)
     |> Rule_Cases.save thm
   end;
 
@@ -198,6 +199,8 @@
 
 (** tactics **)
 
+val schematic = Attrib.setup_config_bool @{binding rule_insts_schematic} (K true);
+
 (* resolution after lifting and instantiation; may refer to parameters of the subgoal *)
 
 fun bires_inst_tac bires_flag ctxt mixed_insts fixes thm i st = CSUBGOAL (fn (cgoal, _) =>
@@ -216,7 +219,7 @@
       |> Variable.improper_fixes
       |> Proof_Context.add_fixes (map (fn (x, T) => (Binding.name x, SOME T, NoSyn)) params)
       ||> Variable.restore_proper_fixes ctxt
-      ||> Proof_Context.set_mode Proof_Context.mode_schematic;
+      ||> Config.get ctxt schematic ? Proof_Context.set_mode Proof_Context.mode_schematic;
     val paramTs = map #2 params;
 
 
@@ -225,7 +228,7 @@
     val (fixed, fixes_ctxt) = param_ctxt
       |> Proof_Context.read_vars fixes |-> Proof_Context.add_fixes;
 
-    val (inst_tvars, inst_vars) = read_insts fixes_ctxt mixed_insts thm;
+    val ((inst_tvars, inst_vars), inst_ctxt) = read_insts thm mixed_insts fixes_ctxt;
 
 
     (* lift and instantiate rule *)
@@ -238,14 +241,14 @@
         (Logic.incr_indexes (fixed, paramTs, inc) t);
 
     val inst_tvars' = inst_tvars
-      |> map (apply2 (Thm.ctyp_of fixes_ctxt o Logic.incr_tvar inc) o apfst TVar);
+      |> map (apply2 (Thm.ctyp_of inst_ctxt o Logic.incr_tvar inc) o apfst TVar);
     val inst_vars' = inst_vars
-      |> map (fn (v, t) => apply2 (Thm.cterm_of fixes_ctxt) (lift_var v, lift_term t));
+      |> map (fn (v, t) => apply2 (Thm.cterm_of inst_ctxt) (lift_var v, lift_term t));
 
     val thm' =
       Drule.instantiate_normalize (inst_tvars', inst_vars')
         (Thm.lift_rule cgoal thm)
-      |> singleton (Variable.export fixes_ctxt param_ctxt);
+      |> singleton (Variable.export inst_ctxt param_ctxt);
   in
     compose_tac param_ctxt (bires_flag, thm', Thm.nprems_of thm) i
   end) i st;
--- a/src/Pure/variable.ML	Tue Mar 24 18:10:56 2015 +0100
+++ b/src/Pure/variable.ML	Tue Mar 24 23:39:42 2015 +0100
@@ -6,9 +6,6 @@
 
 signature VARIABLE =
 sig
-  val is_body: Proof.context -> bool
-  val set_body: bool -> Proof.context -> Proof.context
-  val restore_body: Proof.context -> Proof.context -> Proof.context
   val names_of: Proof.context -> Name.context
   val binds_of: Proof.context -> (typ * term) Vartab.table
   val maxidx_of: Proof.context -> int
@@ -34,6 +31,9 @@
   val declare_const: string * string -> Proof.context -> Proof.context
   val next_bound: string * typ -> Proof.context -> term * Proof.context
   val revert_bounds: Proof.context -> term -> term
+  val is_body: Proof.context -> bool
+  val set_body: bool -> Proof.context -> Proof.context
+  val restore_body: Proof.context -> Proof.context -> Proof.context
   val improper_fixes: Proof.context -> Proof.context
   val restore_proper_fixes: Proof.context -> Proof.context -> Proof.context
   val is_improper: Proof.context -> string -> bool
@@ -52,15 +52,16 @@
   val add_fixes: string list -> Proof.context -> string list * Proof.context
   val add_fixes_direct: string list -> Proof.context -> Proof.context
   val auto_fixes: term -> Proof.context -> Proof.context
+  val fix_dummy_patterns: term -> Proof.context -> term * Proof.context
   val variant_fixes: string list -> Proof.context -> string list * Proof.context
   val dest_fixes: Proof.context -> (string * string) list
-  val invent_types: sort list -> Proof.context -> (string * sort) list * Proof.context
   val export_terms: Proof.context -> Proof.context -> term list -> term list
   val exportT_terms: Proof.context -> Proof.context -> term list -> term list
   val exportT: Proof.context -> Proof.context -> thm list -> thm list
   val export_prf: Proof.context -> Proof.context -> Proofterm.proof -> Proofterm.proof
   val export: Proof.context -> Proof.context -> thm list -> thm list
   val export_morphism: Proof.context -> Proof.context -> morphism
+  val invent_types: sort list -> Proof.context -> (string * sort) list * Proof.context
   val importT_inst: term list -> Proof.context -> ((indexname * sort) * typ) list * Proof.context
   val import_inst: bool -> term list -> Proof.context ->
     (((indexname * sort) * typ) list * ((indexname * typ) * term) list) * Proof.context
@@ -89,8 +90,7 @@
 val empty_fixes: fixes = Name_Space.empty_table Markup.fixedN;
 
 datatype data = Data of
- {is_body: bool,                        (*inner body mode*)
-  names: Name.context,                  (*type/term variable names*)
+ {names: Name.context,                  (*type/term variable names*)
   consts: string Symtab.table,          (*consts within the local scope*)
   bounds: int * ((string * typ) * string) list,  (*next index, internal name, type, external name*)
   fixes: fixes,                         (*term fixes -- global name space, intern ~> extern*)
@@ -102,13 +102,12 @@
     typ Vartab.table *                  (*type constraints*)
     sort Vartab.table};                 (*default sorts*)
 
-fun make_data
-    (is_body, names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =
-  Data {is_body = is_body, names = names, consts = consts, bounds = bounds, fixes = fixes,
-    binds = binds, type_occs = type_occs, maxidx = maxidx, sorts = sorts, constraints = constraints};
+fun make_data (names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =
+  Data {names = names, consts = consts, bounds = bounds, fixes = fixes, binds = binds,
+    type_occs = type_occs, maxidx = maxidx, sorts = sorts, constraints = constraints};
 
 val empty_data =
-  make_data (false, Name.context, Symtab.empty, (0, []), empty_fixes, Vartab.empty,
+  make_data (Name.context, Symtab.empty, (0, []), empty_fixes, Vartab.empty,
     Symtab.empty, ~1, [], (Vartab.empty, Vartab.empty));
 
 structure Data = Proof_Data
@@ -118,66 +117,47 @@
 );
 
 fun map_data f =
-  Data.map (fn
-      Data {is_body, names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints} =>
-    make_data
-      (f (is_body, names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints)));
+  Data.map (fn Data {names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints} =>
+    make_data (f (names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints)));
 
 fun map_names f =
-  map_data (fn
-      (is_body, names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
-    (is_body, f names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints));
+  map_data (fn (names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
+    (f names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints));
 
 fun map_consts f =
-  map_data (fn
-      (is_body, names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
-    (is_body, names, f consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints));
+  map_data (fn (names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
+    (names, f consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints));
 
 fun map_bounds f =
-  map_data (fn
-      (is_body, names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
-    (is_body, names, consts, f bounds, fixes, binds, type_occs, maxidx, sorts, constraints));
+  map_data (fn (names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
+    (names, consts, f bounds, fixes, binds, type_occs, maxidx, sorts, constraints));
 
 fun map_fixes f =
-  map_data (fn
-      (is_body, names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
-    (is_body, names, consts, bounds, f fixes, binds, type_occs, maxidx, sorts, constraints));
+  map_data (fn (names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
+    (names, consts, bounds, f fixes, binds, type_occs, maxidx, sorts, constraints));
 
 fun map_binds f =
-  map_data (fn
-      (is_body, names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
-    (is_body, names, consts, bounds, fixes, f binds, type_occs, maxidx, sorts, constraints));
+  map_data (fn (names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
+    (names, consts, bounds, fixes, f binds, type_occs, maxidx, sorts, constraints));
 
 fun map_type_occs f =
-  map_data (fn
-      (is_body, names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
-    (is_body, names, consts, bounds, fixes, binds, f type_occs, maxidx, sorts, constraints));
+  map_data (fn (names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
+    (names, consts, bounds, fixes, binds, f type_occs, maxidx, sorts, constraints));
 
 fun map_maxidx f =
-  map_data (fn
-      (is_body, names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
-    (is_body, names, consts, bounds, fixes, binds, type_occs, f maxidx, sorts, constraints));
+  map_data (fn (names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
+    (names, consts, bounds, fixes, binds, type_occs, f maxidx, sorts, constraints));
 
 fun map_sorts f =
-  map_data (fn
-      (is_body, names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
-    (is_body, names, consts, bounds, fixes, binds, type_occs, maxidx, f sorts, constraints));
+  map_data (fn (names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
+    (names, consts, bounds, fixes, binds, type_occs, maxidx, f sorts, constraints));
 
 fun map_constraints f =
-  map_data (fn
-      (is_body, names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
-    (is_body, names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, f constraints));
+  map_data (fn (names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
+    (names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, f constraints));
 
 fun rep_data ctxt = Data.get ctxt |> (fn Data rep => rep);
 
-val is_body = #is_body o rep_data;
-
-fun set_body b =
-  map_data (fn (_, names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints) =>
-    (b, names, consts, bounds, fixes, binds, type_occs, maxidx, sorts, constraints));
-
-fun restore_body ctxt = set_body (is_body ctxt);
-
 val names_of = #names o rep_data;
 val fixes_of = #fixes o rep_data;
 val fixes_space = Name_Space.space_of_table o fixes_of;
@@ -338,6 +318,16 @@
 
 (** fixes **)
 
+(* inner body mode *)
+
+val inner_body =
+  Config.bool (Config.declare ("inner_body", @{here}) (K (Config.Bool false)));
+
+fun is_body ctxt = Config.get ctxt inner_body;
+val set_body = Config.put inner_body;
+fun restore_body ctxt = set_body (is_body ctxt);
+
+
 (* proper mode *)
 
 val proper_fixes =
@@ -460,11 +450,21 @@
   |> not (is_body ctxt) ? add_fixes_direct (rev (add_free_names ctxt t []))
   |> declare_term t;
 
-fun invent_types Ss ctxt =
-  let
-    val tfrees = Name.invent (names_of ctxt) Name.aT (length Ss) ~~ Ss;
-    val ctxt' = fold (declare_constraints o Logic.mk_type o TFree) tfrees ctxt;
-  in (tfrees, ctxt') end;
+
+(* dummy patterns *)
+
+fun fix_dummy_patterns (Const ("Pure.dummy_pattern", T)) ctxt =
+      let val ([x], ctxt') = add_fixes [Name.uu_] ctxt
+      in (Free (x, T), ctxt') end
+  | fix_dummy_patterns (Abs (x, T, b)) ctxt =
+      let val (b', ctxt') = fix_dummy_patterns b ctxt
+      in (Abs (x, T, b'), ctxt') end
+  | fix_dummy_patterns (t $ u) ctxt =
+      let
+        val (t', ctxt') = fix_dummy_patterns t ctxt;
+        val (u', ctxt'') = fix_dummy_patterns u ctxt';
+      in (t' $ u', ctxt'') end
+  | fix_dummy_patterns a ctxt = (a, ctxt);
 
 
 
@@ -541,6 +541,12 @@
 
 (** import -- fix schematic type/term variables **)
 
+fun invent_types Ss ctxt =
+  let
+    val tfrees = Name.invent (names_of ctxt) Name.aT (length Ss) ~~ Ss;
+    val ctxt' = fold (declare_constraints o Logic.mk_type o TFree) tfrees ctxt;
+  in (tfrees, ctxt') end;
+
 fun importT_inst ts ctxt =
   let
     val tvars = rev (fold Term.add_tvars ts []);
--- a/src/Tools/Code/code_thingol.ML	Tue Mar 24 18:10:56 2015 +0100
+++ b/src/Tools/Code/code_thingol.ML	Tue Mar 24 23:39:42 2015 +0100
@@ -895,7 +895,7 @@
       (fn thy'' => not (Sign.declared_const thy'' c)) (Theory.parents_of thy');
     fun consts_of_select thy' = filter (belongs_here thy') (consts_of thy');
     fun read_const_expr str =
-      (case Syntax.parse_token ctxt (K NONE) (K Markup.empty) (SOME o Symbol_Pos.implode o #1) str of
+      (case Syntax.parse_input ctxt (K NONE) (K Markup.empty) (SOME o Symbol_Pos.implode o #1) str of
         SOME "_" => ([], consts_of thy)
       | SOME s =>
           if String.isSuffix "._" s
@@ -910,7 +910,7 @@
   let
     val (consts, consts_permissive) = read_const_exprs_internal ctxt const_exprs;
     val consts' = implemented_deps
-      (consts_program_permissive ((Proof_Context.theory_of ctxt)) consts_permissive);
+      (consts_program_permissive (Proof_Context.theory_of ctxt) consts_permissive);
   in union (op =) consts' consts end;
 
 
--- a/src/Tools/induct_tacs.ML	Tue Mar 24 18:10:56 2015 +0100
+++ b/src/Tools/induct_tacs.ML	Tue Mar 24 23:39:42 2015 +0100
@@ -6,8 +6,10 @@
 
 signature INDUCT_TACS =
 sig
-  val case_tac: Proof.context -> string -> int -> tactic
-  val case_rule_tac: Proof.context -> string -> thm -> int -> tactic
+  val case_tac: Proof.context -> string -> (binding * string option * mixfix) list ->
+    int -> tactic
+  val case_rule_tac: Proof.context -> string -> (binding * string option * mixfix) list ->
+    thm -> int -> tactic
   val induct_tac: Proof.context -> string option list list -> int -> tactic
   val induct_rules_tac: Proof.context -> string option list list -> thm list -> int -> tactic
 end
@@ -26,29 +28,35 @@
         quote (Syntax.string_of_term ctxt u) ^ Position.here pos);
   in (u, U) end;
 
-fun gen_case_tac ctxt0 s opt_rule i st =
+fun gen_case_tac ctxt s fixes opt_rule i st =
   let
-    val (_, ctxt) = Variable.focus_subgoal i st ctxt0;
     val rule =
       (case opt_rule of
         SOME rule => rule
       | NONE =>
-          (case Induct.find_casesT ctxt
-              (#2 (check_type ctxt (Proof_Context.read_term_schematic ctxt s,
-                Syntax.read_token_pos s))) of
-            rule :: _ => rule
-          | [] => @{thm case_split}));
+          let
+            val ctxt' = ctxt
+              |> Variable.focus_subgoal i st |> #2
+              |> Config.get ctxt Rule_Insts.schematic ?
+                  Proof_Context.set_mode Proof_Context.mode_schematic
+              |> Context_Position.set_visible false;
+            val t = Syntax.read_term ctxt' s;
+          in
+            (case Induct.find_casesT ctxt' (#2 (check_type ctxt' (t, Syntax.read_input_pos s))) of
+              rule :: _ => rule
+            | [] => @{thm case_split})
+          end);
     val _ = Method.trace ctxt [rule];
 
     val xi =
       (case Induct.vars_of (Thm.term_of (Thm.cprem_of rule 1)) of
         Var (xi, _) :: _ => xi
       | _ => raise THM ("Malformed cases rule", 0, [rule]));
-  in Rule_Insts.res_inst_tac ctxt [((xi, Position.none), s)] [] rule i st end
+  in Rule_Insts.res_inst_tac ctxt [((xi, Position.none), s)] fixes rule i st end
   handle THM _ => Seq.empty;
 
-fun case_tac ctxt s = gen_case_tac ctxt s NONE;
-fun case_rule_tac ctxt s rule = gen_case_tac ctxt s (SOME rule);
+fun case_tac ctxt s xs = gen_case_tac ctxt s xs NONE;
+fun case_rule_tac ctxt s xs rule = gen_case_tac ctxt s xs (SOME rule);
 
 
 (* induction *)
@@ -72,7 +80,7 @@
     fun induct_var name =
       let
         val t = Syntax.read_term ctxt name;
-        val pos = Syntax.read_token_pos name;
+        val pos = Syntax.read_input_pos name;
         val (x, _) = Term.dest_Free t handle TERM _ =>
           error ("Induction argument not a variable: " ^
             quote (Syntax.string_of_term ctxt t) ^ Position.here pos);
@@ -130,8 +138,8 @@
 val _ =
   Theory.setup
    (Method.setup @{binding case_tac}
-      (Args.goal_spec -- Scan.lift Args.name_inner_syntax -- opt_rule >>
-        (fn ((quant, s), r) => fn ctxt => SIMPLE_METHOD'' quant (gen_case_tac ctxt s r)))
+      (Args.goal_spec -- Scan.lift (Args.name_inner_syntax -- Parse.for_fixes) -- opt_rule >>
+        (fn ((quant, (s, xs)), r) => fn ctxt => SIMPLE_METHOD'' quant (gen_case_tac ctxt s xs r)))
       "unstructured case analysis on types" #>
     Method.setup @{binding induct_tac}
       (Args.goal_spec -- varss -- opt_rules >>