src/Pure/Isar/net_rules.ML
author wenzelm
Sun, 01 Mar 2009 23:36:12 +0100
changeset 30190 479806475f3c
parent 29606 fedb8be05f24
permissions -rw-r--r--
use long names for old-style fold combinators;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
8298
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/Isar/net_rules.ML
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
     2
    Author:     Markus Wenzel, TU Muenchen
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
     3
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
     4
Efficient storage of rules: preserves order, prefers later entries.
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
     5
*)
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
     6
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
     7
signature NET_RULES =
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
     8
sig
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
     9
  type 'a T
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    10
  val rules: 'a T -> 'a list
11776
d4f9de0bde28 support weight;
wenzelm
parents: 11693
diff changeset
    11
  val retrieve: 'a T -> term -> 'a list
12385
389d11fb62c8 removed unused functionality (weight etc.);
wenzelm
parents: 12290
diff changeset
    12
  val init: ('a * 'a -> bool) -> ('a -> term) -> 'a T
8298
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    13
  val merge: 'a T * 'a T -> 'a T
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    14
  val delete: 'a -> 'a T -> 'a T
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    15
  val insert: 'a -> 'a T -> 'a T
11776
d4f9de0bde28 support weight;
wenzelm
parents: 11693
diff changeset
    16
  val intro: thm T
d4f9de0bde28 support weight;
wenzelm
parents: 11693
diff changeset
    17
  val elim: thm T
8298
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    18
end;
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    19
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    20
structure NetRules: NET_RULES =
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    21
struct
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    22
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    23
(* datatype rules *)
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    24
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    25
datatype 'a T =
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    26
  Rules of {
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    27
    eq: 'a * 'a -> bool,
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    28
    index: 'a -> term,
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    29
    rules: 'a list,
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    30
    next: int,
12385
389d11fb62c8 removed unused functionality (weight etc.);
wenzelm
parents: 12290
diff changeset
    31
    net: (int * 'a) Net.net};
8298
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    32
12385
389d11fb62c8 removed unused functionality (weight etc.);
wenzelm
parents: 12290
diff changeset
    33
fun mk_rules eq index rules next net =
389d11fb62c8 removed unused functionality (weight etc.);
wenzelm
parents: 12290
diff changeset
    34
  Rules {eq = eq, index = index, rules = rules, next = next, net = net};
8298
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    35
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    36
fun rules (Rules {rules = rs, ...}) = rs;
11776
d4f9de0bde28 support weight;
wenzelm
parents: 11693
diff changeset
    37
12385
389d11fb62c8 removed unused functionality (weight etc.);
wenzelm
parents: 12290
diff changeset
    38
fun retrieve (Rules {rules, net, ...}) tm =
14472
cba7c0a3ffb3 Removing the datatype declaration of "order" allows the standard General.order
paulson
parents: 13105
diff changeset
    39
  Tactic.untaglist 
16512
wenzelm
parents: 15574
diff changeset
    40
     ((Library.sort (int_ord o pairself #1) (Net.unify_term net tm)));
8298
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    41
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    42
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    43
(* build rules *)
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    44
12385
389d11fb62c8 removed unused functionality (weight etc.);
wenzelm
parents: 12290
diff changeset
    45
fun init eq index = mk_rules eq index [] ~1 Net.empty;
8298
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    46
12385
389d11fb62c8 removed unused functionality (weight etc.);
wenzelm
parents: 12290
diff changeset
    47
fun add rule (Rules {eq, index, rules, next, net}) =
389d11fb62c8 removed unused functionality (weight etc.);
wenzelm
parents: 12290
diff changeset
    48
  mk_rules eq index (rule :: rules) (next - 1)
16800
90eff1b52428 improved Net interface;
wenzelm
parents: 16512
diff changeset
    49
    (Net.insert_term (K false) (index rule, (next, rule)) net);
8298
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    50
12385
389d11fb62c8 removed unused functionality (weight etc.);
wenzelm
parents: 12290
diff changeset
    51
fun merge (Rules {eq, index, rules = rules1, ...}, Rules {rules = rules2, ...}) =
18921
f47c46d7d654 canonical member/insert/merge;
wenzelm
parents: 18646
diff changeset
    52
  let val rules = Library.merge eq (rules1, rules2)
17351
wenzelm
parents: 16800
diff changeset
    53
  in fold_rev add rules (init eq index) end;
8298
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    54
12385
389d11fb62c8 removed unused functionality (weight etc.);
wenzelm
parents: 12290
diff changeset
    55
fun delete rule (rs as Rules {eq, index, rules, next, net}) =
18646
wenzelm
parents: 17351
diff changeset
    56
  if not (member eq rules rule) then rs
wenzelm
parents: 17351
diff changeset
    57
  else mk_rules eq index (remove eq rule rules) next
16800
90eff1b52428 improved Net interface;
wenzelm
parents: 16512
diff changeset
    58
    (Net.delete_term (eq o pairself #2) (index rule, (0, rule)) net);
8298
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    59
12385
389d11fb62c8 removed unused functionality (weight etc.);
wenzelm
parents: 12290
diff changeset
    60
fun insert rule rs = add rule (delete rule rs);    (*ensure that new rule gets precedence*)
8298
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    61
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    62
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    63
(* intro/elim rules *)
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    64
22360
26ead7ed4f4b moved eq_thm etc. to structure Thm in Pure/more_thm.ML;
wenzelm
parents: 18921
diff changeset
    65
val intro = init Thm.eq_thm_prop Thm.concl_of;
26ead7ed4f4b moved eq_thm etc. to structure Thm in Pure/more_thm.ML;
wenzelm
parents: 18921
diff changeset
    66
val elim = init Thm.eq_thm_prop Thm.major_prem_of;
8298
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    67
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    68
9b089bc07f69 added Isar/net_rules.ML;
wenzelm
parents:
diff changeset
    69
end;