git.iko.soy/elk
on 42c3f75 help sign in
elk/src/Generate/JavaScript/Name.hs
264 lines 5.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.Name
4 ( Name
5 , Mode(..)
6 , toBuilder
7 , fromInt
8 , fromLocal
9 , fromGlobal
10 , fromCycle
11 , fromKernel
12 , fromField
13 , makeLabel
14 , makeTemp
15 , dollar
16 )
17 where
20import qualified Data.ByteString.Builder as B
21import qualified Data.ByteString.Short as S
22import Data.Monoid ((<>))
23import Data.Map ((!))
24import qualified Data.Map as Map
25import qualified Data.Set as Set
26import qualified Data.Text as Text
27import qualified Data.Text.Encoding as Text
28import Data.Word (Word8)
30import qualified AST.Module.Name as ModuleName
31import qualified Elm.Name as N
32import qualified Elm.Package as Pkg
36-- NAME
39newtype Name =
40 Name { toBuilder :: B.Builder }
44-- MODE
47data Mode
48 = Debug
49 | Prod (Map.Map N.Name B.Builder)
53-- CONSTRUCTORS
56fromInt :: Int -> Name
57fromInt n =
58 Name (B.shortByteString (intToAscii n))
61fromLocal :: N.Name -> Name
62fromLocal name =
63 if Set.member name reservedNames then
64 Name ("_" <> N.toBuilder name)
65 else
66 Name (N.toBuilder name)
69fromGlobal :: ModuleName.Canonical -> N.Name -> Name
70fromGlobal (ModuleName.Canonical (Pkg.Name user project) home) name =
71 Name $
72 Text.encodeUtf8Builder (Text.replace "-" "_" user)
73 <> "$" <> Text.encodeUtf8Builder (Text.replace "-" "_" project) -- TODO store this in a better way
74 <> "$" <> N.toBuilder home
75 <> "$" <> N.toBuilder name
78fromCycle :: ModuleName.Canonical -> N.Name -> Name
79fromCycle (ModuleName.Canonical (Pkg.Name user project) home) name =
80 Name $
81 Text.encodeUtf8Builder (Text.replace "-" "_" user)
82 <> "$" <> Text.encodeUtf8Builder (Text.replace "-" "_" project) -- TODO store this in a better way
83 <> "$" <> N.toBuilder home
84 <> "$cyclic$" <> N.toBuilder name
87fromKernel :: N.Name -> N.Name -> Name
88fromKernel home name =
89 Name ("_" <> N.toBuilder home <> "_" <> N.toBuilder name)
92fromField :: Mode -> N.Name -> Name
93fromField mode name =
94 case mode of
95 Debug ->
96 Name (N.toBuilder name)
98 Prod fields ->
99 Name (fields ! name)
103-- TEMPORARY NAMES
106makeLabel :: N.Name -> Int -> Name
107makeLabel name index =
108 Name (N.toBuilder name <> "$" <> B.intDec index)
111makeTemp :: N.Name -> Name
112makeTemp name =
113 Name ("$temp$" <> N.toBuilder name)
116dollar :: Name
117dollar =
118 Name (N.toBuilder N.dollar)
122-- RESERVED NAMES
125{-# NOINLINE reservedNames #-}
126reservedNames :: Set.Set N.Name
127reservedNames =
128 Set.union jsReservedWords elmReservedWords
131jsReservedWords :: Set.Set N.Name
132jsReservedWords =
133 Set.fromList
134 [ "do", "if", "in"
135 , "NaN", "int", "for", "new", "try", "var", "let"
136 , "null", "true", "eval", "byte", "char", "goto", "long", "case", "else", "this", "void", "with", "enum"
137 , "false", "final", "float", "short", "break", "catch", "throw", "while", "class", "const", "super", "yield"
138 , "double", "native", "throws", "delete", "return", "switch", "typeof", "export", "import", "public", "static"
139 , "boolean", "default", "finally", "extends", "package", "private"
140 , "Infinity", "abstract", "volatile", "function", "continue", "debugger", "function"
141 , "undefined", "arguments", "transient", "interface", "protected"
142 , "instanceof", "implements"
143 , "synchronized"
144 ]
147elmReservedWords :: Set.Set N.Name
148elmReservedWords =
149 Set.fromList
150 [ "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
151 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
152 ]
156-- INT TO ASCII
159intToAscii :: Int -> S.ShortByteString
160intToAscii n =
161 if n < 53 then -- skip $ as a standalone name
162 S.pack [toByte n]
164 else
165 intToAsciiHelp (numStartBytes * numInnerBytes) allBadFields (n - 53)
168intToAsciiHelp :: Int -> [BadFields] -> Int -> S.ShortByteString
169intToAsciiHelp blockSize badFields n =
170 case badFields of
171 [] ->
172 if n < blockSize then
173 unsafeIntToAscii n
174 else
175 intToAsciiHelp (blockSize * numInnerBytes) [] (n - blockSize)
177 BadFields renamings : biggerBadFields ->
178 let availableSize = blockSize - Map.size renamings in
179 if n < availableSize then
180 let name = unsafeIntToAscii n in
181 Map.findWithDefault name name renamings
182 else
183 intToAsciiHelp (blockSize * numInnerBytes) biggerBadFields (n - availableSize)
187-- UNSAFE INT TO ASCII
190unsafeIntToAscii :: Int -> S.ShortByteString
191unsafeIntToAscii n =
192 let
193 (quotient, remainder) =
194 quotRem n numStartBytes
195 in
196 S.pack $ toByte remainder : unsafeIntToAsciiHelp quotient
199unsafeIntToAsciiHelp :: Int -> [Word8]
200unsafeIntToAsciiHelp n =
201 if n == 0 then
202 []
203 else
204 let (quotient, remainder) = quotRem n numInnerBytes in
205 toByte remainder : unsafeIntToAsciiHelp quotient
209-- ASCII BYTES
212numStartBytes :: Int
213numStartBytes =
214 54
217numInnerBytes :: Int
218numInnerBytes =
219 64
222toByte :: Int -> Word8
223toByte n
224 | n < 26 = fromIntegral (97 + n ) {- lower -}
225 | n < 52 = fromIntegral (65 + n - 26) {- upper -}
226 | n == 53 = 95 {- _ -}
227 | n == 54 = 36 {- $ -}
228 | n < 64 = fromIntegral (48 + n - 54) {- digit -}
229 | True = error $ "cannot convert int " ++ show n ++ " to ASCII"
233-- BAD FIELDS
236newtype BadFields =
237 BadFields { _renamings :: Renamings }
240type Renamings =
241 Map.Map S.ShortByteString S.ShortByteString
244allBadFields :: [BadFields]
245allBadFields =
246 let
247 add keyword dict =
248 Map.alter (Just . addRenaming keyword) (N.length keyword) dict
249 in
250 Map.elems $ Set.foldr add Map.empty jsReservedWords
253addRenaming :: N.Name -> Maybe BadFields -> BadFields
254addRenaming keyword maybeBadFields =
255 let
256 maxName =
257 numStartBytes * numInnerBytes ^ (N.length keyword - 1) - 1
258 in
259 case maybeBadFields of
260 Nothing ->
261 BadFields $ Map.singleton (N.toShort keyword) (unsafeIntToAscii maxName)
263 Just (BadFields renamings) ->
264 BadFields $ Map.insert (N.toShort keyword) (unsafeIntToAscii (maxName - Map.size renamings)) renamings