src/Pure/Isar/context_rules.ML
changeset 13105 3d1e7a199bdc
parent 12805 3be853cf19cf
child 13372 18790d503fe0
equal deleted inserted replaced
13104:df7aac8543c9 13105:3d1e7a199bdc
   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;