git.iko.soy/elk
on 4953132 help sign in
elk/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 , 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.toBuilder (Text.replace "." "$" 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.toBuilder 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 (numStartBytes * numInnerBytes) allBadFields (n - 53)
237intToAsciiHelp :: Int -> [BadFields] -> Int -> S.ShortByteString
238intToAsciiHelp blockSize badFields n =
239 case badFields of
240 [] ->
241 if n < blockSize then
242 unsafeIntToAscii n
243 else
244 intToAsciiHelp (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 n in
250 Map.findWithDefault name name renamings
251 else
252 intToAsciiHelp (blockSize * numInnerBytes) biggerBadFields (n - availableSize)
256-- UNSAFE INT TO ASCII
259unsafeIntToAscii :: Int -> S.ShortByteString
260unsafeIntToAscii n =
261 let
262 (quotient, remainder) =
263 quotRem n numStartBytes
264 in
265 S.pack $ toByte remainder : unsafeIntToAsciiHelp quotient
268unsafeIntToAsciiHelp :: Int -> [Word8]
269unsafeIntToAsciiHelp n =
270 if n == 0 then
271 []
272 else
273 let (quotient, remainder) = quotRem n numInnerBytes in
274 toByte remainder : unsafeIntToAsciiHelp 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 == 53 = 95 {- _ -}
296 | n == 54 = 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 maxName =
326 numStartBytes * numInnerBytes ^ (N.length keyword - 1) - 1
327 in
328 case maybeBadFields of
329 Nothing ->
330 BadFields $ Map.singleton (N.toShort keyword) (unsafeIntToAscii maxName)
332 Just (BadFields renamings) ->
333 BadFields $ Map.insert (N.toShort keyword) (unsafeIntToAscii (maxName - Map.size renamings)) renamings