module GHC.StgToJS.Ids
( freshUnique
, freshIdent
, makeIdentForId
, cachedIdentForId
, identForId
, identForIdN
, identsForId
, identForEntryId
, identForDataConEntryId
, identForDataConWorker
, 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
freshUnique :: G Int
freshUnique :: G Int
freshUnique = do
FastMutInt
id_gen <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.gets GenState -> FastMutInt
gsId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Int
v <- FastMutInt -> IO Int
readFastMutInt FastMutInt
id_gen
FastMutInt -> Int -> IO ()
writeFastMutInt FastMutInt
id_gen (Int
vforall a. Num a => a -> a -> a
+Int
1)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
v
freshIdent :: G Ident
freshIdent :: G Ident
freshIdent = do
Int
i <- G Int
freshUnique
Module
mod <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.gets GenState -> Module
gsModule
let !name :: FastString
name = Module -> Int -> FastString
mkFreshJsSymbol Module
mod Int
i
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> Ident
TxtI FastString
name)
makeIdentForId :: Id -> Maybe Int -> IdType -> Module -> Ident
makeIdentForId :: Id -> Maybe Int -> IdType -> Module -> Ident
makeIdentForId Id
i Maybe Int
num IdType
id_type Module
current_module = FastString -> Ident
TxtI FastString
ident
where
exported :: Bool
exported = Id -> Bool
isExportedId Id
i
name :: Name
name = forall a. NamedThing a => a -> Name
getName Id
i
mod :: Module
mod
| Bool
exported
, Just Module
m <- Name -> Maybe Module
nameModule_maybe Name
name
= Module
m
| Bool
otherwise
= Module
current_module
!ident :: FastString
ident = ByteString -> FastString
mkFastStringByteString forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
[ Bool -> Module -> FastString -> ByteString
mkJsSymbolBS Bool
exported Module
mod (OccName -> FastString
occNameFS (Name -> OccName
nameOccName Name
name))
, case Maybe Int
num of
Maybe Int
Nothing -> forall a. Monoid a => a
mempty
Just Int
v -> forall a. Monoid a => [a] -> a
mconcat [String -> ByteString
BSC.pack String
"_", Int -> ByteString
intBS Int
v]
, case IdType
id_type of
IdType
IdPlain -> forall a. Monoid a => a
mempty
IdType
IdEntry -> String -> ByteString
BSC.pack String
"_e"
IdType
IdConEntry -> String -> ByteString
BSC.pack String
"_con_e"
, if Bool
exported
then forall a. Monoid a => a
mempty
else let (Char
c,Int
u) = Unique -> (Char, Int)
unpkUnique (forall a. Uniquable a => a -> Unique
getUnique Id
i)
in forall a. Monoid a => [a] -> a
mconcat [String -> ByteString
BSC.pack [Char
'_',Char
c,Char
'_'], Int -> ByteString
intBS Int
u]
]
cachedIdentForId :: Id -> Maybe Int -> IdType -> G Ident
cachedIdentForId :: Id -> Maybe Int -> IdType -> G Ident
cachedIdentForId Id
i Maybe Int
mi IdType
id_type = do
let !key :: IdKey
key = Int -> Int -> IdType -> IdKey
IdKey (Unique -> Int
getKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Uniquable a => a -> Unique
getUnique forall a b. (a -> b) -> a -> b
$ Id
i) (forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
mi) IdType
id_type
IdCache Map IdKey Ident
cache <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.gets GenState -> IdCache
gsIdents
Ident
ident <- case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup IdKey
key Map IdKey Ident
cache of
Just Ident
ident -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Ident
ident
Maybe Ident
Nothing -> do
Module
mod <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.gets GenState -> Module
gsModule
let !ident :: Ident
ident = Id -> Maybe Int -> IdType -> Module -> Ident
makeIdentForId Id
i Maybe Int
mi IdType
id_type Module
mod
let !cache' :: IdCache
cache' = Map IdKey Ident -> IdCache
IdCache (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert IdKey
key Ident
ident Map IdKey Ident
cache)
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify (\GenState
s -> GenState
s { gsIdents :: IdCache
gsIdents = IdCache
cache' })
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ident
ident
let update_global_cache :: Bool
update_global_cache = Id -> Bool
isGlobalId Id
i Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe Int
mi Bool -> Bool -> Bool
&& IdType
id_type forall a. Eq a => a -> a -> Bool
== IdType
IdPlain
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
update_global_cache) forall a b. (a -> b) -> a -> b
$ do
GlobalIdCache UniqFM Ident (IdKey, Id)
gidc <- G GlobalIdCache
getGlobalIdCache
case forall key elt. Uniquable key => key -> UniqFM key elt -> Bool
elemUFM Ident
ident UniqFM Ident (IdKey, Id)
gidc of
Bool
False -> GlobalIdCache -> StateT GenState IO ()
setGlobalIdCache forall a b. (a -> b) -> a -> b
$ UniqFM Ident (IdKey, Id) -> GlobalIdCache
GlobalIdCache (forall key elt.
Uniquable key =>
UniqFM key elt -> key -> elt -> UniqFM key elt
addToUFM UniqFM Ident (IdKey, Id)
gidc Ident
ident (IdKey
key, Id
i))
Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ident
ident
identForId :: Id -> G Ident
identForId :: Id -> G Ident
identForId Id
i = Id -> Maybe Int -> IdType -> G Ident
cachedIdentForId Id
i forall a. Maybe a
Nothing IdType
IdPlain
identForIdN :: Id -> Int -> G Ident
identForIdN :: Id -> Int -> G Ident
identForIdN Id
i Int
n = Id -> Maybe Int -> IdType -> G Ident
cachedIdentForId Id
i (forall a. a -> Maybe a
Just Int
n) IdType
IdPlain
identsForId :: Id -> G [Ident]
identsForId :: Id -> G [Ident]
identsForId Id
i = case Type -> Int
typeSize (Id -> Type
idType Id
i) of
Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
Int
1 -> (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Id -> G Ident
identForId Id
i
Int
s -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Id -> Int -> G Ident
identForIdN Id
i) [Int
1..Int
s]
identForEntryId :: Id -> G Ident
identForEntryId :: Id -> G Ident
identForEntryId Id
i = Id -> Maybe Int -> IdType -> G Ident
cachedIdentForId Id
i forall a. Maybe a
Nothing IdType
IdEntry
identForDataConEntryId :: Id -> G Ident
identForDataConEntryId :: Id -> G Ident
identForDataConEntryId Id
i = Id -> Maybe Int -> IdType -> G Ident
cachedIdentForId Id
i forall a. Maybe a
Nothing IdType
IdConEntry
varForId :: Id -> G JExpr
varForId :: Id -> G JExpr
varForId Id
i = forall a. ToJExpr a => a -> JExpr
toJExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Id -> G Ident
identForId Id
i
varForIdN :: Id -> Int -> G JExpr
varForIdN :: Id -> Int -> G JExpr
varForIdN Id
i Int
n = forall a. ToJExpr a => a -> JExpr
toJExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Id -> Int -> G Ident
identForIdN Id
i Int
n
varsForId :: Id -> G [JExpr]
varsForId :: Id -> G [JExpr]
varsForId Id
i = case Type -> Int
typeSize (Id -> Type
idType Id
i) of
Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
Int
1 -> (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Id -> G JExpr
varForId Id
i
Int
s -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Id -> Int -> G JExpr
varForIdN Id
i) [Int
1..Int
s]
varForEntryId :: Id -> G JExpr
varForEntryId :: Id -> G JExpr
varForEntryId Id
i = forall a. ToJExpr a => a -> JExpr
toJExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Id -> G Ident
identForEntryId Id
i
varForDataConEntryId :: Id -> G JExpr
varForDataConEntryId :: Id -> G JExpr
varForDataConEntryId Id
i = JVal -> JExpr
ValExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> JVal
JVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Id -> G Ident
identForDataConEntryId Id
i
identForDataConWorker :: DataCon -> G Ident
identForDataConWorker :: DataCon -> G Ident
identForDataConWorker DataCon
d = Id -> G Ident
identForDataConEntryId (DataCon -> Id
dataConWorkId DataCon
d)
varForDataConWorker :: DataCon -> G JExpr
varForDataConWorker :: DataCon -> G JExpr
varForDataConWorker DataCon
d = Id -> G JExpr
varForDataConEntryId (DataCon -> Id
dataConWorkId DataCon
d)
declVarsForId :: Id -> G JStat
declVarsForId :: Id -> G JStat
declVarsForId Id
i = case Type -> Int
typeSize (Id -> Type
idType Id
i) of
Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
Int
1 -> Ident -> JStat
decl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Id -> G Ident
identForId Id
i
Int
s -> forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Int
n -> Ident -> JStat
decl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Id -> Int -> G Ident
identForIdN Id
i Int
n) [Int
1..Int
s]