src/Pure/Isar/method.ML
changeset 58016 28e5ccf4a27f
parent 58011 bc6bced136e5
child 58018 beb4b7c0bb30
equal deleted inserted replaced
58015:2777096e0adf 58016:28e5ccf4a27f
    36   val try_intros_tac: thm list -> thm list -> tactic
    36   val try_intros_tac: thm list -> thm list -> tactic
    37   val rule: Proof.context -> thm list -> method
    37   val rule: Proof.context -> thm list -> method
    38   val erule: Proof.context -> int -> thm list -> method
    38   val erule: Proof.context -> int -> thm list -> method
    39   val drule: Proof.context -> int -> thm list -> method
    39   val drule: Proof.context -> int -> thm list -> method
    40   val frule: Proof.context -> int -> thm list -> method
    40   val frule: Proof.context -> int -> thm list -> method
    41   val set_tactic: (thm list -> tactic) -> Proof.context -> Proof.context
    41   val set_tactic: (thm list -> tactic) -> Context.generic -> Context.generic
    42   val tactic: Symbol_Pos.source -> Proof.context -> method
    42   val tactic: Symbol_Pos.source -> Proof.context -> method
    43   val raw_tactic: Symbol_Pos.source -> Proof.context -> method
    43   val raw_tactic: Symbol_Pos.source -> Proof.context -> method
    44   type combinator_info
    44   type combinator_info
    45   val no_combinator_info: combinator_info
    45   val no_combinator_info: combinator_info
    46   datatype combinator = Then | Orelse | Try | Repeat1 | Select_Goals of int
    46   datatype combinator = Then | Orelse | Try | Repeat1 | Select_Goals of int
   245 
   245 
   246 val intros_tac = gen_intros_tac ALLGOALS;
   246 val intros_tac = gen_intros_tac ALLGOALS;
   247 val try_intros_tac = gen_intros_tac TRYALL;
   247 val try_intros_tac = gen_intros_tac TRYALL;
   248 
   248 
   249 
   249 
   250 (* ML tactics *)
   250 
   251 
   251 (** method syntax **)
   252 structure ML_Tactic = Proof_Data
   252 
       
   253 (* context data *)
       
   254 
       
   255 structure Data = Generic_Data
   253 (
   256 (
   254   type T = thm list -> tactic;
   257   type T =
   255   fun init _ = undefined;
   258     ((Token.src -> Proof.context -> method) * string) Name_Space.table *  (*methods*)
       
   259     (thm list -> tactic) option;  (*ML tactic*)
       
   260   val empty : T = (Name_Space.empty_table "method", NONE);
       
   261   val extend = I;
       
   262   fun merge ((tab, tac), (tab', tac')) : T =
       
   263     (Name_Space.merge_tables (tab, tab'), merge_options (tac, tac'));
   256 );
   264 );
   257 
   265 
   258 val set_tactic = ML_Tactic.put;
   266 val get_methods = fst o Data.get;
       
   267 val map_methods = Data.map o apfst;
       
   268 
       
   269 
       
   270 (* ML tactic *)
       
   271 
       
   272 val set_tactic = Data.map o apsnd o K o SOME;
       
   273 
       
   274 fun the_tactic context =
       
   275   (case snd (Data.get context) of
       
   276     SOME tac => tac
       
   277   | NONE => raise Fail "Undefined ML tactic");
   259 
   278 
   260 fun ml_tactic source ctxt =
   279 fun ml_tactic source ctxt =
   261   let
   280   let
   262     val ctxt' = ctxt |> Context.proof_map
   281     val context = Context.Proof ctxt
       
   282     val context' = context |>
   263       (ML_Context.expression (#pos source)
   283       (ML_Context.expression (#pos source)
   264         "fun tactic (facts: thm list) : tactic"
   284         "fun tactic (facts: thm list) : tactic"
   265         "Context.map_proof (Method.set_tactic tactic)" (ML_Lex.read_source false source));
   285         "Method.set_tactic tactic" (ML_Lex.read_source false source));
   266   in Context.setmp_thread_data (SOME (Context.Proof ctxt)) (ML_Tactic.get ctxt') end;
   286   in Context.setmp_thread_data (SOME context) (the_tactic context') end;
   267 
   287 
   268 fun tactic source ctxt = METHOD (ml_tactic source ctxt);
   288 fun tactic source ctxt = METHOD (ml_tactic source ctxt);
   269 fun raw_tactic source ctxt = NO_CASES o ml_tactic source ctxt;
   289 fun raw_tactic source ctxt = NO_CASES o ml_tactic source ctxt;
   270 
   290 
   271 
       
   272 
       
   273 (** method syntax **)
       
   274 
   291 
   275 (* method text *)
   292 (* method text *)
   276 
   293 
   277 datatype combinator_info = Combinator_Info of {keywords: Position.T list};
   294 datatype combinator_info = Combinator_Info of {keywords: Position.T list};
   278 fun combinator_info keywords = Combinator_Info {keywords = keywords};
   295 fun combinator_info keywords = Combinator_Info {keywords = keywords};
   301       Combinator (no_combinator_info, Then, [txt, Basic (finish immed)]);
   318       Combinator (no_combinator_info, Then, [txt, Basic (finish immed)]);
   302 
   319 
   303 
   320 
   304 (* method definitions *)
   321 (* method definitions *)
   305 
   322 
   306 structure Methods = Generic_Data
       
   307 (
       
   308   type T = ((Token.src -> Proof.context -> method) * string) Name_Space.table;
       
   309   val empty : T = Name_Space.empty_table "method";
       
   310   val extend = I;
       
   311   fun merge data : T = Name_Space.merge_tables data;
       
   312 );
       
   313 
       
   314 val get_methods = Methods.get o Context.Proof;
       
   315 
       
   316 fun transfer_methods ctxt =
   323 fun transfer_methods ctxt =
   317   let
   324   let
   318     val meths0 = Methods.get (Context.Theory (Proof_Context.theory_of ctxt));
   325     val meths0 = get_methods (Context.Theory (Proof_Context.theory_of ctxt));
   319     val meths' = Name_Space.merge_tables (meths0, get_methods ctxt);
   326     val meths' = Name_Space.merge_tables (meths0, get_methods (Context.Proof ctxt));
   320   in Context.proof_map (Methods.put meths') ctxt end;
   327   in Context.proof_map (map_methods (K meths')) ctxt end;
   321 
   328 
   322 fun print_methods ctxt =
   329 fun print_methods ctxt =
   323   let
   330   let
   324     val meths = get_methods ctxt;
   331     val meths = get_methods (Context.Proof ctxt);
   325     fun prt_meth (name, (_, "")) = Pretty.mark_str name
   332     fun prt_meth (name, (_, "")) = Pretty.mark_str name
   326       | prt_meth (name, (_, comment)) =
   333       | prt_meth (name, (_, comment)) =
   327           Pretty.block
   334           Pretty.block
   328             (Pretty.mark_str name :: Pretty.str ":" :: Pretty.brk 2 :: Pretty.text comment);
   335             (Pretty.mark_str name :: Pretty.str ":" :: Pretty.brk 2 :: Pretty.text comment);
   329   in
   336   in
   336 
   343 
   337 fun define_global binding meth comment thy =
   344 fun define_global binding meth comment thy =
   338   let
   345   let
   339     val context = Context.Theory thy;
   346     val context = Context.Theory thy;
   340     val (name, meths') =
   347     val (name, meths') =
   341       Name_Space.define context true (binding, (meth, comment)) (Methods.get context);
   348       Name_Space.define context true (binding, (meth, comment)) (get_methods context);
   342   in (name, Context.the_theory (Methods.put meths' context)) end;
   349   in (name, Context.the_theory (map_methods (K meths') context)) end;
   343 
   350 
   344 fun define binding meth comment =
   351 fun define binding meth comment =
   345   Local_Theory.background_theory_result (define_global binding meth comment)
   352   Local_Theory.background_theory_result (define_global binding meth comment)
   346   #-> (fn name =>
   353   #-> (fn name =>
   347     Local_Theory.map_contexts (K transfer_methods)
   354     Local_Theory.map_contexts (K transfer_methods)
   348     #> Local_Theory.generic_alias Methods.map binding name
   355     #> Local_Theory.generic_alias map_methods binding name
   349     #> pair name);
   356     #> pair name);
   350 
   357 
   351 
   358 
   352 (* check *)
   359 (* check *)
   353 
   360 
   354 fun check_name ctxt = #1 o Name_Space.check (Context.Proof ctxt) (get_methods ctxt);
   361 fun check_name ctxt =
   355 fun check_src ctxt src = Token.check_src ctxt (get_methods ctxt) src;
   362   let val context = Context.Proof ctxt
       
   363   in #1 o Name_Space.check context (get_methods context) end;
       
   364 
       
   365 fun check_src ctxt src =
       
   366   Token.check_src ctxt (get_methods (Context.Proof ctxt)) src;
   356 
   367 
   357 
   368 
   358 (* method setup *)
   369 (* method setup *)
   359 
   370 
   360 fun method_syntax scan src ctxt : method =
   371 fun method_syntax scan src ctxt : method =
   374 
   385 
   375 
   386 
   376 (* prepare methods *)
   387 (* prepare methods *)
   377 
   388 
   378 fun method ctxt =
   389 fun method ctxt =
   379   let val table = get_methods ctxt
   390   let val table = get_methods (Context.Proof ctxt)
   380   in fn src => #1 (Name_Space.get table (#1 (Token.name_of_src src))) src end;
   391   in fn src => #1 (Name_Space.get table (#1 (Token.name_of_src src))) src end;
   381 
   392 
   382 fun method_closure ctxt0 src0 =
   393 fun method_closure ctxt0 src0 =
   383   let
   394   let
   384     val (src1, meth) = check_src ctxt0 src0;
   395     val (src1, meth) = check_src ctxt0 src0;