Mercurial > urweb
comparison 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 |
comparison
equal
deleted
inserted
replaced
1010:6b0f3853cc81 | 1011:16f7cb0891b6 |
---|---|
43 if n < 0.0 then | 43 if n < 0.0 then |
44 "-" ^ Real.toString (Real.~ n) | 44 "-" ^ Real.toString (Real.~ n) |
45 else | 45 else |
46 Real.toString n | 46 Real.toString n |
47 | 47 |
48 val attrifyString = String.translate (fn #"\"" => """ | 48 fun attrifyChar ch = |
49 | #"&" => "&" | 49 case ch of |
50 | ch => if Char.isPrint ch then | 50 #"\"" => """ |
51 str ch | 51 | #"&" => "&" |
52 else | 52 | ch => if Char.isPrint ch then |
53 "&#" ^ Int.toString (ord ch) ^ ";") | 53 str ch |
54 else | |
55 "&#" ^ Int.toString (ord ch) ^ ";" | |
56 | |
57 val attrifyString = String.translate attrifyChar | |
54 | 58 |
55 val urlifyInt = attrifyInt | 59 val urlifyInt = attrifyInt |
56 val urlifyFloat = attrifyFloat | 60 val urlifyFloat = attrifyFloat |
57 | 61 |
58 val htmlifyInt = attrifyInt | 62 val htmlifyInt = attrifyInt |
93 | 97 |
94 fun sqlifyInt n = #p_cast (Settings.currentDbms ()) (attrifyInt n, Settings.Int) | 98 fun sqlifyInt n = #p_cast (Settings.currentDbms ()) (attrifyInt n, Settings.Int) |
95 fun sqlifyFloat n = #p_cast (Settings.currentDbms ()) (attrifyFloat n, Settings.Float) | 99 fun sqlifyFloat n = #p_cast (Settings.currentDbms ()) (attrifyFloat n, Settings.Float) |
96 | 100 |
97 fun sqlifyString s = #sqlifyString (Settings.currentDbms ()) s | 101 fun sqlifyString s = #sqlifyString (Settings.currentDbms ()) s |
102 fun sqlifyChar ch = #sqlifyString (Settings.currentDbms ()) (str ch) | |
98 | 103 |
99 fun unAs s = | 104 fun unAs s = |
100 let | 105 let |
101 fun doChars (cs, acc) = | 106 fun doChars (cs, acc) = |
102 case cs of | 107 case cs of |
258 | EWrite (EFfiApp ("Basis", "attrifyString", [(EPrim (Prim.String s), _)]), loc) => | 263 | EWrite (EFfiApp ("Basis", "attrifyString", [(EPrim (Prim.String s), _)]), loc) => |
259 EWrite (EPrim (Prim.String (attrifyString s)), loc) | 264 EWrite (EPrim (Prim.String (attrifyString s)), loc) |
260 | EWrite (EFfiApp ("Basis", "attrifyString", [e]), _) => | 265 | EWrite (EFfiApp ("Basis", "attrifyString", [e]), _) => |
261 EFfiApp ("Basis", "attrifyString_w", [e]) | 266 EFfiApp ("Basis", "attrifyString_w", [e]) |
262 | 267 |
268 | EFfiApp ("Basis", "attrifyChar", [(EPrim (Prim.Char s), _)]) => | |
269 EPrim (Prim.String (attrifyChar s)) | |
270 | EWrite (EFfiApp ("Basis", "attrifyChar", [(EPrim (Prim.Char s), _)]), loc) => | |
271 EWrite (EPrim (Prim.String (attrifyChar s)), loc) | |
272 | EWrite (EFfiApp ("Basis", "attrifyChar", [e]), _) => | |
273 EFfiApp ("Basis", "attrifyChar_w", [e]) | |
274 | |
263 | EFfiApp ("Basis", "attrifyCss_class", [(EPrim (Prim.String s), _)]) => | 275 | EFfiApp ("Basis", "attrifyCss_class", [(EPrim (Prim.String s), _)]) => |
264 EPrim (Prim.String s) | 276 EPrim (Prim.String s) |
265 | EWrite (EFfiApp ("Basis", "attrifyCss_class", [(EPrim (Prim.String s), _)]), loc) => | 277 | EWrite (EFfiApp ("Basis", "attrifyCss_class", [(EPrim (Prim.String s), _)]), loc) => |
266 EWrite (EPrim (Prim.String s), loc) | 278 EWrite (EPrim (Prim.String s), loc) |
267 | EWrite (EFfiApp ("Basis", "attrifyCss_class", [e]), _) => | 279 | EWrite (EFfiApp ("Basis", "attrifyCss_class", [e]), _) => |
316 (EPrim (Prim.String "FALSE"), loc))], | 328 (EPrim (Prim.String "FALSE"), loc))], |
317 {disc = (TFfi ("Basis", "bool"), loc), | 329 {disc = (TFfi ("Basis", "bool"), loc), |
318 result = (TFfi ("Basis", "string"), loc)}), loc) | 330 result = (TFfi ("Basis", "string"), loc)}), loc) |
319 | EFfiApp ("Basis", "sqlifyString", [(EPrim (Prim.String n), _)]) => | 331 | EFfiApp ("Basis", "sqlifyString", [(EPrim (Prim.String n), _)]) => |
320 EPrim (Prim.String (sqlifyString n)) | 332 EPrim (Prim.String (sqlifyString n)) |
333 | EFfiApp ("Basis", "sqlifyChar", [(EPrim (Prim.Char n), _)]) => | |
334 EPrim (Prim.String (sqlifyChar n)) | |
321 | 335 |
322 | EWrite (ECase (discE, pes, {disc, ...}), loc) => | 336 | EWrite (ECase (discE, pes, {disc, ...}), loc) => |
323 optExp (ECase (discE, | 337 optExp (ECase (discE, |
324 map (fn (p, e) => (p, (EWrite e, loc))) pes, | 338 map (fn (p, e) => (p, (EWrite e, loc))) pes, |
325 {disc = disc, | 339 {disc = disc, |