tuned attribute names;
authorwenzelm
Mon, 16 Nov 1998 11:09:02 +0100
changeset 5885 6c920d876098
parent 5884 113badd4dae5
child 5886 0373323180f5
tuned attribute names; all modifiers turned into attributes; realistic method syntax;
src/Provers/classical.ML
--- a/src/Provers/classical.ML	Mon Nov 16 11:07:12 1998 +0100
+++ b/src/Provers/classical.ML	Mon Nov 16 11:09:02 1998 +0100
@@ -150,20 +150,20 @@
   val print_local_claset: Proof.context -> unit
   val get_local_claset: Proof.context -> claset
   val put_local_claset: claset -> Proof.context -> Proof.context
-  val dest_global: theory attribute
-  val elim_global: theory attribute
-  val intro_global: theory attribute
+  val haz_dest_global: theory attribute
+  val haz_elim_global: theory attribute
+  val haz_intro_global: theory attribute
   val safe_dest_global: theory attribute
   val safe_elim_global: theory attribute
   val safe_intro_global: theory attribute
-  val delrules_global: theory attribute
-  val dest_local: Proof.context attribute
-  val elim_local: Proof.context attribute
-  val intro_local: Proof.context attribute
+  val delrule_global: theory attribute
+  val haz_dest_local: Proof.context attribute
+  val haz_elim_local: Proof.context attribute
+  val haz_intro_local: Proof.context attribute
   val safe_dest_local: Proof.context attribute
   val safe_elim_local: Proof.context attribute
   val safe_intro_local: Proof.context attribute
-  val delrules_local: Proof.context attribute
+  val delrule_local: Proof.context attribute
   val trace_rules: bool ref
   val single_tac: claset -> tthm list -> int -> tactic
   val setup: (theory -> theory) list
@@ -845,6 +845,33 @@
 val put_local_claset = LocalClaset.put;
 
 
+(* attributes *)
+
+fun change_global_cs f (thy, th) =
+  let val r = claset_ref_of thy
+  in r := f (! r, [Attribute.thm_of th]); (thy, th) end;
+
+fun change_local_cs f (ctxt, th) =
+  let val cs = f (get_local_claset ctxt, [Attribute.thm_of th])
+  in (put_local_claset cs ctxt, th) end;
+
+val haz_dest_global = change_global_cs (op addDs);
+val haz_elim_global = change_global_cs (op addEs);
+val haz_intro_global = change_global_cs (op addIs);
+val safe_dest_global = change_global_cs (op addSDs);
+val safe_elim_global = change_global_cs (op addSEs);
+val safe_intro_global = change_global_cs (op addSIs);
+val delrule_global = change_global_cs (op delrules);
+
+val haz_dest_local = change_local_cs (op addDs);
+val haz_elim_local = change_local_cs (op addEs);
+val haz_intro_local = change_local_cs (op addIs);
+val safe_dest_local = change_local_cs (op addSDs);
+val safe_elim_local = change_local_cs (op addSEs);
+val safe_intro_local = change_local_cs (op addSIs);
+val delrule_local = change_local_cs (op delrules);
+
+
 (* tactics referring to the implicit claset *)
 
 (*the abstraction over the proof state delays the dereferencing*)
@@ -864,7 +891,7 @@
 
 
 
-(** attributes **)
+(** concrete syntax of attributes **)
 
 (* add / del rules *)
 
@@ -872,58 +899,28 @@
 val elimN = "elim";
 val destN = "dest";
 val delN = "del";
-
-val addDs' = Attribute.lift_modifier (op addDs);
-val addEs' = Attribute.lift_modifier (op addEs);
-val addIs' = Attribute.lift_modifier (op addIs);
-val addSDs' = Attribute.lift_modifier (op addSDs);
-val addSEs' = Attribute.lift_modifier (op addSEs);
-val addSIs' = Attribute.lift_modifier (op addSIs);
-val delrules' = Attribute.lift_modifier (op delrules);
+val delruleN = "delrule";
 
-local
-  fun change_global_cs f (thy, tth) =
-    let val r = claset_ref_of thy
-    in r := f (! r, [tth]); (thy, tth) end;
-
-  fun change_local_cs f (ctxt, tth) =
-    let val cs = f (get_local_claset ctxt, [tth])
-    in (put_local_claset cs ctxt, tth) end;
+val bang = Args.$$$ "!";
 
-  fun cla_att change f g = Attrib.syntax (Args.$$$ "!" >> K f || Scan.succeed g) change;
-in
-  val dest_global = change_global_cs addDs';
-  val elim_global = change_global_cs addEs';
-  val intro_global = change_global_cs addIs';
-  val safe_dest_global = change_global_cs addDs';
-  val safe_elim_global = change_global_cs addEs';
-  val safe_intro_global = change_global_cs addIs';
-  val delrules_global = change_global_cs delrules';
+fun cla_att change haz safe =
+  Attrib.syntax (Scan.lift ((bang >> K haz || Scan.succeed safe) >> change));
 
