git.iko.soy/elk
on master help sign in
Add intToAscii which converts ints to valid JS field names
8060c4eEvan Czaplicki
src/Generate/JavaScript/Symbol.hsdeleted−74
compare with master
unifiedsplit
@@ -1,74 +0,0 @@
1−import qualified Data.Char as Char
2−import Data.Word (Word16, Word32)
3−
4−
5−
6−-- SYMBOLS
7−
8−
9−data Symbol =
10− Symbol
11− { _home :: !Word16
12− , _name :: !Word32
13− }
14−
15−
16−
17−-- BINARY
18−
19−
20−instance Binary Symbol where
21− put (Symbol home name) =
22− put home >> put name
23−
24− get =
25− liftM2 Symbol get get
26−
27−
28−
29−-- EXPRESSION
30−
31−
32−toExpr :: Symbol -> JS.Expr
33−toExpr (Symbol home name) =
34− JS.DotRef (JS.ref (homeToText home)) (JS.Id (nameToText name))
35−
36−
37−homeToText :: Word16 -> Text
38−homeToText word =
39− Text.pack ('$' : show word)
40−
41−
42−nameToText :: Word32 -> Text
43−nameToText word =
44− Text.pack (makeName word "")
45−
46−
47−makeName :: Word32 -> String -> String
48−makeName word str =
49− if word < 26 then
50− makeChar 97 word : str
51−
52− else if word < 52 then
53− makeChar 65 (word - 26) : str
54−
55− else
56− let
57− (next, leftover) =
58− quotRem word 52
59− in
60− makeName next (makeInnerChar leftover : str)
61−
62−
63−makeInnerChar :: Word32 -> Char
64−makeInnerChar word =
65− if word < 26 then
66− makeChar 97 word
67− else
68− makeChar 65 (word - 26)
69−
70−
71−{-# INLINE makeChar #-}
72−makeChar :: Word32 -> Word32 -> Char
73−makeChar root offset =
74− Char.chr (fromIntegral (root + offset))
src/Generate/JavaScript/Variable.hs+145−17
@@ -9,15 +9,20 @@ module Generate.JavaScript.Variable
9 , global
9 , global
10 , globalName
10 , globalName
11 , globalToName
11 , globalToName
12+ , intToAscii
12 )
13 )
13 where
14 where
14
15
15
16
16import qualified Control.Monad.State.Strict as State
17import qualified Control.Monad.State.Strict as State
18+import qualified Data.ByteString as BS
17import Data.Monoid ((<>))
19import Data.Monoid ((<>))
20+import qualified Data.Map as Map
18import qualified Data.Set as Set
21import qualified Data.Set as Set
19−import qualified Data.Text as Text
20import Data.Text (Text)
22import Data.Text (Text)
23+import qualified Data.Text as Text
24+import qualified Data.Text.Encoding as Text (encodeUtf8)
25+import Data.Word (Word8)
21
26
22import qualified AST.Helpers as Help
27import qualified AST.Helpers as Help
23import qualified AST.Module.Name as ModuleName
28import qualified AST.Module.Name as ModuleName
@@ -61,28 +66,41 @@ local name =
61
66
62safe :: Text -> Text
67safe :: Text -> Text
63safe name =
68safe name =
64− if Set.member name reservedWords then
69+ if Set.member name reservedNames then
65 "_" <> name
70 "_" <> name
66 else
71 else
67 name
72 name
68
73
69
74
75+
76+-- RESERVED NAMES
77+
78+
79+reservedNames :: Set.Set Text
80+reservedNames =
81+ Set.union jsReservedWords elmReservedWords
82+
83+
70−reservedWords :: Set.Set Text
84+jsReservedWords :: Set.Set Text
71−reservedWords =
85+jsReservedWords =
72 Set.fromList
86 Set.fromList
73− -- reserved by JavaScript
87+ [ "do", "if", "in"
74− [ "null", "undefined", "NaN", "Infinity", "true", "false", "eval"
88+ , "NaN", "int", "for", "new", "try", "var", "let"
75− , "arguments", "int", "byte", "char", "goto", "long", "final", "float"
89+ , "null", "true", "eval", "byte", "char", "goto", "long", "case", "else", "this", "void", "with", "enum"
76− , "short", "double", "native", "throws", "boolean", "abstract", "volatile"
90+ , "false", "final", "float", "short", "break", "catch", "throw", "while", "class", "const", "super", "yield"
77− , "transient", "synchronized", "function", "break", "case", "catch"
91+ , "double", "native", "throws", "delete", "return", "switch", "typeof", "export", "import", "public", "static"
78− , "continue", "debugger", "default", "delete", "do", "else", "finally"
92+ , "boolean", "default", "finally", "extends", "package", "private"
79− , "for", "function", "if", "in", "instanceof", "new", "return", "switch"
93+ , "Infinity", "abstract", "volatile", "function", "continue", "debugger", "function"
80− , "this", "throw", "try", "typeof", "var", "void", "while", "with", "class"
94+ , "undefined", "arguments", "transient", "interface", "protected"
81− , "const", "enum", "export", "extends", "import", "super", "implements"
95+ , "instanceof", "implements"
82− , "interface", "let", "package", "private", "protected", "public"
96+ , "synchronized"
83− , "static", "yield"
97+ ]
84− -- reserved by Elm
98+
99+
100+elmReservedWords :: Set.Set Text
101+elmReservedWords =
102+ Set.fromList
85− , "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
103+ [ "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
86 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
104 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
87 ]
105 ]
88
106
@@ -119,3 +137,113 @@ globalToName (ModuleName.Canonical (Pkg.Name user project) moduleName) name =
119 <> "$" <> Text.replace "." "_" moduleName
137 <> "$" <> Text.replace "." "_" moduleName
120 <> "$" <> revisedName
138 <> "$" <> revisedName
121
139
140+
141+
142+-- INT TO ASCII
143+
144+
145+intToAscii :: Int -> BS.ByteString
146+intToAscii n =
147+ if n < 53 then -- skip $ as a standalone name
148+ BS.singleton (toByte n)
149+
150+ else
151+ intToAsciiHelp (numStartBytes * numInnerBytes) allBadFields (n - 53)
152+
153+
154+intToAsciiHelp :: Int -> [BadFields] -> Int -> BS.ByteString
155+intToAsciiHelp blockSize badFields n =
156+ case badFields of
157+ [] ->
158+ if n < blockSize then
159+ unsafeIntToAscii n
160+ else
161+ intToAsciiHelp (blockSize * numInnerBytes) [] (n - blockSize)
162+
163+ BadFields renamings : biggerBadFields ->
164+ if n < blockSize - Map.size renamings then
165+ let name = unsafeIntToAscii n in
166+ Map.findWithDefault name name renamings
167+ else
168+ intToAsciiHelp (blockSize * numInnerBytes) biggerBadFields (n - blockSize)
169+
170+
171+
172+-- UNSAFE INT TO ASCII
173+
174+
175+unsafeIntToAscii :: Int -> BS.ByteString
176+unsafeIntToAscii n =
177+ let
178+ (quotient, remainder) =
179+ quotRem n numStartBytes
180+ in
181+ BS.pack $ toByte remainder : unsafeIntToAsciiHelp quotient
182+
183+
184+unsafeIntToAsciiHelp :: Int -> [Word8]
185+unsafeIntToAsciiHelp n =
186+ if n == 0 then
187+ []
188+ else
189+ let (quotient, remainder) = quotRem n numInnerBytes in
190+ toByte remainder : unsafeIntToAsciiHelp quotient
191+
192+
193+
194+-- ASCII BYTES
195+
196+
197+numStartBytes :: Int
198+numStartBytes =
199+ 54
200+
201+
202+numInnerBytes :: Int
203+numInnerBytes =
204+ 64
205+
206+
207+toByte :: Int -> Word8
208+toByte n
209+ | n < 26 = fromIntegral (97 + n ) {- lower -}
210+ | n < 52 = fromIntegral (65 + n - 26) {- upper -}
211+ | n == 53 = 95 {- _ -}
212+ | n == 54 = 36 {- $ -}
213+ | n < 64 = fromIntegral (48 + n - 54) {- digit -}
214+ | True = error $ "cannot convert int " ++ show n ++ " to ASCII"
215+
216+
217+
218+-- BAD FIELDS
219+
220+
221+newtype BadFields =
222+ BadFields { _renamings :: Renamings }
223+
224+
225+type Renamings =
226+ Map.Map BS.ByteString BS.ByteString
227+
228+
229+allBadFields :: [BadFields]
230+allBadFields =
231+ let
232+ add keyword dict =
233+ Map.alter (Just . addRenaming keyword) (Text.length keyword) dict
234+ in
235+ Map.elems $ Set.foldr add Map.empty jsReservedWords
236+
237+
238+addRenaming :: Text -> Maybe BadFields -> BadFields
239+addRenaming keyword maybeBadFields =
240+ let
241+ maxName =
242+ numStartBytes * numInnerBytes ^ (Text.length keyword - 1) - 1
243+ in
244+ case maybeBadFields of
245+ Nothing ->
246+ BadFields $ Map.singleton (Text.encodeUtf8 keyword) (unsafeIntToAscii maxName)
247+
248+ Just (BadFields renamings) ->
249+ BadFields $ Map.insert (Text.encodeUtf8 keyword) (unsafeIntToAscii (maxName - Map.size renamings)) renamings