src/Tools/induct.ML
changeset 32445 64f30bdd3ba1
parent 32188 005f9abae1e3
child 32861 105f40051387
     1.1 --- a/src/Tools/induct.ML	Fri Aug 28 18:23:24 2009 +0200
     1.2 +++ b/src/Tools/induct.ML	Fri Aug 28 21:04:03 2009 +0200
     1.3 @@ -288,21 +288,21 @@
     1.4  
     1.5  (* prep_inst *)
     1.6  
     1.7 -fun prep_inst thy align tune (tm, ts) =
     1.8 +fun prep_inst ctxt align tune (tm, ts) =
     1.9    let
    1.10 -    val cert = Thm.cterm_of thy;
    1.11 +    val cert = Thm.cterm_of (ProofContext.theory_of ctxt);
    1.12      fun prep_var (x, SOME t) =
    1.13            let
    1.14              val cx = cert x;
    1.15              val xT = #T (Thm.rep_cterm cx);
    1.16              val ct = cert (tune t);
    1.17 -            val tT = Thm.ctyp_of_term ct;
    1.18 +            val tT = #T (Thm.rep_cterm ct);
    1.19            in
    1.20 -            if Type.could_unify (Thm.typ_of tT, xT) then SOME (cx, ct)
    1.21 +            if Type.could_unify (tT, xT) then SOME (cx, ct)
    1.22              else error (Pretty.string_of (Pretty.block
    1.23               [Pretty.str "Ill-typed instantiation:", Pretty.fbrk,
    1.24 -              Display.pretty_cterm ct, Pretty.str " ::", Pretty.brk 1,
    1.25 -              Display.pretty_ctyp (#T (Thm.crep_cterm ct))]))
    1.26 +              Syntax.pretty_term ctxt (Thm.term_of ct), Pretty.str " ::", Pretty.brk 1,
    1.27 +              Syntax.pretty_typ ctxt tT]))
    1.28            end
    1.29        | prep_var (_, NONE) = NONE;
    1.30      val xs = vars_of tm;
    1.31 @@ -342,12 +342,11 @@
    1.32  fun cases_tac ctxt insts opt_rule facts =
    1.33    let
    1.34      val thy = ProofContext.theory_of ctxt;
    1.35 -    val cert = Thm.cterm_of thy;
    1.36  
    1.37      fun inst_rule r =
    1.38        if null insts then `RuleCases.get r
    1.39        else (align_left "Rule has fewer premises than arguments given" (Thm.prems_of r) insts
    1.40 -        |> maps (prep_inst thy align_left I)
    1.41 +        |> maps (prep_inst ctxt align_left I)
    1.42          |> Drule.cterm_instantiate) r |> pair (RuleCases.get r);
    1.43  
    1.44      val ruleq =
    1.45 @@ -411,8 +410,8 @@
    1.46  
    1.47  (* prepare rule *)
    1.48  
    1.49 -fun rule_instance thy inst rule =
    1.50 -  Drule.cterm_instantiate (prep_inst thy align_left I (Thm.prop_of rule, inst)) rule;
    1.51 +fun rule_instance ctxt inst rule =
    1.52 +  Drule.cterm_instantiate (prep_inst ctxt align_left I (Thm.prop_of rule, inst)) rule;
    1.53  
    1.54  fun internalize k th =
    1.55    th |> Thm.permute_prems 0 k
    1.56 @@ -589,7 +588,7 @@
    1.57        (if null insts then `RuleCases.get r
    1.58         else (align_left "Rule has fewer conclusions than arguments given"
    1.59            (map Logic.strip_imp_concl (Logic.dest_conjunctions (Thm.concl_of r))) insts
    1.60 -        |> maps (prep_inst thy align_right (atomize_term thy))
    1.61 +        |> maps (prep_inst ctxt align_right (atomize_term thy))
    1.62          |> Drule.cterm_instantiate) r |> pair (RuleCases.get r))
    1.63        |> (fn ((cases, consumes), th) => (((cases, concls), consumes), th));
    1.64  
    1.65 @@ -619,7 +618,7 @@
    1.66            THEN' inner_atomize_tac) j))
    1.67          THEN' atomize_tac) i st |> Seq.maps (fn st' =>
    1.68              guess_instance ctxt (internalize more_consumes rule) i st'
    1.69 -            |> Seq.map (rule_instance thy (burrow_options (Variable.polymorphic ctxt) taking))
    1.70 +            |> Seq.map (rule_instance ctxt (burrow_options (Variable.polymorphic ctxt) taking))
    1.71              |> Seq.maps (fn rule' =>
    1.72                CASES (rule_cases rule' cases)
    1.73                  (Tactic.rtac rule' i THEN
    1.74 @@ -657,7 +656,7 @@
    1.75  
    1.76      fun inst_rule r =
    1.77        if null inst then `RuleCases.get r
    1.78 -      else Drule.cterm_instantiate (prep_inst thy align_right I (main_prop_of r, inst)) r
    1.79 +      else Drule.cterm_instantiate (prep_inst ctxt align_right I (main_prop_of r, inst)) r
    1.80          |> pair (RuleCases.get r);
    1.81  
    1.82      fun ruleq goal =
    1.83 @@ -673,7 +672,7 @@
    1.84        |> Seq.maps (RuleCases.consume [] facts)
    1.85        |> Seq.maps (fn ((cases, (_, more_facts)), rule) =>
    1.86          guess_instance ctxt rule i st
    1.87 -        |> Seq.map (rule_instance thy (burrow_options (Variable.polymorphic ctxt) taking))
    1.88 +        |> Seq.map (rule_instance ctxt (burrow_options (Variable.polymorphic ctxt) taking))
    1.89          |> Seq.maps (fn rule' =>
    1.90            CASES (RuleCases.make_common false (thy, Thm.prop_of rule') cases)
    1.91              (Method.insert_tac more_facts i THEN Tactic.rtac rule' i) st)))