src/Pure/Isar/method.ML
changeset 30515 bca05b17b618
parent 30512 17b2aad869fa
child 30540 5e2d9604a3d3
equal deleted inserted replaced
30514:9455ecc7796d 30515:bca05b17b618
   454 fun thm_args f = thms_args (fn [thm] => f thm | _ => error "Single theorem expected");
   454 fun thm_args f = thms_args (fn [thm] => f thm | _ => error "Single theorem expected");
   455 
   455 
   456 end;
   456 end;
   457 
   457 
   458 
   458 
       
   459 (* extra rule methods *)
       
   460 
       
   461 fun xrule_meth m =
       
   462   Scan.lift (Scan.optional (Args.parens OuterParse.nat) 0) -- Attrib.thms >>
       
   463   (fn (n, ths) => K (m n ths));
       
   464 
       
   465 
   459 (* tactic syntax *)
   466 (* tactic syntax *)
   460 
   467 
   461 fun nat_thms_args f = uncurry f oo
   468 fun goal_args' args tac src ctxt = fst (syntax (Args.goal_spec -- args >>
   462   (fst oo syntax (Scan.lift (Scan.optional (Args.parens P.nat) 0) -- Attrib.thms));
       
   463 
       
   464 fun goal_args' args tac src ctxt = fst (syntax (Args.goal_spec HEADGOAL -- args >>
       
   465   (fn (quant, s) => SIMPLE_METHOD'' quant (tac s))) src ctxt);
   469   (fn (quant, s) => SIMPLE_METHOD'' quant (tac s))) src ctxt);
   466 
   470 
   467 fun goal_args args tac = goal_args' (Scan.lift args) tac;
   471 fun goal_args args tac = goal_args' (Scan.lift args) tac;
   468 
   472 
   469 fun goal_args_ctxt' args tac src ctxt =
   473 fun goal_args_ctxt' args tac src ctxt =
   470   fst (syntax (Args.goal_spec HEADGOAL -- args >>
   474   fst (syntax (Args.goal_spec -- args >>
   471   (fn (quant, s) => SIMPLE_METHOD'' quant (tac ctxt s))) src ctxt);
   475   (fn (quant, s) => SIMPLE_METHOD'' quant (tac ctxt s))) src ctxt);
   472 
   476 
   473 fun goal_args_ctxt args tac = goal_args_ctxt' (Scan.lift args) tac;
   477 fun goal_args_ctxt args tac = goal_args_ctxt' (Scan.lift args) tac;
   474 
   478 
   475 
   479 
   498 
   502 
   499 
   503 
   500 (* theory setup *)
   504 (* theory setup *)
   501 
   505 
   502 val _ = Context.>> (Context.map_theory
   506 val _ = Context.>> (Context.map_theory
   503   (add_methods
   507  (setup (Binding.name "fail") (Scan.succeed (K fail)) "force failure" #>
   504    [("fail", no_args fail, "force failure"),
   508   setup (Binding.name "succeed") (Scan.succeed (K succeed)) "succeed" #>
   505     ("succeed", no_args succeed, "succeed"),
   509   setup (Binding.name "-") (Scan.succeed (K insert_facts))
   506     ("-", no_args insert_facts, "do nothing (insert current facts only)"),
   510     "do nothing (insert current facts only)" #>
   507     ("insert", thms_args insert, "insert theorems, ignoring facts (improper)"),
   511   setup (Binding.name "insert") (Attrib.thms >> (K o insert))
   508     ("intro", thms_args intro, "repeatedly apply introduction rules"),
   512     "insert theorems, ignoring facts (improper)" #>
   509     ("elim", thms_args elim, "repeatedly apply elimination rules"),
   513   setup (Binding.name "intro") (Attrib.thms >> (K o intro))
   510     ("unfold", thms_ctxt_args unfold_meth, "unfold definitions"),
   514     "repeatedly apply introduction rules" #>
   511     ("fold", thms_ctxt_args fold_meth, "fold definitions"),
   515   setup (Binding.name "elim") (Attrib.thms >> (K o elim))
   512     ("atomize", (atomize o fst) oo syntax (Args.mode "full"),
   516     "repeatedly apply elimination rules" #>
   513       "present local premises as object-level statements"),
   517   setup (Binding.name "unfold") (Attrib.thms >> unfold_meth) "unfold definitions" #>
   514     ("rule", thms_ctxt_args some_rule, "apply some intro/elim rule"),
   518   setup (Binding.name "fold") (Attrib.thms >> fold_meth) "fold definitions" #>
   515     ("erule", nat_thms_args erule, "apply rule in elimination manner (improper)"),
   519   setup (Binding.name "atomize") (Args.mode "full" >> (K o atomize))
   516     ("drule", nat_thms_args drule, "apply rule in destruct manner (improper)"),
   520     "present local premises as object-level statements" #>
   517     ("frule", nat_thms_args frule, "apply rule in forward manner (improper)"),
   521   setup (Binding.name "rule") (Attrib.thms >> some_rule) "apply some intro/elim rule" #>
   518     ("this", no_args this, "apply current facts as rules"),
   522   setup (Binding.name "erule") (xrule_meth erule) "apply rule in elimination manner (improper)" #>
   519     ("fact", thms_ctxt_args fact, "composition by facts from context"),
   523   setup (Binding.name "drule") (xrule_meth drule) "apply rule in destruct manner (improper)" #>
   520     ("assumption", ctxt_args assumption, "proof by assumption, preferring facts"),
   524   setup (Binding.name "frule") (xrule_meth frule) "apply rule in forward manner (improper)" #>
   521     ("rename_tac", goal_args (Scan.repeat1 Args.name) Tactic.rename_tac,
   525   setup (Binding.name "this") (Scan.succeed (K this)) "apply current facts as rules" #>
   522       "rename parameters of goal"),
   526   setup (Binding.name "fact") (Attrib.thms >> fact) "composition by facts from context" #>
   523     ("rotate_tac", goal_args (Scan.optional P.int 1) Tactic.rotate_tac,
   527   setup (Binding.name "assumption") (Scan.succeed assumption)
   524       "rotate assumptions of goal"),
   528     "proof by assumption, preferring facts" #>
   525     ("tactic", simple_args (P.position Args.name) tactic, "ML tactic as proof method"),
   529   setup (Binding.name "rename_tac") (Args.goal_spec -- Scan.lift (Scan.repeat1 Args.name) >>
   526     ("raw_tactic", simple_args (P.position Args.name) raw_tactic,
   530     (fn (quant, xs) => K (SIMPLE_METHOD'' quant (Tactic.rename_tac xs))))
   527       "ML tactic as raw proof method")]));
   531     "rename parameters of goal" #>
       
   532   setup (Binding.name "rotate_tac") (Args.goal_spec -- Scan.lift (Scan.optional P.int 1) >>
       
   533     (fn (quant, i) => K (SIMPLE_METHOD'' quant (Tactic.rotate_tac i))))
       
   534       "rotate assumptions of goal" #>
       
   535   setup (Binding.name "tactic") (Scan.lift (P.position Args.name) >> tactic)
       
   536     "ML tactic as proof method" #>
       
   537   setup (Binding.name "raw_tactic") (Scan.lift (P.position Args.name) >> raw_tactic)
       
   538     "ML tactic as raw proof method"));
   528 
   539 
   529 
   540 
   530 (*final declarations of this structure!*)
   541 (*final declarations of this structure!*)
   531 val unfold = unfold_meth;
   542 val unfold = unfold_meth;
   532 val fold = fold_meth;
   543 val fold = fold_meth;