Mercurial > urweb
diff src/mono_opt.sml @ 1011:16f7cb0891b6
Initial support for char in SQL
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 22 Oct 2009 16:15:56 -0400 |
| parents | ad434669f299 |
| children | ea9f03ac2710 |
line wrap: on
line diff
--- a/src/mono_opt.sml Thu Oct 22 14:05:48 2009 -0400 +++ b/src/mono_opt.sml Thu Oct 22 16:15:56 2009 -0400 @@ -45,12 +45,16 @@ else Real.toString n -val attrifyString = String.translate (fn #"\"" => """ - | #"&" => "&" - | ch => if Char.isPrint ch then - str ch - else - "&#" ^ Int.toString (ord ch) ^ ";") +fun attrifyChar ch = + case ch of + #"\"" => """ + | #"&" => "&" + | ch => if Char.isPrint ch then + str ch + else + "&#" ^ Int.toString (ord ch) ^ ";" + +val attrifyString = String.translate attrifyChar val urlifyInt = attrifyInt val urlifyFloat = attrifyFloat @@ -95,6 +99,7 @@ fun sqlifyFloat n = #p_cast (Settings.currentDbms ()) (attrifyFloat n, Settings.Float) fun sqlifyString s = #sqlifyString (Settings.currentDbms ()) s +fun sqlifyChar ch = #sqlifyString (Settings.currentDbms ()) (str ch) fun unAs s = let @@ -260,6 +265,13 @@ | EWrite (EFfiApp ("Basis", "attrifyString", [e]), _) => EFfiApp ("Basis", "attrifyString_w", [e]) + | EFfiApp ("Basis", "attrifyChar", [(EPrim (Prim.Char s), _)]) => + EPrim (Prim.String (attrifyChar s)) + | EWrite (EFfiApp ("Basis", "attrifyChar", [(EPrim (Prim.Char s), _)]), loc) => + EWrite (EPrim (Prim.String (attrifyChar s)), loc) + | EWrite (EFfiApp ("Basis", "attrifyChar", [e]), _) => + EFfiApp ("Basis", "attrifyChar_w", [e]) + | EFfiApp ("Basis", "attrifyCss_class", [(EPrim (Prim.String s), _)]) => EPrim (Prim.String s) | EWrite (EFfiApp ("Basis", "attrifyCss_class", [(EPrim (Prim.String s), _)]), loc) => @@ -318,6 +330,8 @@ result = (TFfi ("Basis", "string"), loc)}), loc) | EFfiApp ("Basis", "sqlifyString", [(EPrim (Prim.String n), _)]) => EPrim (Prim.String (sqlifyString n)) + | EFfiApp ("Basis", "sqlifyChar", [(EPrim (Prim.Char n), _)]) => + EPrim (Prim.String (sqlifyChar n)) | EWrite (ECase (discE, pes, {disc, ...}), loc) => optExp (ECase (discE,