| author | wenzelm | 
| Sat, 23 Apr 2005 19:51:54 +0200 | |
| changeset 15836 | b805d85909c7 | 
| parent 15574 | b1d1b5bfc464 | 
| child 16512 | 1fa048f2a590 | 
| permissions | -rw-r--r-- | 
| 8298 | 1 | (* Title: Pure/Isar/net_rules.ML | 
| 2 | ID: $Id$ | |
| 3 | Author: Markus Wenzel, TU Muenchen | |
| 4 | ||
| 5 | Efficient storage of rules: preserves order, prefers later entries. | |
| 6 | *) | |
| 7 | ||
| 8 | signature NET_RULES = | |
| 9 | sig | |
| 10 | type 'a T | |
| 11 | val rules: 'a T -> 'a list | |
| 11776 | 12 | val retrieve: 'a T -> term -> 'a list | 
| 12385 | 13 |   val init: ('a * 'a -> bool) -> ('a -> term) -> 'a T
 | 
| 8298 | 14 | val merge: 'a T * 'a T -> 'a T | 
| 15 | val delete: 'a -> 'a T -> 'a T | |
| 16 | val insert: 'a -> 'a T -> 'a T | |
| 11776 | 17 | val intro: thm T | 
| 18 | val elim: thm T | |
| 8298 | 19 | end; | 
| 20 | ||
| 21 | structure NetRules: NET_RULES = | |
| 22 | struct | |
| 23 | ||
| 24 | (* datatype rules *) | |
| 25 | ||
| 26 | datatype 'a T = | |
| 27 |   Rules of {
 | |
| 28 | eq: 'a * 'a -> bool, | |
| 29 | index: 'a -> term, | |
| 30 | rules: 'a list, | |
| 31 | next: int, | |
| 12385 | 32 | net: (int * 'a) Net.net}; | 
| 8298 | 33 | |
| 12385 | 34 | fun mk_rules eq index rules next net = | 
| 35 |   Rules {eq = eq, index = index, rules = rules, next = next, net = net};
 | |
| 8298 | 36 | |
| 37 | fun rules (Rules {rules = rs, ...}) = rs;
 | |
| 11776 | 38 | |
| 12385 | 39 | fun retrieve (Rules {rules, net, ...}) tm =
 | 
| 14472 
cba7c0a3ffb3
Removing the datatype declaration of "order" allows the standard General.order
 paulson parents: 
13105diff
changeset | 40 | Tactic.untaglist | 
| 
cba7c0a3ffb3
Removing the datatype declaration of "order" allows the standard General.order
 paulson parents: 
13105diff
changeset | 41 | ((Library.sort (Int.compare o pairself #1) (Net.unify_term net tm))); | 
| 8298 | 42 | |
| 43 | ||
| 44 | (* build rules *) | |
| 45 | ||
| 12385 | 46 | fun init eq index = mk_rules eq index [] ~1 Net.empty; | 
| 8298 | 47 | |
| 12385 | 48 | fun add rule (Rules {eq, index, rules, next, net}) =
 | 
| 49 | mk_rules eq index (rule :: rules) (next - 1) | |
| 50 | (Net.insert_term ((index rule, (next, rule)), net, K false)); | |
| 8298 | 51 | |
| 12385 | 52 | fun merge (Rules {eq, index, rules = rules1, ...}, Rules {rules = rules2, ...}) =
 | 
| 53 | let val rules = Library.gen_merge_lists' eq rules1 rules2 | |
| 15574 
b1d1b5bfc464
Removed practically all references to Library.foldr.
 skalberg parents: 
15570diff
changeset | 54 | in foldr (uncurry add) (init eq index) rules end; | 
| 8298 | 55 | |
| 12385 | 56 | fun delete rule (rs as Rules {eq, index, rules, next, net}) =
 | 
| 8298 | 57 | if not (Library.gen_mem eq (rule, rules)) then rs | 
| 12385 | 58 | else mk_rules eq index (Library.gen_rem eq (rules, rule)) next | 
| 59 | (Net.delete_term ((index rule, (0, rule)), net, eq o pairself #2)); | |
| 8298 | 60 | |
| 12385 | 61 | fun insert rule rs = add rule (delete rule rs); (*ensure that new rule gets precedence*) | 
| 8298 | 62 | |
| 63 | ||
| 64 | (* intro/elim rules *) | |
| 65 | ||
| 13105 
3d1e7a199bdc
use eq_thm_prop instead of slightly inadequate eq_thm;
 wenzelm parents: 
12385diff
changeset | 66 | val intro = init Drule.eq_thm_prop Thm.concl_of; | 
| 
3d1e7a199bdc
use eq_thm_prop instead of slightly inadequate eq_thm;
 wenzelm parents: 
12385diff
changeset | 67 | val elim = init Drule.eq_thm_prop Thm.major_prem_of; | 
| 8298 | 68 | |
| 69 | ||
| 70 | end; |