diff options
Diffstat (limited to 'src/mono_opt.sml')
| -rw-r--r-- | src/mono_opt.sml | 36 |
1 files changed, 35 insertions, 1 deletions
diff --git a/src/mono_opt.sml b/src/mono_opt.sml index 7f23d8b1..dfa0420c 100644 --- a/src/mono_opt.sml +++ b/src/mono_opt.sml @@ -87,7 +87,13 @@ fun sqlifyInt n = attrifyInt n ^ "::int8" 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 @@ fun exp e = | 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) |