formal comments (still dummy);
authorwenzelm
Tue, 25 May 1999 20:24:10 +0200
changeset 6729 b6e167580a32
parent 6728 b51b25db7bc6
child 6730 fa1f63249077
formal comments (still dummy);
src/HOL/Tools/datatype_package.ML
src/HOL/Tools/inductive_package.ML
src/HOL/Tools/primrec_package.ML
src/HOL/Tools/recdef_package.ML
src/HOL/Tools/record_package.ML
src/HOL/Tools/typedef_package.ML
src/Pure/axclass.ML
--- a/src/HOL/Tools/datatype_package.ML	Tue May 25 20:23:30 1999 +0200
+++ b/src/HOL/Tools/datatype_package.ML	Tue May 25 20:24:10 1999 +0200
@@ -670,7 +670,7 @@
 
 val datatype_decl =
   Scan.option (P.$$$ "(" |-- P.name --| P.$$$ ")") -- P.type_args -- P.name -- P.opt_infix --
-    (P.$$$ "=" |-- P.enum1 "|" (P.name -- Scan.repeat P.typ -- P.opt_mixfix));
+    (P.$$$ "=" |-- P.enum1 "|" (P.name -- Scan.repeat P.typ -- P.opt_mixfix --| P.marg_comment));
 
 fun mk_datatype args =
   let
--- a/src/HOL/Tools/inductive_package.ML	Tue May 25 20:23:30 1999 +0200
+++ b/src/HOL/Tools/inductive_package.ML	Tue May 25 20:24:10 1999 +0200
@@ -710,10 +710,11 @@
   #1 o add_inductive true coind sets atts (map P.triple_swap intrs) monos con_defs;
 
 fun ind_decl coind =
-  Scan.repeat1 P.term --
-  (P.$$$ "intrs" |-- P.!!! (P.opt_attribs -- Scan.repeat1 (P.opt_thm_name ":" -- P.term))) --
-  Scan.optional (P.$$$ "monos" |-- P.!!! P.xthms1) [] --
-  Scan.optional (P.$$$ "con_defs" |-- P.!!! P.xthms1) []
+  (Scan.repeat1 P.term --| P.marg_comment) --
+  (P.$$$ "intrs" |--
+    P.!!! (P.opt_attribs -- Scan.repeat1 (P.opt_thm_name ":" -- P.term --| P.marg_comment))) --
+  Scan.optional (P.$$$ "monos" |-- P.!!! P.xthms1 --| P.marg_comment) [] --
+  Scan.optional (P.$$$ "con_defs" |-- P.!!! P.xthms1 --| P.marg_comment) []
   >> (Toplevel.theory o mk_ind coind);
 
 val inductiveP =
--- a/src/HOL/Tools/primrec_package.ML	Tue May 25 20:23:30 1999 +0200
+++ b/src/HOL/Tools/primrec_package.ML	Tue May 25 20:24:10 1999 +0200
@@ -265,7 +265,7 @@
 
 val primrec_decl =
   Scan.optional (P.$$$ "(" |-- P.name --| P.$$$ ")") "" --
-    Scan.repeat1 (P.opt_thm_name ":" -- P.term);
+    Scan.repeat1 (P.opt_thm_name ":" -- P.term --| P.marg_comment);
 
 val primrecP =
   OuterSyntax.command "primrec" "define primitive recursive functions on datatypes" K.thy_decl
--- a/src/HOL/Tools/recdef_package.ML	Tue May 25 20:23:30 1999 +0200
+++ b/src/HOL/Tools/recdef_package.ML	Tue May 25 20:24:10 1999 +0200
@@ -139,7 +139,7 @@
 local structure P = OuterParse and K = OuterSyntax.Keyword in
 
 val recdef_decl =
