-moduleOf command-line option; compatibility fixes and better error messages for SQLite

5 files changed, 103 insertions, 43 deletions

diff --git a/src/compiler.sig b/src/compiler.sig
index cc23fe74..16207e8b 100644
--- a/src/compiler.sig
+++ b/src/compiler.sig
@@ -169,4 +169,6 @@ signature COMPILER = sig
     val addPath : string * string -> unit
     val addModuleRoot : string * string -> unit
 
+    val moduleOf : string -> string
+
 end
diff --git a/src/compiler.sml b/src/compiler.sml
index d39122f0..1d15367f 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -1254,4 +1254,23 @@ fun compiler job =
     else
         OS.Process.exit OS.Process.failure
 
+fun moduleOf fname =
+    let
+        val mrs = !moduleRoots
+        val fname = OS.Path.mkCanonical fname
+    in
+        case List.find (fn (root, _) => String.isPrefix (root ^ "/") fname) mrs of
+            NONE => capitalize (OS.Path.base (OS.Path.file fname))
+          | SOME (root, name) =>
+            let
+                val fname = OS.Path.base fname
+                val fname = String.extract (fname, size root + 1, NONE)
+                val fs = String.fields (fn ch => ch = #"/") fname
+                val fs = List.filter (CharVector.exists (fn ch => not (Char.isDigit ch))) fs
+                val fs = map capitalize fs
+            in
+                String.concatWith "." (name :: fs)
+            end
+    end
+
 end
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index f4f74be2..33838c93 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -85,6 +85,9 @@ fun doArgs args =
       | "-iflow" :: rest =>
         (Compiler.doIflow := true;
          doArgs rest)
+      | "-moduleOf" :: fname :: _ =>
+        (print (Compiler.moduleOf fname ^ "\n");
+         OS.Process.exit OS.Process.success)
       | arg :: rest =>
         (if size arg > 0 andalso String.sub (arg, 0) = #"-" then
              raise Fail ("Unknown flag " ^ arg)
diff --git a/src/monoize.sml b/src/monoize.sml
index e6c91abd..e2377bae 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1900,7 +1900,8 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                       {disc = s,
                                                        result = s}), loc),
                                            (L'.ECase (gf "Where",
-                                                      [((L'.PPrim (Prim.String "TRUE"), loc),
+                                                      [((L'.PPrim (Prim.String (#trueString (Settings.currentDbms ()))),
+                                                         loc),
                                                         sc ""),
                                                        ((L'.PWild, loc),
                                                         strcat [sc " WHERE ", gf "Where"])],
@@ -2114,13 +2115,21 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                            ((L'.PRecord [("2", (L'.PPrim (Prim.String ""), loc), s)], loc),
                                                             (L'.ERel 2, loc)),
                                                            ((L'.PWild, loc),
-                                                            strcat [(L'.EPrim (Prim.String "("), loc),
-                                                                    (L'.ERel 2, loc),
-                                                                    (L'.EPrim (Prim.String " JOIN "), loc),
-                                                                    (L'.ERel 1, loc),
-                                                                    (L'.EPrim (Prim.String " ON "), loc),
-                                                                    (L'.ERel 0, loc),
-                                                                    (L'.EPrim (Prim.String ")"), loc)])],
+                                                            strcat ((if #nestedRelops
+                                                                                      (Settings.currentDbms ()) then
+                                                                                   [(L'.EPrim (Prim.String "("), loc)]
+                                                                               else
+                                                                                   [])
+                                                                    @ [(L'.ERel 2, loc),
+                                                                       (L'.EPrim (Prim.String " JOIN "), loc),
+                                                                       (L'.ERel 1, loc),
+                                                                       (L'.EPrim (Prim.String " ON "), loc),
+                                                                       (L'.ERel 0, loc)]
+                                                                    @ (if #nestedRelops
+                                                                              (Settings.currentDbms ()) then
+                                                                           [(L'.EPrim (Prim.String ")"), loc)]
+                                                                       else
+                                                                           [])))],
                                                           {disc = (L'.TRecord [("1", s), ("2", s)], loc),
                                                            result = s}), loc)), loc)), loc)), loc),
                  fm)
@@ -2144,13 +2153,22 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                                                           loc), s)], loc),
                                                                       (L'.ERel 2, loc)),
                                                                      ((L'.PWild, loc),
-                                                                      strcat [(L'.EPrim (Prim.String "("), loc),
-                                                                              (L'.ERel 2, loc),
-                                                                              (L'.EPrim (Prim.String " LEFT JOIN "), loc),
-                                                                              (L'.ERel 1, loc),
-                                                                              (L'.EPrim (Prim.String " ON "), loc),
-                                                                              (L'.ERel 0, loc),
-                                                                              (L'.EPrim (Prim.String ")"), loc)])],
+                                                                      strcat ((if #nestedRelops
+                                                                                      (Settings.currentDbms ()) then
+                                                                                   [(L'.EPrim (Prim.String "("), loc)]
+                                                                               else
+                                                                                   [])
+                                                                              @ [(L'.ERel 2, loc),
+                                                                                 (L'.EPrim (Prim.String " LEFT JOIN "),
+                                                                                  loc),
+                                                                                 (L'.ERel 1, loc),
+                                                                                 (L'.EPrim (Prim.String " ON "), loc),
+                                                                                 (L'.ERel 0, loc)]
+                                                                              @ (if #nestedRelops
+                                                                                        (Settings.currentDbms ()) then
+                                                                                     [(L'.EPrim (Prim.String ")"), loc)]
+                                                                                 else
+                                                                                     [])))],
                                                                     {disc = (L'.TRecord [("1", s), ("2", s)], loc),
                                                                      result = s}), loc)), loc)), loc)), loc)), loc),
                  fm)
@@ -2174,13 +2192,22 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                                                           loc), s)], loc),
                                                                       (L'.ERel 2, loc)),
                                                                      ((L'.PWild, loc),
-                                                                      strcat [(L'.EPrim (Prim.String "("), loc),
-                                                                              (L'.ERel 2, loc),
-                                                                              (L'.EPrim (Prim.String " RIGHT JOIN "), loc),
-                                                                              (L'.ERel 1, loc),
-                                                                              (L'.EPrim (Prim.String " ON "), loc),
-                                                                              (L'.ERel 0, loc),
-                                                                              (L'.EPrim (Prim.String ")"), loc)])],
+                                                                      strcat ((if #nestedRelops
+                                                                                      (Settings.currentDbms ()) then
+                                                                                   [(L'.EPrim (Prim.String "("), loc)]
+                                                                               else
+                                                                                   [])
+                                                                              @ [(L'.ERel 2, loc),
+                                                                                 (L'.EPrim (Prim.String " RIGHT JOIN "),
+                                                                                  loc),
+                                                                                 (L'.ERel 1, loc),
+                                                                                 (L'.EPrim (Prim.String " ON "), loc),
+                                                                                 (L'.ERel 0, loc)]
+                                                                              @ (if #nestedRelops
+                                                                                        (Settings.currentDbms ()) then
+                                                                                     [(L'.EPrim (Prim.String ")"), loc)]
+                                                                                 else
+                                                                                     [])))],
                                                                     {disc = (L'.TRecord [("1", s), ("2", s)], loc),
                                                                      result = s}), loc)), loc)), loc)), loc)), loc),
                  fm)
@@ -2204,13 +2231,22 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                                                           loc), s)], loc),
                                                                       (L'.ERel 2, loc)),
                                                                      ((L'.PWild, loc),
-                                                                      strcat [(L'.EPrim (Prim.String "("), loc),
-                                                                              (L'.ERel 2, loc),
-                                                                              (L'.EPrim (Prim.String " FULL JOIN "), loc),
-                                                                              (L'.ERel 1, loc),
-                                                                              (L'.EPrim (Prim.String " ON "), loc),
-                                                                              (L'.ERel 0, loc),
-                                                                              (L'.EPrim (Prim.String ")"), loc)])],
+                                                                      strcat ((if #nestedRelops
+                                                                                      (Settings.currentDbms ()) then
+                                                                                   [(L'.EPrim (Prim.String "("), loc)]
+                                                                               else
+                                                                                   [])
+                                                                              @ [(L'.ERel 2, loc),
+                                                                                 (L'.EPrim (Prim.String " FULL JOIN "),
+                                                                                  loc),
+                                                                                 (L'.ERel 1, loc),
+                                                                                 (L'.EPrim (Prim.String " ON "), loc),
+                                                                                 (L'.ERel 0, loc)]
+                                                                              @ (if #nestedRelops
+                                                                                        (Settings.currentDbms ()) then
+                                                                                     [(L'.EPrim (Prim.String ")"), loc)]
+                                                                                 else
+                                                                                     [])))],
                                                                     {disc = (L'.TRecord [("1", s), ("2", s)], loc),
                                                                      result = s}), loc)), loc)), loc)), loc)), loc),
                  fm)
diff --git a/src/sqlite.sml b/src/sqlite.sml
index 26cfc9d5..d628da16 100644
--- a/src/sqlite.sml
+++ b/src/sqlite.sml
@@ -58,7 +58,7 @@ fun checkRel (table, checkNullable) (s, xts) =
              newline,
              box [string "sqlite3_close(conn->conn);",
                   newline,
-                  string "uw_error(ctx, FATAL, \"Query preparation failed:\\n",
+                  string "uw_error(ctx, FATAL, \"Query preparation failed:<br />",
                   string q,
                   string "\");",
                   newline],
@@ -77,7 +77,7 @@ fun checkRel (table, checkNullable) (s, xts) =
                   newline,
                   string "sqlite3_close(conn->conn);",
                   newline,
-                  string "uw_error(ctx, FATAL, \"No row returned:\\n",
+                  string "uw_error(ctx, FATAL, \"No row returned:<br />",
                   string q,
                   string "\");",
                   newline],
@@ -90,7 +90,7 @@ fun checkRel (table, checkNullable) (s, xts) =
                   newline,
                   string "sqlite3_close(conn->conn);",
                   newline,
-                  string "uw_error(ctx, FATAL, \"Error getting row:\\n",
+                  string "uw_error(ctx, FATAL, \"Error getting row:<br />",
                   string q,
                   string "\");",
                   newline],
@@ -104,7 +104,7 @@ fun checkRel (table, checkNullable) (s, xts) =
                   newline,
                   string "sqlite3_close(conn->conn);",
                   newline,
-                  string "uw_error(ctx, FATAL, \"Bad column count:\\n",
+                  string "uw_error(ctx, FATAL, \"Bad column count:<br />",
                   string q,
                   string "\");",
                   newline],
@@ -242,7 +242,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
                                                                     string "msg[1023] = 0;",
                                                                     newline,
                                                                     uhoh false ("Error preparing statement: "
-                                                                                ^ String.toString s ^ "\\n%s") ["msg"]],
+                                                                                ^ String.toString s ^ "<br />%s") ["msg"]],
                                                                string "}",
                                                                newline]
                                                       end)
@@ -353,7 +353,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
                   newline],
              string "else {",
              newline,
-             box [string "fprintf(stderr, \"Begin error: %s\\n\", sqlite3_errmsg(conn->conn));",
+             box [string "fprintf(stderr, \"Begin error: %s<br />\", sqlite3_errmsg(conn->conn));",
                   newline,
                   string "return 1;",
                   newline],
@@ -371,7 +371,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
                   newline],
              string "else {",
              newline,
-             box [string "fprintf(stderr, \"Commit error: %s\\n\", sqlite3_errmsg(conn->conn));",
+             box [string "fprintf(stderr, \"Commit error: %s<br />\", sqlite3_errmsg(conn->conn));",
                   newline,
                   string "return 1;",
                   newline],
@@ -391,7 +391,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
                   newline],
              string "else {",
              newline,
-             box [string "fprintf(stderr, \"Rollback error: %s\\n\", sqlite3_errmsg(conn->conn));",
+             box [string "fprintf(stderr, \"Rollback error: %s<br />\", sqlite3_errmsg(conn->conn));",
                   newline,
                   string "return 1;",
                   newline],
@@ -522,7 +522,7 @@ fun queryCommon {loc, query, cols, doCols} =
 
          string "if (r != SQLITE_DONE) uw_error(ctx, FATAL, \"",
          string (ErrorMsg.spanToString loc),
-         string ": query step failed: %s\\n%s\", ",
+         string ": query step failed: %s<br />%s\", ",
          query,
          string ", sqlite3_errmsg(conn->conn));",
          newline,
@@ -534,7 +534,7 @@ fun query {loc, cols, doCols} =
          string "sqlite3_stmt *stmt;",
          newline,
          newline,
-         string "if (sqlite3_prepare_v2(conn->conn, query, -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: %s\\n%s\", sqlite3_errmsg(conn->conn));",
+         string "if (sqlite3_prepare_v2(conn->conn, query, -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: %s<br />%s\", sqlite3_errmsg(conn->conn), query);",
          newline,
          newline,
          string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_finalize, stmt);",
@@ -654,7 +654,7 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
          string (String.toString query),
          string "\", -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: ",
          string (String.toString query),
-         string "\\n%s\", sqlite3_errmsg(conn->conn));",
+         string "<br />%s\", sqlite3_errmsg(conn->conn));",
          newline,
          if nested then
              box [string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_finalize, stmt);",
@@ -703,7 +703,7 @@ fun dmlCommon {loc, dml} =
 
          string "if (r != SQLITE_DONE) uw_error(ctx, FATAL, \"",
          string (ErrorMsg.spanToString loc),
-         string ": DML step failed: %s\\n%s\", ",
+         string ": DML step failed: %s<br />%s\", ",
          dml,
          string ", sqlite3_errmsg(conn->conn));",
          newline]
@@ -714,7 +714,7 @@ fun dml loc =
          string "sqlite3_stmt *stmt;",
          newline,
          newline,
-         string "if (sqlite3_prepare_v2(conn->conn, dml, -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: %s\\n%s\", dml, sqlite3_errmsg(conn->conn));",
+         string "if (sqlite3_prepare_v2(conn->conn, dml, -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: %s<br />%s\", dml, sqlite3_errmsg(conn->conn));",
          newline,
          newline,
          string "uw_push_cleanup(ctx, (void (*)(void *))sqlite3_finalize, stmt);",
@@ -742,7 +742,7 @@ fun dmlPrepared {loc, id, dml, inputs} =
               string (String.toString dml),
               string "\", -1, &stmt, NULL) != SQLITE_OK) uw_error(ctx, FATAL, \"Error preparing statement: ",
               string (String.toString dml),
-              string "\\n%s\", sqlite3_errmsg(conn->conn));",
+              string "<br />%s\", sqlite3_errmsg(conn->conn));",
               newline,
               string "conn->p",
               string (Int.toString id),