git.iko.soy/elk
on fdf2d75 help sign in
elk/compiler/src/Generate/JavaScript/Name.hs
327 lines 7.3 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.Name
4 ( Name
5 , Mode(..)
6 , Target(..)
7 , isServer
8 , toBuilder
9 , fromIndex
10 , fromInt
11 , fromLocal
12 , fromGlobal
13 , fromCycle
14 , fromKernel
15 , fromField
16 , makeF
17 , makeA
18 , makeLabel
19 , makeTemp
20 , dollar
21 , shortenFieldNames
22 )
23 where
26import qualified Data.ByteString.Builder as B
27import qualified Data.ByteString.Short as S
28import qualified Data.List as List
29import Data.Monoid ((<>))
30import Data.Map ((!))
31import qualified Data.Map as Map
32import qualified Data.Set as Set
33import qualified Data.Text as Text
34import qualified Data.Text.Encoding as Text
35import Data.Word (Word8)
37import qualified AST.Module.Name as ModuleName
38import qualified Data.Index as Index
39import qualified Elm.Name as N
40import qualified Elm.Package as Pkg
44-- NAME
47newtype Name =
48 Name { toBuilder :: B.Builder }
52-- MODE
55data Mode
56 = Debug Target
57 | Prod Target ShortFieldNames
60data Target = Client | Server
63type ShortFieldNames =
64 Map.Map N.Name Name
67isServer :: Mode -> Bool
68isServer mode =
69 case mode of
70 Debug target -> isServerHelp target
71 Prod target _ -> isServerHelp target
74isServerHelp :: Target -> Bool
75isServerHelp target =
76 case target of { Client -> False ; Server -> True }
80-- CONSTRUCTORS
83fromIndex :: Index.ZeroBased -> Name
84fromIndex index =
85 fromInt (Index.toMachine index)
88fromInt :: Int -> Name
89fromInt n =
90 Name (B.shortByteString (intToAscii n))
93fromLocal :: N.Name -> Name
94fromLocal name =
95 if Set.member name reservedNames then
96 Name ("_" <> N.toBuilder name)
97 else
98 Name (N.toBuilder name)
101fromGlobal :: ModuleName.Canonical -> N.Name -> Name
102fromGlobal (ModuleName.Canonical (Pkg.Name user project) home) name =
103 Name $
104 Text.encodeUtf8Builder (Text.replace "-" "_" user)
105 <> "$" <> Text.encodeUtf8Builder (Text.replace "-" "_" project) -- TODO store this in a better way
106 <> "$" <> N.toDotlessBuilder home
107 <> "$" <> N.toBuilder name
110fromCycle :: ModuleName.Canonical -> N.Name -> Name
111fromCycle (ModuleName.Canonical (Pkg.Name user project) home) name =
112 Name $
113 Text.encodeUtf8Builder (Text.replace "-" "_" user)
114 <> "$" <> Text.encodeUtf8Builder (Text.replace "-" "_" project) -- TODO store this in a better way
115 <> "$" <> N.toDotlessBuilder home
116 <> "$cyclic$" <> N.toBuilder name
119fromKernel :: N.Name -> N.Name -> Name
120fromKernel home name =
121 Name ("_" <> N.toBuilder home <> "_" <> N.toBuilder name)
124fromField :: Mode -> N.Name -> Name
125fromField mode name =
126 case mode of
127 Debug _ ->
128 Name (N.toBuilder name)
130 Prod _ fields ->
131 fields ! name
135-- TEMPORARY NAMES
138makeF :: Int -> Name
139makeF n =
140 Name ("F" <> B.intDec n)
143makeA :: Int -> Name
144makeA n =
145 Name ("A" <> B.intDec n)
148makeLabel :: N.Name -> Int -> Name
149makeLabel name index =
150 Name (N.toBuilder name <> "$" <> B.intDec index)
153makeTemp :: N.Name -> Name
154makeTemp name =
155 Name ("$temp$" <> N.toBuilder name)
158dollar :: Name
159dollar =
160 Name (N.toBuilder N.dollar)
164-- SHORTEN FIELD NAMES
167shortenFieldNames :: Map.Map N.Name Int -> ShortFieldNames
168shortenFieldNames frequencies =
169 Map.foldr addToShortNames Map.empty $
170 Map.foldrWithKey addToBuckets Map.empty frequencies
173addToBuckets :: N.Name -> Int -> Map.Map Int [N.Name] -> Map.Map Int [N.Name]
174addToBuckets field frequency buckets =
175 -- TODO try using an IntMap for buckets
176 Map.insertWith (++) frequency [field] buckets
179addToShortNames :: [N.Name] -> ShortFieldNames -> ShortFieldNames
180addToShortNames fields shortNames =
181 List.foldl' addField shortNames fields
184addField :: ShortFieldNames -> N.Name -> ShortFieldNames
185addField shortNames field =
186 let rename = fromInt (Map.size shortNames) in
187 Map.insert field rename shortNames
191-- RESERVED NAMES
194{-# NOINLINE reservedNames #-}
195reservedNames :: Set.Set N.Name
196reservedNames =
197 Set.union jsReservedWords elmReservedWords
200jsReservedWords :: Set.Set N.Name
201jsReservedWords =
202 Set.fromList
203 [ "do", "if", "in"
204 , "NaN", "int", "for", "new", "try", "var", "let"
205 , "null", "true", "eval", "byte", "char", "goto", "long", "case", "else", "this", "void", "with", "enum"
206 , "false", "final", "float", "short", "break", "catch", "throw", "while", "class", "const", "super", "yield"
207 , "double", "native", "throws", "delete", "return", "switch", "typeof", "export", "import", "public", "static"
208 , "boolean", "default", "finally", "extends", "package", "private"
209 , "Infinity", "abstract", "volatile", "function", "continue", "debugger", "function"
210 , "undefined", "arguments", "transient", "interface", "protected"
211 , "instanceof", "implements"
212 , "synchronized"
213 ]
216elmReservedWords :: Set.Set N.Name
217elmReservedWords =
218 Set.fromList
219 [ "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
220 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
221 ]
225-- INT TO ASCII
228intToAscii :: Int -> S.ShortByteString
229intToAscii n =
230 if n < 53 then -- skip $ as a standalone name
231 S.pack [toByte n]
233 else
234 intToAsciiHelp 2 (numStartBytes * numInnerBytes) allBadFields (n - 53)
237intToAsciiHelp :: Int -> Int -> [BadFields] -> Int -> S.ShortByteString
238intToAsciiHelp width blockSize badFields n =
239 case badFields of
240 [] ->
241 if n < blockSize then
242 unsafeIntToAscii width [] n
243 else
244 intToAsciiHelp (width + 1) (blockSize * numInnerBytes) [] (n - blockSize)
246 BadFields renamings : biggerBadFields ->
247 let availableSize = blockSize - Map.size renamings in
248 if n < availableSize then
249 let name = unsafeIntToAscii width [] n in
250 Map.findWithDefault name name renamings
251 else
252 intToAsciiHelp (width + 1) (blockSize * numInnerBytes) biggerBadFields (n - availableSize)
256-- UNSAFE INT TO ASCII
259unsafeIntToAscii :: Int -> [Word8] -> Int -> S.ShortByteString
260unsafeIntToAscii width bytes n =
261 if width <= 1 then
262 S.pack (toByte n : bytes)
263 else
264 let
265 (quotient, remainder) =
266 quotRem n numInnerBytes
267 in
268 unsafeIntToAscii (width - 1) (toByte remainder : bytes) quotient
272-- ASCII BYTES
275numStartBytes :: Int
276numStartBytes =
277 54
280numInnerBytes :: Int
281numInnerBytes =
282 64
285toByte :: Int -> Word8
286toByte n
287 | n < 26 = fromIntegral (97 + n ) {- lower -}
288 | n < 52 = fromIntegral (65 + n - 26) {- upper -}
289 | n == 52 = 95 {- _ -}
290 | n == 53 = 36 {- $ -}
291 | n < 64 = fromIntegral (48 + n - 54) {- digit -}
292 | True = error $ "cannot convert int " ++ show n ++ " to ASCII"
296-- BAD FIELDS
299newtype BadFields =
300 BadFields { _renamings :: Renamings }
303type Renamings =
304 Map.Map S.ShortByteString S.ShortByteString
307allBadFields :: [BadFields]
308allBadFields =
309 let
310 add keyword dict =
311 Map.alter (Just . addRenaming keyword) (N.length keyword) dict
312 in
313 Map.elems $ Set.foldr add Map.empty jsReservedWords
316addRenaming :: N.Name -> Maybe BadFields -> BadFields
317addRenaming keyword maybeBadFields =
318 let
319 width = N.length keyword
320 maxName = numStartBytes * numInnerBytes ^ (width - 1) - 1
321 in
322 case maybeBadFields of
323 Nothing ->
324 BadFields $ Map.singleton (N.toShort keyword) (unsafeIntToAscii width [] maxName)
326 Just (BadFields renamings) ->
327 BadFields $ Map.insert (N.toShort keyword) (unsafeIntToAscii width [] (maxName - Map.size renamings)) renamings