git.iko.soy/elk
on 71fa816 help sign in
elk/compiler/src/Generate/JavaScript/Name.hs
261 lines 5.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.Name
4 ( Name
5 , toBuilder
6 , fromIndex
7 , fromInt
8 , fromLocal
9 , fromGlobal
10 , fromCycle
11 , fromKernel
12 , makeF
13 , makeA
14 , makeLabel
15 , makeTemp
16 , dollar
17 )
18 where
21import qualified Data.ByteString.Builder as B
22import Data.Monoid ((<>))
23import qualified Data.Map as Map
24import qualified Data.Name as Name
25import qualified Data.Set as Set
26import qualified Data.Utf8 as Utf8
27import Data.Word (Word8)
29import qualified Data.Index as Index
30import qualified Elm.ModuleName as ModuleName
31import qualified Elm.Package as Pkg
35-- NAME
38newtype Name =
39 Name { toBuilder :: B.Builder }
43-- CONSTRUCTORS
46fromIndex :: Index.ZeroBased -> Name
47fromIndex index =
48 fromInt (Index.toMachine index)
51fromInt :: Int -> Name
52fromInt n =
53 Name (Name.toBuilder (intToAscii n))
56fromLocal :: Name.Name -> Name
57fromLocal name =
58 if Set.member name reservedNames then
59 Name ("_" <> Name.toBuilder name)
60 else
61 Name (Name.toBuilder name)
64fromGlobal :: ModuleName.Canonical -> Name.Name -> Name
65fromGlobal home name =
66 Name $ homeToBuilder home <> usd <> Name.toBuilder name
69fromCycle :: ModuleName.Canonical -> Name.Name -> Name
70fromCycle home name =
71 Name $ homeToBuilder home <> "$cyclic$" <> Name.toBuilder name
74fromKernel :: Name.Name -> Name.Name -> Name
75fromKernel home name =
76 Name ("_" <> Name.toBuilder home <> "_" <> Name.toBuilder name)
79{-# INLINE homeToBuilder #-}
80homeToBuilder :: ModuleName.Canonical -> B.Builder
81homeToBuilder (ModuleName.Canonical (Pkg.Name author project) home) =
82 usd <>
83 Utf8.toEscapedBuilder 0x2D {- - -} 0x5F {- _ -} author
84 <> usd <>
85 Utf8.toEscapedBuilder 0x2D {- - -} 0x5F {- _ -} project
86 <> usd <>
87 Utf8.toEscapedBuilder 0x2E {- . -} 0x24 {- $ -} home
91-- TEMPORARY NAMES
94makeF :: Int -> Name
95makeF n =
96 Name ("F" <> B.intDec n)
99makeA :: Int -> Name
100makeA n =
101 Name ("A" <> B.intDec n)
104makeLabel :: Name.Name -> Int -> Name
105makeLabel name index =
106 Name (Name.toBuilder name <> usd <> B.intDec index)
109makeTemp :: Name.Name -> Name
110makeTemp name =
111 Name ("$temp$" <> Name.toBuilder name)
114dollar :: Name
115dollar =
116 Name usd
119usd :: B.Builder
120usd =
121 Name.toBuilder Name.dollar
125-- RESERVED NAMES
128{-# NOINLINE reservedNames #-}
129reservedNames :: Set.Set Name.Name
130reservedNames =
131 Set.union jsReservedWords elmReservedWords
134jsReservedWords :: Set.Set Name.Name
135jsReservedWords =
136 Set.fromList
137 [ "do", "if", "in"
138 , "NaN", "int", "for", "new", "try", "var", "let"
139 , "null", "true", "eval", "byte", "char", "goto", "long", "case", "else", "this", "void", "with", "enum"
140 , "false", "final", "float", "short", "break", "catch", "throw", "while", "class", "const", "super", "yield"
141 , "double", "native", "throws", "delete", "return", "switch", "typeof", "export", "import", "public", "static"
142 , "boolean", "default", "finally", "extends", "package", "private"
143 , "Infinity", "abstract", "volatile", "function", "continue", "debugger", "function"
144 , "undefined", "arguments", "transient", "interface", "protected"
145 , "instanceof", "implements"
146 , "synchronized"
147 ]
150elmReservedWords :: Set.Set Name.Name
151elmReservedWords =
152 Set.fromList
153 [ "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
154 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
155 ]
159-- INT TO ASCII
162intToAscii :: Int -> Name.Name
163intToAscii n =
164 if n < 53 then -- skip $ as a standalone name
165 Name.fromWords [toByte n]
167 else
168 intToAsciiHelp 2 (numStartBytes * numInnerBytes) allBadFields (n - 53)
171intToAsciiHelp :: Int -> Int -> [BadFields] -> Int -> Name.Name
172intToAsciiHelp width blockSize badFields n =
173 case badFields of
174 [] ->
175 if n < blockSize then
176 unsafeIntToAscii width [] n
177 else
178 intToAsciiHelp (width + 1) (blockSize * numInnerBytes) [] (n - blockSize)
180 BadFields renamings : biggerBadFields ->
181 let availableSize = blockSize - Map.size renamings in
182 if n < availableSize then
183 let name = unsafeIntToAscii width [] n in
184 Map.findWithDefault name name renamings
185 else
186 intToAsciiHelp (width + 1) (blockSize * numInnerBytes) biggerBadFields (n - availableSize)
190-- UNSAFE INT TO ASCII
193unsafeIntToAscii :: Int -> [Word8] -> Int -> Name.Name
194unsafeIntToAscii width bytes n =
195 if width <= 1 then
196 Name.fromWords (toByte n : bytes)
197 else
198 let
199 (quotient, remainder) =
200 quotRem n numInnerBytes
201 in
202 unsafeIntToAscii (width - 1) (toByte remainder : bytes) quotient
206-- ASCII BYTES
209numStartBytes :: Int
210numStartBytes =
211 54
214numInnerBytes :: Int
215numInnerBytes =
216 64
219toByte :: Int -> Word8
220toByte n
221 | n < 26 = fromIntegral (97 + n ) {- lower -}
222 | n < 52 = fromIntegral (65 + n - 26) {- upper -}
223 | n == 52 = 95 {- _ -}
224 | n == 53 = 36 {- $ -}
225 | n < 64 = fromIntegral (48 + n - 54) {- digit -}
226 | True = error $ "cannot convert int " ++ show n ++ " to ASCII"
230-- BAD FIELDS
233newtype BadFields =
234 BadFields { _renamings :: Renamings }
237type Renamings =
238 Map.Map Name.Name Name.Name
241allBadFields :: [BadFields]
242allBadFields =
243 let
244 add keyword dict =
245 Map.alter (Just . addRenaming keyword) (Utf8.size keyword) dict
246 in
247 Map.elems $ Set.foldr add Map.empty jsReservedWords
250addRenaming :: Name.Name -> Maybe BadFields -> BadFields
251addRenaming keyword maybeBadFields =
252 let
253 width = Utf8.size keyword
254 maxName = numStartBytes * numInnerBytes ^ (width - 1) - 1
255 in
256 case maybeBadFields of
257 Nothing ->
258 BadFields $ Map.singleton keyword (unsafeIntToAscii width [] maxName)
260 Just (BadFields renamings) ->
261 BadFields $ Map.insert keyword (unsafeIntToAscii width [] (maxName - Map.size renamings)) renamings