Mercurial > urweb

comparison src/cjr_print.sml @ 704:70cbdcf5989b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
UNIQUE constraints
author Adam Chlipala <adamc@hcoop.net>
date Tue, 07 Apr 2009 12:24:31 -0400
parents 655bcc9b77e0
children d8217b4cb617
comparison
equal deleted inserted replaced
703:a5d8b470d7ca 704:70cbdcf5989b
1433 1433
1434 val wontLeakStrings = notLeaky env true state 1434 val wontLeakStrings = notLeaky env true state
1435 val wontLeakAnything = notLeaky env false state 1435 val wontLeakAnything = notLeaky env false state
1436 in 1436 in
1437 box [if wontLeakAnything then 1437 box [if wontLeakAnything then
1438 string "uw_begin_region(ctx), " 1438 string "(uw_begin_region(ctx), "
1439 else 1439 else
1440 box [], 1440 box [],
1441 string "({", 1441 string "({",
1442 newline, 1442 newline,
1443 string "PGconn *conn = uw_get_db(ctx);", 1443 string "PGconn *conn = uw_get_db(ctx);",
1583 newline] 1583 newline]
1584 else 1584 else
1585 box [], 1585 box [],
1586 string "acc;", 1586 string "acc;",
1587 newline, 1587 newline,
1588 string "})"] 1588 string "})",
1589 if wontLeakAnything then
1590 string ")"
1591 else
1592 box []]
1589 end 1593 end
1590 1594
1591 | EDml {dml, prepared} => 1595 | EDml {dml, prepared} =>
1592 box [string "(uw_begin_region(ctx), ({", 1596 box [string "(uw_begin_region(ctx), ({",
1593 newline, 1597 newline,
1935 string ");"]) vis, 1939 string ");"]) vis,
1936 newline, 1940 newline,
1937 p_list_sep newline (p_fun env) vis, 1941 p_list_sep newline (p_fun env) vis,
1938 newline] 1942 newline]
1939 end 1943 end
1940 | DTable (x, _) => box [string "/* SQL table ", 1944 | DTable (x, _, csts) => box [string "/* SQL table ",
1941 string x, 1945 string x,
1942 string " */", 1946 space,
1943 newline] 1947 string "constraints",
1948 space,
1949 p_list (fn (x, v) => box [string x,
1950 space,
1951 string ":",
1952 space,
1953 string v]) csts,
1954 space,
1955 string " */",
1956 newline]
1944 | DSequence x => box [string "/* SQL sequence ", 1957 | DSequence x => box [string "/* SQL sequence ",
1945 string x, 1958 string x,
1946 string " */", 1959 string " */",
1947 newline] 1960 newline]
1948 | DDatabase {name, expunge, initialize} => 1961 | DDatabase {name, expunge, initialize} =>
2452 ] 2465 ]
2453 end 2466 end
2454 2467
2455 val pds' = map p_page ps 2468 val pds' = map p_page ps
2456 2469
2457 val tables = List.mapPartial (fn (DTable (s, xts), _) => SOME (s, xts) 2470 val tables = List.mapPartial (fn (DTable (s, xts, _), _) => SOME (s, xts)
2458 | _ => NONE) ds 2471 | _ => NONE) ds
2459 val sequences = List.mapPartial (fn (DSequence s, _) => SOME s 2472 val sequences = List.mapPartial (fn (DSequence s, _) => SOME s
2460 | _ => NONE) ds 2473 | _ => NONE) ds
2461 2474
2462 val validate = 2475 val validate =
2796 let 2809 let
2797 val (pps, _) = ListUtil.foldlMap 2810 val (pps, _) = ListUtil.foldlMap
2798 (fn (dAll as (d, _), env) => 2811 (fn (dAll as (d, _), env) =>
2799 let 2812 let
2800 val pp = case d of 2813 val pp = case d of
2801 DTable (s, xts) => 2814 DTable (s, xts, csts) =>
2802 box [string "CREATE TABLE ", 2815 box [string "CREATE TABLE ",
2803 string s, 2816 string s,
2804 string "(", 2817 string "(",
2805 p_list (fn (x, t) => 2818 p_list (fn (x, t) =>
2806 box [string "uw_", 2819 box [string "uw_",
2807 string (CharVector.map Char.toLower x), 2820 string (CharVector.map Char.toLower x),
2808 space, 2821 space,
2809 p_sqltype env (t, ErrorMsg.dummySpan)]) xts, 2822 p_sqltype env (t, ErrorMsg.dummySpan)]) xts,
2823 case csts of
2824 [] => box []
2825 | _ => box [string ","],
2826 cut,
2827 p_list_sep (box [string ",", newline])
2828 (fn (x, c) =>
2829 box [string "CONSTRAINT",
2830 space,
2831 string s,
2832 string "_",
2833 string x,
2834 space,
2835 string c]) csts,
2836 newline,
2810 string ");", 2837 string ");",
2811 newline, 2838 newline,
2812 newline] 2839 newline]
2813 | DSequence s => 2840 | DSequence s =>
2814 box [string "CREATE SEQUENCE ", 2841 box [string "CREATE SEQUENCE ",