Mercurial > urweb

comparison src/cjr_print.sml @ 274:e4baf03a3a64

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Generating SQL files
author Adam Chlipala <adamc@hcoop.net>
date Tue, 02 Sep 2008 13:44:54 -0400
parents 09c66a30ef32
children 73456bfde988
comparison
equal deleted inserted replaced
273:09c66a30ef32 274:e4baf03a3a64
1236 newline, 1236 newline,
1237 string "}", 1237 string "}",
1238 newline] 1238 newline]
1239 end 1239 end
1240 1240
1241 fun p_sqltype env (tAll as (t, loc)) =
1242 let
1243 val s = case t of
1244 TFfi ("Basis", "int") => "int8"
1245 | TFfi ("Basis", "float") => "float8"
1246 | TFfi ("Basis", "string") => "text"
1247 | TFfi ("Basis", "bool") => "bool"
1248 | _ => (ErrorMsg.errorAt loc "Don't know SQL equivalent of type";
1249 Print.eprefaces' [("Type", p_typ env tAll)];
1250 "ERROR")
1251 in
1252 string s
1253 end
1254
1255 fun p_sql env (ds, _) =
1256 let
1257 val (pps, _) = ListUtil.foldlMap
1258 (fn (dAll as (d, _), env) =>
1259 let
1260 val pp = case d of
1261 DTable (s, xts) =>
1262 box [string "CREATE TABLE ",
1263 string s,
1264 string "(",
1265 p_list (fn (x, t) =>
1266 box [string "lw_",
1267 string x,
1268 space,
1269 string ":",
1270 space,
1271 p_sqltype env t,
1272 space,
1273 string "NOT",
1274 space,
1275 string "NULL"]) xts,
1276 string ");",
1277 newline,
1278 newline]
1279 | _ => box []
1280 in
1281 (pp, E.declBinds env dAll)
1282 end)
1283 env ds
1284 in
1285 box pps
1286 end
1287
1241 end 1288 end