From b4d31722f1ee192d91717e40a3c1bed281ed9392 Mon Sep 17 00:00:00 2001 From: fab Date: Wed, 9 Jan 2019 22:21:14 +0000 Subject: fix unit tests. implement urlifyChar --- src/mono_opt.sml | 67 +++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 59 insertions(+), 8 deletions(-) (limited to 'src/mono_opt.sml') diff --git a/src/mono_opt.sml b/src/mono_opt.sml index 40b865b0..218be1ba 100644 --- a/src/mono_opt.sml +++ b/src/mono_opt.sml @@ -66,16 +66,64 @@ 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 + case size s of 0 => "00" | 1 => "0" ^ s | _ => 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) @@ -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), _), _)]) => -- cgit v1.2.3 From 0844858d23b5a0d695ad719a650e755cc21a235c Mon Sep 17 00:00:00 2001 From: fab Date: Mon, 21 Jan 2019 20:17:56 +0000 Subject: fixes for review 1 --- lib/js/urweb.js | 1 + src/mono_opt.sml | 58 ++++++++++++++++++++++++++++---------------------------- 2 files changed, 30 insertions(+), 29 deletions(-) (limited to 'src/mono_opt.sml') diff --git a/lib/js/urweb.js b/lib/js/urweb.js index 6b493c4f..357e4c1c 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -7,6 +7,7 @@ function needsDynPrefix() { return scripts.length == 0; } +// Codepoint implementations brought from https://norbertlindenberg.com/2012/05/ecmascript-supplementary-characters/#String if (!String.fromCodePoint) { String.fromCodePoint = function () { var chars = [], i; diff --git a/src/mono_opt.sml b/src/mono_opt.sml index 218be1ba..cc85f05b 100644 --- a/src/mono_opt.sml +++ b/src/mono_opt.sml @@ -68,9 +68,9 @@ fun htmlifySpecialChar ch = "&#" ^ Int.toString (ord ch) ^ ";" fun hexPad c = let - val s = Int.fmt StringCvt.HEX c + val s = Int.fmt StringCvt.HEX c in - case size s of + case size s of 0 => "00" | 1 => "0" ^ s | _ => s @@ -88,42 +88,42 @@ fun andb a b = fun hexIt ch = let - val c = ord ch + 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) + 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 + if ord ch = 0 then + "_" + else + if Char.isAlphaNum ch then + str ch else - "." ^ hexIt ch - + "." ^ hexIt ch + fun urlifyChar c = case c of - #"_" => "_" ^ urlifyCharAux c + #"_" => "_" ^ urlifyCharAux c | _ => urlifyCharAux c - - + + fun urlifyString s = case s of "" => "_" @@ -399,7 +399,7 @@ fun exp e = 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), _), _)]) => -- cgit v1.2.3 From 0bb63dca9409308491070d94a0436ad73f81b9e0 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 10 Jan 2020 14:49:05 -0500 Subject: At compile time, allow '#' as a URL --- src/mono_opt.sml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/mono_opt.sml') diff --git a/src/mono_opt.sml b/src/mono_opt.sml index cc85f05b..7e737e44 100644 --- a/src/mono_opt.sml +++ b/src/mono_opt.sml @@ -161,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 = #"-") -- cgit v1.2.3