--- a/src/Pure/Isar/net_rules.ML Wed Dec 05 03:17:34 2001 +0100
+++ b/src/Pure/Isar/net_rules.ML Wed Dec 05 03:18:03 2001 +0100
@@ -11,13 +11,10 @@
type 'a T
val rules: 'a T -> 'a list
val retrieve: 'a T -> term -> 'a list
- val retrieve_weighted: 'a T -> term -> 'a list
- val init: ('a * 'a -> bool) -> ('a -> int) -> ('a -> term) -> 'a T
+ val init: ('a * 'a -> bool) -> ('a -> term) -> 'a T
val merge: 'a T * 'a T -> 'a T
val delete: 'a -> 'a T -> 'a T
val insert: 'a -> 'a T -> 'a T
- val deletes: 'a list -> 'a T -> 'a T
- val inserts: 'a list -> 'a T -> 'a T
val intro: thm T
val elim: thm T
end;
@@ -30,57 +27,44 @@
datatype 'a T =
Rules of {
eq: 'a * 'a -> bool,
- weight: 'a -> int,
index: 'a -> term,
rules: 'a list,
next: int,
- net: ((int * int) * 'a) Net.net};
+ net: (int * 'a) Net.net};
-fun mk_rules eq weight index rules next net =
- Rules {eq = eq, weight = weight, index = index, rules = rules, next = next, net = net};
+fun mk_rules eq index rules next net =
+ Rules {eq = eq, index = index, rules = rules, next = next, net = net};
fun rules (Rules {rules = rs, ...}) = rs;
-
-(* retrieve rules *)
-
-fun gen_retrieve order (Rules {rules, net, ...}) tm =
- Tactic.untaglist (map (fn ((_, k), x) => (k, x))
- (sort (order o pairself #1) (Net.unify_term net tm)));
-
-fun retrieve x = gen_retrieve (int_ord o pairself snd) x;
-fun retrieve_weighted x = gen_retrieve (prod_ord int_ord int_ord) x;
+fun retrieve (Rules {rules, net, ...}) tm =
+ Tactic.untaglist ((Library.sort (int_ord o pairself #1) (Net.unify_term net tm)));
(* build rules *)
-fun init eq weight index = mk_rules eq weight index [] ~1 Net.empty;
+fun init eq index = mk_rules eq index [] ~1 Net.empty;
-fun add rule (Rules {eq, weight, index, rules, next, net}) =
- mk_rules eq weight index (rule :: rules) (next - 1)
- (Net.insert_term ((index rule, ((weight rule, next), rule)), net, K false));
-
-fun make eq weight index rules = foldr (uncurry add) (rules, init eq weight index);
-
+fun add rule (Rules {eq, index, rules, next, net}) =
+ mk_rules eq index (rule :: rules) (next - 1)
+ (Net.insert_term ((index rule, (next, rule)), net, K false));
-fun merge (Rules {eq, weight, index, rules = rules1, ...}, Rules {rules = rules2, ...}) =
- make eq weight index (Library.gen_merge_lists' eq rules1 rules2);
+fun merge (Rules {eq, index, rules = rules1, ...}, Rules {rules = rules2, ...}) =
+ let val rules = Library.gen_merge_lists' eq rules1 rules2
+ in foldr (uncurry add) (rules, init eq index) end;
-fun delete rule (rs as Rules {eq, weight, index, rules, next, net}) =
+fun delete rule (rs as Rules {eq, index, rules, next, net}) =
if not (Library.gen_mem eq (rule, rules)) then rs
- else mk_rules eq weight index (Library.gen_rem eq (rules, rule)) next
- (Net.delete_term ((index rule, ((0, 0), rule)), net, eq o pairself #2));
+ else mk_rules eq index (Library.gen_rem eq (rules, rule)) next
+ (Net.delete_term ((index rule, (0, rule)), net, eq o pairself #2));
-fun insert rule rs = add rule (delete rule rs); (*ensure new rule gets precedence*)
-
-fun deletes rules rs = foldr (uncurry delete) (rules, rs);
-fun inserts rules rs = foldr (uncurry insert) (rules, rs);
+fun insert rule rs = add rule (delete rule rs); (*ensure that new rule gets precedence*)
(* intro/elim rules *)
-val intro = init Thm.eq_thm Thm.nprems_of Thm.concl_of;
-val elim = init Thm.eq_thm Thm.nprems_of Thm.major_prem_of;
+val intro = init Thm.eq_thm Thm.concl_of;
+val elim = init Thm.eq_thm Thm.major_prem_of;
end;