Nominal/NewParser.thy
changeset 2424 621ebd8b13c4
parent 2411 dceaf2d9fedd
child 2425 715ab84065a0
--- a/Nominal/NewParser.thy	Thu Aug 19 18:24:36 2010 +0800
+++ b/Nominal/NewParser.thy	Sat Aug 21 16:20:10 2010 +0800
@@ -20,48 +20,7 @@
 
 *}
 
-
-ML {* 
-(* nominal datatype parser *)
-local
-  structure P = Parse;
-  structure S = Scan
-
-  fun triple1 ((x, y), z) = (x, y, z)
-  fun triple2 (x, (y, z)) = (x, y, z)
-  fun tuple ((x, y, z), u) = (x, y, z, u)
-  fun tswap (((x, y), z), u) = (x, y, u, z)
-in
-
-val _ = Keyword.keyword "bind"
-val _ = Keyword.keyword "bind_set"
-val _ = Keyword.keyword "bind_res"
-
-val anno_typ = S.option (P.name --| P.$$$ "::") -- P.typ
-
-val bind_mode = P.$$$ "bind" || P.$$$ "bind_set" || P.$$$ "bind_res"
-
-val bind_clauses = 
-  P.enum "," (bind_mode -- S.repeat1 P.term -- (P.$$$ "in" |-- S.repeat1 P.name) >> triple1)
-
-val cnstr_parser =
-  P.binding -- S.repeat anno_typ -- bind_clauses -- P.opt_mixfix >> tswap
-
-(* datatype parser *)
-val dt_parser =
-  (P.type_args -- P.binding -- P.opt_mixfix >> triple1) -- 
-    (P.$$$ "=" |-- P.enum1 "|" cnstr_parser) >> tuple
-
-(* binding function parser *)
-val bnfun_parser = 
-  S.optional (P.$$$ "binder" |-- P.fixes -- Parse_Spec.where_alt_specs) ([], [])
-
-(* main parser *)
-val main_parser =
-  P.and_list1 dt_parser -- bnfun_parser >> triple2
-
-end
-*}
+ML {* print_depth 50 *}
 
 ML {*
 fun get_cnstrs dts =
@@ -744,16 +703,12 @@
  
   fun prep_body env bn_str = index_lookup env bn_str
 
-  fun prep_mode "bind"     = Lst 
-    | prep_mode "bind_set" = Set 
-    | prep_mode "bind_res" = Res 
-
   fun prep_bclause env (mode, binders, bodies) = 
   let
     val binders' = map (prep_binder env) binders
     val bodies' = map (prep_body env) bodies
   in  
-    BC (prep_mode mode, binders', bodies')
+    BC (mode, binders', bodies')
   end
 
   fun prep_bclauses (annos, bclause_strs) = 
@@ -812,7 +767,51 @@
 in
   timeit (fn () => nominal_datatype2 dts bn_funs bn_eqs bclauses' lthy |> snd)
 end
+*}
 
+ML {* 
+(* nominal datatype parser *)
+local
+  structure P = Parse;
+  structure S = Scan
+
+  fun triple1 ((x, y), z) = (x, y, z)
+  fun triple2 (x, (y, z)) = (x, y, z)
+  fun tuple ((x, y, z), u) = (x, y, z, u)
+  fun tswap (((x, y), z), u) = (x, y, u, z)
+in
+
+val _ = Keyword.keyword "bind"
+val _ = Keyword.keyword "set"
+val _ = Keyword.keyword "res"
+val _ = Keyword.keyword "list"
+
+val anno_typ = S.option (P.name --| P.$$$ "::") -- P.typ
+
+val bind_mode = P.$$$ "bind" |--
+  S.optional (Args.parens 
+    (P.$$$ "list" >> K Lst || P.$$$ "set" >> K Set || P.$$$ "res" >> K Res)) Lst
+
+val bind_clauses = 
+  P.enum "," (bind_mode -- S.repeat1 P.term -- (P.$$$ "in" |-- S.repeat1 P.name) >> triple1)
+
+val cnstr_parser =
+  P.binding -- S.repeat anno_typ -- bind_clauses -- P.opt_mixfix >> tswap
+
+(* datatype parser *)
+val dt_parser =
+  (P.type_args -- P.binding -- P.opt_mixfix >> triple1) -- 
+    (P.$$$ "=" |-- P.enum1 "|" cnstr_parser) >> tuple
+
+(* binding function parser *)
+val bnfun_parser = 
+  S.optional (P.$$$ "binder" |-- P.fixes -- Parse_Spec.where_alt_specs) ([], [])
+
+(* main parser *)
+val main_parser =
+  P.and_list1 dt_parser -- bnfun_parser >> triple2
+
+end
 
 (* Command Keyword *)