{-# LANGUAGE RecordWildCards #-}
module Parsley.Internal.Frontend.Analysis.Dependencies (dependencyAnalysis) where
import Control.Monad (unless, forM_)
import Control.Monad.ST (ST)
import Data.Array (Array)
import Data.Array.MArray (readArray, writeArray, newArray, newArray_)
import Data.Array.ST (STArray, runSTUArray, runSTArray)
import Data.Array.Unboxed (UArray)
import Data.Bifunctor (first, second)
import Data.Dependent.Map (DMap)
import Data.Foldable (foldl')
import Data.Map.Strict (Map)
import Data.Set (Set)
import Data.STRef (newSTRef, readSTRef, writeSTRef)
import Parsley.Internal.Common.Indexed (Fix, cata, Const1(..), (:*:)(..), zipper)
import Parsley.Internal.Common.State (State, MonadState, execState, modify')
import Parsley.Internal.Core.CombinatorAST (Combinator(..), traverseCombinator)
import Parsley.Internal.Core.Identifiers (IMVar, MVar(..), ΣVar, SomeΣVar(..))
import qualified Data.Dependent.Map as DMap (foldrWithKey, filterWithKey)
import qualified Data.Map.Strict as Map ((!), empty, insert, findMax, elems, maxView, fromList, fromDistinctAscList)
import qualified Data.Set as Set (toList, insert, union, unions, member, notMember, empty, (\\), fromDistinctAscList, size)
import qualified Data.Array as Array ((!), listArray, bounds, indices)
import qualified Data.Array.Unboxed as UArray ((!), assocs)
import qualified Data.List as List (partition)
type Graph = Array IMVar [IMVar]
type PQueue k a = Map k a
dependencyAnalysis :: Fix Combinator a -> DMap MVar (Fix Combinator) -> (DMap MVar (Fix Combinator), Map IMVar (Set SomeΣVar))
dependencyAnalysis :: forall a.
Fix Combinator a
-> DMap MVar (Fix Combinator)
-> (DMap MVar (Fix Combinator), Map IMVar (Set SomeΣVar))
dependencyAnalysis Fix Combinator a
toplevel DMap MVar (Fix Combinator)
μs =
let
roots :: Set IMVar
roots = forall a. Fix Combinator a -> Set IMVar
directDependencies Fix Combinator a
toplevel
DependencyMaps{Map IMVar (Set SomeΣVar)
Map IMVar (Set IMVar)
definedRegisters :: DependencyMaps -> Map IMVar (Set SomeΣVar)
immediateDependencies :: DependencyMaps -> Map IMVar (Set IMVar)
usedRegisters :: DependencyMaps -> Map IMVar (Set SomeΣVar)
definedRegisters :: Map IMVar (Set SomeΣVar)
immediateDependencies :: Map IMVar (Set IMVar)
usedRegisters :: Map IMVar (Set SomeΣVar)
..} = DMap MVar (Fix Combinator) -> DependencyMaps
buildDependencyMaps DMap MVar (Fix Combinator)
μs
callees :: Graph
callees = Map IMVar (Set IMVar) -> Graph
buildGraph Map IMVar (Set IMVar)
immediateDependencies
(UArray IMVar DFNum
dfnums, [IMVar]
lives, Set IMVar
dead) = Set IMVar -> Graph -> (UArray IMVar DFNum, [IMVar], Set IMVar)
topoOrdering Set IMVar
roots Graph
callees
callers :: Graph
callers = Graph -> Set IMVar -> Graph
invertGraph Graph
callers Set IMVar
dead
regs :: Map IMVar (Set SomeΣVar)
regs = [IMVar]
-> UArray IMVar DFNum
-> Map IMVar (Set SomeΣVar)
-> Map IMVar (Set SomeΣVar)
-> Graph
-> Graph
-> Map IMVar (Set SomeΣVar)
propagateRegs [IMVar]
lives UArray IMVar DFNum
dfnums Map IMVar (Set SomeΣVar)
usedRegisters Map IMVar (Set SomeΣVar)
definedRegisters Graph
callees Graph
callers
in (forall {k1} (k2 :: k1 -> Type) (f :: k1 -> Type).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> Bool) -> DMap k2 f -> DMap k2 f
DMap.filterWithKey (\(MVar IMVar
v) Fix Combinator v
_ -> forall a. Ord a => a -> Set a -> Bool
Set.notMember IMVar
v Set IMVar
dead) DMap MVar (Fix Combinator)
μs, Map IMVar (Set SomeΣVar)
regs)
buildGraph :: Map IMVar (Set IMVar) -> Graph
buildGraph :: Map IMVar (Set IMVar) -> Graph
buildGraph Map IMVar (Set IMVar)
deps = forall i e. Ix i => (i, i) -> [e] -> Array i e
Array.listArray (IMVar
0, forall a b. (a, b) -> a
fst (forall k a. Map k a -> (k, a)
Map.findMax Map IMVar (Set IMVar)
deps)) (forall a b. (a -> b) -> [a] -> [b]
map forall a. Set a -> [a]
Set.toList (forall k a. Map k a -> [a]
Map.elems Map IMVar (Set IMVar)
deps))
invertGraph :: Graph -> Set IMVar -> Graph
invertGraph :: Graph -> Set IMVar -> Graph
invertGraph Graph
g Set IMVar
unreachable = forall i e. (forall s. ST s (STArray s i e)) -> Array i e
runSTArray forall a b. (a -> b) -> a -> b
$ do
STArray s IMVar [IMVar]
g' <- forall (a :: Type -> Type -> Type) e (m :: Type -> Type) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (forall i e. Array i e -> (i, i)
Array.bounds Graph
g) []
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall i e. Ix i => Array i e -> [i]
Array.indices Graph
g) forall a b. (a -> b) -> a -> b
$ \IMVar
n ->
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (forall a. Ord a => a -> Set a -> Bool
Set.member IMVar
n Set IMVar
unreachable) forall a b. (a -> b) -> a -> b
$
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Graph
g forall i e. Ix i => Array i e -> i -> e
Array.! IMVar
n) forall a b. (a -> b) -> a -> b
$ \IMVar
s -> do
[IMVar]
preds <- forall (a :: Type -> Type -> Type) e (m :: Type -> Type) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STArray s IMVar [IMVar]
g' IMVar
s
forall (a :: Type -> Type -> Type) e (m :: Type -> Type) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s IMVar [IMVar]
g' IMVar
s (IMVar
n forall a. a -> [a] -> [a]
: [IMVar]
preds)
forall (m :: Type -> Type) a. Monad m => a -> m a
return STArray s IMVar [IMVar]
g'
type DFNum = Int
topoOrdering :: Set IMVar -> Graph -> (UArray IMVar DFNum, [IMVar], Set IMVar)
topoOrdering :: Set IMVar -> Graph -> (UArray IMVar DFNum, [IMVar], Set IMVar)
topoOrdering Set IMVar
roots Graph
graph =
let dfnums :: UArray IMVar DFNum
dfnums :: UArray IMVar DFNum
dfnums = forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray forall a b. (a -> b) -> a -> b
$ do
STUArray s IMVar DFNum
dfnums <- forall (a :: Type -> Type -> Type) e (m :: Type -> Type) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (forall i e. Array i e -> (i, i)
Array.bounds Graph
graph) DFNum
0
STRef s DFNum
nextDfnum <- forall a s. a -> ST s (STRef s a)
newSTRef DFNum
1
let dfs :: IMVar -> ST s ()
dfs IMVar
v = do Bool
seen <- (forall a. Eq a => a -> a -> Bool
/= DFNum
0) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: Type -> Type -> Type) e (m :: Type -> Type) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s IMVar DFNum
dfnums IMVar
v
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
seen forall a b. (a -> b) -> a -> b
$
do DFNum
dfnum <- forall s a. STRef s a -> ST s a
readSTRef STRef s DFNum
nextDfnum
forall (a :: Type -> Type -> Type) e (m :: Type -> Type) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s IMVar DFNum
dfnums IMVar
v DFNum
dfnum
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s DFNum
nextDfnum (DFNum
dfnum forall a. Num a => a -> a -> a
+ DFNum
1)
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Graph
graph forall i e. Ix i => Array i e -> i -> e
Array.! IMVar
v) IMVar -> ST s ()
dfs
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set IMVar
roots IMVar -> ST s ()
dfs
forall (m :: Type -> Type) a. Monad m => a -> m a
return STUArray s IMVar DFNum
dfnums
lives, deads :: [(IMVar, DFNum)]
([(IMVar, DFNum)]
lives, [(IMVar, DFNum)]
deads) = forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition ((forall a. Eq a => a -> a -> Bool
/= DFNum
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall (a :: Type -> Type -> Type) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
UArray.assocs UArray IMVar DFNum
dfnums)
in (UArray IMVar DFNum
dfnums, forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(IMVar, DFNum)]
lives, forall a. [a] -> Set a
Set.fromDistinctAscList (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(IMVar, DFNum)]
deads))
propagateRegs :: [IMVar] -> UArray IMVar DFNum -> Map IMVar (Set SomeΣVar) -> Map IMVar (Set SomeΣVar) -> Graph -> Graph -> Map IMVar (Set SomeΣVar)
propagateRegs :: [IMVar]
-> UArray IMVar DFNum
-> Map IMVar (Set SomeΣVar)
-> Map IMVar (Set SomeΣVar)
-> Graph
-> Graph
-> Map IMVar (Set SomeΣVar)
propagateRegs [IMVar]
reachables UArray IMVar DFNum
dfnums Map IMVar (Set SomeΣVar)
uses Map IMVar (Set SomeΣVar)
defs Graph
callees Graph
callers = Array IMVar (Set SomeΣVar) -> Map IMVar (Set SomeΣVar)
toMap forall a b. (a -> b) -> a -> b
$ forall i e. (forall s. ST s (STArray s i e)) -> Array i e
runSTArray forall a b. (a -> b) -> a -> b
$
do STArray s IMVar (Set SomeΣVar)
freeRegs <- forall (a :: Type -> Type -> Type) e (m :: Type -> Type) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ (forall i e. Array i e -> (i, i)
Array.bounds Graph
callees)
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [IMVar]
reachables forall a b. (a -> b) -> a -> b
$ \IMVar
v -> forall (a :: Type -> Type -> Type) e (m :: Type -> Type) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s IMVar (Set SomeΣVar)
freeRegs IMVar
v ((Map IMVar (Set SomeΣVar)
uses forall k a. Ord k => Map k a -> k -> a
Map.! IMVar
v) forall a. Ord a => Set a -> Set a -> Set a
Set.\\ (Map IMVar (Set SomeΣVar)
defs forall k a. Ord k => Map k a -> k -> a
Map.! IMVar
v))
let worklist :: Map DFNum IMVar
worklist = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall a b. (a -> b) -> [a] -> [b]
map (\IMVar
v -> (UArray IMVar DFNum
dfnums forall (a :: Type -> Type -> Type) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
UArray.! IMVar
v, IMVar
v)) [IMVar]
reachables)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: Type -> Type) a. Monad m => a -> m a
return ()) (forall (m :: Type -> Type) s.
Monad m =>
(s -> m (Maybe s)) -> s -> m ()
unfoldM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall s.
STArray s IMVar (Set SomeΣVar)
-> IMVar
-> Map DFNum IMVar
-> ST s (Maybe (IMVar, Map DFNum IMVar))
propagate STArray s IMVar (Set SomeΣVar)
freeRegs))) (forall k a. Map k a -> Maybe (a, Map k a)
Map.maxView Map DFNum IMVar
worklist)
forall (m :: Type -> Type) a. Monad m => a -> m a
return STArray s IMVar (Set SomeΣVar)
freeRegs
where
propagate :: STArray s IMVar (Set SomeΣVar) -> IMVar -> PQueue DFNum IMVar -> ST s (Maybe (IMVar, PQueue DFNum IMVar))
propagate :: forall s.
STArray s IMVar (Set SomeΣVar)
-> IMVar
-> Map DFNum IMVar
-> ST s (Maybe (IMVar, Map DFNum IMVar))
propagate STArray s IMVar (Set SomeΣVar)
freeRegs IMVar
v Map DFNum IMVar
work = do
!Set SomeΣVar
frees <- forall (a :: Type -> Type -> Type) e (m :: Type -> Type) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STArray s IMVar (Set SomeΣVar)
freeRegs IMVar
v
!Set SomeΣVar
freesCallees <- forall (f :: Type -> Type) a.
(Foldable f, Ord a) =>
f (Set a) -> Set a
Set.unions forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (a :: Type -> Type -> Type) e (m :: Type -> Type) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STArray s IMVar (Set SomeΣVar)
freeRegs) (Graph
callees forall i e. Ix i => Array i e -> i -> e
Array.! IMVar
v)
let !frees' :: Set SomeΣVar
frees' = Set SomeΣVar
frees forall a. Ord a => Set a -> Set a -> Set a
`Set.union` (Set SomeΣVar
freesCallees forall a. Ord a => Set a -> Set a -> Set a
Set.\\ (Map IMVar (Set SomeΣVar)
defs forall k a. Ord k => Map k a -> k -> a
Map.! IMVar
v))
if forall a. Set a -> DFNum
Set.size Set SomeΣVar
frees forall a. Eq a => a -> a -> Bool
/= forall a. Set a -> DFNum
Set.size Set SomeΣVar
frees' then do
forall (a :: Type -> Type -> Type) e (m :: Type -> Type) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s IMVar (Set SomeΣVar)
freeRegs IMVar
v Set SomeΣVar
frees'
forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall k a. Map k a -> Maybe (a, Map k a)
Map.maxView ([IMVar] -> Map DFNum IMVar -> Map DFNum IMVar
addWork (Graph
callers forall i e. Ix i => Array i e -> i -> e
Array.! IMVar
v) Map DFNum IMVar
work))
else forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall k a. Map k a -> Maybe (a, Map k a)
Map.maxView Map DFNum IMVar
work)
addWork :: [IMVar] -> PQueue DFNum IMVar -> PQueue DFNum IMVar
addWork :: [IMVar] -> Map DFNum IMVar -> Map DFNum IMVar
addWork [IMVar]
vs Map DFNum IMVar
work = forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip (\IMVar
v -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (UArray IMVar DFNum
dfnums forall (a :: Type -> Type -> Type) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
UArray.! IMVar
v) IMVar
v)) Map DFNum IMVar
work [IMVar]
vs
unfoldM_ :: Monad m => (s -> m (Maybe s)) -> s -> m ()
unfoldM_ :: forall (m :: Type -> Type) s.
Monad m =>
(s -> m (Maybe s)) -> s -> m ()
unfoldM_ s -> m (Maybe s)
f s
s = s -> m (Maybe s)
f s
s forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: Type -> Type) s.
Monad m =>
(s -> m (Maybe s)) -> s -> m ()
unfoldM_ s -> m (Maybe s)
f)
toMap :: Array IMVar (Set SomeΣVar) -> Map IMVar (Set SomeΣVar)
toMap Array IMVar (Set SomeΣVar)
arr = forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList (forall a b. (a -> b) -> [a] -> [b]
map (\IMVar
v -> (IMVar
v, Array IMVar (Set SomeΣVar)
arr forall i e. Ix i => Array i e -> i -> e
Array.! IMVar
v)) [IMVar]
reachables)
data DependencyMaps = DependencyMaps {
DependencyMaps -> Map IMVar (Set SomeΣVar)
usedRegisters :: !(Map IMVar (Set SomeΣVar)),
DependencyMaps -> Map IMVar (Set IMVar)
immediateDependencies :: !(Map IMVar (Set IMVar)),
DependencyMaps -> Map IMVar (Set SomeΣVar)
definedRegisters :: !(Map IMVar (Set SomeΣVar))
}
buildDependencyMaps :: DMap MVar (Fix Combinator) -> DependencyMaps
buildDependencyMaps :: DMap MVar (Fix Combinator) -> DependencyMaps
buildDependencyMaps = forall {k1} (k2 :: k1 -> Type) (f :: k1 -> Type) b.
(forall (v :: k1). k2 v -> f v -> b -> b) -> b -> DMap k2 f -> b
DMap.foldrWithKey (\(MVar IMVar
v) Fix Combinator v
p deps :: DependencyMaps
deps@DependencyMaps{Map IMVar (Set SomeΣVar)
Map IMVar (Set IMVar)
definedRegisters :: Map IMVar (Set SomeΣVar)
immediateDependencies :: Map IMVar (Set IMVar)
usedRegisters :: Map IMVar (Set SomeΣVar)
definedRegisters :: DependencyMaps -> Map IMVar (Set SomeΣVar)
immediateDependencies :: DependencyMaps -> Map IMVar (Set IMVar)
usedRegisters :: DependencyMaps -> Map IMVar (Set SomeΣVar)
..} ->
let (Set SomeΣVar
uses, Set SomeΣVar
defs, Set IMVar
ds) = forall a.
IMVar
-> Fix Combinator a -> (Set SomeΣVar, Set SomeΣVar, Set IMVar)
freeRegistersAndDependencies IMVar
v Fix Combinator v
p
in DependencyMaps
deps { usedRegisters :: Map IMVar (Set SomeΣVar)
usedRegisters = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert IMVar
v Set SomeΣVar
uses Map IMVar (Set SomeΣVar)
usedRegisters
, immediateDependencies :: Map IMVar (Set IMVar)
immediateDependencies = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert IMVar
v Set IMVar
ds Map IMVar (Set IMVar)
immediateDependencies
, definedRegisters :: Map IMVar (Set SomeΣVar)
definedRegisters = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert IMVar
v Set SomeΣVar
defs Map IMVar (Set SomeΣVar)
definedRegisters}) (Map IMVar (Set SomeΣVar)
-> Map IMVar (Set IMVar)
-> Map IMVar (Set SomeΣVar)
-> DependencyMaps
DependencyMaps forall k a. Map k a
Map.empty forall k a. Map k a
Map.empty forall k a. Map k a
Map.empty)
freeRegistersAndDependencies :: IMVar -> Fix Combinator a -> (Set SomeΣVar, Set SomeΣVar, Set IMVar)
freeRegistersAndDependencies :: forall a.
IMVar
-> Fix Combinator a -> (Set SomeΣVar, Set SomeΣVar, Set IMVar)
freeRegistersAndDependencies IMVar
v Fix Combinator a
p =
let FreeRegisters a
frsm :*: Dependencies a
depsm = forall (f :: (Type -> Type) -> Type -> Type) (a :: Type -> Type)
(b :: Type -> Type) i.
IFunctor f =>
(forall j. f a j -> a j)
-> (forall j. f b j -> b j) -> Fix f i -> (:*:) a b i
zipper forall a. Combinator FreeRegisters a -> FreeRegisters a
freeRegistersAlg (forall a.
Maybe IMVar -> Combinator Dependencies a -> Dependencies a
dependenciesAlg (forall a. a -> Maybe a
Just IMVar
v)) Fix Combinator a
p
(Set SomeΣVar
uses, Set SomeΣVar
defs) = forall {k} (a :: k).
FreeRegisters a -> (Set SomeΣVar, Set SomeΣVar)
runFreeRegisters FreeRegisters a
frsm
ds :: Set IMVar
ds = forall {k} (a :: k). Dependencies a -> Set IMVar
runDependencies Dependencies a
depsm
in (Set SomeΣVar
uses, Set SomeΣVar
defs, Set IMVar
ds)
newtype Dependencies a = Dependencies { forall {k} (a :: k). Dependencies a -> State (Set IMVar) ()
doDependencies :: State (Set IMVar) () }
runDependencies :: Dependencies a -> Set IMVar
runDependencies :: forall {k} (a :: k). Dependencies a -> Set IMVar
runDependencies = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
execState forall a. Set a
Set.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k). Dependencies a -> State (Set IMVar) ()
doDependencies
directDependencies :: Fix Combinator a -> Set IMVar
directDependencies :: forall a. Fix Combinator a -> Set IMVar
directDependencies = forall {k} (a :: k). Dependencies a -> Set IMVar
runDependencies forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: (Type -> Type) -> Type -> Type) (a :: Type -> Type) i.
IFunctor f =>
(forall j. f a j -> a j) -> Fix f i -> a i
cata (forall a.
Maybe IMVar -> Combinator Dependencies a -> Dependencies a
dependenciesAlg forall a. Maybe a
Nothing)
{-# INLINE dependenciesAlg #-}
dependenciesAlg :: Maybe IMVar -> Combinator Dependencies a -> Dependencies a
dependenciesAlg :: forall a.
Maybe IMVar -> Combinator Dependencies a -> Dependencies a
dependenciesAlg (Just IMVar
v) (Let μ :: MVar a
μ@(MVar IMVar
u)) = forall {k} (a :: k). State (Set IMVar) () -> Dependencies a
Dependencies forall a b. (a -> b) -> a -> b
$ do forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (IMVar
u forall a. Eq a => a -> a -> Bool
== IMVar
v) (forall (m :: Type -> Type) a.
MonadState (Set IMVar) m =>
MVar a -> m ()
dependsOn MVar a
μ)
dependenciesAlg Maybe IMVar
Nothing (Let MVar a
μ) = forall {k} (a :: k). State (Set IMVar) () -> Dependencies a
Dependencies forall a b. (a -> b) -> a -> b
$ do forall (m :: Type -> Type) a.
MonadState (Set IMVar) m =>
MVar a -> m ()
dependsOn MVar a
μ
dependenciesAlg Maybe IMVar
_ Combinator Dependencies a
p = forall {k} (a :: k). State (Set IMVar) () -> Dependencies a
Dependencies forall a b. (a -> b) -> a -> b
$ do forall (m :: Type -> Type) (f :: Type -> Type) (k :: Type -> Type)
a.
Applicative m =>
(forall a1. f a1 -> m (k a1))
-> Combinator f a -> m (Combinator k a)
traverseCombinator (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} a (k1 :: k). a -> Const1 a k1
Const1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k). Dependencies a -> State (Set IMVar) ()
doDependencies) Combinator Dependencies a
p; forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
dependsOn :: MonadState (Set IMVar) m => MVar a -> m ()
dependsOn :: forall (m :: Type -> Type) a.
MonadState (Set IMVar) m =>
MVar a -> m ()
dependsOn (MVar IMVar
v) = forall s (m :: Type -> Type). MonadState s m => (s -> s) -> m ()
modify' (forall a. Ord a => a -> Set a -> Set a
Set.insert IMVar
v)
newtype FreeRegisters a = FreeRegisters { forall {k} (a :: k).
FreeRegisters a -> State (Set SomeΣVar, Set SomeΣVar) ()
doFreeRegisters :: State (Set SomeΣVar, Set SomeΣVar) () }
runFreeRegisters :: FreeRegisters a -> (Set SomeΣVar, Set SomeΣVar)
runFreeRegisters :: forall {k} (a :: k).
FreeRegisters a -> (Set SomeΣVar, Set SomeΣVar)
runFreeRegisters = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
execState (forall a. Set a
Set.empty, forall a. Set a
Set.empty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k).
FreeRegisters a -> State (Set SomeΣVar, Set SomeΣVar) ()
doFreeRegisters
{-# INLINE freeRegistersAlg #-}
freeRegistersAlg :: Combinator FreeRegisters a -> FreeRegisters a
freeRegistersAlg :: forall a. Combinator FreeRegisters a -> FreeRegisters a
freeRegistersAlg (GetRegister ΣVar a
σ) = forall {k} (a :: k).
State (Set SomeΣVar, Set SomeΣVar) () -> FreeRegisters a
FreeRegisters forall a b. (a -> b) -> a -> b
$ do forall vs (m :: Type -> Type) a.
MonadState (Set SomeΣVar, vs) m =>
ΣVar a -> m ()
uses ΣVar a
σ
freeRegistersAlg (PutRegister ΣVar a1
σ FreeRegisters a1
p) = forall {k} (a :: k).
State (Set SomeΣVar, Set SomeΣVar) () -> FreeRegisters a
FreeRegisters forall a b. (a -> b) -> a -> b
$ do forall vs (m :: Type -> Type) a.
MonadState (Set SomeΣVar, vs) m =>
ΣVar a -> m ()
uses ΣVar a1
σ; forall {k} (a :: k).
FreeRegisters a -> State (Set SomeΣVar, Set SomeΣVar) ()
doFreeRegisters FreeRegisters a1
p
freeRegistersAlg (MakeRegister ΣVar a1
σ FreeRegisters a1
p FreeRegisters a
q) = forall {k} (a :: k).
State (Set SomeΣVar, Set SomeΣVar) () -> FreeRegisters a
FreeRegisters forall a b. (a -> b) -> a -> b
$ do forall vs (m :: Type -> Type) a.
MonadState (vs, Set SomeΣVar) m =>
ΣVar a -> m ()
defs ΣVar a1
σ; forall {k} (a :: k).
FreeRegisters a -> State (Set SomeΣVar, Set SomeΣVar) ()
doFreeRegisters FreeRegisters a1
p; forall {k} (a :: k).
FreeRegisters a -> State (Set SomeΣVar, Set SomeΣVar) ()
doFreeRegisters FreeRegisters a
q
freeRegistersAlg Combinator FreeRegisters a
p = forall {k} (a :: k).
State (Set SomeΣVar, Set SomeΣVar) () -> FreeRegisters a
FreeRegisters forall a b. (a -> b) -> a -> b
$ do forall (m :: Type -> Type) (f :: Type -> Type) (k :: Type -> Type)
a.
Applicative m =>
(forall a1. f a1 -> m (k a1))
-> Combinator f a -> m (Combinator k a)
traverseCombinator (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} a (k1 :: k). a -> Const1 a k1
Const1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k).
FreeRegisters a -> State (Set SomeΣVar, Set SomeΣVar) ()
doFreeRegisters) Combinator FreeRegisters a
p; forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
uses :: MonadState (Set SomeΣVar, vs) m => ΣVar a -> m ()
uses :: forall vs (m :: Type -> Type) a.
MonadState (Set SomeΣVar, vs) m =>
ΣVar a -> m ()
uses ΣVar a
σ = forall s (m :: Type -> Type). MonadState s m => (s -> s) -> m ()
modify' (forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a. Ord a => a -> Set a -> Set a
Set.insert (forall r. ΣVar r -> SomeΣVar
SomeΣVar ΣVar a
σ)))
defs :: MonadState (vs, Set SomeΣVar) m => ΣVar a -> m ()
defs :: forall vs (m :: Type -> Type) a.
MonadState (vs, Set SomeΣVar) m =>
ΣVar a -> m ()
defs ΣVar a
σ = forall s (m :: Type -> Type). MonadState s m => (s -> s) -> m ()
modify' (forall (p :: Type -> Type -> Type) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a. Ord a => a -> Set a -> Set a
Set.insert (forall r. ΣVar r -> SomeΣVar
SomeΣVar ΣVar a
σ)))