{-# 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 <- StateT
DependencyDataCache G [(Int, BlockDeps, Bool, [ExportedFun])]
-> DependencyDataCache
-> StateT GenState IO [(Int, BlockDeps, Bool, [ExportedFun])]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (((LinkableUnit, Int)
-> StateT
DependencyDataCache G (Int, BlockDeps, Bool, [ExportedFun]))
-> [(LinkableUnit, Int)]
-> StateT
DependencyDataCache G [(Int, BlockDeps, Bool, [ExportedFun])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((LinkableUnit
-> Int
-> StateT
DependencyDataCache G (Int, BlockDeps, Bool, [ExportedFun]))
-> (LinkableUnit, Int)
-> StateT
DependencyDataCache G (Int, BlockDeps, Bool, [ExportedFun])
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 IntMap Unit
forall a. IntMap a
IM.empty IntMap ExportedFun
forall a. IntMap a
IM.empty Map OtherSymb ExportedFun
forall k a. Map k a
M.empty)
Deps -> G Deps
forall a. a -> StateT GenState IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Deps -> G Deps) -> Deps -> G Deps
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 = [(ExportedFun, Int)] -> Map ExportedFun Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ExportedFun, Int)] -> Map ExportedFun Int)
-> [(ExportedFun, Int)] -> Map ExportedFun Int
forall a b. (a -> b) -> a -> b
$ (\(Int
n,BlockDeps
_,Bool
_,[ExportedFun]
es) -> (ExportedFun -> (ExportedFun, Int))
-> [ExportedFun] -> [(ExportedFun, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (,Int
n) [ExportedFun]
es) ((Int, BlockDeps, Bool, [ExportedFun]) -> [(ExportedFun, Int)])
-> [(Int, BlockDeps, Bool, [ExportedFun])] -> [(ExportedFun, Int)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(Int, BlockDeps, Bool, [ExportedFun])]
ds
, depsBlocks :: Array Int BlockDeps
depsBlocks = (Int, Int) -> [BlockDeps] -> Array Int BlockDeps
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, [(LinkableUnit, Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(LinkableUnit, Int)]
blocksInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (((Int, BlockDeps, Bool, [ExportedFun]) -> BlockDeps)
-> [(Int, BlockDeps, Bool, [ExportedFun])] -> [BlockDeps]
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 = [(Id, Int)] -> UniqFM Id Int
forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
listToUFM ([(Id, Int)] -> UniqFM Id Int) -> [(Id, Int)] -> UniqFM Id Int
forall a b. (a -> b) -> a -> b
$
((LinkableUnit, Int) -> [(Id, Int)])
-> [(LinkableUnit, Int)] -> [(Id, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(LinkableUnit
u,Int
n) -> (Id -> (Id, Int)) -> [Id] -> [(Id, Int)]
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 = [(OtherSymb, Int)] -> Map OtherSymb Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(OtherSymb, Int)] -> Map OtherSymb Int)
-> [(OtherSymb, Int)] -> Map OtherSymb Int
forall a b. (a -> b) -> a -> b
$
((LinkableUnit, Int) -> [(OtherSymb, Int)])
-> [(LinkableUnit, Int)] -> [(OtherSymb, Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(LinkableUnit
u,Int
n) -> (OtherSymb -> (OtherSymb, Int))
-> [OtherSymb] -> [(OtherSymb, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (,Int
n)
((FastString -> OtherSymb) -> [FastString] -> [OtherSymb]
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 = [LinkableUnit] -> [Int] -> [(LinkableUnit, Int)]
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) <- [Either ExportedFun Int] -> ([ExportedFun], [Int])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ExportedFun Int] -> ([ExportedFun], [Int]))
-> StateT DependencyDataCache G [Either ExportedFun Int]
-> StateT DependencyDataCache G ([ExportedFun], [Int])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Id -> StateT DependencyDataCache G (Either ExportedFun Int))
-> [Id] -> StateT DependencyDataCache G [Either ExportedFun Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int -> Id -> StateT DependencyDataCache G (Either ExportedFun Int)
lookupIdFun Int
n) [Id]
idDeps
([ExportedFun]
edo, [Int]
bdo) <- [Either ExportedFun Int] -> ([ExportedFun], [Int])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ExportedFun Int] -> ([ExportedFun], [Int]))
-> StateT DependencyDataCache G [Either ExportedFun Int]
-> StateT DependencyDataCache G ([ExportedFun], [Int])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (OtherSymb
-> StateT DependencyDataCache G (Either ExportedFun Int))
-> [OtherSymb]
-> StateT DependencyDataCache G [Either ExportedFun Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM OtherSymb -> StateT DependencyDataCache G (Either ExportedFun Int)
lookupOtherFun [OtherSymb]
otherDeps
([ExportedFun]
edp, [Int]
bdp) <- [Either ExportedFun Int] -> ([ExportedFun], [Int])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ExportedFun Int] -> ([ExportedFun], [Int]))
-> StateT DependencyDataCache G [Either ExportedFun Int]
-> StateT DependencyDataCache G ([ExportedFun], [Int])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Unique -> StateT DependencyDataCache G (Either ExportedFun Int))
-> [Unique]
-> StateT DependencyDataCache G [Either ExportedFun Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Int
-> Unique -> StateT DependencyDataCache G (Either ExportedFun Int)
lookupPseudoIdFun Int
n) [Unique]
pseudoIdDeps
[ExportedFun]
expi <- (Id -> StateT DependencyDataCache G ExportedFun)
-> [Id] -> StateT DependencyDataCache G [ExportedFun]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Id -> StateT DependencyDataCache G ExportedFun
lookupExportedId ((Id -> Bool) -> [Id] -> [Id]
forall a. (a -> Bool) -> [a] -> [a]
filter Id -> Bool
isExportedId [Id]
idExports)
[ExportedFun]
expo <- (FastString -> StateT DependencyDataCache G ExportedFun)
-> [FastString] -> StateT DependencyDataCache G [ExportedFun]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FastString -> StateT DependencyDataCache G ExportedFun
lookupExportedOther [FastString]
otherExports
let bdeps :: BlockDeps
bdeps = [Int] -> [ExportedFun] -> BlockDeps
Object.BlockDeps
(BlockIds -> [Int]
IS.toList (BlockIds -> [Int]) -> ([Int] -> BlockIds) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> BlockIds
IS.fromList ([Int] -> BlockIds) -> ([Int] -> [Int]) -> [Int] -> BlockIds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
n) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int]
bdi[Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++[Int]
bdo[Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++[Int]
bdp)
(Set ExportedFun -> [ExportedFun]
forall a. Set a -> [a]
S.toList (Set ExportedFun -> [ExportedFun])
-> ([ExportedFun] -> Set ExportedFun)
-> [ExportedFun]
-> [ExportedFun]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ExportedFun] -> Set ExportedFun
forall a. Ord a => [a] -> Set a
S.fromList ([ExportedFun] -> [ExportedFun]) -> [ExportedFun] -> [ExportedFun]
forall a b. (a -> b) -> a -> b
$ [ExportedFun]
edi[ExportedFun] -> [ExportedFun] -> [ExportedFun]
forall a. [a] -> [a] -> [a]
++[ExportedFun]
edo[ExportedFun] -> [ExportedFun] -> [ExportedFun]
forall a. [a] -> [a] -> [a]
++[ExportedFun]
edp)
(Int, BlockDeps, Bool, [ExportedFun])
-> StateT
DependencyDataCache G (Int, BlockDeps, Bool, [ExportedFun])
forall a. a -> StateT DependencyDataCache G a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n, BlockDeps
bdeps, Bool
req, [ExportedFun]
expi[ExportedFun] -> [ExportedFun] -> [ExportedFun]
forall a. [a] -> [a] -> [a]
++[ExportedFun]
expo)
idModule :: Id -> Maybe Module
idModule :: Id -> Maybe Module
idModule Id
i = Name -> Maybe Module
nameModule_maybe (Id -> Name
forall a. NamedThing a => a -> Name
getName Id
i) Maybe Module -> (Module -> Maybe Module) -> Maybe Module
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Module
m ->
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Module
m Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= Module
mod) Maybe () -> Maybe Module -> Maybe Module
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Module -> Maybe Module
forall a. a -> Maybe a
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 UniqFM Id Int -> Unique -> Maybe Int
forall key elt. UniqFM key elt -> Unique -> Maybe elt
lookupUFM_Directly UniqFM Id Int
unitIdExports Unique
u of
Just Int
k -> Either ExportedFun Int
-> StateT DependencyDataCache G (Either ExportedFun Int)
forall a. a -> StateT DependencyDataCache G a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Either ExportedFun Int
forall a b. b -> Either a b
Right Int
k)
Maybe Int
_ -> String -> StateT DependencyDataCache G (Either ExportedFun 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 UniqFM Id Int -> Id -> Maybe Int
forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
lookupUFM UniqFM Id Int
unitIdExports Id
i of
Just Int
k -> Either ExportedFun Int
-> StateT DependencyDataCache G (Either ExportedFun Int)
forall a. a -> StateT DependencyDataCache G a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Either ExportedFun Int
forall a b. b -> Either a b
Right Int
k)
Maybe Int
Nothing -> case Id -> Maybe Module
idModule Id
i of
Maybe Module
Nothing -> Either ExportedFun Int
-> StateT DependencyDataCache G (Either ExportedFun Int)
forall a. a -> StateT DependencyDataCache G a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Either ExportedFun Int
forall a b. b -> Either a b
Right Int
n)
Just Module
m ->
let k :: Int
k = Unique -> Int
getKey (Unique -> Int) -> (Id -> Unique) -> Id -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Unique
forall a. Uniquable a => a -> Unique
getUnique (Id -> Int) -> Id -> Int
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) <- G Ident -> StateT DependencyDataCache G Ident
forall (m :: * -> *) a.
Monad m =>
m a -> StateT DependencyDataCache m a
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 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
k) (Module -> FastString -> OtherSymb
OtherSymb Module
m FastString
idTxt)
in if Module
m Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
mod
then String
-> SDoc -> StateT DependencyDataCache G (Either ExportedFun Int)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"local id not found" (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m)
else ExportedFun -> Either ExportedFun Int
forall a b. a -> Either a b
Left (ExportedFun -> Either ExportedFun Int)
-> StateT DependencyDataCache G ExportedFun
-> StateT DependencyDataCache G (Either ExportedFun Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Maybe ExportedFun
mr <- (DependencyDataCache -> Maybe ExportedFun)
-> StateT DependencyDataCache G (Maybe ExportedFun)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (Int -> IntMap ExportedFun -> Maybe ExportedFun
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
k (IntMap ExportedFun -> Maybe ExportedFun)
-> (DependencyDataCache -> IntMap ExportedFun)
-> DependencyDataCache
-> Maybe ExportedFun
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DependencyDataCache -> IntMap ExportedFun
ddcId)
StateT DependencyDataCache G ExportedFun
-> (ExportedFun -> StateT DependencyDataCache G ExportedFun)
-> Maybe ExportedFun
-> StateT DependencyDataCache G ExportedFun
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StateT DependencyDataCache G ExportedFun
addEntry ExportedFun -> StateT DependencyDataCache G ExportedFun
forall a. a -> StateT DependencyDataCache G a
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 OtherSymb -> Map OtherSymb Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup OtherSymb
od Map OtherSymb Int
unitOtherExports of
Just Int
n -> Either ExportedFun Int
-> StateT DependencyDataCache G (Either ExportedFun Int)
forall a. a -> StateT DependencyDataCache G a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Either ExportedFun Int
forall a b. b -> Either a b
Right Int
n)
Maybe Int
Nothing | Module
m Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
mod -> String -> StateT DependencyDataCache G (Either ExportedFun Int)
forall a. HasCallStack => String -> a
panic (String
"genDependencyData.lookupOtherFun: unknown local other id: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FastString -> String
unpackFS FastString
idTxt)
Maybe Int
Nothing -> ExportedFun -> Either ExportedFun Int
forall a b. a -> Either a b
Left (ExportedFun -> Either ExportedFun Int)
-> StateT DependencyDataCache G ExportedFun
-> StateT DependencyDataCache G (Either ExportedFun Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT DependencyDataCache G ExportedFun
-> (ExportedFun -> StateT DependencyDataCache G ExportedFun)
-> Maybe ExportedFun
-> StateT DependencyDataCache G ExportedFun
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Int -> OtherSymb -> StateT DependencyDataCache G ExportedFun
lookupExternalFun Maybe Int
forall a. Maybe a
Nothing OtherSymb
od) ExportedFun -> StateT DependencyDataCache G ExportedFun
forall a. a -> StateT DependencyDataCache G a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExportedFun -> StateT DependencyDataCache G ExportedFun)
-> StateT DependencyDataCache G (Maybe ExportedFun)
-> StateT DependencyDataCache G ExportedFun
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
(DependencyDataCache -> Maybe ExportedFun)
-> StateT DependencyDataCache G (Maybe ExportedFun)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (OtherSymb -> Map OtherSymb ExportedFun -> Maybe ExportedFun
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup OtherSymb
od (Map OtherSymb ExportedFun -> Maybe ExportedFun)
-> (DependencyDataCache -> Map OtherSymb ExportedFun)
-> DependencyDataCache
-> Maybe ExportedFun
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) <- G Ident -> StateT DependencyDataCache G Ident
forall (m :: * -> *) a.
Monad m =>
m a -> StateT DependencyDataCache m a
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 (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Id -> Int) -> Id -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique -> Int
getKey (Unique -> Int) -> (Id -> Unique) -> Id -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Unique
forall a. Uniquable a => a -> Unique
getUnique (Id -> Maybe Int) -> Id -> Maybe Int
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 Maybe Int
forall a. Maybe a
Nothing (OtherSymb -> StateT DependencyDataCache G ExportedFun)
-> (FastString -> OtherSymb)
-> FastString
-> StateT DependencyDataCache G ExportedFun
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 (Unique -> Int) -> (Module -> Unique) -> Module -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> Unique
forall a. Uniquable a => a -> Unique
getUnique (Module -> Int) -> Module -> Int
forall a b. (a -> b) -> a -> b
$ Module
m
mpk :: Unit
mpk = Module -> Unit
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 <- (DependencyDataCache -> IntMap Unit)
-> StateT DependencyDataCache G (IntMap Unit)
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets DependencyDataCache -> IntMap Unit
ddcModule
let !cache' :: IntMap Unit
cache' = Int -> Unit -> IntMap Unit -> IntMap Unit
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
mk Unit
mpk IntMap Unit
ms
(DependencyDataCache -> DependencyDataCache)
-> StateT DependencyDataCache G ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (\DependencyDataCache
s -> DependencyDataCache
s { ddcModule = cache'})
ExportedFun -> StateT DependencyDataCache G ExportedFun
forall a. a -> StateT DependencyDataCache G a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExportedFun
exp_fun
ExportedFun
f <- do
Bool
mbm <- (DependencyDataCache -> Bool) -> StateT DependencyDataCache G Bool
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (Int -> IntMap Unit -> Bool
forall a. Int -> IntMap a -> Bool
IM.member Int
mk (IntMap Unit -> Bool)
-> (DependencyDataCache -> IntMap Unit)
-> DependencyDataCache
-> Bool
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 -> ExportedFun -> StateT DependencyDataCache G ExportedFun
forall a. a -> StateT DependencyDataCache G a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExportedFun
exp_fun
case Maybe Int
mbIdKey of
Maybe Int
Nothing -> (DependencyDataCache -> DependencyDataCache)
-> StateT DependencyDataCache G ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (\DependencyDataCache
s -> DependencyDataCache
s { ddcOther = M.insert od f (ddcOther s) })
Just Int
k -> (DependencyDataCache -> DependencyDataCache)
-> StateT DependencyDataCache G ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (\DependencyDataCache
s -> DependencyDataCache
s { ddcId = IM.insert k f (ddcId s) })
ExportedFun -> StateT DependencyDataCache G ExportedFun
forall a. a -> StateT DependencyDataCache G a
forall (m :: * -> *) a. Monad m => a -> m a
return ExportedFun
f