slightly saner way of parsing the quotient_def
authorChristian Urban <urbanc@in.tum.de>
Mon, 02 Nov 2009 18:16:19 +0100
changeset 263 a159ba20979e
parent 262 9279f95e574a
child 264 d0581fbc096c
slightly saner way of parsing the quotient_def
IntEx.thy
QuotMain.thy
--- a/IntEx.thy	Mon Nov 02 15:39:25 2009 +0100
+++ b/IntEx.thy	Mon Nov 02 18:16:19 2009 +0100
@@ -41,6 +41,14 @@
 term PLUS
 thm PLUS_def
 
+definition
+  "MPLUS x y \<equiv> my_plus x y"
+
+term MPLUS
+thm MPLUS_def
+thm MPLUS_def_raw
+
+
 fun
   my_neg :: "(nat \<times> nat) \<Rightarrow> (nat \<times> nat)"
 where
--- a/QuotMain.thy	Mon Nov 02 15:39:25 2009 +0100
+++ b/QuotMain.thy	Mon Nov 02 18:16:19 2009 +0100
@@ -321,31 +321,40 @@
 end
 *}
 
+
 ML {*
-val qd_parser = 
-  (Args.parens (OuterParse.$$$ "for" |-- (Scan.repeat OuterParse.typ))) --
-    (SpecParse.constdecl -- (SpecParse.opt_thm_name ":" -- OuterParse.prop))
+fun quotdef_cmd qenv ((bind, qty_, mx), (attr, prop)) lthy =
+let    
+  val (lhs_, rhs) = Logic.dest_equals prop
+in
+  make_const_def bind rhs mx qenv lthy
+end
 *}
 
 ML {*
-fun parse_qd_spec (qtystrs, ((bind, tystr, mx), (attr__, propstr))) lthy = 
+val quotdef_parser = 
+  Scan.option (Args.parens (OuterParse.$$$ "for" |-- (Scan.repeat OuterParse.typ))) --
+    (SpecParse.constdecl -- (SpecParse.opt_thm_name ":" -- 
+       OuterParse.prop)) >> OuterParse.triple2
+*}
+
+ML {*
+fun quotdef (qtystrs, (bind, tystr, mx), (attr, propstr)) lthy = 
 let
-  val qtys = map (Syntax.check_typ lthy o Syntax.parse_typ lthy) qtystrs
+  val qtys = map (Syntax.check_typ lthy o Syntax.parse_typ lthy) (the qtystrs)
   val qenv = build_qenv lthy qtys
-  val qty = Syntax.parse_typ lthy (the tystr) |> Syntax.check_typ lthy
+  val qty  = Option.map (Syntax.check_typ lthy o Syntax.parse_typ lthy) tystr
   val prop = Syntax.parse_prop lthy propstr |> Syntax.check_prop lthy
-  val (lhs, rhs) = Logic.dest_equals prop
 in
-  make_const_def bind rhs mx qenv lthy |> snd
+  quotdef_cmd qenv ((bind, qty, mx), (attr, prop)) lthy |> snd
 end
 *}
 
 ML {*
 val _ = OuterSyntax.local_theory "quotient_def" "lifted definition of constants"
-  OuterKeyword.thy_decl (qd_parser >> parse_qd_spec)
+  OuterKeyword.thy_decl (quotdef_parser >> quotdef)
 *}
 
-
 section {* ATOMIZE *}
 
 text {*