1099 case these (Symtab.lookup ((the_types o the_exec) thy) tyco) |
1099 case these (Symtab.lookup ((the_types o the_exec) thy) tyco) |
1100 of (_, (_, Constructors cos)) :: _ => (map fst cos, NONE) |
1100 of (_, (_, Constructors cos)) :: _ => (map fst cos, NONE) |
1101 | (_, (_, Abstractor (_, (co, _)))) :: _ => ([], SOME co) |
1101 | (_, (_, Abstractor (_, (co, _)))) :: _ => ([], SOME co) |
1102 | [] => ([], NONE) |
1102 | [] => ([], NONE) |
1103 val outdated_funs = case some_old_proj |
1103 val outdated_funs = case some_old_proj |
1104 of NONE => [] |
1104 of NONE => old_constrs |
1105 | SOME old_proj => Symtab.fold |
1105 | SOME old_proj => Symtab.fold |
1106 (fn (c, ((_, spec), _)) => if member (op =) (the_list (associated_abstype spec)) tyco |
1106 (fn (c, ((_, spec), _)) => if member (op =) (the_list (associated_abstype spec)) tyco |
1107 then insert (op =) c else I) |
1107 then insert (op =) c else I) |
1108 ((the_functions o the_exec) thy) [old_proj]; |
1108 ((the_functions o the_exec) thy) (old_proj :: old_constrs); |
1109 fun drop_outdated_cases cases = fold Symtab.delete_safe |
1109 fun drop_outdated_cases cases = fold Symtab.delete_safe |
1110 (Symtab.fold (fn (c, (_, (_, cos))) => |
1110 (Symtab.fold (fn (c, (_, (_, cos))) => |
1111 if exists (member (op =) old_constrs) cos |
1111 if exists (member (op =) old_constrs) cos |
1112 then insert (op =) c else I) cases []) cases; |
1112 then insert (op =) c else I) cases []) cases; |
1113 in |
1113 in |
1149 fun add_abstype proto_abs proto_rep thy = |
1149 fun add_abstype proto_abs proto_rep thy = |
1150 let |
1150 let |
1151 val (abs, rep) = pairself (unoverload_const_typ thy) (proto_abs, proto_rep); |
1151 val (abs, rep) = pairself (unoverload_const_typ thy) (proto_abs, proto_rep); |
1152 val (tyco, (vs, (abs_ty as (abs, ty), (rep, cert_prop)))) = abstype_cert thy abs (fst rep); |
1152 val (tyco, (vs, (abs_ty as (abs, ty), (rep, cert_prop)))) = abstype_cert thy abs (fst rep); |
1153 fun after_qed [[cert]] = ProofContext.theory |
1153 fun after_qed [[cert]] = ProofContext.theory |
1154 (register_type (tyco, (vs, Abstractor (abs_ty, (rep, cert)))) |
1154 (del_eqns abs |
|
1155 #> register_type (tyco, (vs, Abstractor (abs_ty, (rep, cert)))) |
1155 #> change_fun_spec false rep ((K o Proj) |
1156 #> change_fun_spec false rep ((K o Proj) |
1156 (map_types Logic.varifyT (mk_proj tyco vs ty abs rep), tyco)) |
1157 (map_types Logic.varifyT (mk_proj tyco vs ty abs rep), tyco)) |
1157 #> Abstype_Interpretation.data (tyco, serial ())); |
1158 #> Abstype_Interpretation.data (tyco, serial ())); |
1158 in |
1159 in |
1159 thy |
1160 thy |