-  val dest_local = change_local_cs addDs';
-  val elim_local = change_local_cs addEs';
-  val intro_local = change_local_cs addIs';
-  val safe_dest_local = change_local_cs addDs';
-  val safe_elim_local = change_local_cs addEs';
-  val safe_intro_local = change_local_cs addIs';
-  val delrules_local = change_local_cs delrules';
-
-  fun cla_attr f g = (cla_att change_global_cs f g, cla_att change_local_cs f g);
-  val del_attr = (Attrib.no_args delrules_global, Attrib.no_args delrules_local);
-end;
+fun cla_attr f g = (cla_att change_global_cs f g, cla_att change_local_cs f g);
+val del_attr = (Attrib.no_args delrule_global, Attrib.no_args delrule_local);
 
 
 (* setup_attrs *)
 
 val setup_attrs = Attrib.add_attributes
- [("dest", cla_attr addDs' addSDs', "destruction rule"),
-  ("elim", cla_attr addEs' addSEs', "elimination rule"),
-  ("intro", cla_attr addIs' addSIs', "introduction rule"),
-  ("del", del_attr, "delete rule")];
+ [(destN, cla_attr (op addDs) (op addSDs), "destruction rule"),
+  (elimN, cla_attr (op addEs) (op addSEs), "elimination rule"),
+  (introN, cla_attr (op addIs) (op addSIs), "introduction rule"),
+  (delruleN, del_attr, "delete rule")];
 
 
 
-(** standard rule proof method **)
+(** single rule proof method **)
 
 (* utils *)
 
@@ -958,7 +955,7 @@
 fun single_tac cs tfacts =
   let
     val CS {safe0_netpair, safep_netpair, haz_netpair, dup_netpair, ...} = cs;
-    val facts = map Attribute.thm_of tfacts;
+    val facts = Attribute.thms_of tfacts;
     val nets = [safe0_netpair, safep_netpair, haz_netpair, dup_netpair];
     val erules = find_erules facts nets;
 
@@ -978,18 +975,21 @@
 
 (** automatic methods **)
 
-(* FIXME handle "!" *)
+val cla_args =
+  Method.only_sectioned_args
+   [Args.$$$ destN -- bang >> K haz_dest_local,
+    Args.$$$ destN >> K safe_dest_local,
+    Args.$$$ elimN -- bang >> K haz_elim_local,
+    Args.$$$ elimN >> K safe_elim_local,
+    Args.$$$ introN -- bang >> K haz_intro_local,
+    Args.$$$ introN >> K safe_intro_local,
+    Args.$$$ delN >> K delrule_local];
 
-fun cla_args meth =
-  Method.sectioned_args get_local_claset addIs'
-    [(destN, addSDs'), ("unsafe_dest", addDs'),
-      (elimN, addSEs'), ("unsafe_elim", addEs'),
-      (introN, addSIs'), ("unsafe_intro", addIs'),
-      (delN, delrules')] meth;
+fun cla_meth tac ctxt = Method.METHOD0 (tac (get_local_claset ctxt));
+fun cla_meth' tac ctxt = Method.METHOD0 (FIRSTGOAL (tac (get_local_claset ctxt)));
 
-(* FIXME facts!? (e.g. apply trivial first) *)
-fun gen_cla tac = cla_args (fn cs => Method.METHOD0 (tac cs));
-fun gen_cla' tac = cla_args (fn cs => Method.METHOD0 (FIRSTGOAL (tac cs)));
+val cla_method = cla_args o cla_meth;
+val cla_method' = cla_args o cla_meth';
 
 
 
@@ -998,12 +998,12 @@
 val setup_methods = Method.add_methods
  [("single", Method.no_args single, "apply standard rule (single step)"),
   ("default", Method.no_args single, "apply standard rule (single step)"),
-  ("safe_tac", gen_cla safe_tac, "safe_tac"),
-  ("safe_step", gen_cla' safe_step_tac, "step_tac"),
-  ("fast", gen_cla' fast_tac, "fast_tac"),
-  ("best", gen_cla' best_tac, "best_tac"),
-  ("slow", gen_cla' slow_tac, "slow_tac"),
-  ("slow_best", gen_cla' slow_best_tac, "slow_best_tac")];
+  ("safe_tac", cla_method safe_tac, "safe_tac"),
+  ("safe_step", cla_method' safe_step_tac, "step_tac"),
+  ("fast", cla_method' fast_tac, "fast_tac"),
+  ("best", cla_method' best_tac, "best_tac"),
+  ("slow", cla_method' slow_tac, "slow_tac"),
+  ("slow_best", cla_method' slow_best_tac, "slow_best_tac")];