on master help sign in
Add intToAscii which converts ints to valid JS field names

It converts an int to ASCII by checking if it is in progressively larger “block sizes” to make sure we get every possible name. We start with a block size of 53. This contains [a-zA-Z_]. If that is too small, we move on to [a-zA-Z_$][a-zA-Z_$0-9] with a block size of (54 * 64). From there we can just keep getting bigger indefinitely (54 * 64^n) so we never run out of names. This code also checks for collisions with reserved words in JS, skipping over them. The logic about block sizes is a bit fancier on account of this.

commit8060c4ec4e3b71063ac350f36f9c75a09dbd8994 authorEvan Czaplicki <evancz@users.noreply.github.com> dateTue 18 Jul 2017, 16:02 (9 years ago) parent9b1217b
2 files changed+145−91
src/Generate/JavaScript/Symbol.hs−74 src/Generate/JavaScript/Variable.hs+145−17
src/Generate/JavaScript/Symbol.hsdeleted−74
@@ -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
99 , global
1010 , globalName
1111 , globalToName
12+ , intToAscii
1213 )
1314 where
1415
1516
1617import qualified Control.Monad.State.Strict as State
18+import qualified Data.ByteString as BS
1719import Data.Monoid ((<>))
20+import qualified Data.Map as Map
1821import qualified Data.Set as Set
19−import qualified Data.Text as Text
2022import Data.Text (Text)
23+import qualified Data.Text as Text
24+import qualified Data.Text.Encoding as Text (encodeUtf8)
25+import Data.Word (Word8)
2126
2227import qualified AST.Helpers as Help
2328import qualified AST.Module.Name as ModuleName
@@ -61,28 +66,41 @@ local name =
6166
6267safe :: Text -> Text
6368safe name =
64− if Set.member name reservedWords then
69+ if Set.member name reservedNames then
6570 "_" <> name
6671 else
6772 name
6873
6974
70−reservedWords :: Set.Set Text
71−reservedWords =
75+
76+-- RESERVED NAMES
77+
78+
79+reservedNames :: Set.Set Text
80+reservedNames =
81+ Set.union jsReservedWords elmReservedWords
82+
83+
84+jsReservedWords :: Set.Set Text
85+jsReservedWords =
7286 Set.fromList
73− -- reserved by JavaScript
74− [ "null", "undefined", "NaN", "Infinity", "true", "false", "eval"
75− , "arguments", "int", "byte", "char", "goto", "long", "final", "float"
76− , "short", "double", "native", "throws", "boolean", "abstract", "volatile"
77− , "transient", "synchronized", "function", "break", "case", "catch"
78− , "continue", "debugger", "default", "delete", "do", "else", "finally"
79− , "for", "function", "if", "in", "instanceof", "new", "return", "switch"
80− , "this", "throw", "try", "typeof", "var", "void", "while", "with", "class"
81− , "const", "enum", "export", "extends", "import", "super", "implements"
82− , "interface", "let", "package", "private", "protected", "public"
83− , "static", "yield"
84− -- reserved by Elm
85− , "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
87+ [ "do", "if", "in"
88+ , "NaN", "int", "for", "new", "try", "var", "let"
89+ , "null", "true", "eval", "byte", "char", "goto", "long", "case", "else", "this", "void", "with", "enum"
90+ , "false", "final", "float", "short", "break", "catch", "throw", "while", "class", "const", "super", "yield"
91+ , "double", "native", "throws", "delete", "return", "switch", "typeof", "export", "import", "public", "static"
92+ , "boolean", "default", "finally", "extends", "package", "private"
93+ , "Infinity", "abstract", "volatile", "function", "continue", "debugger", "function"
94+ , "undefined", "arguments", "transient", "interface", "protected"
95+ , "instanceof", "implements"
96+ , "synchronized"
97+ ]
98+
99+
100+elmReservedWords :: Set.Set Text
101+elmReservedWords =
102+ Set.fromList
103+ [ "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
86104 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
87105 ]
88106
@@ -119,3 +137,113 @@ globalToName (ModuleName.Canonical (Pkg.Name user project) moduleName) name =
119137 <> "$" <> Text.replace "." "_" moduleName
120138 <> "$" <> revisedName
121139
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