git.iko.soy/elk
on 4290da5 help sign in
elk/compiler/src/Generate/JavaScript/Name.hs
333 lines 7.4 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.Name
4 ( Name
5 , Mode(..)
6 , Target(..)
7 , Debugger(..)
8 , isServer
9 , toBuilder
10 , fromIndex
11 , fromInt
12 , fromLocal
13 , fromGlobal
14 , fromCycle
15 , fromKernel
16 , fromField
17 , makeF
18 , makeA
19 , makeLabel
20 , makeTemp
21 , dollar
22 , shortenFieldNames
23 )
24 where
27import qualified Data.ByteString.Builder as B
28import qualified Data.ByteString.Short as S
29import qualified Data.List as List
30import Data.Monoid ((<>))
31import Data.Map ((!))
32import qualified Data.Map as Map
33import qualified Data.Set as Set
34import qualified Data.Text as Text
35import qualified Data.Text.Encoding as Text
36import Data.Word (Word8)
38import qualified AST.Module.Name as ModuleName
39import qualified Data.Index as Index
40import qualified Elm.Name as N
41import qualified Elm.Package as Pkg
45-- NAME
48newtype Name =
49 Name { toBuilder :: B.Builder }
53-- MODE
56data Mode
57 = Dev Target Debugger
58 | Prod Target ShortFieldNames
61data Target = Client | Server
64data Debugger
65 = DebuggerOn
66 | DebuggerOff
69type ShortFieldNames =
70 Map.Map N.Name Name
73isServer :: Mode -> Bool
74isServer mode =
75 case mode of
76 Dev target _ -> isServerHelp target
77 Prod target _ -> isServerHelp target
80isServerHelp :: Target -> Bool
81isServerHelp target =
82 case target of { Client -> False ; Server -> True }
86-- CONSTRUCTORS
89fromIndex :: Index.ZeroBased -> Name
90fromIndex index =
91 fromInt (Index.toMachine index)
94fromInt :: Int -> Name
95fromInt n =
96 Name (B.shortByteString (intToAscii n))
99fromLocal :: N.Name -> Name
100fromLocal name =
101 if Set.member name reservedNames then
102 Name ("_" <> N.toBuilder name)
103 else
104 Name (N.toBuilder name)
107fromGlobal :: ModuleName.Canonical -> N.Name -> Name
108fromGlobal (ModuleName.Canonical (Pkg.Name user project) home) name =
109 Name $
110 Text.encodeUtf8Builder (Text.replace "-" "_" user)
111 <> "$" <> Text.encodeUtf8Builder (Text.replace "-" "_" project) -- TODO store this in a better way
112 <> "$" <> N.toDotlessBuilder home
113 <> "$" <> N.toBuilder name
116fromCycle :: ModuleName.Canonical -> N.Name -> Name
117fromCycle (ModuleName.Canonical (Pkg.Name user project) home) name =
118 Name $
119 Text.encodeUtf8Builder (Text.replace "-" "_" user)
120 <> "$" <> Text.encodeUtf8Builder (Text.replace "-" "_" project) -- TODO store this in a better way
121 <> "$" <> N.toDotlessBuilder home
122 <> "$cyclic$" <> N.toBuilder name
125fromKernel :: N.Name -> N.Name -> Name
126fromKernel home name =
127 Name ("_" <> N.toBuilder home <> "_" <> N.toBuilder name)
130fromField :: Mode -> N.Name -> Name
131fromField mode name =
132 case mode of
133 Dev _ _ ->
134 Name (N.toBuilder name)
136 Prod _ fields ->
137 fields ! name
141-- TEMPORARY NAMES
144makeF :: Int -> Name
145makeF n =
146 Name ("F" <> B.intDec n)
149makeA :: Int -> Name
150makeA n =
151 Name ("A" <> B.intDec n)
154makeLabel :: N.Name -> Int -> Name
155makeLabel name index =
156 Name (N.toBuilder name <> "$" <> B.intDec index)
159makeTemp :: N.Name -> Name
160makeTemp name =
161 Name ("$temp$" <> N.toBuilder name)
164dollar :: Name
165dollar =
166 Name (N.toBuilder N.dollar)
170-- SHORTEN FIELD NAMES
173shortenFieldNames :: Map.Map N.Name Int -> ShortFieldNames
174shortenFieldNames frequencies =
175 Map.foldr addToShortNames Map.empty $
176 Map.foldrWithKey addToBuckets Map.empty frequencies
179addToBuckets :: N.Name -> Int -> Map.Map Int [N.Name] -> Map.Map Int [N.Name]
180addToBuckets field frequency buckets =
181 -- TODO try using an IntMap for buckets
182 Map.insertWith (++) frequency [field] buckets
185addToShortNames :: [N.Name] -> ShortFieldNames -> ShortFieldNames
186addToShortNames fields shortNames =
187 List.foldl' addField shortNames fields
190addField :: ShortFieldNames -> N.Name -> ShortFieldNames
191addField shortNames field =
192 let rename = fromInt (Map.size shortNames) in
193 Map.insert field rename shortNames
197-- RESERVED NAMES
200{-# NOINLINE reservedNames #-}
201reservedNames :: Set.Set N.Name
202reservedNames =
203 Set.union jsReservedWords elmReservedWords
206jsReservedWords :: Set.Set N.Name
207jsReservedWords =
208 Set.fromList
209 [ "do", "if", "in"
210 , "NaN", "int", "for", "new", "try", "var", "let"
211 , "null", "true", "eval", "byte", "char", "goto", "long", "case", "else", "this", "void", "with", "enum"
212 , "false", "final", "float", "short", "break", "catch", "throw", "while", "class", "const", "super", "yield"
213 , "double", "native", "throws", "delete", "return", "switch", "typeof", "export", "import", "public", "static"
214 , "boolean", "default", "finally", "extends", "package", "private"
215 , "Infinity", "abstract", "volatile", "function", "continue", "debugger", "function"
216 , "undefined", "arguments", "transient", "interface", "protected"
217 , "instanceof", "implements"
218 , "synchronized"
219 ]
222elmReservedWords :: Set.Set N.Name
223elmReservedWords =
224 Set.fromList
225 [ "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
226 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
227 ]
231-- INT TO ASCII
234intToAscii :: Int -> S.ShortByteString
235intToAscii n =
236 if n < 53 then -- skip $ as a standalone name
237 S.pack [toByte n]
239 else
240 intToAsciiHelp 2 (numStartBytes * numInnerBytes) allBadFields (n - 53)
243intToAsciiHelp :: Int -> Int -> [BadFields] -> Int -> S.ShortByteString
244intToAsciiHelp width blockSize badFields n =
245 case badFields of
246 [] ->
247 if n < blockSize then
248 unsafeIntToAscii width [] n
249 else
250 intToAsciiHelp (width + 1) (blockSize * numInnerBytes) [] (n - blockSize)
252 BadFields renamings : biggerBadFields ->
253 let availableSize = blockSize - Map.size renamings in
254 if n < availableSize then
255 let name = unsafeIntToAscii width [] n in
256 Map.findWithDefault name name renamings
257 else
258 intToAsciiHelp (width + 1) (blockSize * numInnerBytes) biggerBadFields (n - availableSize)
262-- UNSAFE INT TO ASCII
265unsafeIntToAscii :: Int -> [Word8] -> Int -> S.ShortByteString
266unsafeIntToAscii width bytes n =
267 if width <= 1 then
268 S.pack (toByte n : bytes)
269 else
270 let
271 (quotient, remainder) =
272 quotRem n numInnerBytes
273 in
274 unsafeIntToAscii (width - 1) (toByte remainder : bytes) quotient
278-- ASCII BYTES
281numStartBytes :: Int
282numStartBytes =
283 54
286numInnerBytes :: Int
287numInnerBytes =
288 64
291toByte :: Int -> Word8
292toByte n
293 | n < 26 = fromIntegral (97 + n ) {- lower -}
294 | n < 52 = fromIntegral (65 + n - 26) {- upper -}
295 | n == 52 = 95 {- _ -}
296 | n == 53 = 36 {- $ -}
297 | n < 64 = fromIntegral (48 + n - 54) {- digit -}
298 | True = error $ "cannot convert int " ++ show n ++ " to ASCII"
302-- BAD FIELDS
305newtype BadFields =
306 BadFields { _renamings :: Renamings }
309type Renamings =
310 Map.Map S.ShortByteString S.ShortByteString
313allBadFields :: [BadFields]
314allBadFields =
315 let
316 add keyword dict =
317 Map.alter (Just . addRenaming keyword) (N.length keyword) dict
318 in
319 Map.elems $ Set.foldr add Map.empty jsReservedWords
322addRenaming :: N.Name -> Maybe BadFields -> BadFields
323addRenaming keyword maybeBadFields =
324 let
325 width = N.length keyword
326 maxName = numStartBytes * numInnerBytes ^ (width - 1) - 1
327 in
328 case maybeBadFields of
329 Nothing ->
330 BadFields $ Map.singleton (N.toShort keyword) (unsafeIntToAscii width [] maxName)
332 Just (BadFields renamings) ->
333 BadFields $ Map.insert (N.toShort keyword) (unsafeIntToAscii width [] (maxName - Map.size renamings)) renamings