diff options
Diffstat (limited to 'src/mono_opt.sml')
| -rw-r--r-- | src/mono_opt.sml | 67 |
1 files changed, 59 insertions, 8 deletions
diff --git a/src/mono_opt.sml b/src/mono_opt.sml index 40b865b0..7e737e44 100644 --- a/src/mono_opt.sml +++ b/src/mono_opt.sml @@ -66,9 +66,9 @@ val htmlifyString = String.translate (fn #"<" => "<" fun htmlifySpecialChar ch = "&#" ^ Int.toString (ord ch) ^ ";" -fun hexIt ch = +fun hexPad c = let - val s = Int.fmt StringCvt.HEX (ord ch) + val s = Int.fmt StringCvt.HEX c in case size s of 0 => "00" @@ -76,6 +76,54 @@ fun hexIt ch = | _ => s end +fun rsh a b = + Int.fromLarge (IntInf.~>>(IntInf.fromInt a, Word.fromInt b)) + +fun orb a b = + Int.fromLarge (IntInf.orb(IntInf.fromInt a, IntInf.fromInt b)) + +fun andb a b = + Int.fromLarge (IntInf.andb(IntInf.fromInt a, IntInf.fromInt b)) + + +fun hexIt ch = + let + val c = ord ch + in + if (c <= 0x7f) then + hexPad c + else + ((if (c <= 0x7fff) then + hexPad (orb (rsh c 6) 0xc0) + else + (if (c <= 0xffff) then + hexPad (orb (rsh c 12) 0xe0) + else + hexPad (orb (rsh c 18) 0xf0) + ^ hexPad (orb (andb (rsh c 12) 0x3f) 0x80) + ) + ^ hexPad (orb (andb (rsh c 6) 0x3f) 0x80)) + ) ^ hexPad (orb (andb c 0x3f) 0x80) + end + +fun urlifyCharAux ch = + case ch of + #" " => "+" + | _ => + if ord ch = 0 then + "_" + else + if Char.isAlphaNum ch then + str ch + else + "." ^ hexIt ch + +fun urlifyChar c = + case c of + #"_" => "_" ^ urlifyCharAux c + | _ => urlifyCharAux c + + fun urlifyString s = case s of "" => "_" @@ -84,11 +132,7 @@ fun urlifyString s = "_" else "") - ^ String.translate (fn #" " => "+" - | ch => if Char.isAlphaNum ch then - str ch - else - "." ^ hexIt ch) s + ^ String.translate urlifyCharAux s fun sqlifyInt n = #p_cast (Settings.currentDbms ()) (attrifyInt n, Settings.Int) @@ -117,7 +161,7 @@ fun unAs s = doChars (String.explode s, []) end -fun checkUrl s = CharVector.all Char.isGraph s andalso Settings.checkUrl s +fun checkUrl s = CharVector.all Char.isGraph s andalso (s = "#" orelse Settings.checkUrl s) val checkData = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"_" orelse ch = #"-") @@ -349,6 +393,13 @@ fun exp e = | EWrite (EFfiApp ("Basis", "urlifyString", [e]), _) => EFfiApp ("Basis", "urlifyString_w", [e]) + | EFfiApp ("Basis", "urlifyChar", [((EPrim (Prim.Char c), _), _)]) => + EPrim (Prim.String (Prim.Normal, urlifyChar c)) + | EWrite (EFfiApp ("Basis", "urlifyChar", [((EPrim (Prim.Char c), _), _)]), loc) => + EWrite (EPrim (Prim.String (Prim.Normal, urlifyChar c)), loc) + | EWrite (EFfiApp ("Basis", "urlifyChar", [e]), _) => + EFfiApp ("Basis", "urlifyChar_w", [e]) + | EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "True", ...}, NONE), _), _)]) => EPrim (Prim.String (Prim.Normal, "1")) | EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "False", ...}, NONE), _), _)]) => |