summaryrefslogtreecommitdiff
path: root/src/mono_opt.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-12-03 11:20:13 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-12-03 11:20:13 -0500
commite7b50987708729b9c3d0c8c0acb58e801142e6b9 (patch)
treea926eddc786dbf468be0d7a96f3d6824291f2156 /src/mono_opt.sml
parent68e0439b741bf84508f90b42611d681ced933874 (diff)
Escaping UTF-8 in MonoOpt
Diffstat (limited to 'src/mono_opt.sml')
-rw-r--r--src/mono_opt.sml39
1 files changed, 31 insertions, 8 deletions
diff --git a/src/mono_opt.sml b/src/mono_opt.sml
index d4441ac7..3a5b4f4c 100644
--- a/src/mono_opt.sml
+++ b/src/mono_opt.sml
@@ -61,14 +61,37 @@ val urlifyFloat = attrifyFloat
val htmlifyInt = attrifyInt
val htmlifyFloat = attrifyFloat
-val htmlifyString = String.translate (fn ch => case ch of
- #"<" => "&lt;"
- | #"&" => "&amp;"
- | _ =>
- if Char.isPrint ch orelse Char.isSpace ch then
- str ch
- else
- "&#" ^ Int.toString (ord ch) ^ ";")
+
+fun htmlifyString s =
+ let
+ fun hs (pos, acc) =
+ if pos >= size s then
+ String.concat (rev acc)
+ else
+ case String.sub (s, pos) of
+ #"<" => hs (pos+1, "&lt;" :: acc)
+ | #"&" => hs (pos+1, "&amp;" :: acc)
+ | ch =>
+ let
+ val n = ord ch
+ fun isCont k = pos + k < size s
+ andalso ord (String.sub (s, pos + k)) div 64 = 2
+ fun unicode k = hs (pos+k+1, String.substring (s, pos, k+1) :: acc)
+ in
+ if Char.isPrint ch orelse Char.isSpace ch then
+ hs (pos+1, str ch :: acc)
+ else if n div 32 = 6 andalso isCont 1 then
+ unicode 1
+ else if n div 16 = 14 andalso isCont 1 andalso isCont 2 then
+ unicode 2
+ else if n div 8 = 30 andalso isCont 1 andalso isCont 2 andalso isCont 3 then
+ unicode 3
+ else
+ hs (pos+1, "&#" ^ Int.toString (ord ch) ^ ";" :: acc)
+ end
+ in
+ hs (0, [])
+ end
fun hexIt ch =
let