diff src/mono_opt.sml @ 714:0f42461273cf

CHECK constraints
author Adam Chlipala <adamc@hcoop.net>
date Thu, 09 Apr 2009 15:30:15 -0400
parents bab524996fca
children e28637743279
line wrap: on
line diff
--- a/src/mono_opt.sml	Thu Apr 09 14:59:29 2009 -0400
+++ b/src/mono_opt.sml	Thu Apr 09 15:30:15 2009 -0400
@@ -87,7 +87,13 @@
 fun sqlifyFloat n = attrifyFloat n ^ "::float8"
 
 fun sqlifyString s = "E'" ^ String.translate (fn #"'" => "\\'"
-                                               | ch => str ch)
+                                               | #"\\" => "\\\\"
+                                               | ch =>
+                                                 if Char.isPrint ch then
+                                                     str ch
+                                                 else
+                                                     "\\" ^ StringCvt.padLeft #"0" 3
+                                                                              (Int.fmt StringCvt.OCT (ord ch)))
                                              (String.toString s) ^ "'::text"
 
 fun exp e =
@@ -365,6 +371,34 @@
 
       | EJavaScript (_, _, SOME (e, _)) => e
 
+      | EFfiApp ("Basis", "checkString", [(EPrim (Prim.String s), loc)]) => 
+        let
+            fun uwify (cs, acc) =
+                case cs of
+                    [] => String.concat (rev acc)
+                  | #"(" :: #"_" :: cs => uwify (cs, "(uw_" :: acc)
+                  | #" " :: #"_" :: cs => uwify (cs, " uw_" :: acc)
+                  | #"'" :: cs =>
+                    let
+                        fun waitItOut (cs, acc) =
+                            case cs of
+                                [] => raise Fail "MonoOpt: Unterminated SQL string literal"
+                              | #"'" :: cs => uwify (cs, "'" :: acc)
+                              | #"\\" :: #"'" :: cs => waitItOut (cs, "\\'" :: acc)
+                              | #"\\" :: #"\\" :: cs => waitItOut (cs, "\\\\" :: acc)
+                              | c :: cs => waitItOut (cs, str c :: acc)
+                    in
+                        waitItOut (cs, "'" :: acc)
+                    end
+                  | c :: cs => uwify (cs, str c :: acc)
+
+            val s = case String.explode s of
+                        #"_" :: cs => uwify (cs, ["uw_"])
+                      | cs => uwify (cs, [])
+        in
+            EPrim (Prim.String s)
+        end
+
       | _ => e
 
 and optExp e = #1 (U.Exp.map {typ = typ, exp = exp} e)