-  P.name -- P.term -- Scan.repeat1 P.term --
+  P.name -- P.term -- Scan.repeat1 (P.term --| P.marg_comment) --
   Scan.optional (P.$$$ "(" |-- P.$$$ "congs" |-- P.!!! (P.xthms1 --| P.$$$ ")")) [] --
   Scan.option (P.$$$ "(" |-- P.$$$ "simpset" |-- P.!!! (P.name --| P.$$$ ")"))
   >> (fn ((((f, R), eqs), congs), ss) => #1 o add_recdef_x f R eqs ss congs);
--- a/src/HOL/Tools/record_package.ML	Tue May 25 20:23:30 1999 +0200
+++ b/src/HOL/Tools/record_package.ML	Tue May 25 20:24:10 1999 +0200
@@ -882,7 +882,7 @@
 
 val record_decl =
   P.type_args -- P.name -- (P.$$$ "=" |-- Scan.option (P.typ --| P.$$$ "+")
-    -- Scan.repeat1 (P.name -- (P.$$$ "::" |-- P.typ)));
+    -- Scan.repeat1 (P.name -- (P.$$$ "::" |-- P.typ) --| P.marg_comment));
 
 val recordP =
   OuterSyntax.command "record" "define extensible record" K.thy_decl
--- a/src/HOL/Tools/typedef_package.ML	Tue May 25 20:23:30 1999 +0200
+++ b/src/HOL/Tools/typedef_package.ML	Tue May 25 20:24:10 1999 +0200
@@ -15,9 +15,9 @@
     term -> string list -> thm list -> tactic option -> theory -> theory
   val add_typedef_i_no_def: string -> bstring * string list * mixfix ->
     term -> string list -> thm list -> tactic option -> theory -> theory
-  val typedef_proof: string -> bstring * string list * mixfix -> string
+  val typedef_proof: (string * (bstring * string list * mixfix) * string) * Comment.text
     -> bool -> theory -> ProofHistory.T
-  val typedef_proof_i: string -> bstring * string list * mixfix -> term
+  val typedef_proof_i: (string * (bstring * string list * mixfix) * term) * Comment.text
     -> bool -> theory -> ProofHistory.T
 end;
 
@@ -189,13 +189,13 @@
 fun typedef_attribute cset do_typedef (thy, thm) =
   (check_nonempty cset thm; (thy |> do_typedef, thm));
 
-fun gen_typedef_proof prep_term name typ set int thy =
+fun gen_typedef_proof prep_term ((name, typ, set), comment) int thy =
   let
     val (cset, do_typedef) = prepare_typedef prep_term false name typ set thy;
     val goal = Thm.term_of (goal_nonempty cset);
   in
     thy
-    |> IsarThy.theorem_i "" [typedef_attribute cset do_typedef] (goal, []) int
+    |> IsarThy.theorem_i (("", [typedef_attribute cset do_typedef], (goal, [])), comment) int
   end;
 
 val typedef_proof = gen_typedef_proof read_term;
@@ -209,16 +209,16 @@
 
 val typedeclP =
   OuterSyntax.command "typedecl" "HOL type declaration" K.thy_decl
