101 (map_nth_elem i (curry insert_tagged_brl ((w, next), (b, th))) netpairs) wrappers |
101 (map_nth_elem i (curry insert_tagged_brl ((w, next), (b, th))) netpairs) wrappers |
102 end; |
102 end; |
103 |
103 |
104 fun del_rule th (rs as Rules {next, rules, netpairs, wrappers}) = |
104 fun del_rule th (rs as Rules {next, rules, netpairs, wrappers}) = |
105 let |
105 let |
106 fun eq_th (_, (_, th')) = Thm.eq_thm (th, th'); |
106 fun eq_th (_, (_, th')) = Drule.eq_thm_prop (th, th'); |
107 fun del b netpair = delete_tagged_brl ((b, th), netpair) handle Net.DELETE => netpair; |
107 fun del b netpair = delete_tagged_brl ((b, th), netpair) handle Net.DELETE => netpair; |
108 in |
108 in |
109 if not (exists eq_th rules) then rs |
109 if not (exists eq_th rules) then rs |
110 else make_rules next (filter_out eq_th rules) (map (del false o del true) netpairs) wrappers |
110 else make_rules next (filter_out eq_th rules) (map (del false o del true) netpairs) wrappers |
111 end; |
111 end; |
133 fun merge (Rules {rules = rules1, wrappers = (ws1, ws1'), ...}, |
133 fun merge (Rules {rules = rules1, wrappers = (ws1, ws1'), ...}, |
134 Rules {rules = rules2, wrappers = (ws2, ws2'), ...}) = |
134 Rules {rules = rules2, wrappers = (ws2, ws2'), ...}) = |
135 let |
135 let |
136 val wrappers = (gen_merge_lists' eq_snd ws1 ws2, gen_merge_lists' eq_snd ws1' ws2'); |
136 val wrappers = (gen_merge_lists' eq_snd ws1 ws2, gen_merge_lists' eq_snd ws1' ws2'); |
137 val rules = gen_merge_lists' (fn ((_, (k1, th1)), (_, (k2, th2))) => |
137 val rules = gen_merge_lists' (fn ((_, (k1, th1)), (_, (k2, th2))) => |
138 k1 = k2 andalso Thm.eq_thm (th1, th2)) rules1 rules2; |
138 k1 = k2 andalso Drule.eq_thm_prop (th1, th2)) rules1 rules2; |
139 val next = ~ (length rules); |
139 val next = ~ (length rules); |
140 val netpairs = foldl (fn (nps, (n, (w, ((i, b), th)))) => |
140 val netpairs = foldl (fn (nps, (n, (w, ((i, b), th)))) => |
141 map_nth_elem i (curry insert_tagged_brl ((w, n), (b, th))) nps) |
141 map_nth_elem i (curry insert_tagged_brl ((w, n), (b, th))) nps) |
142 (empty_netpairs, next upto ~1 ~~ rules); |
142 (empty_netpairs, next upto ~1 ~~ rules); |
143 in make_rules (next - 1) rules netpairs wrappers end; |
143 in make_rules (next - 1) rules netpairs wrappers end; |