diff options
author | Adam Chlipala <adamc@hcoop.net> | 2008-09-02 13:44:54 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2008-09-02 13:44:54 -0400 |
commit | 3b770e100b11cbcfc19af6f810962975e9221d9f (patch) | |
tree | 118fc415c7d76078537557985afc4ed1d878918b /src/cjr_print.sml | |
parent | 4d83cf46590e7c48581612fd9fe6218b896b89b8 (diff) |
Generating SQL files
Diffstat (limited to 'src/cjr_print.sml')
-rw-r--r-- | src/cjr_print.sml | 47 |
1 files changed, 47 insertions, 0 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml index de8f21fc..ff2cada1 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -1238,4 +1238,51 @@ fun p_file env (ds, ps) = 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 |