1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
|
-----------------------------------------------------------------------------
-- |
-- Module : GHC.StgToJS.Ids
-- Copyright : (c) The University of Glasgow 2001
-- License : BSD-style (see the file LICENSE)
--
-- Maintainer : Jeffrey Young <jeffrey.young@iohk.io>
-- Luite Stegeman <luite.stegeman@iohk.io>
-- Sylvain Henry <sylvain.henry@iohk.io>
-- Josh Meredith <josh.meredith@iohk.io>
-- Stability : experimental
--
-- Module to deal with JS identifiers
-----------------------------------------------------------------------------
module GHC.StgToJS.Ids
( freshUnique
, freshIdent
, makeIdentForId
, cachedIdentForId
-- * Helpers for Idents
, identForId
, identForIdN
, identsForId
, identForEntryId
, identForDataConEntryId
, identForDataConWorker
-- * Helpers for variables
, varForId
, varForIdN
, varsForId
, varForEntryId
, varForDataConEntryId
, varForDataConWorker
, declVarsForId
)
where
import GHC.Prelude
import GHC.StgToJS.Types
import GHC.StgToJS.Monad
import GHC.StgToJS.CoreUtils
import GHC.StgToJS.Symbols
import GHC.JS.Syntax
import GHC.JS.Make
import GHC.Core.DataCon
import GHC.Types.Id
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Types.Name
import GHC.Unit.Module
import GHC.Data.FastString
import GHC.Data.FastMutInt
import Control.Monad
import Control.Monad.IO.Class
import qualified Control.Monad.Trans.State.Strict as State
import qualified Data.Map as M
import Data.Maybe
import qualified Data.ByteString.Char8 as BSC
-- | Get fresh unique number
freshUnique :: G Int
freshUnique = do
id_gen <- State.gets gsId
liftIO $ do
-- no need for atomicFetchAdd as we don't use threads in G
v <- readFastMutInt id_gen
writeFastMutInt id_gen (v+1)
pure v
-- | Get fresh local Ident of the form: h$$unit:module_uniq
freshIdent :: G Ident
freshIdent = do
i <- freshUnique
mod <- State.gets gsModule
let !name = mkFreshJsSymbol mod i
return (TxtI name)
-- | Generate unique Ident for the given ID (uncached!)
--
-- The ident has the following forms:
--
-- global Id: h$unit:module.name[_num][_type_suffix]
-- local Id: h$$unit:module.name[_num][_type_suffix]_uniq
--
-- Note that the string is z-encoded except for "_" delimiters.
--
-- Optional "_type_suffix" can be:
-- - "_e" for IdEntry
-- - "_con_e" for IdConEntry
--
-- Optional "_num" is passed as an argument to this function. It is used for
-- Haskell Ids that require several JS variables: e.g. 64-bit numbers (Word64#,
-- Int64#), Addr#, StablePtr#, unboxed tuples, etc.
--
makeIdentForId :: Id -> Maybe Int -> IdType -> Module -> Ident
makeIdentForId i num id_type current_module = TxtI ident
where
exported = isExportedId i
name = getName i
mod
| exported
, Just m <- nameModule_maybe name
= m
| otherwise
= current_module
!ident = mkFastStringByteString $ mconcat
[ mkJsSymbolBS exported mod (occNameFS (nameOccName name))
-------------
-- suffixes
-- suffix for Ids represented with more than one JS var ("_0", "_1", etc.)
, case num of
Nothing -> mempty
Just v -> mconcat [BSC.pack "_", intBS v]
-- suffix for entry and constructor entry
, case id_type of
IdPlain -> mempty
IdEntry -> BSC.pack "_e"
IdConEntry -> BSC.pack "_con_e"
-- unique suffix for non-exported Ids
, if exported
then mempty
else let (c,u) = unpkUnique (getUnique i)
in mconcat [BSC.pack ['_',c,'_'], intBS u]
]
-- | Retrieve the cached Ident for the given Id if there is one. Otherwise make
-- a new one with 'makeIdentForId' and cache it.
cachedIdentForId :: Id -> Maybe Int -> IdType -> G Ident
cachedIdentForId i mi id_type = do
-- compute key
let !key = IdKey (getKey . getUnique $ i) (fromMaybe 0 mi) id_type
-- lookup Ident in the Ident cache
IdCache cache <- State.gets gsIdents
ident <- case M.lookup key cache of
Just ident -> pure ident
Nothing -> do
mod <- State.gets gsModule
let !ident = makeIdentForId i mi id_type mod
let !cache' = IdCache (M.insert key ident cache)
State.modify (\s -> s { gsIdents = cache' })
pure ident
-- Now update the GlobalId cache, if required
let update_global_cache = isGlobalId i && isNothing mi && id_type == IdPlain
-- fixme also allow caching entries for lifting?
when (update_global_cache) $ do
GlobalIdCache gidc <- getGlobalIdCache
case elemUFM ident gidc of
False -> setGlobalIdCache $ GlobalIdCache (addToUFM gidc ident (key, i))
True -> pure ()
pure ident
-- | Retrieve default Ident for the given Id
identForId :: Id -> G Ident
identForId i = cachedIdentForId i Nothing IdPlain
-- | Retrieve default Ident for the given Id with sub index
--
-- Some types, Word64, Addr#, unboxed tuple have more than one corresponding JS
-- var, hence we use the sub index to identify each subpart / JS variable.
identForIdN :: Id -> Int -> G Ident
identForIdN i n = cachedIdentForId i (Just n) IdPlain
-- | Retrieve all the idents for the given Id.
identsForId :: Id -> G [Ident]
identsForId i = case typeSize (idType i) of
0 -> pure mempty
1 -> (:[]) <$> identForId i
s -> mapM (identForIdN i) [1..s]
-- | Retrieve entry Ident for the given Id
identForEntryId :: Id -> G Ident
identForEntryId i = cachedIdentForId i Nothing IdEntry
-- | Retrieve datacon entry Ident for the given Id
--
-- Different name than the datacon wrapper.
identForDataConEntryId :: Id -> G Ident
identForDataConEntryId i = cachedIdentForId i Nothing IdConEntry
-- | Retrieve default variable name for the given Id
varForId :: Id -> G JExpr
varForId i = toJExpr <$> identForId i
-- | Retrieve default variable name for the given Id with sub index
varForIdN :: Id -> Int -> G JExpr
varForIdN i n = toJExpr <$> identForIdN i n
-- | Retrieve all the JS vars for the given Id
varsForId :: Id -> G [JExpr]
varsForId i = case typeSize (idType i) of
0 -> pure mempty
1 -> (:[]) <$> varForId i
s -> mapM (varForIdN i) [1..s]
-- | Retrieve entry variable name for the given Id
varForEntryId :: Id -> G JExpr
varForEntryId i = toJExpr <$> identForEntryId i
-- | Retrieve datacon entry variable name for the given Id
varForDataConEntryId :: Id -> G JExpr
varForDataConEntryId i = ValExpr . JVar <$> identForDataConEntryId i
-- | Retrieve datacon worker entry variable name for the given datacon
identForDataConWorker :: DataCon -> G Ident
identForDataConWorker d = identForDataConEntryId (dataConWorkId d)
-- | Retrieve datacon worker entry variable name for the given datacon
varForDataConWorker :: DataCon -> G JExpr
varForDataConWorker d = varForDataConEntryId (dataConWorkId d)
-- | Declare all js vars for the id
declVarsForId :: Id -> G JStat
declVarsForId i = case typeSize (idType i) of
0 -> return mempty
1 -> decl <$> identForId i
s -> mconcat <$> mapM (\n -> decl <$> identForIdN i n) [1..s]
|
