git.iko.soy/elk
on e28d01e help sign in
elk/src/Generate/JavaScript/Variable.hs
241 lines 5.3 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.Module.Name as ModuleName
28import qualified AST.Variable as Var
29import qualified Elm.Package as Pkg
30import qualified Generate.JavaScript.Builder as JS
31import qualified Generate.JavaScript.Helpers as JS
35-- GENERATOR
38type Generator = State.State Int
41run :: Generator a -> a
42run generator =
43 State.evalState generator 0
47-- FRESH NAMES
50fresh :: Generator Text
51fresh =
52 do uid <- State.get
53 State.put (uid + 1)
54 return ("_v" <> Text.pack (show uid))
58-- LOCAL NAMES
61local :: Text -> JS.Expr
62local name =
63 JS.ref (safe name)
66safe :: Text -> Text
67safe name =
68 if Set.member name reservedNames then
69 "_" <> name
70 else
71 name
75-- RESERVED NAMES
78reservedNames :: Set.Set Text
79reservedNames =
80 Set.union jsReservedWords elmReservedWords
83jsReservedWords :: Set.Set Text
84jsReservedWords =
85 Set.fromList
86 [ "do", "if", "in"
87 , "NaN", "int", "for", "new", "try", "var", "let"
88 , "null", "true", "eval", "byte", "char", "goto", "long", "case", "else", "this", "void", "with", "enum"
89 , "false", "final", "float", "short", "break", "catch", "throw", "while", "class", "const", "super", "yield"
90 , "double", "native", "throws", "delete", "return", "switch", "typeof", "export", "import", "public", "static"
91 , "boolean", "default", "finally", "extends", "package", "private"
92 , "Infinity", "abstract", "volatile", "function", "continue", "debugger", "function"
93 , "undefined", "arguments", "transient", "interface", "protected"
94 , "instanceof", "implements"
95 , "synchronized"
96 ]
99elmReservedWords :: Set.Set Text
100elmReservedWords =
101 Set.fromList
102 [ "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
103 , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
104 ]
108-- GLOBAL NAMES
111global :: Var.Global -> Generator JS.Expr
112global var =
113 JS.ref <$> globalName var
116globalName :: Var.Global -> Generator Text
117globalName (Var.Global home name) =
118 return (globalToName home name)
121globalToName :: ModuleName.Canonical -> Text -> Text
122globalToName (ModuleName.Canonical (Pkg.Name user project) moduleName) name =
123 if ModuleName.isKernel moduleName then
124 "_" <> ModuleName.getKernel moduleName <> "_" <> name
126 else
127 Text.replace "-" "_" user
128 <> "$" <> Text.replace "-" "_" project
129 <> "$" <> Text.replace "." "_" moduleName
130 <> "$" <> name
134-- INT TO ASCII
137intToAscii :: Int -> BS.ByteString
138intToAscii n =
139 if n < 53 then -- skip $ as a standalone name
140 BS.singleton (toByte n)
142 else
143 intToAsciiHelp (numStartBytes * numInnerBytes) allBadFields (n - 53)
146intToAsciiHelp :: Int -> [BadFields] -> Int -> BS.ByteString
147intToAsciiHelp blockSize badFields n =
148 case badFields of
149 [] ->
150 if n < blockSize then
151 unsafeIntToAscii n
152 else
153 intToAsciiHelp (blockSize * numInnerBytes) [] (n - blockSize)
155 BadFields renamings : biggerBadFields ->
156 if n < blockSize - Map.size renamings then
157 let name = unsafeIntToAscii n in
158 Map.findWithDefault name name renamings
159 else
160 intToAsciiHelp (blockSize * numInnerBytes) biggerBadFields (n - blockSize)
164-- UNSAFE INT TO ASCII
167unsafeIntToAscii :: Int -> BS.ByteString
168unsafeIntToAscii n =
169 let
170 (quotient, remainder) =
171 quotRem n numStartBytes
172 in
173 BS.pack $ toByte remainder : unsafeIntToAsciiHelp quotient
176unsafeIntToAsciiHelp :: Int -> [Word8]
177unsafeIntToAsciiHelp n =
178 if n == 0 then
179 []
180 else
181 let (quotient, remainder) = quotRem n numInnerBytes in
182 toByte remainder : unsafeIntToAsciiHelp quotient
186-- ASCII BYTES
189numStartBytes :: Int
190numStartBytes =
191 54
194numInnerBytes :: Int
195numInnerBytes =
196 64
199toByte :: Int -> Word8
200toByte n
201 | n < 26 = fromIntegral (97 + n ) {- lower -}
202 | n < 52 = fromIntegral (65 + n - 26) {- upper -}
203 | n == 53 = 95 {- _ -}
204 | n == 54 = 36 {- $ -}
205 | n < 64 = fromIntegral (48 + n - 54) {- digit -}
206 | True = error $ "cannot convert int " ++ show n ++ " to ASCII"
210-- BAD FIELDS
213newtype BadFields =
214 BadFields { _renamings :: Renamings }
217type Renamings =
218 Map.Map BS.ByteString BS.ByteString
221allBadFields :: [BadFields]
222allBadFields =
223 let
224 add keyword dict =
225 Map.alter (Just . addRenaming keyword) (Text.length keyword) dict
226 in
227 Map.elems $ Set.foldr add Map.empty jsReservedWords
230addRenaming :: Text -> Maybe BadFields -> BadFields
231addRenaming keyword maybeBadFields =
232 let
233 maxName =
234 numStartBytes * numInnerBytes ^ (Text.length keyword - 1) - 1
235 in
236 case maybeBadFields of
237 Nothing ->
238 BadFields $ Map.singleton (Text.encodeUtf8 keyword) (unsafeIntToAscii maxName)
240 Just (BadFields renamings) ->
241 BadFields $ Map.insert (Text.encodeUtf8 keyword) (unsafeIntToAscii (maxName - Map.size renamings)) renamings