931 local |
931 local |
932 |
932 |
933 fun union_digest (oracles1, thms1) (oracles2, thms2) = |
933 fun union_digest (oracles1, thms1) (oracles2, thms2) = |
934 (Proofterm.unions_oracles [oracles1, oracles2], Proofterm.unions_thms [thms1, thms2]); |
934 (Proofterm.unions_oracles [oracles1, oracles2], Proofterm.unions_thms [thms1, thms2]); |
935 |
935 |
936 fun thm_digest (Thm (Deriv {body = Proofterm.PBody {oracles, thms, ...}, ...}, _)) = |
936 fun thm_digest (Thm (Deriv {body = PBody {oracles, thms, ...}, ...}, _)) = |
937 (oracles, thms); |
937 (oracles, thms); |
938 |
938 |
939 fun constraint_digest ({theory = thy, typ, sort, ...}: constraint) = |
939 fun constraint_digest ({theory = thy, typ, sort, ...}: constraint) = |
940 Sorts.of_sort_derivation (Sign.classes_of thy) |
940 Sorts.of_sort_derivation (Sign.classes_of thy) |
941 {class_relation = fn _ => fn _ => fn (digest, c1) => fn c2 => |
941 {class_relation = fn _ => fn _ => fn (digest, c1) => fn c2 => |
961 if null bad_thys then () |
961 if null bad_thys then () |
962 else |
962 else |
963 raise THEORY ("solve_constraints: bad theories for theorem\n" ^ |
963 raise THEORY ("solve_constraints: bad theories for theorem\n" ^ |
964 Syntax.string_of_term_global thy (prop_of thm), thy :: bad_thys); |
964 Syntax.string_of_term_global thy (prop_of thm), thy :: bad_thys); |
965 |
965 |
966 val Deriv {promises, body = Proofterm.PBody {oracles, thms, proof}} = der; |
966 val Deriv {promises, body = PBody {oracles, thms, proof}} = der; |
967 val (oracles', thms') = (oracles, thms) |
967 val (oracles', thms') = (oracles, thms) |
968 |> fold (fold union_digest o constraint_digest) constraints; |
968 |> fold (fold union_digest o constraint_digest) constraints; |
969 val body' = Proofterm.PBody {oracles = oracles', thms = thms', proof = proof}; |
969 val body' = PBody {oracles = oracles', thms = thms', proof = proof}; |
970 in |
970 in |
971 Thm (Deriv {promises = promises, body = body'}, |
971 Thm (Deriv {promises = promises, body = body'}, |
972 {constraints = [], cert = cert, tags = tags, maxidx = maxidx, |
972 {constraints = [], cert = cert, tags = tags, maxidx = maxidx, |
973 shyps = shyps, hyps = hyps, tpairs = tpairs, prop = prop}) |
973 shyps = shyps, hyps = hyps, tpairs = tpairs, prop = prop}) |
974 end; |
974 end; |