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