Mercurial > urweb

comparison src/mono_opt.sml @ 1011:16f7cb0891b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 #"\"" => "&quot;" 48 fun attrifyChar ch =
49 | #"&" => "&amp;" 49 case ch of
50 | ch => if Char.isPrint ch then 50 #"\"" => "&quot;"
51 str ch 51 | #"&" => "&amp;"
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,