src/Pure/axclass.ML
changeset 12876 a70df1e5bf10
parent 12694 9950c1ce9d24
child 14605 9de4d64eee3b
equal deleted inserted replaced
12875:bda60442bf02 12876:a70df1e5bf10
    24     -> thm list -> tactic option -> theory -> theory
    24     -> thm list -> tactic option -> theory -> theory
    25   val add_inst_arity: xstring * string list * string -> tactic -> theory -> theory
    25   val add_inst_arity: xstring * string list * string -> tactic -> theory -> theory
    26   val add_inst_arity_i: string * sort list * sort -> tactic -> theory -> theory
    26   val add_inst_arity_i: string * sort list * sort -> tactic -> theory -> theory
    27   val default_intro_classes_tac: thm list -> int -> tactic
    27   val default_intro_classes_tac: thm list -> int -> tactic
    28   val axclass_tac: thm list -> tactic
    28   val axclass_tac: thm list -> tactic
    29   val instance_subclass_proof: (xclass * xclass) * Comment.text -> bool -> theory -> ProofHistory.T
    29   val instance_subclass_proof: xclass * xclass -> bool -> theory -> ProofHistory.T
    30   val instance_subclass_proof_i: (class * class) * Comment.text -> bool -> theory -> ProofHistory.T
    30   val instance_subclass_proof_i: class * class -> bool -> theory -> ProofHistory.T
    31   val instance_arity_proof: (xstring * string list * xclass) * Comment.text
    31   val instance_arity_proof: xstring * string list * xclass -> bool -> theory -> ProofHistory.T
    32     -> bool -> theory -> ProofHistory.T
    32   val instance_arity_proof_i: string * sort list * class -> bool -> theory -> ProofHistory.T
    33   val instance_arity_proof_i: (string * sort list * class) * Comment.text
       
    34     -> bool -> theory -> ProofHistory.T
       
    35   val setup: (theory -> theory) list
    33   val setup: (theory -> theory) list
    36 end;
    34 end;
    37 
    35 
    38 structure AxClass : AX_CLASS =
    36 structure AxClass : AX_CLASS =
    39 struct
    37 struct
   419 
   417 
   420 (** instance proof interfaces **)
   418 (** instance proof interfaces **)
   421 
   419 
   422 fun inst_attribute add_thms (thy, thm) = (add_thms [thm] thy, thm);
   420 fun inst_attribute add_thms (thy, thm) = (add_thms [thm] thy, thm);
   423 
   421 
   424 fun inst_proof mk_prop add_thms (sig_prop, comment) int thy =
   422 fun inst_proof mk_prop add_thms sig_prop int thy =
   425   thy
   423   thy
   426   |> IsarThy.theorem_i Drule.internalK ((("", [inst_attribute add_thms]),
   424   |> IsarThy.theorem_i Drule.internalK (("", [inst_attribute add_thms]),
   427     (mk_prop (Theory.sign_of thy) sig_prop, ([], []))), comment) int;
   425     (mk_prop (Theory.sign_of thy) sig_prop, ([], []))) int;
   428 
   426 
   429 val instance_subclass_proof = inst_proof (mk_classrel oo read_classrel) add_classrel_thms;
   427 val instance_subclass_proof = inst_proof (mk_classrel oo read_classrel) add_classrel_thms;
   430 val instance_subclass_proof_i = inst_proof (mk_classrel oo cert_classrel) add_classrel_thms;
   428 val instance_subclass_proof_i = inst_proof (mk_classrel oo cert_classrel) add_classrel_thms;
   431 val instance_arity_proof = inst_proof (mk_arity oo read_simple_arity) add_arity_thms;
   429 val instance_arity_proof = inst_proof (mk_arity oo read_simple_arity) add_arity_thms;
   432 val instance_arity_proof_i = inst_proof (mk_arity oo cert_simple_arity) add_arity_thms;
   430 val instance_arity_proof_i = inst_proof (mk_arity oo cert_simple_arity) add_arity_thms;
   446 
   444 
   447 local structure P = OuterParse and K = OuterSyntax.Keyword in
   445 local structure P = OuterParse and K = OuterSyntax.Keyword in
   448 
   446 
   449 val axclassP =
   447 val axclassP =
   450   OuterSyntax.command "axclass" "define axiomatic type class" K.thy_decl
   448   OuterSyntax.command "axclass" "define axiomatic type class" K.thy_decl
   451     (((P.name -- Scan.optional ((P.$$$ "\\<subseteq>" || P.$$$ "<") |--
   449     ((P.name -- Scan.optional ((P.$$$ "\\<subseteq>" || P.$$$ "<") |--
   452         P.!!! (P.list1 P.xname)) []) --| P.marg_comment)
   450         P.!!! (P.list1 P.xname)) []) -- Scan.repeat P.spec_name
   453       -- Scan.repeat (P.spec_name --| P.marg_comment)
       
   454       >> (fn (cls, axs) => Toplevel.theory (#1 o add_axclass cls axs)));
   451       >> (fn (cls, axs) => Toplevel.theory (#1 o add_axclass cls axs)));
   455 
   452 
   456 val instanceP =
   453 val instanceP =
   457   OuterSyntax.command "instance" "prove type arity or subclass relation" K.thy_goal
   454   OuterSyntax.command "instance" "prove type arity or subclass relation" K.thy_goal
   458     ((P.xname -- ((P.$$$ "\\<subseteq>" || P.$$$ "<") |-- P.xname)
   455     ((P.xname -- ((P.$$$ "\\<subseteq>" || P.$$$ "<") |-- P.xname) >> instance_subclass_proof ||
   459         -- P.marg_comment >> instance_subclass_proof ||
   456       (P.xname -- (P.$$$ "::" |-- P.simple_arity) >> P.triple2) >> instance_arity_proof)
   460       (P.xname -- (P.$$$ "::" |-- P.simple_arity) >> P.triple2) -- P.marg_comment
       
   461         >> instance_arity_proof)
       
   462       >> (Toplevel.print oo Toplevel.theory_to_proof));
   457       >> (Toplevel.print oo Toplevel.theory_to_proof));
   463 
   458 
   464 val _ = OuterSyntax.add_parsers [axclassP, instanceP];
   459 val _ = OuterSyntax.add_parsers [axclassP, instanceP];
   465 
   460 
   466 end;
   461 end;