git.iko.soy/elk
on 4e94115 help sign in
elk/compiler/src/Generate/JavaScript/Name.hs
255 lines 5.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.Name
4 ( Name
5 , toBuilder
6 , fromIndex
7 , fromInt
8 , fromLocal
9 , fromGlobal
10 , fromCycle
11 , fromKernel
12 , makeF
13 , makeA
14 , makeLabel
15 , makeTemp
16 , dollar
17 )
18 where
21import qualified Data.ByteString.Builder as B
22import qualified Data.ByteString.Short as S
23import Data.Monoid ((<>))
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 Data.Index as Index
32import qualified Elm.Name as N
33import qualified Elm.Package as Pkg
37-- NAME
40newtype Name =
41 Name { toBuilder :: B.Builder }
45-- CONSTRUCTORS
48fromIndex :: Index.ZeroBased -> Name
49fromIndex index =
50 fromInt (Index.toMachine index)
53fromInt :: Int -> Name
54fromInt n =
55 Name (B.shortByteString (intToAscii n))
58fromLocal :: N.Name -> Name
59fromLocal name =
60 if Set.member name reservedNames then
61 Name ("_" <> N.toBuilder name)
62 else
63 Name (N.toBuilder name)
66fromGlobal :: ModuleName.Canonical -> N.Name -> Name
67fromGlobal (ModuleName.Canonical (Pkg.Name user project) home) name =
68 Name $
69 Text.encodeUtf8Builder (Text.replace "-" "_" user)
70 <> "$" <> Text.encodeUtf8Builder (Text.replace "-" "_" project) -- TODO store this in a better way
71 <> "$" <> N.toDotlessBuilder home
72 <> "$" <> N.toBuilder name
75fromCycle :: ModuleName.Canonical -> N.Name -> Name
76fromCycle (ModuleName.Canonical (Pkg.Name user project) home) name =
77 Name $
78 Text.encodeUtf8Builder (Text.replace "-" "_" user)
79 <> "$" <> Text.encodeUtf8Builder (Text.replace "-" "_" project) -- TODO store this in a better way
80 <> "$" <> N.toDotlessBuilder home
81 <> "$cyclic$" <> N.toBuilder name
84fromKernel :: N.Name -> N.Name -> Name
85fromKernel home name =
86 Name ("_" <> N.toBuilder home <> "_" <> N.toBuilder name)
90-- TEMPORARY NAMES
93makeF :: Int -> Name
94makeF n =
95 Name ("F" <> B.intDec n)
98makeA :: Int -> Name
99makeA n =
100 Name ("A" <> B.intDec n)
103makeLabel :: N.Name -> Int -> Name
104makeLabel name index =
105 Name (N.toBuilder name <> "$" <> B.intDec index)
108makeTemp :: N.Name -> Name
109makeTemp name =
110 Name ("$temp$" <> N.toBuilder name)
113dollar :: Name
114dollar =
115 Name (N.toBuilder N.dollar)
119-- RESERVED NAMES
122{-# NOINLINE reservedNames #-}
123reservedNames :: Set.Set N.Name
124reservedNames =
125 Set.union jsReservedWords elmReservedWords
128jsReservedWords :: Set.Set N.Name
129jsReservedWords =
130 Set.fromList
131 [ "do", "if", "in"
132 , "NaN", "int", "for", "new", "try", "var", "let"
133 , "null", "true", "eval", "byte", "char", "goto", "long", "case", "else", "this", "void", "with", "enum"
134 , "false", "final", "float", "short", "break", "catch", "throw", "while", "class", "const", "super", "yield"
135 , "double", "native", "throws", "delete", "return", "switch", "typeof", "export", "import", "public", "static"
136 , "boolean", "default", "finally", "extends", "package", "private"
137 , "Infinity", "abstract", "volatile", "function", "continue", "debugger", "function"
138 , "undefined", "arguments", "transient", "interface", "protected"
139 , "instanceof", "implements"
140 , "synchronized"
141 ]
144elmReservedWords :: Set.Set N.Name
145elmReservedWords =
146 Set.fromList
147 [ "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
148 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
149 ]
153-- INT TO ASCII
156intToAscii :: Int -> S.ShortByteString
157intToAscii n =
158 if n < 53 then -- skip $ as a standalone name
159 S.pack [toByte n]
161 else
162 intToAsciiHelp 2 (numStartBytes * numInnerBytes) allBadFields (n - 53)
165intToAsciiHelp :: Int -> Int -> [BadFields] -> Int -> S.ShortByteString
166intToAsciiHelp width blockSize badFields n =
167 case badFields of
168 [] ->
169 if n < blockSize then
170 unsafeIntToAscii width [] n
171 else
172 intToAsciiHelp (width + 1) (blockSize * numInnerBytes) [] (n - blockSize)
174 BadFields renamings : biggerBadFields ->
175 let availableSize = blockSize - Map.size renamings in
176 if n < availableSize then
177 let name = unsafeIntToAscii width [] n in
178 Map.findWithDefault name name renamings
179 else
180 intToAsciiHelp (width + 1) (blockSize * numInnerBytes) biggerBadFields (n - availableSize)
184-- UNSAFE INT TO ASCII
187unsafeIntToAscii :: Int -> [Word8] -> Int -> S.ShortByteString
188unsafeIntToAscii width bytes n =
189 if width <= 1 then
190 S.pack (toByte n : bytes)
191 else
192 let
193 (quotient, remainder) =
194 quotRem n numInnerBytes
195 in
196 unsafeIntToAscii (width - 1) (toByte remainder : bytes) quotient
200-- ASCII BYTES
203numStartBytes :: Int
204numStartBytes =
205 54
208numInnerBytes :: Int
209numInnerBytes =
210 64
213toByte :: Int -> Word8
214toByte n
215 | n < 26 = fromIntegral (97 + n ) {- lower -}
216 | n < 52 = fromIntegral (65 + n - 26) {- upper -}
217 | n == 52 = 95 {- _ -}
218 | n == 53 = 36 {- $ -}
219 | n < 64 = fromIntegral (48 + n - 54) {- digit -}
220 | True = error $ "cannot convert int " ++ show n ++ " to ASCII"
224-- BAD FIELDS
227newtype BadFields =
228 BadFields { _renamings :: Renamings }
231type Renamings =
232 Map.Map S.ShortByteString S.ShortByteString
235allBadFields :: [BadFields]
236allBadFields =
237 let
238 add keyword dict =
239 Map.alter (Just . addRenaming keyword) (N.length keyword) dict
240 in
241 Map.elems $ Set.foldr add Map.empty jsReservedWords
244addRenaming :: N.Name -> Maybe BadFields -> BadFields
245addRenaming keyword maybeBadFields =
246 let
247 width = N.length keyword
248 maxName = numStartBytes * numInnerBytes ^ (width - 1) - 1
249 in
250 case maybeBadFields of
251 Nothing ->
252 BadFields $ Map.singleton (N.toShort keyword) (unsafeIntToAscii width [] maxName)
254 Just (BadFields renamings) ->
255 BadFields $ Map.insert (N.toShort keyword) (unsafeIntToAscii width [] (maxName - Map.size renamings)) renamings