git.iko.soy/elk
on 5fab52a help sign in
elk/src/Generate/JavaScript/Variable.hs
249 lines 5.5 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.Variable
4 ( Generator
5 , run
6 , fresh
7 , local
8 , safe
9 , global
10 , globalName
11 , globalToName
12 , intToAscii
13 )
14 where
17import qualified Control.Monad.State.Strict as State
18import qualified Data.ByteString as BS
19import Data.Monoid ((<>))
20import qualified Data.Map as Map
21import qualified Data.Set as Set
22import Data.Text (Text)
23import qualified Data.Text as Text
24import qualified Data.Text.Encoding as Text (encodeUtf8)
25import Data.Word (Word8)
27import qualified AST.Helpers as Help
28import qualified AST.Module.Name as ModuleName
29import qualified AST.Variable as Var
30import qualified Elm.Package as Pkg
31import qualified Generate.JavaScript.Builder as JS
32import qualified Generate.JavaScript.Helpers as JS
36-- GENERATOR
39type Generator = State.State Int
42run :: Generator a -> a
43run generator =
44 State.evalState generator 0
48-- FRESH NAMES
51fresh :: Generator Text
52fresh =
53 do uid <- State.get
54 State.put (uid + 1)
55 return ("_v" <> Text.pack (show uid))
59-- LOCAL NAMES
62local :: Text -> JS.Expr
63local name =
64 JS.ref (safe name)
67safe :: Text -> Text
68safe name =
69 if Set.member name reservedNames then
70 "_" <> name
71 else
72 name
76-- RESERVED NAMES
79reservedNames :: Set.Set Text
80reservedNames =
81 Set.union jsReservedWords elmReservedWords
84jsReservedWords :: Set.Set Text
85jsReservedWords =
86 Set.fromList
87 [ "do", "if", "in"
88 , "NaN", "int", "for", "new", "try", "var", "let"
89 , "null", "true", "eval", "byte", "char", "goto", "long", "case", "else", "this", "void", "with", "enum"
90 , "false", "final", "float", "short", "break", "catch", "throw", "while", "class", "const", "super", "yield"
91 , "double", "native", "throws", "delete", "return", "switch", "typeof", "export", "import", "public", "static"
92 , "boolean", "default", "finally", "extends", "package", "private"
93 , "Infinity", "abstract", "volatile", "function", "continue", "debugger", "function"
94 , "undefined", "arguments", "transient", "interface", "protected"
95 , "instanceof", "implements"
96 , "synchronized"
97 ]
100elmReservedWords :: Set.Set Text
101elmReservedWords =
102 Set.fromList
103 [ "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
104 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
105 ]
109-- GLOBAL NAMES
112global :: Var.Global -> Generator JS.Expr
113global var =
114 JS.ref <$> globalName var
117globalName :: Var.Global -> Generator Text
118globalName (Var.Global home name) =
119 return (globalToName home name)
122globalToName :: ModuleName.Canonical -> Text -> Text
123globalToName (ModuleName.Canonical (Pkg.Name user project) moduleName) name =
124 if ModuleName.isKernel moduleName then
125 "_" <> ModuleName.getKernel moduleName <> "_" <> name
127 else
128 let
129 revisedName =
130 if Help.isOp name then
131 "_op_" <> Help.desymbol name
132 else
133 name
134 in
135 Text.replace "-" "_" user
136 <> "$" <> Text.replace "-" "_" project
137 <> "$" <> Text.replace "." "_" moduleName
138 <> "$" <> revisedName
142-- INT TO ASCII
145intToAscii :: Int -> BS.ByteString
146intToAscii n =
147 if n < 53 then -- skip $ as a standalone name
148 BS.singleton (toByte n)
150 else
151 intToAsciiHelp (numStartBytes * numInnerBytes) allBadFields (n - 53)
154intToAsciiHelp :: Int -> [BadFields] -> Int -> BS.ByteString
155intToAsciiHelp blockSize badFields n =
156 case badFields of
157 [] ->
158 if n < blockSize then
159 unsafeIntToAscii n
160 else
161 intToAsciiHelp (blockSize * numInnerBytes) [] (n - blockSize)
163 BadFields renamings : biggerBadFields ->
164 if n < blockSize - Map.size renamings then
165 let name = unsafeIntToAscii n in
166 Map.findWithDefault name name renamings
167 else
168 intToAsciiHelp (blockSize * numInnerBytes) biggerBadFields (n - blockSize)
172-- UNSAFE INT TO ASCII
175unsafeIntToAscii :: Int -> BS.ByteString
176unsafeIntToAscii n =
177 let
178 (quotient, remainder) =
179 quotRem n numStartBytes
180 in
181 BS.pack $ toByte remainder : unsafeIntToAsciiHelp quotient
184unsafeIntToAsciiHelp :: Int -> [Word8]
185unsafeIntToAsciiHelp n =
186 if n == 0 then
187 []
188 else
189 let (quotient, remainder) = quotRem n numInnerBytes in
190 toByte remainder : unsafeIntToAsciiHelp quotient
194-- ASCII BYTES
197numStartBytes :: Int
198numStartBytes =
199 54
202numInnerBytes :: Int
203numInnerBytes =
204 64
207toByte :: Int -> Word8
208toByte n
209 | n < 26 = fromIntegral (97 + n ) {- lower -}
210 | n < 52 = fromIntegral (65 + n - 26) {- upper -}
211 | n == 53 = 95 {- _ -}
212 | n == 54 = 36 {- $ -}
213 | n < 64 = fromIntegral (48 + n - 54) {- digit -}
214 | True = error $ "cannot convert int " ++ show n ++ " to ASCII"
218-- BAD FIELDS
221newtype BadFields =
222 BadFields { _renamings :: Renamings }
225type Renamings =
226 Map.Map BS.ByteString BS.ByteString
229allBadFields :: [BadFields]
230allBadFields =
231 let
232 add keyword dict =
233 Map.alter (Just . addRenaming keyword) (Text.length keyword) dict
234 in
235 Map.elems $ Set.foldr add Map.empty jsReservedWords
238addRenaming :: Text -> Maybe BadFields -> BadFields
239addRenaming keyword maybeBadFields =
240 let
241 maxName =
242 numStartBytes * numInnerBytes ^ (Text.length keyword - 1) - 1
243 in
244 case maybeBadFields of
245 Nothing ->
246 BadFields $ Map.singleton (Text.encodeUtf8 keyword) (unsafeIntToAscii maxName)
248 Just (BadFields renamings) ->
249 BadFields $ Map.insert (Text.encodeUtf8 keyword) (unsafeIntToAscii (maxName - Map.size renamings)) renamings