git.iko.soy/elk
on 7130d19 help sign in
elk/src/Generate/JavaScript/Name.hs
321 lines 7.2 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 , makeLabel
17 , makeTemp
18 , dollar
19 , shortenFieldNames
20 )
21 where
24import qualified Data.ByteString.Builder as B
25import qualified Data.ByteString.Short as S
26import qualified Data.List as List
27import Data.Monoid ((<>))
28import Data.Map ((!))
29import qualified Data.Map as Map
30import qualified Data.Set as Set
31import qualified Data.Text as Text
32import qualified Data.Text.Encoding as Text
33import Data.Word (Word8)
35import qualified AST.Module.Name as ModuleName
36import qualified Data.Index as Index
37import qualified Elm.Name as N
38import qualified Elm.Package as Pkg
42-- NAME
45newtype Name =
46 Name { toBuilder :: B.Builder }
50-- MODE
53data Mode
54 = Debug Target
55 | Prod Target ShortFieldNames
58data Target = Client | Server
61type ShortFieldNames =
62 Map.Map N.Name Name
65isServer :: Mode -> Bool
66isServer mode =
67 case mode of
68 Debug target -> isServerHelp target
69 Prod target _ -> isServerHelp target
72isServerHelp :: Target -> Bool
73isServerHelp target =
74 case target of { Client -> False ; Server -> True }
78-- CONSTRUCTORS
81fromIndex :: Index.ZeroBased -> Name
82fromIndex index =
83 fromInt (Index.toMachine index)
86fromInt :: Int -> Name
87fromInt n =
88 Name (B.shortByteString (intToAscii n))
91fromLocal :: N.Name -> Name
92fromLocal name =
93 if Set.member name reservedNames then
94 Name ("_" <> N.toBuilder name)
95 else
96 Name (N.toBuilder name)
99fromGlobal :: ModuleName.Canonical -> N.Name -> Name
100fromGlobal (ModuleName.Canonical (Pkg.Name user project) home) name =
101 Name $
102 Text.encodeUtf8Builder (Text.replace "-" "_" user)
103 <> "$" <> Text.encodeUtf8Builder (Text.replace "-" "_" project) -- TODO store this in a better way
104 <> "$" <> N.toBuilder home
105 <> "$" <> N.toBuilder name
108fromCycle :: ModuleName.Canonical -> N.Name -> Name
109fromCycle (ModuleName.Canonical (Pkg.Name user project) home) name =
110 Name $
111 Text.encodeUtf8Builder (Text.replace "-" "_" user)
112 <> "$" <> Text.encodeUtf8Builder (Text.replace "-" "_" project) -- TODO store this in a better way
113 <> "$" <> N.toBuilder home
114 <> "$cyclic$" <> N.toBuilder name
117fromKernel :: N.Name -> N.Name -> Name
118fromKernel home name =
119 Name ("_" <> N.toBuilder home <> "_" <> N.toBuilder name)
122fromField :: Mode -> N.Name -> Name
123fromField mode name =
124 case mode of
125 Debug _ ->
126 Name (N.toBuilder name)
128 Prod _ fields ->
129 fields ! name
133-- TEMPORARY NAMES
136makeLabel :: N.Name -> Int -> Name
137makeLabel name index =
138 Name (N.toBuilder name <> "$" <> B.intDec index)
141makeTemp :: N.Name -> Name
142makeTemp name =
143 Name ("$temp$" <> N.toBuilder name)
146dollar :: Name
147dollar =
148 Name (N.toBuilder N.dollar)
152-- SHORTEN FIELD NAMES
155shortenFieldNames :: Map.Map N.Name Int -> ShortFieldNames
156shortenFieldNames frequencies =
157 Map.foldr addToShortNames Map.empty $
158 Map.foldrWithKey addToBuckets Map.empty frequencies
161addToBuckets :: N.Name -> Int -> Map.Map Int [N.Name] -> Map.Map Int [N.Name]
162addToBuckets field frequency buckets =
163 -- TODO try using an IntMap for buckets
164 Map.insertWith (++) frequency [field] buckets
167addToShortNames :: [N.Name] -> ShortFieldNames -> ShortFieldNames
168addToShortNames fields shortNames =
169 List.foldl' addField shortNames fields
172addField :: ShortFieldNames -> N.Name -> ShortFieldNames
173addField shortNames field =
174 let rename = fromInt (Map.size shortNames) in
175 Map.insert field rename shortNames
179-- RESERVED NAMES
182{-# NOINLINE reservedNames #-}
183reservedNames :: Set.Set N.Name
184reservedNames =
185 Set.union jsReservedWords elmReservedWords
188jsReservedWords :: Set.Set N.Name
189jsReservedWords =
190 Set.fromList
191 [ "do", "if", "in"
192 , "NaN", "int", "for", "new", "try", "var", "let"
193 , "null", "true", "eval", "byte", "char", "goto", "long", "case", "else", "this", "void", "with", "enum"
194 , "false", "final", "float", "short", "break", "catch", "throw", "while", "class", "const", "super", "yield"
195 , "double", "native", "throws", "delete", "return", "switch", "typeof", "export", "import", "public", "static"
196 , "boolean", "default", "finally", "extends", "package", "private"
197 , "Infinity", "abstract", "volatile", "function", "continue", "debugger", "function"
198 , "undefined", "arguments", "transient", "interface", "protected"
199 , "instanceof", "implements"
200 , "synchronized"
201 ]
204elmReservedWords :: Set.Set N.Name
205elmReservedWords =
206 Set.fromList
207 [ "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
208 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
209 ]
213-- INT TO ASCII
216intToAscii :: Int -> S.ShortByteString
217intToAscii n =
218 if n < 53 then -- skip $ as a standalone name
219 S.pack [toByte n]
221 else
222 intToAsciiHelp (numStartBytes * numInnerBytes) allBadFields (n - 53)
225intToAsciiHelp :: Int -> [BadFields] -> Int -> S.ShortByteString
226intToAsciiHelp blockSize badFields n =
227 case badFields of
228 [] ->
229 if n < blockSize then
230 unsafeIntToAscii n
231 else
232 intToAsciiHelp (blockSize * numInnerBytes) [] (n - blockSize)
234 BadFields renamings : biggerBadFields ->
235 let availableSize = blockSize - Map.size renamings in
236 if n < availableSize then
237 let name = unsafeIntToAscii n in
238 Map.findWithDefault name name renamings
239 else
240 intToAsciiHelp (blockSize * numInnerBytes) biggerBadFields (n - availableSize)
244-- UNSAFE INT TO ASCII
247unsafeIntToAscii :: Int -> S.ShortByteString
248unsafeIntToAscii n =
249 let
250 (quotient, remainder) =
251 quotRem n numStartBytes
252 in
253 S.pack $ toByte remainder : unsafeIntToAsciiHelp quotient
256unsafeIntToAsciiHelp :: Int -> [Word8]
257unsafeIntToAsciiHelp n =
258 if n == 0 then
259 []
260 else
261 let (quotient, remainder) = quotRem n numInnerBytes in
262 toByte remainder : unsafeIntToAsciiHelp quotient
266-- ASCII BYTES
269numStartBytes :: Int
270numStartBytes =
271 54
274numInnerBytes :: Int
275numInnerBytes =
276 64
279toByte :: Int -> Word8
280toByte n
281 | n < 26 = fromIntegral (97 + n ) {- lower -}
282 | n < 52 = fromIntegral (65 + n - 26) {- upper -}
283 | n == 53 = 95 {- _ -}
284 | n == 54 = 36 {- $ -}
285 | n < 64 = fromIntegral (48 + n - 54) {- digit -}
286 | True = error $ "cannot convert int " ++ show n ++ " to ASCII"
290-- BAD FIELDS
293newtype BadFields =
294 BadFields { _renamings :: Renamings }
297type Renamings =
298 Map.Map S.ShortByteString S.ShortByteString
301allBadFields :: [BadFields]
302allBadFields =
303 let
304 add keyword dict =
305 Map.alter (Just . addRenaming keyword) (N.length keyword) dict
306 in
307 Map.elems $ Set.foldr add Map.empty jsReservedWords
310addRenaming :: N.Name -> Maybe BadFields -> BadFields
311addRenaming keyword maybeBadFields =
312 let
313 maxName =
314 numStartBytes * numInnerBytes ^ (N.length keyword - 1) - 1
315 in
316 case maybeBadFields of
317 Nothing ->
318 BadFields $ Map.singleton (N.toShort keyword) (unsafeIntToAscii maxName)
320 Just (BadFields renamings) ->
321 BadFields $ Map.insert (N.toShort keyword) (unsafeIntToAscii (maxName - Map.size renamings)) renamings