--- 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 *)