Mercurial > urweb
diff src/cjr_print.sml @ 809:81fce435e255
Mutual datatypes through Cjrize
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sat, 16 May 2009 16:02:17 -0400 |
| parents | 10fe57e4a8c2 |
| children | 2fbd1ac2f04b |
line wrap: on
line diff
--- a/src/cjr_print.sml Sat May 16 15:55:15 2009 -0400 +++ b/src/cjr_print.sml Sat May 16 16:02:17 2009 -0400 @@ -2037,63 +2037,72 @@ newline]) xts, string "};"] end - | DDatatype (Enum, x, n, xncs) => - box [string "enum", - space, - string ("__uwe_" ^ ident x ^ "_" ^ Int.toString n), - space, - string "{", - space, - p_list_sep (box [string ",", space]) (fn (x, n, _) => - string ("__uwc_" ^ ident x ^ "_" ^ Int.toString n)) xncs, - space, - string "};"] - | DDatatype (Option, _, _, _) => box [] - | DDatatype (Default, x, n, xncs) => + | DDatatype dts => let - val xncsArgs = List.mapPartial (fn (x, n, NONE) => NONE - | (x, n, SOME t) => SOME (x, n, t)) xncs + val dts = ListMergeSort.sort (fn ((dk1, _, _, _), (dk2, _, _, _)) => + dk1 = Enum andalso dk2 <> Enum) dts + + fun p_one (Enum, x, n, xncs) = + box [string "enum", + space, + string ("__uwe_" ^ ident x ^ "_" ^ Int.toString n), + space, + string "{", + space, + p_list_sep (box [string ",", space]) (fn (x, n, _) => + string ("__uwc_" ^ ident x ^ "_" ^ Int.toString n)) xncs, + space, + string "};"] + | p_one (Option, _, _, _) = box [] + | p_one (Default, x, n, xncs) = + let + val xncsArgs = List.mapPartial (fn (x, n, NONE) => NONE + | (x, n, SOME t) => SOME (x, n, t)) xncs + in + box [string "enum", + space, + string ("__uwe_" ^ ident x ^ "_" ^ Int.toString n), + space, + string "{", + space, + p_list_sep (box [string ",", space]) (fn (x, n, _) => + string ("__uwc_" ^ ident x ^ "_" ^ Int.toString n)) + xncs, + space, + string "};", + newline, + newline, + string "struct", + space, + string ("__uwd_" ^ ident x ^ "_" ^ Int.toString n), + space, + string "{", + newline, + string "enum", + space, + string ("__uwe_" ^ ident x ^ "_" ^ Int.toString n), + space, + string "tag;", + newline, + box (case xncsArgs of + [] => [] + | _ => [string "union", + space, + string "{", + newline, + p_list_sep newline (fn (x, n, t) => box [p_typ env t, + space, + string ("uw_" ^ ident x), + string ";"]) xncsArgs, + newline, + string "}", + space, + string "data;", + newline]), + string "};"] + end in - box [string "enum", - space, - string ("__uwe_" ^ ident x ^ "_" ^ Int.toString n), - space, - string "{", - space, - p_list_sep (box [string ",", space]) (fn (x, n, _) => - string ("__uwc_" ^ ident x ^ "_" ^ Int.toString n)) xncs, - space, - string "};", - newline, - newline, - string "struct", - space, - string ("__uwd_" ^ ident x ^ "_" ^ Int.toString n), - space, - string "{", - newline, - string "enum", - space, - string ("__uwe_" ^ ident x ^ "_" ^ Int.toString n), - space, - string "tag;", - newline, - box (case xncsArgs of - [] => [] - | _ => [string "union", - space, - string "{", - newline, - p_list_sep newline (fn (x, n, t) => box [p_typ env t, - space, - string ("uw_" ^ ident x), - string ";"]) xncsArgs, - newline, - string "}", - space, - string "data;", - newline]), - string "};"] + p_list_sep (box []) p_one dts end | DDatatypeForward _ => box []