comparison 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
comparison
equal deleted inserted replaced
808:d8f58d488cfb 809:81fce435e255
2035 p_ident x, 2035 p_ident x,
2036 string ";", 2036 string ";",
2037 newline]) xts, 2037 newline]) xts,
2038 string "};"] 2038 string "};"]
2039 end 2039 end
2040 | DDatatype (Enum, x, n, xncs) => 2040 | DDatatype dts =>
2041 box [string "enum",
2042 space,
2043 string ("__uwe_" ^ ident x ^ "_" ^ Int.toString n),
2044 space,
2045 string "{",
2046 space,
2047 p_list_sep (box [string ",", space]) (fn (x, n, _) =>
2048 string ("__uwc_" ^ ident x ^ "_" ^ Int.toString n)) xncs,
2049 space,
2050 string "};"]
2051 | DDatatype (Option, _, _, _) => box []
2052 | DDatatype (Default, x, n, xncs) =>
2053 let 2041 let
2054 val xncsArgs = List.mapPartial (fn (x, n, NONE) => NONE 2042 val dts = ListMergeSort.sort (fn ((dk1, _, _, _), (dk2, _, _, _)) =>
2055 | (x, n, SOME t) => SOME (x, n, t)) xncs 2043 dk1 = Enum andalso dk2 <> Enum) dts
2044
2045 fun p_one (Enum, x, n, xncs) =
2046 box [string "enum",
2047 space,
2048 string ("__uwe_" ^ ident x ^ "_" ^ Int.toString n),
2049 space,
2050 string "{",
2051 space,
2052 p_list_sep (box [string ",", space]) (fn (x, n, _) =>
2053 string ("__uwc_" ^ ident x ^ "_" ^ Int.toString n)) xncs,
2054 space,
2055 string "};"]
2056 | p_one (Option, _, _, _) = box []
2057 | p_one (Default, x, n, xncs) =
2058 let
2059 val xncsArgs = List.mapPartial (fn (x, n, NONE) => NONE
2060 | (x, n, SOME t) => SOME (x, n, t)) xncs
2061 in
2062 box [string "enum",
2063 space,
2064 string ("__uwe_" ^ ident x ^ "_" ^ Int.toString n),
2065 space,
2066 string "{",
2067 space,
2068 p_list_sep (box [string ",", space]) (fn (x, n, _) =>
2069 string ("__uwc_" ^ ident x ^ "_" ^ Int.toString n))
2070 xncs,
2071 space,
2072 string "};",
2073 newline,
2074 newline,
2075 string "struct",
2076 space,
2077 string ("__uwd_" ^ ident x ^ "_" ^ Int.toString n),
2078 space,
2079 string "{",
2080 newline,
2081 string "enum",
2082 space,
2083 string ("__uwe_" ^ ident x ^ "_" ^ Int.toString n),
2084 space,
2085 string "tag;",
2086 newline,
2087 box (case xncsArgs of
2088 [] => []
2089 | _ => [string "union",
2090 space,
2091 string "{",
2092 newline,
2093 p_list_sep newline (fn (x, n, t) => box [p_typ env t,
2094 space,
2095 string ("uw_" ^ ident x),
2096 string ";"]) xncsArgs,
2097 newline,
2098 string "}",
2099 space,
2100 string "data;",
2101 newline]),
2102 string "};"]
2103 end
2056 in 2104 in
2057 box [string "enum", 2105 p_list_sep (box []) p_one dts
2058 space,
2059 string ("__uwe_" ^ ident x ^ "_" ^ Int.toString n),
2060 space,
2061 string "{",
2062 space,
2063 p_list_sep (box [string ",", space]) (fn (x, n, _) =>
2064 string ("__uwc_" ^ ident x ^ "_" ^ Int.toString n)) xncs,
2065 space,
2066 string "};",
2067 newline,
2068 newline,
2069 string "struct",
2070 space,
2071 string ("__uwd_" ^ ident x ^ "_" ^ Int.toString n),
2072 space,
2073 string "{",
2074 newline,
2075 string "enum",
2076 space,
2077 string ("__uwe_" ^ ident x ^ "_" ^ Int.toString n),
2078 space,
2079 string "tag;",
2080 newline,
2081 box (case xncsArgs of
2082 [] => []
2083 | _ => [string "union",
2084 space,
2085 string "{",
2086 newline,
2087 p_list_sep newline (fn (x, n, t) => box [p_typ env t,
2088 space,
2089 string ("uw_" ^ ident x),
2090 string ";"]) xncsArgs,
2091 newline,
2092 string "}",
2093 space,
2094 string "data;",
2095 newline]),
2096 string "};"]
2097 end 2106 end
2098 2107
2099 | DDatatypeForward _ => box [] 2108 | DDatatypeForward _ => box []
2100 2109
2101 | DVal (x, n, t, e) => 2110 | DVal (x, n, t, e) =>