Mercurial > urweb
diff src/cjr_print.sml @ 274:e4baf03a3a64
Generating SQL files
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 02 Sep 2008 13:44:54 -0400 |
parents | 09c66a30ef32 |
children | 73456bfde988 |
line wrap: on
line diff
--- a/src/cjr_print.sml Tue Sep 02 13:09:54 2008 -0400 +++ b/src/cjr_print.sml Tue Sep 02 13:44:54 2008 -0400 @@ -1238,4 +1238,51 @@ newline] end +fun p_sqltype env (tAll as (t, loc)) = + let + val s = case t of + TFfi ("Basis", "int") => "int8" + | TFfi ("Basis", "float") => "float8" + | TFfi ("Basis", "string") => "text" + | TFfi ("Basis", "bool") => "bool" + | _ => (ErrorMsg.errorAt loc "Don't know SQL equivalent of type"; + Print.eprefaces' [("Type", p_typ env tAll)]; + "ERROR") + in + string s + end + +fun p_sql env (ds, _) = + let + val (pps, _) = ListUtil.foldlMap + (fn (dAll as (d, _), env) => + let + val pp = case d of + DTable (s, xts) => + box [string "CREATE TABLE ", + string s, + string "(", + p_list (fn (x, t) => + box [string "lw_", + string x, + space, + string ":", + space, + p_sqltype env t, + space, + string "NOT", + space, + string "NULL"]) xts, + string ");", + newline, + newline] + | _ => box [] + in + (pp, E.declBinds env dAll) + end) + env ds + in + box pps + end + end