git.iko.soy/Idris-dev
on master help sign in
Merge pull request #3861 from jakwings/unicode
32a05baNiklas Larsson
src/IRTS/CodegenC.hs+18−18
compare with master
unifiedsplit
@@ -151,29 +151,29 @@ showCStr s = '"' : foldr ((++) . showChar) "\"" s
151 -- Note: we need the double quotes around the codes because otherwise
151 -- Note: we need the double quotes around the codes because otherwise
152 -- "\n3" would get encoded as "\x0a3", which is incorrect.
152 -- "\n3" would get encoded as "\x0a3", which is incorrect.
153 -- Instead, we opt for "\x0a""3" and let the C compiler deal with it.
153 -- 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)
156 | ord c < 0x7f = [c] -- 0x7f = \DEL
155 | ord c < 0x7f = [c] -- 0x7f = \DEL
157 | otherwise = showHexes (utf8bytes (ord c))
156 | otherwise = showHexes (utf8bytes (ord c))
158
157
158+ showUTF8 c = "\"\"\\x" ++ pad (showHex c "") ++ "\"\""
159+ showHexes = foldr ((++) . showUTF8) ""
160+
159 utf8bytes :: Int -> [Int]
161 utf8bytes :: Int -> [Int]
160− utf8bytes x = let (h : bytes) = split [] x in
162+ utf8bytes x
161− headHex h (length bytes) : map toHex bytes
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 ""
162 where
168 where
163− split acc 0 = acc
169+ split acc 1 x = x : acc
164− split acc x = let xbits = x .&. 0x3f
170+ split acc i x = split (x .&. 0x3f : acc) (i - 1) (shiftR x 6)
165− xrest = shiftR x 6 in
171+
166− split (xbits : acc) xrest
172+ pad :: String -> String
167−
173+ pad s = case length s of
168− headHex h 1 = h + 0xc0
174+ 1 -> "0" ++ s
169− headHex h 2 = h + 0xe0
175+ 2 -> s
170− headHex h 3 = h + 0xf0
176+ _ -> error $ "Can't happen: String of invalid length " ++ show s
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 "\"\""
177
177
178bcc :: Int -> BC -> String
178bcc :: Int -> BC -> String
179bcc i (ASSIGN l r) = indent i ++ creg l ++ " = " ++ creg r ++ ";\n"
179bcc i (ASSIGN l r) = indent i ++ creg l ++ " = " ++ creg r ++ ";\n"
src/IRTS/JavaScript/AST.hs+8−19
@@ -99,35 +99,24 @@ data JsExpr
99
99
100translateChar :: Char -> String
100translateChar :: Char -> String
101translateChar ch
101translateChar ch
102− | '\a' <- ch = "\\u0007"
103 | '\b' <- ch = "\\b"
102 | '\b' <- ch = "\\b"
104 | '\f' <- ch = "\\f"
103 | '\f' <- ch = "\\f"
105 | '\n' <- ch = "\\n"
104 | '\n' <- ch = "\\n"
106 | '\r' <- ch = "\\r"
105 | '\r' <- ch = "\\r"
107 | '\t' <- ch = "\\t"
106 | '\t' <- ch = "\\t"
108 | '\v' <- ch = "\\v"
107 | '\v' <- ch = "\\v"
109− | '\SO' <- ch = "\\u000E"
110− | '\DEL' <- ch = "\\u007F"
111 | '\\' <- ch = "\\\\"
108 | '\\' <- ch = "\\\\"
112 | '\"' <- ch = "\\\""
109 | '\"' <- ch = "\\\""
113 | '\'' <- ch = "\\\'"
110 | '\'' <- ch = "\\\'"
111+ | ord ch < 0x20 = "\\x" ++ pad 2 (showHex (ord ch) "")
112+ | ord ch < 0x7f = [ch] -- 0x7f '\DEL'
114− | ch `elem` asciiTab = "\\u" ++ fill (showHex (ord ch) "")
113+ | ord ch <= 0xff = "\\x" ++ pad 2 (showHex (ord ch) "")
115− | ord ch > 255 = "\\u" ++ fill (showHex (ord ch) "")
114+ | ord ch <= 0xffff = "\\u" ++ pad 4 (showHex (ord ch) "")
116− | otherwise = [ch]
115+ | ord ch <= 0x10ffff = "\\u{" ++ showHex (ord ch) "}"
116+ | otherwise = error $ "Invalid Unicode code point U+" ++ showHex (ord ch) ""
117 where
117 where
118− fill :: String -> String
118+ pad :: Int -> String -> String
119− fill s = case length s of
119+ pad n s = replicate (n - length s) '0' ++ s
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−
131
120
132indent :: Text -> Text
121indent :: Text -> Text
133indent x =
122indent x =