src/HOL/Tools/typedef_package.ML
changeset 13443 1c3327c348b3
parent 13413 0b60b9e18a26
child 14570 0bf4e84bf51d
equal deleted inserted replaced
13442:70479ec9f44f 13443:1c3327c348b3
    20   val add_typedef_i: bool -> string option -> bstring * string list * mixfix ->
    20   val add_typedef_i: bool -> string option -> bstring * string list * mixfix ->
    21     term -> (bstring * bstring) option -> tactic -> theory -> theory *
    21     term -> (bstring * bstring) option -> tactic -> theory -> theory *
    22     {type_definition: thm, set_def: thm option, Rep: thm, Rep_inverse: thm,
    22     {type_definition: thm, set_def: thm option, Rep: thm, Rep_inverse: thm,
    23       Abs_inverse: thm, Rep_inject: thm, Abs_inject: thm, Rep_cases: thm, Abs_cases: thm,
    23       Abs_inverse: thm, Rep_inject: thm, Abs_inject: thm, Rep_cases: thm, Abs_cases: thm,
    24       Rep_induct: thm, Abs_induct: thm}
    24       Rep_induct: thm, Abs_induct: thm}
    25   val typedef_proof: string * (bstring * string list * mixfix) * string * (string * string) option
    25   val typedef_proof: (bool * string) * (bstring * string list * mixfix) * string
    26     -> bool -> theory -> ProofHistory.T
    26     * (string * string) option -> bool -> theory -> ProofHistory.T
    27   val typedef_proof_i: string * (bstring * string list * mixfix) * term * (string * string) option
    27   val typedef_proof_i: (bool * string) * (bstring * string list * mixfix) * term
    28     -> bool -> theory -> ProofHistory.T
    28     * (string * string) option -> bool -> theory -> ProofHistory.T
    29 end;
    29 end;
    30 
    30 
    31 structure TypedefPackage: TYPEDEF_PACKAGE =
    31 structure TypedefPackage: TYPEDEF_PACKAGE =
    32 struct
    32 struct
    33 
    33 
   236 val add_typedef_i = sane_typedef cert_term;
   236 val add_typedef_i = sane_typedef cert_term;
   237 
   237 
   238 
   238 
   239 (* typedef_proof interface *)
   239 (* typedef_proof interface *)
   240 
   240 
   241 fun gen_typedef_proof prep_term (name, typ, set, opt_morphs) int thy =
   241 fun gen_typedef_proof prep_term ((def, name), typ, set, opt_morphs) int thy =
   242   let
   242   let
   243     val (_, goal, goal_pat, att_result) =
   243     val (_, goal, goal_pat, att_result) =
   244       prepare_typedef prep_term true name typ set opt_morphs thy;
   244       prepare_typedef prep_term def name typ set opt_morphs thy;
   245     val att = #1 o att_result;
   245     val att = #1 o att_result;
   246   in thy |> IsarThy.theorem_i Drule.internalK (("", [att]), (goal, ([goal_pat], []))) int end;
   246   in thy |> IsarThy.theorem_i Drule.internalK (("", [att]), (goal, ([goal_pat], []))) int end;
   247 
   247 
   248 val typedef_proof = gen_typedef_proof read_term;
   248 val typedef_proof = gen_typedef_proof read_term;
   249 val typedef_proof_i = gen_typedef_proof cert_term;
   249 val typedef_proof_i = gen_typedef_proof cert_term;
   259     (P.type_args -- P.name -- P.opt_infix >> (fn ((vs, t), mx) =>
   259     (P.type_args -- P.name -- P.opt_infix >> (fn ((vs, t), mx) =>
   260       Toplevel.theory (add_typedecls [(t, vs, mx)])));
   260       Toplevel.theory (add_typedecls [(t, vs, mx)])));
   261 
   261 
   262 
   262 
   263 val typedef_proof_decl =
   263 val typedef_proof_decl =
   264   Scan.option (P.$$$ "(" |-- P.name --| P.$$$ ")") --
   264   Scan.optional (P.$$$ "(" |-- P.!!!
       
   265       (((P.$$$ "open" >> K false) -- Scan.option P.name || P.name >> (fn s => (true, Some s)))
       
   266         --| P.$$$ ")")) (true, None) --
   265     (P.type_args -- P.name) -- P.opt_infix -- (P.$$$ "=" |-- P.term) --
   267     (P.type_args -- P.name) -- P.opt_infix -- (P.$$$ "=" |-- P.term) --
   266     Scan.option (P.$$$ "morphisms" |-- P.!!! (P.name -- P.name));
   268     Scan.option (P.$$$ "morphisms" |-- P.!!! (P.name -- P.name));
   267 
   269 
   268 fun mk_typedef_proof ((((opt_name, (vs, t)), mx), A), morphs) =
   270 fun mk_typedef_proof ((((((def, opt_name), (vs, t)), mx), A), morphs)) =
   269   typedef_proof (if_none opt_name (Syntax.type_name t mx), (t, vs, mx), A, morphs);
   271   typedef_proof ((def, if_none opt_name (Syntax.type_name t mx)), (t, vs, mx), A, morphs);
   270 
   272 
   271 val typedefP =
   273 val typedefP =
   272   OuterSyntax.command "typedef" "HOL type definition (requires non-emptiness proof)" K.thy_goal
   274   OuterSyntax.command "typedef" "HOL type definition (requires non-emptiness proof)" K.thy_goal
   273     (typedef_proof_decl >> (Toplevel.print oo (Toplevel.theory_to_proof o mk_typedef_proof)));
   275     (typedef_proof_decl >> (Toplevel.print oo (Toplevel.theory_to_proof o mk_typedef_proof)));
   274 
   276