{-# LANGUAGE TupleSections #-}
module GHC.StgToJS.Deps
( genDependencyData
)
where
import GHC.Prelude
import GHC.StgToJS.Object as Object
import GHC.StgToJS.Types
import GHC.StgToJS.Ids
import GHC.JS.Syntax
import GHC.Types.Id
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Types.Name
import GHC.Unit.Module
import GHC.Utils.Misc
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Data.FastString
import Data.Map (Map)
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import Data.IntMap (IntMap)
import Data.Array
import Data.Either
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.State
data DependencyDataCache = DDC
{ DependencyDataCache -> IntMap Unit
ddcModule :: !(IntMap Unit)
, DependencyDataCache -> IntMap ExportedFun
ddcId :: !(IntMap Object.ExportedFun)
, DependencyDataCache -> Map OtherSymb ExportedFun
ddcOther :: !(Map OtherSymb Object.ExportedFun)
}
genDependencyData
:: HasDebugCallStack
=> Module
-> [LinkableUnit]
-> G Object.Deps
genDependencyData :: HasDebugCallStack => Module -> [LinkableUnit] -> G Deps
genDependencyData Module
mod [LinkableUnit]
units = do
[(Int, BlockDeps, Bool, [ExportedFun])]
ds <- forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LinkableUnit
-> Int
-> StateT
DependencyDataCache G (Int, BlockDeps, Bool, [ExportedFun])
oneDep) [(LinkableUnit, Int)]
blocks)
(IntMap Unit
-> IntMap ExportedFun
-> Map OtherSymb ExportedFun
-> DependencyDataCache
DDC forall a. IntMap a
IM.empty forall a. IntMap a
IM.empty forall k a. Map k a
M.empty)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Object.Deps
{ depsModule :: Module
depsModule = Module
mod
, depsRequired :: BlockIds
depsRequired = [Int] -> BlockIds
IS.fromList [ Int
n | (Int
n, BlockDeps
_, Bool
True, [ExportedFun]
_) <- [(Int, BlockDeps, Bool, [ExportedFun])]
ds ]
, depsHaskellExported :: Map ExportedFun Int
depsHaskellExported = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ (\(Int
n,BlockDeps
_,Bool
_,[ExportedFun]
es) -> forall a b. (a -> b) -> [a] -> [b]
map (,Int
n) [ExportedFun]
es) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(Int, BlockDeps, Bool, [ExportedFun])]
ds
, depsBlocks :: Array Int BlockDeps
depsBlocks = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, forall (t :: * -> *) a. Foldable t => t a -> Int
length [(LinkableUnit, Int)]
blocksforall a. Num a => a -> a -> a
-Int
1) (forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_,BlockDeps
deps,Bool
_,[ExportedFun]
_) -> BlockDeps
deps) [(Int, BlockDeps, Bool, [ExportedFun])]
ds)
}
where
unitIdExports :: UniqFM Id Int
unitIdExports :: UniqFM Id Int
unitIdExports = forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
listToUFM forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(LinkableUnit
u,Int
n) -> forall a b. (a -> b) -> [a] -> [b]
map (,Int
n) (LinkableUnit -> [Id]
luIdExports LinkableUnit
u)) [(LinkableUnit, Int)]
blocks
unitOtherExports :: Map OtherSymb Int
unitOtherExports :: Map OtherSymb Int
unitOtherExports = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(LinkableUnit
u,Int
n) -> forall a b. (a -> b) -> [a] -> [b]
map (,Int
n)
(forall a b. (a -> b) -> [a] -> [b]
map (Module -> FastString -> OtherSymb
OtherSymb Module
mod)
(LinkableUnit -> [FastString]
luOtherExports LinkableUnit
u)))
[(LinkableUnit, Int)]
blocks
blocks :: [(LinkableUnit, Int)]
blocks :: [(LinkableUnit, Int)]
blocks = forall a b. [a] -> [b] -> [(a, b)]
zip [LinkableUnit]
units [Int
0..]
oneDep :: LinkableUnit
-> Int
-> StateT DependencyDataCache G (Int, Object.BlockDeps, Bool, [Object.ExportedFun])
oneDep :: LinkableUnit
-> Int
-> StateT
DependencyDataCache G (Int, BlockDeps, Bool, [ExportedFun])
oneDep (LinkableUnit ObjUnit
_ [Id]
idExports [FastString]
otherExports [Id]
idDeps [Unique]
pseudoIdDeps [OtherSymb]
otherDeps Bool
req [ForeignJSRef]
_frefs) Int
n = do
([ExportedFun]
edi, [Int]
bdi) <- forall a b. [Either a b] -> ([a], [b])
partitionEithers 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 -> Id -> StateT DependencyDataCache G (Either ExportedFun Int)
lookupIdFun Int
n) [Id]
idDeps
([ExportedFun]
edo, [Int]
bdo) <- forall a b. [Either a b] -> ([a], [b])
partitionEithers 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 OtherSymb -> StateT DependencyDataCache G (Either ExportedFun Int)
lookupOtherFun [OtherSymb]
otherDeps
([ExportedFun]
edp, [Int]
bdp) <- forall a b. [Either a b] -> ([a], [b])
partitionEithers 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
-> Unique -> StateT DependencyDataCache G (Either ExportedFun Int)
lookupPseudoIdFun Int
n) [Unique]
pseudoIdDeps
[ExportedFun]
expi <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Id -> StateT DependencyDataCache G ExportedFun
lookupExportedId (forall a. (a -> Bool) -> [a] -> [a]
filter Id -> Bool
isExportedId [Id]
idExports)
[ExportedFun]
expo <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FastString -> StateT DependencyDataCache G ExportedFun
lookupExportedOther [FastString]
otherExports
let bdeps :: BlockDeps
bdeps = [Int] -> [ExportedFun] -> BlockDeps
Object.BlockDeps
(BlockIds -> [Int]
IS.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> BlockIds
IS.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Int
n) forall a b. (a -> b) -> a -> b
$ [Int]
bdiforall a. [a] -> [a] -> [a]
++[Int]
bdoforall a. [a] -> [a] -> [a]
++[Int]
bdp)
(forall a. Set a -> [a]
S.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ [ExportedFun]
ediforall a. [a] -> [a] -> [a]
++[ExportedFun]
edoforall a. [a] -> [a] -> [a]
++[ExportedFun]
edp)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n, BlockDeps
bdeps, Bool
req, [ExportedFun]
expiforall a. [a] -> [a] -> [a]
++[ExportedFun]
expo)
idModule :: Id -> Maybe Module
idModule :: Id -> Maybe Module
idModule Id
i = Name -> Maybe Module
nameModule_maybe (forall a. NamedThing a => a -> Name
getName Id
i) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Module
m ->
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Module
m forall a. Eq a => a -> a -> Bool
/= Module
mod) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Module
m
lookupPseudoIdFun :: Int -> Unique
-> StateT DependencyDataCache G (Either Object.ExportedFun Int)
lookupPseudoIdFun :: Int
-> Unique -> StateT DependencyDataCache G (Either ExportedFun Int)
lookupPseudoIdFun Int
_n Unique
u =
case forall key elt. UniqFM key elt -> Unique -> Maybe elt
lookupUFM_Directly UniqFM Id Int
unitIdExports Unique
u of
Just Int
k -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Int
k)
Maybe Int
_ -> forall a. HasCallStack => String -> a
panic String
"lookupPseudoIdFun"
lookupIdFun :: Int -> Id
-> StateT DependencyDataCache G (Either Object.ExportedFun Int)
lookupIdFun :: Int -> Id -> StateT DependencyDataCache G (Either ExportedFun Int)
lookupIdFun Int
n Id
i = case forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM Id Int
unitIdExports Id
i of
Just Int
k -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Int
k)
Maybe Int
Nothing -> case Id -> Maybe Module
idModule Id
i of
Maybe Module
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Int
n)
Just Module
m ->
let k :: Int
k = 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
addEntry :: StateT DependencyDataCache G Object.ExportedFun
addEntry :: StateT DependencyDataCache G ExportedFun
addEntry = do
(TxtI FastString
idTxt) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Id -> G Ident
identForId Id
i)
Maybe Int -> OtherSymb -> StateT DependencyDataCache G ExportedFun
lookupExternalFun (forall a. a -> Maybe a
Just Int
k) (Module -> FastString -> OtherSymb
OtherSymb Module
m FastString
idTxt)
in if Module
m forall a. Eq a => a -> a -> Bool
== Module
mod
then forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"local id not found" (forall a. Outputable a => a -> SDoc
ppr Module
m)
else forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Maybe ExportedFun
mr <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. DependencyDataCache -> IntMap ExportedFun
ddcId)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StateT DependencyDataCache G ExportedFun
addEntry forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExportedFun
mr
lookupOtherFun :: OtherSymb
-> StateT DependencyDataCache G (Either Object.ExportedFun Int)
lookupOtherFun :: OtherSymb -> StateT DependencyDataCache G (Either ExportedFun Int)
lookupOtherFun od :: OtherSymb
od@(OtherSymb Module
m FastString
idTxt) =
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup OtherSymb
od Map OtherSymb Int
unitOtherExports of
Just Int
n -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Int
n)
Maybe Int
Nothing | Module
m forall a. Eq a => a -> a -> Bool
== Module
mod -> forall a. HasCallStack => String -> a
panic (String
"genDependencyData.lookupOtherFun: unknown local other id: " forall a. [a] -> [a] -> [a]
++ FastString -> String
unpackFS FastString
idTxt)
Maybe Int
Nothing -> forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Int -> OtherSymb -> StateT DependencyDataCache G ExportedFun
lookupExternalFun forall a. Maybe a
Nothing OtherSymb
od) forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup OtherSymb
od forall b c a. (b -> c) -> (a -> b) -> a -> c
. DependencyDataCache -> Map OtherSymb ExportedFun
ddcOther))
lookupExportedId :: Id -> StateT DependencyDataCache G Object.ExportedFun
lookupExportedId :: Id -> StateT DependencyDataCache G ExportedFun
lookupExportedId Id
i = do
(TxtI FastString
idTxt) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Id -> G Ident
identForId Id
i)
Maybe Int -> OtherSymb -> StateT DependencyDataCache G ExportedFun
lookupExternalFun (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) (Module -> FastString -> OtherSymb
OtherSymb Module
mod FastString
idTxt)
lookupExportedOther :: FastString -> StateT DependencyDataCache G Object.ExportedFun
lookupExportedOther :: FastString -> StateT DependencyDataCache G ExportedFun
lookupExportedOther = Maybe Int -> OtherSymb -> StateT DependencyDataCache G ExportedFun
lookupExternalFun forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> FastString -> OtherSymb
OtherSymb Module
mod
lookupExternalFun :: Maybe Int
-> OtherSymb -> StateT DependencyDataCache G Object.ExportedFun
lookupExternalFun :: Maybe Int -> OtherSymb -> StateT DependencyDataCache G ExportedFun
lookupExternalFun Maybe Int
mbIdKey od :: OtherSymb
od@(OtherSymb Module
m FastString
idTxt) = do
let mk :: Int
mk = 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
$ Module
m
mpk :: Unit
mpk = forall unit. GenModule unit -> unit
moduleUnit Module
m
exp_fun :: ExportedFun
exp_fun = Module -> LexicalFastString -> ExportedFun
Object.ExportedFun Module
m (FastString -> LexicalFastString
LexicalFastString FastString
idTxt)
addCache :: StateT DependencyDataCache G ExportedFun
addCache = do
IntMap Unit
ms <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets DependencyDataCache -> IntMap Unit
ddcModule
let !cache' :: IntMap Unit
cache' = forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
mk Unit
mpk IntMap Unit
ms
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (\DependencyDataCache
s -> DependencyDataCache
s { ddcModule :: IntMap Unit
ddcModule = IntMap Unit
cache'})
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExportedFun
exp_fun
ExportedFun
f <- do
Bool
mbm <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (forall a. Int -> IntMap a -> Bool
IM.member Int
mk forall b c a. (b -> c) -> (a -> b) -> a -> c
. DependencyDataCache -> IntMap Unit
ddcModule)
case Bool
mbm of
Bool
False -> StateT DependencyDataCache G ExportedFun
addCache
Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ExportedFun
exp_fun
case Maybe Int
mbIdKey of
Maybe Int
Nothing -> forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (\DependencyDataCache
s -> DependencyDataCache
s { ddcOther :: Map OtherSymb ExportedFun
ddcOther = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert OtherSymb
od ExportedFun
f (DependencyDataCache -> Map OtherSymb ExportedFun
ddcOther DependencyDataCache
s) })
Just Int
k -> forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (\DependencyDataCache
s -> DependencyDataCache
s { ddcId :: IntMap ExportedFun
ddcId = forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
k ExportedFun
f (DependencyDataCache -> IntMap ExportedFun
ddcId DependencyDataCache
s) })
forall (m :: * -> *) a. Monad m => a -> m a
return ExportedFun
f