git.iko.soy/Idris-dev
on master help sign in
Fix character escaping of codegen
commit312094eaf9c050abd6a035fd651b72aa9be19698 authorJ.W <jakwings@gmail.com> dateThu 15 Jun 2017, 07:04 (9 years ago) parentb6b28fe
2 files changed+26−37
compare with master
unifiedsplit
src/IRTS/CodegenC.hs+18−18 src/IRTS/JavaScript/AST.hs+8−19
src/IRTS/CodegenC.hs+18−18
@@ -151,29 +151,29 @@ showCStr s = '"' : foldr ((++) . showChar) "\"" s
151151 -- Note: we need the double quotes around the codes because otherwise
152152 -- "\n3" would get encoded as "\x0a3", which is incorrect.
153153 -- Instead, we opt for "\x0a""3" and let the C compiler deal with it.
154− | ord c < 0x10 = "\"\"\\x0" ++ showHex (ord c) "\"\""
155− | ord c < 0x20 = "\"\"\\x" ++ showHex (ord c) "\"\""
154+ | ord c < 0x20 = showUTF8 (ord c)
156155 | ord c < 0x7f = [c] -- 0x7f = \DEL
157156 | otherwise = showHexes (utf8bytes (ord c))
158157
158+ showUTF8 c = "\"\"\\x" ++ pad (showHex c "") ++ "\"\""
159+ showHexes = foldr ((++) . showUTF8) ""
160+
159161 utf8bytes :: Int -> [Int]
160− utf8bytes x = let (h : bytes) = split [] x in
161− headHex h (length bytes) : map toHex bytes
162+ utf8bytes x
163+ | x <= 0x7f = [x]
164+ | x <= 0x7ff = let (y : ys) = split [] 2 x in (y .|. 0xc0) : map (.|. 0x80) ys
165+ | x <= 0xffff = let (y : ys) = split [] 3 x in (y .|. 0xe0) : map (.|. 0x80) ys
166+ | x <= 0x10ffff = let (y : ys) = split [] 4 x in (y .|. 0xf0) : map (.|. 0x80) ys
167+ | otherwise = error $ "Invalid Unicode code point U+" ++ showHex x ""
162168 where
163− split acc 0 = acc
164− split acc x = let xbits = x .&. 0x3f
165− xrest = shiftR x 6 in
166− split (xbits : acc) xrest
167−
168− headHex h 1 = h + 0xc0
169− headHex h 2 = h + 0xe0
170− headHex h 3 = h + 0xf0
171− headHex h n = error "Can't happen: Invalid UTF8 character"
172−
173− toHex i = i + 0x80
174−
175− showHexes = foldr ((++) . showUTF8) ""
176− showUTF8 c = "\"\"\\x" ++ showHex c "\"\""
169+ split acc 1 x = x : acc
170+ split acc i x = split (x .&. 0x3f : acc) (i - 1) (shiftR x 6)
171+
172+ pad :: String -> String
173+ pad s = case length s of
174+ 1 -> "0" ++ s
175+ 2 -> s
176+ _ -> error $ "Can't happen: String of invalid length " ++ show s
177177
178178bcc :: Int -> BC -> String
179179bcc i (ASSIGN l r) = indent i ++ creg l ++ " = " ++ creg r ++ ";\n"
src/IRTS/JavaScript/AST.hs+8−19
@@ -99,35 +99,24 @@ data JsExpr
9999
100100translateChar :: Char -> String
101101translateChar ch
102− | '\a' <- ch = "\\u0007"
103102 | '\b' <- ch = "\\b"
104103 | '\f' <- ch = "\\f"
105104 | '\n' <- ch = "\\n"
106105 | '\r' <- ch = "\\r"
107106 | '\t' <- ch = "\\t"
108107 | '\v' <- ch = "\\v"
109− | '\SO' <- ch = "\\u000E"
110− | '\DEL' <- ch = "\\u007F"
111108 | '\\' <- ch = "\\\\"
112109 | '\"' <- ch = "\\\""
113110 | '\'' <- ch = "\\\'"
114− | ch `elem` asciiTab = "\\u" ++ fill (showHex (ord ch) "")
115− | ord ch > 255 = "\\u" ++ fill (showHex (ord ch) "")
116− | otherwise = [ch]
111+ | ord ch < 0x20 = "\\x" ++ pad 2 (showHex (ord ch) "")
112+ | ord ch < 0x7f = [ch] -- 0x7f '\DEL'
113+ | ord ch <= 0xff = "\\x" ++ pad 2 (showHex (ord ch) "")
114+ | ord ch <= 0xffff = "\\u" ++ pad 4 (showHex (ord ch) "")
115+ | ord ch <= 0x10ffff = "\\u{" ++ showHex (ord ch) "}"
116+ | otherwise = error $ "Invalid Unicode code point U+" ++ showHex (ord ch) ""
117117 where
118− fill :: String -> String
119− fill s = case length s of
120− 1 -> "000" ++ s
121− 2 -> "00" ++ s
122− 3 -> "0" ++ s
123− _ -> s
124−
125− asciiTab =
126− ['\NUL', '\SOH', '\STX', '\ETX', '\EOT', '\ENQ', '\ACK', '\BEL',
127− '\BS', '\HT', '\LF', '\VT', '\FF', '\CR', '\SO', '\SI',
128− '\DLE', '\DC1', '\DC2', '\DC3', '\DC4', '\NAK', '\SYN', '\ETB',
129− '\CAN', '\EM', '\SUB', '\ESC', '\FS', '\GS', '\RS', '\US']
130−
118+ pad :: Int -> String -> String
119+ pad n s = replicate (n - length s) '0' ++ s
131120
132121indent :: Text -> Text
133122indent x =