Mercurial > urweb
changeset 1266:459a334345ae
-moduleOf command-line option; compatibility fixes and better error messages for SQLite
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 27 May 2010 16:36:17 -0400 |
| parents | e8d68fd8ed4b |
| children | 052af2b82533 |
| files | src/compiler.sig src/compiler.sml src/main.mlton.sml src/monoize.sml src/sqlite.sml |
| diffstat | 5 files changed, 103 insertions(+), 43 deletions(-) [+] |
line wrap: on
line diff
--- a/src/compiler.sig Thu May 27 15:10:52 2010 -0400 +++ b/src/compiler.sig Thu May 27 16:36:17 2010 -0400 @@ -169,4 +169,6 @@ val addPath : string * string -> unit val addModuleRoot : string * string -> unit + val moduleOf : string -> string + end
--- a/src/compiler.sml Thu May 27 15:10:52 2010 -0400 +++ b/src/compiler.sml Thu May 27 16:36:17 2010 -0400 @@ -1254,4 +1254,23 @@ 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
--- a/src/main.mlton.sml Thu May 27 15:10:52 2010 -0400 +++ b/src/main.mlton.sml Thu May 27 16:36:17 2010 -0400 @@ -85,6 +85,9 @@ | "-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)
--- a/src/monoize.sml Thu May 27 15:10:52 2010 -0400 +++ b/src/monoize.sml Thu May 27 16:36:17 2010 -0400 @@ -1900,7 +1900,8 @@ {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 @@ ((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 @@ 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 @@ 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 @@ 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)
--- a/src/sqlite.sml Thu May 27 15:10:52 2010 -0400 +++ b/src/sqlite.sml Thu May 27 16:36:17 2010 -0400 @@ -58,7 +58,7 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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),