beware of duplicate fact names
authorblanchet
Thu, 24 Jul 2014 18:46:38 +0200
changeset 59000f55c173a3cbc
parent 58999 6840b23da81d
child 59001 b246943b3aa3
beware of duplicate fact names
src/HOL/Tools/Sledgehammer/sledgehammer_mash.ML
     1.1 --- a/src/HOL/Tools/Sledgehammer/sledgehammer_mash.ML	Thu Jul 24 18:46:38 2014 +0200
     1.2 +++ b/src/HOL/Tools/Sledgehammer/sledgehammer_mash.ML	Thu Jul 24 18:46:38 2014 +0200
     1.3 @@ -555,7 +555,7 @@
     1.4    ((Graph.new_node (name, (kind, feats, deps)) access_G
     1.5      handle Graph.DUP _ => Graph.map_node name (K (kind, feats, deps)) access_G)
     1.6     |> fold (add_edge_to name) parents,
     1.7 -  (add_to_xtab name fact_xtab, fold maybe_add_to_xtab feats feat_xtab),
     1.8 +  (maybe_add_to_xtab name fact_xtab, fold maybe_add_to_xtab feats feat_xtab),
     1.9    (name, feats, deps) :: learns)
    1.10  
    1.11  fun try_graph ctxt when def f =
    1.12 @@ -1221,7 +1221,7 @@
    1.13      val (parents, access_G) = ([], access_G) |> fold maybe_learn_from parents
    1.14      val (deps, _) = ([], access_G) |> fold maybe_learn_from deps
    1.15  
    1.16 -    val fact_xtab = add_to_xtab name fact_xtab
    1.17 +    val fact_xtab = maybe_add_to_xtab name fact_xtab
    1.18      val feat_xtab = fold maybe_add_to_xtab feats feat_xtab
    1.19    in
    1.20      ((name, parents, feats, deps), (access_G, (fact_xtab, feat_xtab)))
    1.21 @@ -1331,13 +1331,13 @@
    1.22              let
    1.23                val was_empty = Graph.is_empty access_G
    1.24  
    1.25 -              val (learns, (access_G, xtabs)) =
    1.26 +              val (learns, (access_G', xtabs')) =
    1.27                  fold_map (learn_wrt_access_graph ctxt) learns (access_G, xtabs)
    1.28 -              val (relearns, access_G) =
    1.29 -                fold_map (relearn_wrt_access_graph ctxt) relearns access_G
    1.30 +              val (relearns, access_G'') =
    1.31 +                fold_map (relearn_wrt_access_graph ctxt) relearns access_G'
    1.32  
    1.33 -              val access_G = access_G |> fold flop_wrt_access_graph flops
    1.34 -              val dirty_facts =
    1.35 +              val access_G''' = access_G'' |> fold flop_wrt_access_graph flops
    1.36 +              val dirty_facts' =
    1.37                  (case (was_empty, dirty_facts) of
    1.38                    (false, SOME names) => SOME (map #1 learns @ map #1 relearns @ names)
    1.39                  | _ => NONE)
    1.40 @@ -1345,13 +1345,13 @@
    1.41                val (ffds', freqs') =
    1.42                  if null relearns then
    1.43                    recompute_ffds_freqs_from_learns
    1.44 -                    (map (fn (name, _, feats, deps) => (name, feats, deps)) learns) xtabs num_facts0
    1.45 +                    (map (fn (name, _, feats, deps) => (name, feats, deps)) learns) xtabs' num_facts0
    1.46                      ffds freqs
    1.47                  else
    1.48 -                  recompute_ffds_freqs_from_access_G access_G xtabs
    1.49 +                  recompute_ffds_freqs_from_access_G access_G''' xtabs'
    1.50              in
    1.51 -              {access_G = access_G, xtabs = xtabs, ffds = ffds', freqs = freqs',
    1.52 -               dirty_facts = dirty_facts}
    1.53 +              {access_G = access_G''', xtabs = xtabs', ffds = ffds', freqs = freqs',
    1.54 +               dirty_facts = dirty_facts'}
    1.55              end
    1.56  
    1.57          fun commit last learns relearns flops =
    1.58 @@ -1585,7 +1585,8 @@
    1.59      in
    1.60        (case (fact_filter, mess) of
    1.61          (NONE, [(_, (mepo, _)), (_, (mash, _))]) =>
    1.62 -        [(meshN, mesh), (mepoN, mepo |> map fst |> add_and_take),
    1.63 +        [(meshN, mesh),
    1.64 +         (mepoN, mepo |> map fst |> add_and_take),
    1.65           (mashN, mash |> map fst |> add_and_take)]
    1.66        | _ => [(effective_fact_filter, mesh)])
    1.67      end