-    (P.type_args -- P.name -- P.opt_mixfix >> (fn ((vs, t), mx) =>
+    (P.type_args -- P.name -- P.opt_mixfix --| P.marg_comment >> (fn ((vs, t), mx) =>
       Toplevel.theory (add_typedecls [(t, vs, mx)])));
 
 
 val typedef_proof_decl =
   Scan.option (P.$$$ "(" |-- P.name --| P.$$$ ")") --
-    (P.type_args -- P.name) -- P.opt_infix -- (P.$$$ "=" |-- P.term);
+    (P.type_args -- P.name) -- P.opt_infix -- (P.$$$ "=" |-- P.term) -- P.marg_comment;
 
-fun mk_typedef_proof (((opt_name, (vs, t)), mx), A) =
-  typedef_proof (if_none opt_name (Syntax.type_name t mx)) (t, vs, mx) A;
+fun mk_typedef_proof ((((opt_name, (vs, t)), mx), A), comment) =
+  typedef_proof ((if_none opt_name (Syntax.type_name t mx), (t, vs, mx), A), comment);
 
 val typedefP =
   OuterSyntax.command "typedef" "HOL type definition (requires non-emptiness proof)" K.thy_goal
--- a/src/Pure/axclass.ML	Tue May 25 20:23:30 1999 +0200
+++ b/src/Pure/axclass.ML	Tue May 25 20:24:10 1999 +0200
@@ -30,10 +30,12 @@
     -> tactic option -> thm
   val goal_subclass: theory -> xclass * xclass -> thm list
   val goal_arity: theory -> xstring * xsort list * xclass -> thm list
-  val instance_subclass_proof: xclass * xclass -> bool -> theory -> ProofHistory.T
-  val instance_subclass_proof_i: class * class -> bool -> theory -> ProofHistory.T
-  val instance_arity_proof: xstring * xsort list * xclass -> bool -> theory -> ProofHistory.T
-  val instance_arity_proof_i: string * sort list * class -> bool -> theory -> ProofHistory.T
+  val instance_subclass_proof: (xclass * xclass) * Comment.text -> bool -> theory -> ProofHistory.T
+  val instance_subclass_proof_i: (class * class) * Comment.text -> bool -> theory -> ProofHistory.T
+  val instance_arity_proof: (xstring * xsort list * xclass) * Comment.text
+    -> bool -> theory -> ProofHistory.T
+  val instance_arity_proof_i: (string * sort list * class) * Comment.text
+    -> bool -> theory -> ProofHistory.T
   val setup: (theory -> theory) list
 end;
 
@@ -403,10 +405,10 @@
 
 fun inst_attribute add_thms (thy, thm) = (add_thms [thm] thy, thm);
 
-fun inst_proof mk_prop add_thms sig_prop int thy =
+fun inst_proof mk_prop add_thms (sig_prop, comment) int thy =
   thy
-  |> IsarThy.theorem_i "" [inst_attribute add_thms]
-    (mk_prop (Theory.sign_of thy) sig_prop, []) int;
+  |> IsarThy.theorem_i (("", [inst_attribute add_thms],
+    (mk_prop (Theory.sign_of thy) sig_prop, [])), comment) int;
 
 val instance_subclass_proof = inst_proof (mk_classrel oo intrn_classrel) add_classrel_thms;
 val instance_subclass_proof_i = inst_proof (K mk_classrel) add_classrel_thms;
@@ -430,13 +432,15 @@
 
 val axclassP =
   OuterSyntax.command "axclass" "define axiomatic type class" K.thy_decl
-    (P.name -- Scan.optional (P.$$$ "<" |-- P.!!! (P.list1 P.xname)) [] -- Scan.repeat P.spec_name
+    (((P.name -- Scan.optional (P.$$$ "<" |-- P.!!! (P.list1 P.xname)) []) --| P.marg_comment)
+      -- Scan.repeat (P.spec_name --| P.marg_comment)
       >> (fn (cls, axs) => Toplevel.theory (#1 o add_axclass cls axs)));
 
 val instanceP =
   OuterSyntax.command "instance" "prove type arity or subclass relation" K.thy_goal
-    ((P.xname -- (P.$$$ "<" |-- P.xname) >> instance_subclass_proof ||
-      P.xname -- (P.$$$ "::" |-- P.simple_arity) >> (instance_arity_proof o P.triple2))
+    ((P.xname -- (P.$$$ "<" |-- P.xname) -- P.marg_comment >> instance_subclass_proof ||
+      (P.xname -- (P.$$$ "::" |-- P.simple_arity) >> P.triple2) -- P.marg_comment
+        >> instance_arity_proof)
       >> (Toplevel.print oo Toplevel.theory_to_proof));
 
 val _ = OuterSyntax.add_parsers [axclassP, instanceP];