git.iko.soy/elk
on e7ca69f help sign in
elk/compiler/src/Generate/JavaScript/Name.hs
251 lines 5.8 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 Data.Monoid ((<>))
23import qualified Data.Map as Map
24import qualified Data.Name as Name
25import qualified Data.Set as Set
26import qualified Data.Utf8 as Utf8
27import Data.Word (Word8)
29import qualified Data.Index as Index
30import qualified Elm.ModuleName as ModuleName
31import qualified Elm.Package as Pkg
35-- NAME
38newtype Name =
39 Name { toBuilder :: B.Builder }
43-- CONSTRUCTORS
46fromIndex :: Index.ZeroBased -> Name
47fromIndex index =
48 fromInt (Index.toMachine index)
51fromInt :: Int -> Name
52fromInt n =
53 Name (Name.toBuilder (intToAscii n))
56fromLocal :: Name.Name -> Name
57fromLocal name =
58 if Set.member name reservedNames then
59 Name ("_" <> Name.toBuilder name)
60 else
61 Name (Name.toBuilder name)
64fromGlobal :: ModuleName.Canonical -> Name.Name -> Name
65fromGlobal (ModuleName.Canonical (Pkg.Name author project) home) name =
66 Name $ Name.toEscapedBuilder 0x2D {- - -} 0x5F {- _ -} author
67 <> "$" <> Name.toEscapedBuilder 0x2D {- - -} 0x5F {- _ -} project
68 <> "$" <> Name.toEscapedBuilder 0x2E {- . -} 0x24 {- $ -} home
69 <> "$" <> Name.toBuilder name
72fromCycle :: ModuleName.Canonical -> Name.Name -> Name
73fromCycle (ModuleName.Canonical (Pkg.Name author project) home) name =
74 Name $ Name.toEscapedBuilder 0x2D {- - -} 0x5F {- _ -} author
75 <> "$" <> Name.toEscapedBuilder 0x2D {- - -} 0x5F {- _ -} project
76 <> "$" <> Name.toEscapedBuilder 0x2E {- . -} 0x24 {- $ -} home
77 <> "$cyclic$" <> Name.toBuilder name
80fromKernel :: Name.Name -> Name.Name -> Name
81fromKernel home name =
82 Name ("_" <> Name.toBuilder home <> "_" <> Name.toBuilder name)
86-- TEMPORARY NAMES
89makeF :: Int -> Name
90makeF n =
91 Name ("F" <> B.intDec n)
94makeA :: Int -> Name
95makeA n =
96 Name ("A" <> B.intDec n)
99makeLabel :: Name.Name -> Int -> Name
100makeLabel name index =
101 Name (Name.toBuilder name <> "$" <> B.intDec index)
104makeTemp :: Name.Name -> Name
105makeTemp name =
106 Name ("$temp$" <> Name.toBuilder name)
109dollar :: Name
110dollar =
111 Name (Name.toBuilder Name.dollar)
115-- RESERVED NAMES
118{-# NOINLINE reservedNames #-}
119reservedNames :: Set.Set Name.Name
120reservedNames =
121 Set.union jsReservedWords elmReservedWords
124jsReservedWords :: Set.Set Name.Name
125jsReservedWords =
126 Set.fromList
127 [ "do", "if", "in"
128 , "NaN", "int", "for", "new", "try", "var", "let"
129 , "null", "true", "eval", "byte", "char", "goto", "long", "case", "else", "this", "void", "with", "enum"
130 , "false", "final", "float", "short", "break", "catch", "throw", "while", "class", "const", "super", "yield"
131 , "double", "native", "throws", "delete", "return", "switch", "typeof", "export", "import", "public", "static"
132 , "boolean", "default", "finally", "extends", "package", "private"
133 , "Infinity", "abstract", "volatile", "function", "continue", "debugger", "function"
134 , "undefined", "arguments", "transient", "interface", "protected"
135 , "instanceof", "implements"
136 , "synchronized"
137 ]
140elmReservedWords :: Set.Set Name.Name
141elmReservedWords =
142 Set.fromList
143 [ "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
144 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
145 ]
149-- INT TO ASCII
152intToAscii :: Int -> Name.Name
153intToAscii n =
154 if n < 53 then -- skip $ as a standalone name
155 Name.fromWords [toByte n]
157 else
158 intToAsciiHelp 2 (numStartBytes * numInnerBytes) allBadFields (n - 53)
161intToAsciiHelp :: Int -> Int -> [BadFields] -> Int -> Name.Name
162intToAsciiHelp width blockSize badFields n =
163 case badFields of
164 [] ->
165 if n < blockSize then
166 unsafeIntToAscii width [] n
167 else
168 intToAsciiHelp (width + 1) (blockSize * numInnerBytes) [] (n - blockSize)
170 BadFields renamings : biggerBadFields ->
171 let availableSize = blockSize - Map.size renamings in
172 if n < availableSize then
173 let name = unsafeIntToAscii width [] n in
174 Map.findWithDefault name name renamings
175 else
176 intToAsciiHelp (width + 1) (blockSize * numInnerBytes) biggerBadFields (n - availableSize)
180-- UNSAFE INT TO ASCII
183unsafeIntToAscii :: Int -> [Word8] -> Int -> Name.Name
184unsafeIntToAscii width bytes n =
185 if width <= 1 then
186 Name.fromWords (toByte n : bytes)
187 else
188 let
189 (quotient, remainder) =
190 quotRem n numInnerBytes
191 in
192 unsafeIntToAscii (width - 1) (toByte remainder : bytes) quotient
196-- ASCII BYTES
199numStartBytes :: Int
200numStartBytes =
201 54
204numInnerBytes :: Int
205numInnerBytes =
206 64
209toByte :: Int -> Word8
210toByte n
211 | n < 26 = fromIntegral (97 + n ) {- lower -}
212 | n < 52 = fromIntegral (65 + n - 26) {- upper -}
213 | n == 52 = 95 {- _ -}
214 | n == 53 = 36 {- $ -}
215 | n < 64 = fromIntegral (48 + n - 54) {- digit -}
216 | True = error $ "cannot convert int " ++ show n ++ " to ASCII"
220-- BAD FIELDS
223newtype BadFields =
224 BadFields { _renamings :: Renamings }
227type Renamings =
228 Map.Map Name.Name Name.Name
231allBadFields :: [BadFields]
232allBadFields =
233 let
234 add keyword dict =
235 Map.alter (Just . addRenaming keyword) (Utf8.size keyword) dict
236 in
237 Map.elems $ Set.foldr add Map.empty jsReservedWords
240addRenaming :: Name.Name -> Maybe BadFields -> BadFields
241addRenaming keyword maybeBadFields =
242 let
243 width = Utf8.size keyword
244 maxName = numStartBytes * numInnerBytes ^ (width - 1) - 1
245 in
246 case maybeBadFields of
247 Nothing ->
248 BadFields $ Map.singleton keyword (unsafeIntToAscii width [] maxName)
250 Just (BadFields renamings) ->
251 BadFields $ Map.insert keyword (unsafeIntToAscii width [] (maxName - Map.size renamings)) renamings