{-# LANGUAGE RecordWildCards #-}

module Gibbon.Passes.ReorderScalarWrites
  ( reorderScalarWrites, writeOrderMarkers )
  where

import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Graph as G
import           Data.Maybe ( fromJust )
import           Text.PrettyPrint.GenericPretty
import           Text.PrettyPrint ( text )

import           Gibbon.Common hiding ( Mode )
import           Gibbon.Language
import qualified Gibbon.L2.Syntax as L2
import qualified Gibbon.L3.Syntax as L3

--------------------------------------------------------------------------------

-- | Inserts markers which tells subsequent a compiler pass where to
-- move the tag and scalar field allocations so that they happen
-- before any of the subsequent packed fields.
writeOrderMarkers :: L2.Prog2 -> PassM L2.Prog2
writeOrderMarkers :: Prog2 -> PassM Prog2
writeOrderMarkers (Prog DDefs (TyOf Exp2)
ddefs FunDefs Exp2
fundefs Maybe (Exp2, TyOf Exp2)
mainExp) = do
    [FunDef Exp2]
fds' <- (FunDef Exp2 -> PassM (FunDef Exp2))
-> [FunDef Exp2] -> PassM [FunDef Exp2]
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 FunDef Exp2 -> PassM (FunDef Exp2)
gofun (FunDefs Exp2 -> [FunDef Exp2]
forall k a. Map k a -> [a]
M.elems FunDefs Exp2
fundefs)
    let fundefs' :: FunDefs Exp2
fundefs' = [(LocVar, FunDef Exp2)] -> FunDefs Exp2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(LocVar, FunDef Exp2)] -> FunDefs Exp2)
-> [(LocVar, FunDef Exp2)] -> FunDefs Exp2
forall a b. (a -> b) -> a -> b
$ (FunDef Exp2 -> (LocVar, FunDef Exp2))
-> [FunDef Exp2] -> [(LocVar, FunDef Exp2)]
forall a b. (a -> b) -> [a] -> [b]
map (\FunDef Exp2
f -> (FunDef Exp2 -> LocVar
forall ex. FunDef ex -> LocVar
funName FunDef Exp2
f,FunDef Exp2
f)) [FunDef Exp2]
fds'
    Maybe (Exp2, UrTy LocVar)
mainExp' <- case Maybe (Exp2, TyOf Exp2)
mainExp of
                    Just (Exp2
e,TyOf Exp2
ty) -> do let env2 :: Env2 (UrTy LocVar)
env2 = TyEnv (UrTy LocVar)
-> TyEnv (ArrowTy (UrTy LocVar)) -> Env2 (UrTy LocVar)
forall a. TyEnv a -> TyEnv (ArrowTy a) -> Env2 a
Env2 TyEnv (UrTy LocVar)
forall k a. Map k a
M.empty (FunDefs Exp2 -> TyEnv (ArrowTy (TyOf Exp2))
forall a. FunDefs a -> TyEnv (ArrowTy (TyOf a))
initFunEnv FunDefs Exp2
fundefs)
                                      Exp2
e' <- RegEnv
-> AllocEnv -> StoreEnv -> Env2 (UrTy LocVar) -> Exp2 -> PassM Exp2
go RegEnv
forall k a. Map k a
M.empty AllocEnv
forall k a. Map k a
M.empty StoreEnv
forall k a. Map k a
M.empty Env2 (UrTy LocVar)
env2 Exp2
e
                                      Maybe (Exp2, UrTy LocVar) -> PassM (Maybe (Exp2, UrTy LocVar))
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Exp2, UrTy LocVar) -> PassM (Maybe (Exp2, UrTy LocVar)))
-> Maybe (Exp2, UrTy LocVar) -> PassM (Maybe (Exp2, UrTy LocVar))
forall a b. (a -> b) -> a -> b
$ (Exp2, UrTy LocVar) -> Maybe (Exp2, UrTy LocVar)
forall a. a -> Maybe a
Just (Exp2
e', TyOf Exp2
UrTy LocVar
ty)
                    Maybe (Exp2, TyOf Exp2)
Nothing     -> Maybe (Exp2, UrTy LocVar) -> PassM (Maybe (Exp2, UrTy LocVar))
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Exp2, UrTy LocVar)
forall a. Maybe a
Nothing
    Prog2 -> PassM Prog2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Prog2 -> PassM Prog2) -> Prog2 -> PassM Prog2
forall a b. (a -> b) -> a -> b
$ DDefs (TyOf Exp2)
-> FunDefs Exp2 -> Maybe (Exp2, TyOf Exp2) -> Prog2
forall ex.
DDefs (TyOf ex) -> FunDefs ex -> Maybe (ex, TyOf ex) -> Prog ex
Prog DDefs (TyOf Exp2)
ddefs FunDefs Exp2
fundefs' Maybe (Exp2, TyOf Exp2)
Maybe (Exp2, UrTy LocVar)
mainExp'

  where
    gofun :: FunDef Exp2 -> PassM (FunDef Exp2)
gofun f :: FunDef Exp2
f@FunDef{[LocVar]
funArgs :: [LocVar]
funArgs :: forall ex. FunDef ex -> [LocVar]
funArgs,Exp2
funBody :: Exp2
funBody :: forall ex. FunDef ex -> ex
funBody,ArrowTy (TyOf Exp2)
funTy :: ArrowTy (TyOf Exp2)
funTy :: forall ex. FunDef ex -> ArrowTy (TyOf ex)
funTy} = do
        let (RegEnv
reg_env, AllocEnv
alloc_env) =
              (LRM -> (RegEnv, AllocEnv) -> (RegEnv, AllocEnv))
-> (RegEnv, AllocEnv) -> [LRM] -> (RegEnv, AllocEnv)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(L2.LRM LocVar
loc Region
reg Modality
mode) (RegEnv
renv,AllocEnv
aenv) ->
                       let renv' :: RegEnv
renv' = LocVar -> Region -> RegEnv -> RegEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert LocVar
loc Region
reg RegEnv
renv
                           aenv' :: AllocEnv
aenv' = case Modality
mode of
                                     Modality
L2.Output ->
                                       let reg_locs :: RegionLocs
reg_locs = [LocVar] -> Set LocVar -> RegionLocs
RegionLocs [LocVar
loc] Set LocVar
forall a. Set a
S.empty
                                       in Region -> RegionLocs -> AllocEnv -> AllocEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Region
reg RegionLocs
reg_locs AllocEnv
aenv
                                     Modality
L2.Input -> AllocEnv
aenv
                       in (RegEnv
renv',AllocEnv
aenv'))
                    (RegEnv
forall k a. Map k a
M.empty,AllocEnv
forall k a. Map k a
M.empty)
                    (ArrowTy2 (UrTy LocVar) -> [LRM]
forall ty2. ArrowTy2 ty2 -> [LRM]
L2.locVars ArrowTy (TyOf Exp2)
ArrowTy2 (UrTy LocVar)
funTy)
            init_ty_env :: TyEnv (UrTy LocVar)
init_ty_env  = [(LocVar, UrTy LocVar)] -> TyEnv (UrTy LocVar)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(LocVar, UrTy LocVar)] -> TyEnv (UrTy LocVar))
-> [(LocVar, UrTy LocVar)] -> TyEnv (UrTy LocVar)
forall a b. (a -> b) -> a -> b
$ [LocVar] -> [UrTy LocVar] -> [(LocVar, UrTy LocVar)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LocVar]
funArgs (ArrowTy2 (UrTy LocVar) -> [UrTy LocVar]
forall ty2. ArrowTy2 ty2 -> [ty2]
L2.arrIns ArrowTy (TyOf Exp2)
ArrowTy2 (UrTy LocVar)
funTy)
            env2 :: Env2 (UrTy LocVar)
env2 = TyEnv (UrTy LocVar)
-> TyEnv (ArrowTy (UrTy LocVar)) -> Env2 (UrTy LocVar)
forall a. TyEnv a -> TyEnv (ArrowTy a) -> Env2 a
Env2 TyEnv (UrTy LocVar)
init_ty_env (FunDefs Exp2 -> TyEnv (ArrowTy (TyOf Exp2))
forall a. FunDefs a -> TyEnv (ArrowTy (TyOf a))
initFunEnv FunDefs Exp2
fundefs)
        Exp2
funBody' <- RegEnv
-> AllocEnv -> StoreEnv -> Env2 (UrTy LocVar) -> Exp2 -> PassM Exp2
go RegEnv
reg_env AllocEnv
alloc_env StoreEnv
forall k a. Map k a
M.empty Env2 (UrTy LocVar)
env2 Exp2
funBody
        FunDef Exp2 -> PassM (FunDef Exp2)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FunDef Exp2 -> PassM (FunDef Exp2))
-> FunDef Exp2 -> PassM (FunDef Exp2)
forall a b. (a -> b) -> a -> b
$ FunDef Exp2
f { funBody :: Exp2
funBody = Exp2
funBody' }

    go :: RegEnv -> AllocEnv -> StoreEnv -> Env2 L2.Ty2 -> L2.Exp2 -> PassM L2.Exp2
    go :: RegEnv
-> AllocEnv -> StoreEnv -> Env2 (UrTy LocVar) -> Exp2 -> PassM Exp2
go RegEnv
reg_env AllocEnv
alloc_env StoreEnv
store_env Env2 (UrTy LocVar)
env2 Exp2
ex =
      case Exp2
ex of
        LetE (LocVar
v,[LocVar]
locs,UrTy LocVar
ty,Exp2
rhs) Exp2
bod -> do
          let env2' :: Env2 (UrTy LocVar)
env2' = LocVar -> UrTy LocVar -> Env2 (UrTy LocVar) -> Env2 (UrTy LocVar)
forall a. LocVar -> a -> Env2 a -> Env2 a
extendVEnv LocVar
v UrTy LocVar
ty Env2 (UrTy LocVar)
env2
          case (UrTy LocVar -> [LocVar]
L2.locsInTy UrTy LocVar
ty) of
            [] -> ((LocVar, [LocVar], UrTy LocVar, Exp2) -> Exp2 -> Exp2
forall (ext :: * -> * -> *) loc dec.
(LocVar, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (LocVar
v,[LocVar]
locs,UrTy LocVar
ty,Exp2
rhs)) (Exp2 -> Exp2) -> PassM Exp2 -> PassM Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RegEnv
-> AllocEnv -> StoreEnv -> Env2 (UrTy LocVar) -> Exp2 -> PassM Exp2
go RegEnv
reg_env AllocEnv
alloc_env StoreEnv
store_env Env2 (UrTy LocVar)
env2' Exp2
bod)
            [LocVar
one] -> let (Bool
is_ok, [LocVar]
locs_before, Region
reg, (RegionLocs [LocVar]
rlocs Set LocVar
allocated)) = LocVar -> Exp2 -> Exp2 -> (Bool, [LocVar], Region, RegionLocs)
isAllocationOk LocVar
one Exp2
rhs Exp2
bod
                         reg_env' :: RegEnv
reg_env' = (LocVar -> RegEnv -> RegEnv) -> RegEnv -> [LocVar] -> RegEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\LocVar
loc RegEnv
acc -> LocVar -> Region -> RegEnv -> RegEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert LocVar
loc Region
reg RegEnv
acc) RegEnv
reg_env [LocVar]
locs
                         alloc_env' :: AllocEnv
alloc_env' =
                           Region -> RegionLocs -> AllocEnv -> AllocEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Region
reg
                             ([LocVar] -> Set LocVar -> RegionLocs
RegionLocs [LocVar]
rlocs (LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => a -> Set a -> Set a
S.insert LocVar
one ([LocVar] -> Set LocVar
forall a. Ord a => [a] -> Set a
S.fromList [LocVar]
locs_before Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set LocVar
allocated)))
                             AllocEnv
alloc_env
                     in if Bool
is_ok
                        then ((LocVar, [LocVar], UrTy LocVar, Exp2) -> Exp2 -> Exp2
forall (ext :: * -> * -> *) loc dec.
(LocVar, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (LocVar
v,[LocVar]
locs,UrTy LocVar
ty,Exp2
rhs)) (Exp2 -> Exp2) -> PassM Exp2 -> PassM Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RegEnv
-> AllocEnv -> StoreEnv -> Env2 (UrTy LocVar) -> Exp2 -> PassM Exp2
go RegEnv
reg_env' AllocEnv
alloc_env' StoreEnv
store_env Env2 (UrTy LocVar)
env2' Exp2
bod)
                        else do
                          let tag_loc :: LocVar
tag_loc = [LocVar] -> LocVar
forall a. HasCallStack => [a] -> a
head [LocVar]
locs_before
                          let tag_tycon :: [Char]
tag_tycon = LocVar -> Exp2 -> [Char]
findTyCon LocVar
tag_loc Exp2
bod
                          let in_scope :: Set LocVar
in_scope = TyEnv (UrTy LocVar) -> Set LocVar
forall k a. Map k a -> Set k
M.keysSet (Env2 (UrTy LocVar) -> TyEnv (UrTy LocVar)
forall a. Env2 a -> TyEnv a
vEnv Env2 (UrTy LocVar)
env2) Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Map LocVar (ArrowTy2 (UrTy LocVar)) -> Set LocVar
forall k a. Map k a -> Set k
M.keysSet (Env2 (UrTy LocVar) -> TyEnv (ArrowTy (UrTy LocVar))
forall a. Env2 a -> TyEnv (ArrowTy a)
fEnv Env2 (UrTy LocVar)
env2)
                              (Set LocVar
move_set,Bool
move_scalars) = DDefs2 -> Set LocVar -> LocVar -> Exp2 -> (Set LocVar, Bool)
checkScalarDeps DDefs (TyOf Exp2)
DDefs2
ddefs Set LocVar
in_scope LocVar
tag_loc Exp2
ex
                              move_scalars_easy :: Bool
move_scalars_easy = Bool
move_scalars Bool -> Bool -> Bool
&& Set LocVar -> Bool
forall a. Set a -> Bool
S.null Set LocVar
move_set
                              store_env' :: StoreEnv
store_env' = (LocVar -> StoreEnv -> StoreEnv)
-> StoreEnv -> [LocVar] -> StoreEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\LocVar
x StoreEnv
acc -> LocVar -> LocVar -> StoreEnv -> StoreEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert LocVar
x LocVar
tag_loc StoreEnv
acc) StoreEnv
store_env (Set LocVar -> [LocVar]
forall a. Set a -> [a]
S.toList Set LocVar
move_set)
                          LocVar
alloc_tag_here <- LocVar -> PassM LocVar
forall (m :: * -> *). MonadState Int m => LocVar -> m LocVar
gensym LocVar
"alloc_tag_here"
                          LocVar
alloc_scalars_here <- LocVar -> PassM LocVar
forall (m :: * -> *). MonadState Int m => LocVar -> m LocVar
gensym LocVar
"alloc_scalars_here"
                          (LocVar, [LocVar], UrTy LocVar, Exp2) -> Exp2 -> Exp2
forall (ext :: * -> * -> *) loc dec.
(LocVar, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (LocVar
alloc_tag_here,[],[UrTy LocVar] -> UrTy LocVar
forall loc. [UrTy loc] -> UrTy loc
ProdTy [],E2Ext LocVar (UrTy LocVar) -> Exp2
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E2Ext LocVar (UrTy LocVar) -> Exp2)
-> E2Ext LocVar (UrTy LocVar) -> Exp2
forall a b. (a -> b) -> a -> b
$ LocVar -> [Char] -> E2Ext LocVar (UrTy LocVar)
forall loc dec. LocVar -> [Char] -> E2Ext loc dec
L2.AllocateTagHere LocVar
tag_loc [Char]
tag_tycon) (Exp2 -> Exp2) -> PassM Exp2 -> PassM Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                            (if Bool
move_scalars_easy
                             then
                               (LocVar, [LocVar], UrTy LocVar, Exp2) -> Exp2 -> Exp2
forall (ext :: * -> * -> *) loc dec.
(LocVar, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (LocVar
alloc_scalars_here,[],[UrTy LocVar] -> UrTy LocVar
forall loc. [UrTy loc] -> UrTy loc
ProdTy [],E2Ext LocVar (UrTy LocVar) -> Exp2
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E2Ext LocVar (UrTy LocVar) -> Exp2)
-> E2Ext LocVar (UrTy LocVar) -> Exp2
forall a b. (a -> b) -> a -> b
$ LocVar -> E2Ext LocVar (UrTy LocVar)
forall loc dec. LocVar -> E2Ext loc dec
L2.AllocateScalarsHere LocVar
tag_loc) (Exp2 -> Exp2) -> (Exp2 -> Exp2) -> Exp2 -> Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                               (LocVar, [LocVar], UrTy LocVar, Exp2) -> Exp2 -> Exp2
forall (ext :: * -> * -> *) loc dec.
(LocVar, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (LocVar
v,[LocVar]
locs,UrTy LocVar
ty,Exp2
rhs) (Exp2 -> Exp2) -> PassM Exp2 -> PassM Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                 RegEnv
-> AllocEnv -> StoreEnv -> Env2 (UrTy LocVar) -> Exp2 -> PassM Exp2
go RegEnv
reg_env' AllocEnv
alloc_env' StoreEnv
store_env' Env2 (UrTy LocVar)
env2' Exp2
bod
                             else
                               (LocVar, [LocVar], UrTy LocVar, Exp2) -> Exp2 -> Exp2
forall (ext :: * -> * -> *) loc dec.
(LocVar, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (LocVar
v,[LocVar]
locs,UrTy LocVar
ty,Exp2
rhs) (Exp2 -> Exp2) -> PassM Exp2 -> PassM Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                 RegEnv
-> AllocEnv -> StoreEnv -> Env2 (UrTy LocVar) -> Exp2 -> PassM Exp2
go RegEnv
reg_env' AllocEnv
alloc_env' StoreEnv
store_env' Env2 (UrTy LocVar)
env2' Exp2
bod)

            [LocVar]
ls -> [Char] -> PassM Exp2
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp2) -> [Char] -> PassM Exp2
forall a b. (a -> b) -> a -> b
$ [Char]
"writeOrderMarkers: encountered allocation to more" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                          [Char]
" than one output location; " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [LocVar] -> [Char]
forall a. Out a => a -> [Char]
sdoc [LocVar]
ls [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp2 -> [Char]
forall a. Out a => a -> [Char]
sdoc Exp2
ex

        Ext E2Ext LocVar (UrTy LocVar)
ext ->
          case E2Ext LocVar (UrTy LocVar)
ext of
            L2.LetRegionE Region
reg RegionSize
sz Maybe RegionType
ty Exp2
bod -> do
              let alloc_env' :: AllocEnv
alloc_env' = Region -> RegionLocs -> AllocEnv -> AllocEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Region
reg ([LocVar] -> Set LocVar -> RegionLocs
RegionLocs [] Set LocVar
forall a. Set a
S.empty) AllocEnv
alloc_env
              E2Ext LocVar (UrTy LocVar) -> Exp2
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E2Ext LocVar (UrTy LocVar) -> Exp2)
-> (Exp2 -> E2Ext LocVar (UrTy LocVar)) -> Exp2 -> Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Region
-> RegionSize
-> Maybe RegionType
-> Exp2
-> E2Ext LocVar (UrTy LocVar)
forall loc dec.
Region
-> RegionSize -> Maybe RegionType -> E2 loc dec -> E2Ext loc dec
L2.LetRegionE Region
reg RegionSize
sz Maybe RegionType
ty) (Exp2 -> Exp2) -> PassM Exp2 -> PassM Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RegEnv
-> AllocEnv -> StoreEnv -> Env2 (UrTy LocVar) -> Exp2 -> PassM Exp2
go RegEnv
reg_env AllocEnv
alloc_env' StoreEnv
store_env Env2 (UrTy LocVar)
env2 Exp2
bod
            L2.LetParRegionE Region
reg RegionSize
sz Maybe RegionType
ty Exp2
bod -> do
              let alloc_env' :: AllocEnv
alloc_env' = Region -> RegionLocs -> AllocEnv -> AllocEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Region
reg ([LocVar] -> Set LocVar -> RegionLocs
RegionLocs [] Set LocVar
forall a. Set a
S.empty) AllocEnv
alloc_env
              E2Ext LocVar (UrTy LocVar) -> Exp2
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E2Ext LocVar (UrTy LocVar) -> Exp2)
-> (Exp2 -> E2Ext LocVar (UrTy LocVar)) -> Exp2 -> Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Region
-> RegionSize
-> Maybe RegionType
-> Exp2
-> E2Ext LocVar (UrTy LocVar)
forall loc dec.
Region
-> RegionSize -> Maybe RegionType -> E2 loc dec -> E2Ext loc dec
L2.LetParRegionE Region
reg RegionSize
sz Maybe RegionType
ty) (Exp2 -> Exp2) -> PassM Exp2 -> PassM Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RegEnv
-> AllocEnv -> StoreEnv -> Env2 (UrTy LocVar) -> Exp2 -> PassM Exp2
go RegEnv
reg_env AllocEnv
alloc_env' StoreEnv
store_env Env2 (UrTy LocVar)
env2 Exp2
bod
            L2.LetLocE LocVar
loc PreLocExp LocVar
L2.FreeLE Exp2
bod -> do
              E2Ext LocVar (UrTy LocVar) -> Exp2
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E2Ext LocVar (UrTy LocVar) -> Exp2)
-> (Exp2 -> E2Ext LocVar (UrTy LocVar)) -> Exp2 -> Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LocVar -> PreLocExp LocVar -> Exp2 -> E2Ext LocVar (UrTy LocVar)
forall loc dec.
LocVar -> PreLocExp loc -> E2 loc dec -> E2Ext loc dec
L2.LetLocE LocVar
loc PreLocExp LocVar
forall loc. PreLocExp loc
L2.FreeLE) (Exp2 -> Exp2) -> PassM Exp2 -> PassM Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RegEnv
-> AllocEnv -> StoreEnv -> Env2 (UrTy LocVar) -> Exp2 -> PassM Exp2
go RegEnv
reg_env AllocEnv
alloc_env StoreEnv
store_env Env2 (UrTy LocVar)
env2 Exp2
bod)
            L2.StartOfPkdCursor LocVar
cur -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp2 -> PassM Exp2) -> Exp2 -> PassM Exp2
forall a b. (a -> b) -> a -> b
$ E2Ext LocVar (UrTy LocVar) -> Exp2
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E2Ext LocVar (UrTy LocVar) -> Exp2)
-> E2Ext LocVar (UrTy LocVar) -> Exp2
forall a b. (a -> b) -> a -> b
$ LocVar -> E2Ext LocVar (UrTy LocVar)
forall loc dec. LocVar -> E2Ext loc dec
L2.StartOfPkdCursor LocVar
cur
            L2.TagCursor LocVar
a LocVar
b -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp2 -> PassM Exp2) -> Exp2 -> PassM Exp2
forall a b. (a -> b) -> a -> b
$ E2Ext LocVar (UrTy LocVar) -> Exp2
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E2Ext LocVar (UrTy LocVar) -> Exp2)
-> E2Ext LocVar (UrTy LocVar) -> Exp2
forall a b. (a -> b) -> a -> b
$ LocVar -> LocVar -> E2Ext LocVar (UrTy LocVar)
forall loc dec. LocVar -> LocVar -> E2Ext loc dec
L2.TagCursor LocVar
a LocVar
b
            L2.LetLocE LocVar
loc PreLocExp LocVar
rhs Exp2
bod -> do
              let reg :: Region
reg = case PreLocExp LocVar
rhs of
                      L2.StartOfRegionLE Region
r  -> Region
r
                      L2.InRegionLE Region
r -> Region
r
                      L2.AfterConstantLE Int
_ LocVar
lc   -> RegEnv
reg_env RegEnv -> LocVar -> Region
forall a b.
(Ord a, Out a, Out b, Show a, HasCallStack) =>
Map a b -> a -> b
# LocVar
lc
                      L2.AfterVariableLE LocVar
_ LocVar
lc Bool
_ -> RegEnv
reg_env RegEnv -> LocVar -> Region
forall a b.
(Ord a, Out a, Out b, Show a, HasCallStack) =>
Map a b -> a -> b
# LocVar
lc
                      L2.FromEndLE LocVar
lc           -> RegEnv
reg_env RegEnv -> LocVar -> Region
forall a b.
(Ord a, Out a, Out b, Show a, HasCallStack) =>
Map a b -> a -> b
# LocVar
lc
                  reg_env' :: RegEnv
reg_env' = LocVar -> Region -> RegEnv -> RegEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert LocVar
loc Region
reg RegEnv
reg_env
              case Region -> AllocEnv -> Maybe RegionLocs
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Region
reg AllocEnv
alloc_env of
                Maybe RegionLocs
Nothing ->
                  E2Ext LocVar (UrTy LocVar) -> Exp2
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E2Ext LocVar (UrTy LocVar) -> Exp2)
-> (Exp2 -> E2Ext LocVar (UrTy LocVar)) -> Exp2 -> Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LocVar -> PreLocExp LocVar -> Exp2 -> E2Ext LocVar (UrTy LocVar)
forall loc dec.
LocVar -> PreLocExp loc -> E2 loc dec -> E2Ext loc dec
L2.LetLocE LocVar
loc PreLocExp LocVar
rhs) (Exp2 -> Exp2) -> PassM Exp2 -> PassM Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RegEnv
-> AllocEnv -> StoreEnv -> Env2 (UrTy LocVar) -> Exp2 -> PassM Exp2
go RegEnv
reg_env' AllocEnv
alloc_env StoreEnv
store_env Env2 (UrTy LocVar)
env2 Exp2
bod)
                Just (RegionLocs [LocVar]
locs Set LocVar
allocated) -> do
                  let reg_locs :: RegionLocs
reg_locs = [LocVar] -> Set LocVar -> RegionLocs
RegionLocs ([LocVar]
locs [LocVar] -> [LocVar] -> [LocVar]
forall a. [a] -> [a] -> [a]
++ [LocVar
loc]) Set LocVar
allocated
                      alloc_env' :: AllocEnv
alloc_env' = Region -> RegionLocs -> AllocEnv -> AllocEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Region
reg RegionLocs
reg_locs AllocEnv
alloc_env
                  E2Ext LocVar (UrTy LocVar) -> Exp2
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E2Ext LocVar (UrTy LocVar) -> Exp2)
-> (Exp2 -> E2Ext LocVar (UrTy LocVar)) -> Exp2 -> Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LocVar -> PreLocExp LocVar -> Exp2 -> E2Ext LocVar (UrTy LocVar)
forall loc dec.
LocVar -> PreLocExp loc -> E2 loc dec -> E2Ext loc dec
L2.LetLocE LocVar
loc PreLocExp LocVar
rhs) (Exp2 -> Exp2) -> PassM Exp2 -> PassM Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RegEnv
-> AllocEnv -> StoreEnv -> Env2 (UrTy LocVar) -> Exp2 -> PassM Exp2
go RegEnv
reg_env' AllocEnv
alloc_env' StoreEnv
store_env Env2 (UrTy LocVar)
env2 Exp2
bod)
            L2.RetE{} -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
            L2.FromEndE{} -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
            L2.BoundsCheck{} -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
            L2.AddFixed{} -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
            L2.IndirectionE{} -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
            L2.GetCilkWorkerNum{} -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
            L2.LetAvail [LocVar]
vars Exp2
bod -> E2Ext LocVar (UrTy LocVar) -> Exp2
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E2Ext LocVar (UrTy LocVar) -> Exp2)
-> (Exp2 -> E2Ext LocVar (UrTy LocVar)) -> Exp2 -> Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([LocVar] -> Exp2 -> E2Ext LocVar (UrTy LocVar)
forall loc dec. [LocVar] -> E2 loc dec -> E2Ext loc dec
L2.LetAvail [LocVar]
vars) (Exp2 -> Exp2) -> PassM Exp2 -> PassM Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp2 -> PassM Exp2
recur Exp2
bod
            L2.AllocateTagHere{} -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
            L2.AllocateScalarsHere{} -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
            L2.SSPush{} -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
            L2.SSPop{} -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex

        -- straightforward recursion (assumption: a-normal form)
        VarE{}     -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
        LitE{}     -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
        CharE{}    -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
        FloatE{}   -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
        LitSymE{}  -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
        AppE{}     -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
        PrimAppE{} -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
        IfE Exp2
a Exp2
b Exp2
c  -> Exp2 -> Exp2 -> Exp2 -> Exp2
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec
IfE (Exp2 -> Exp2 -> Exp2 -> Exp2)
-> PassM Exp2 -> PassM (Exp2 -> Exp2 -> Exp2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp2 -> PassM Exp2
recur Exp2
a PassM (Exp2 -> Exp2 -> Exp2) -> PassM Exp2 -> PassM (Exp2 -> Exp2)
forall a b. PassM (a -> b) -> PassM a -> PassM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Exp2 -> PassM Exp2
recur Exp2
b PassM (Exp2 -> Exp2) -> PassM Exp2 -> PassM Exp2
forall a b. PassM (a -> b) -> PassM a -> PassM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Exp2 -> PassM Exp2
recur Exp2
c
        MkProdE{}  -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
        ProjE{}    -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
        CaseE Exp2
scrt [([Char], [(LocVar, LocVar)], Exp2)]
brs -> do
          let (VarE LocVar
v) = Exp2
scrt
              PackedTy [Char]
_ LocVar
tyloc = LocVar -> Env2 (UrTy LocVar) -> UrTy LocVar
forall a. Out a => LocVar -> Env2 a -> a
lookupVEnv LocVar
v Env2 (UrTy LocVar)
env2
              reg :: Region
reg = RegEnv
reg_env RegEnv -> LocVar -> Region
forall k a. Ord k => Map k a -> k -> a
M.! LocVar
tyloc
          [([Char], [(LocVar, LocVar)], Exp2)]
brs' <- (([Char], [(LocVar, LocVar)], Exp2)
 -> PassM ([Char], [(LocVar, LocVar)], Exp2))
-> [([Char], [(LocVar, LocVar)], Exp2)]
-> PassM [([Char], [(LocVar, LocVar)], Exp2)]
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 (\([Char]
dcon,[(LocVar, LocVar)]
vlocs,Exp2
rhs) -> do
                           -- Update the envs with bindings for pattern matched variables and locations.
                           -- The locations point to the same region as the scrutinee.
                           let ([LocVar]
vars,[LocVar]
locs) = [(LocVar, LocVar)] -> ([LocVar], [LocVar])
forall a b. [(a, b)] -> ([a], [b])
unzip [(LocVar, LocVar)]
vlocs
                               reg_env' :: RegEnv
reg_env' = (LocVar -> RegEnv -> RegEnv) -> RegEnv -> [LocVar] -> RegEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\LocVar
lc RegEnv
acc -> LocVar -> Region -> RegEnv -> RegEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert LocVar
lc Region
reg RegEnv
acc) RegEnv
reg_env [LocVar]
locs
                               env2' :: Env2 (UrTy LocVar)
env2' = (HasCallStack =>
[Char]
-> DDefs2
-> [LocVar]
-> [LocVar]
-> Env2 (UrTy LocVar)
-> Env2 (UrTy LocVar)
[Char]
-> DDefs2
-> [LocVar]
-> [LocVar]
-> Env2 (UrTy LocVar)
-> Env2 (UrTy LocVar)
L2.extendPatternMatchEnv [Char]
dcon DDefs (TyOf Exp2)
DDefs2
ddefs [LocVar]
vars [LocVar]
locs Env2 (UrTy LocVar)
env2)
                           ([Char]
dcon,[(LocVar, LocVar)]
vlocs,) (Exp2 -> ([Char], [(LocVar, LocVar)], Exp2))
-> PassM Exp2 -> PassM ([Char], [(LocVar, LocVar)], Exp2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RegEnv
-> AllocEnv -> StoreEnv -> Env2 (UrTy LocVar) -> Exp2 -> PassM Exp2
go RegEnv
reg_env' AllocEnv
alloc_env StoreEnv
store_env Env2 (UrTy LocVar)
env2' Exp2
rhs)
                       [([Char], [(LocVar, LocVar)], Exp2)]
brs
          Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp2 -> PassM Exp2) -> Exp2 -> PassM Exp2
forall a b. (a -> b) -> a -> b
$ Exp2 -> [([Char], [(LocVar, LocVar)], Exp2)] -> Exp2
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> [([Char], [(LocVar, loc)], PreExp ext loc dec)]
-> PreExp ext loc dec
CaseE Exp2
scrt [([Char], [(LocVar, LocVar)], Exp2)]
brs'
        DataConE{} -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
        TimeIt{}   -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
        WithArenaE LocVar
v Exp2
e -> (LocVar -> Exp2 -> Exp2
forall (ext :: * -> * -> *) loc dec.
LocVar -> PreExp ext loc dec -> PreExp ext loc dec
WithArenaE LocVar
v) (Exp2 -> Exp2) -> PassM Exp2 -> PassM Exp2
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp2 -> PassM Exp2
recur Exp2
e
        SpawnE{}   -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
        Exp2
SyncE      -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
        MapE{}     -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
        FoldE{}    -> Exp2 -> PassM Exp2
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp2
ex
      where
        recur :: Exp2 -> PassM Exp2
recur = RegEnv
-> AllocEnv -> StoreEnv -> Env2 (UrTy LocVar) -> Exp2 -> PassM Exp2
go RegEnv
reg_env AllocEnv
alloc_env StoreEnv
store_env Env2 (UrTy LocVar)
env2
        isAllocationOk :: LocVar -> Exp2 -> Exp2 -> (Bool, [LocVar], Region, RegionLocs)
isAllocationOk LocVar
loc Exp2
rhs Exp2
bod =
          case LocVar -> RegEnv -> Maybe Region
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup LocVar
loc RegEnv
reg_env of
            Maybe Region
Nothing  -> [Char] -> (Bool, [LocVar], Region, RegionLocs)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Bool, [LocVar], Region, RegionLocs))
-> [Char] -> (Bool, [LocVar], Region, RegionLocs)
forall a b. (a -> b) -> a -> b
$ [Char]
"writeOrderMarkers: free location " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LocVar -> [Char]
forall a. Out a => a -> [Char]
sdoc LocVar
loc
            Just Region
reg -> case Region -> AllocEnv -> Maybe RegionLocs
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Region
reg AllocEnv
alloc_env of
                          Maybe RegionLocs
Nothing -> [Char] -> (Bool, [LocVar], Region, RegionLocs)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Bool, [LocVar], Region, RegionLocs))
-> [Char] -> (Bool, [LocVar], Region, RegionLocs)
forall a b. (a -> b) -> a -> b
$ [Char]
"writeOrderMarkers: free region " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Region -> [Char]
forall a. Out a => a -> [Char]
sdoc Region
reg
                          Just rloc :: RegionLocs
rloc@(RegionLocs [LocVar]
locs Set LocVar
allocated_to) ->
                            let locs_before :: [LocVar]
locs_before = (LocVar -> Bool) -> [LocVar] -> [LocVar]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (LocVar -> LocVar -> Bool
forall a. Eq a => a -> a -> Bool
/= LocVar
loc) [LocVar]
locs in
                              case [LocVar]
locs_before of
                                [] -> (Bool
True, [LocVar]
locs_before, Region
reg, RegionLocs
rloc)
                                [LocVar]
_  ->
                                  let freev :: Set LocVar
freev = Exp2 -> Set LocVar
L2.allFreeVars Exp2
rhs Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Exp2 -> Set LocVar
L2.allFreeVars Exp2
bod
                                      locs_before' :: [LocVar]
locs_before' = (LocVar -> Bool) -> [LocVar] -> [LocVar]
forall a. (a -> Bool) -> [a] -> [a]
filter (\LocVar
x -> LocVar -> Set LocVar -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member LocVar
x Set LocVar
freev) [LocVar]
locs_before
                                  in (Set LocVar -> Set LocVar -> Bool
forall a. Ord a => Set a -> Set a -> Bool
S.isProperSubsetOf ([LocVar] -> Set LocVar
forall a. Ord a => [a] -> Set a
S.fromList [LocVar]
locs_before') Set LocVar
allocated_to, [LocVar]
locs_before', Region
reg, RegionLocs
rloc)

        findTyCon :: LocVar -> L2.Exp2 -> TyCon
        findTyCon :: LocVar -> Exp2 -> [Char]
findTyCon LocVar
want Exp2
e =
          case Exp2
e of
            DataConE LocVar
loc [Char]
dcon [Exp2]
_ | LocVar
want LocVar -> LocVar -> Bool
forall a. Eq a => a -> a -> Bool
== LocVar
loc -> DDefs2 -> [Char] -> [Char]
forall a. Out a => DDefs a -> [Char] -> [Char]
getTyOfDataCon DDefs (TyOf Exp2)
DDefs2
ddefs [Char]
dcon
                                | Bool
otherwise -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"findTyCon: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LocVar -> [Char]
forall a. Show a => a -> [Char]
show LocVar
want [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found. "  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (LocVar, Exp2) -> [Char]
forall a. Out a => a -> [Char]
sdoc (LocVar
want,Exp2
e)
            LetE (LocVar
_v,[LocVar]
_locs,PackedTy [Char]
tycon LocVar
loc,Exp2
_rhs) Exp2
bod | LocVar
want LocVar -> LocVar -> Bool
forall a. Eq a => a -> a -> Bool
== LocVar
loc -> [Char]
tycon
                                                        | Bool
otherwise -> LocVar -> Exp2 -> [Char]
findTyCon LocVar
want Exp2
bod
            LetE (LocVar
_v,[LocVar]
_locs,UrTy LocVar
_ty,Exp2
_rhs) Exp2
bod -> LocVar -> Exp2 -> [Char]
findTyCon LocVar
want Exp2
bod
            IfE Exp2
_ Exp2
b Exp2
c  -> let tycon_b :: [Char]
tycon_b = (LocVar -> Exp2 -> [Char]
findTyCon LocVar
want Exp2
b)
                              tycon_c :: [Char]
tycon_c = (LocVar -> Exp2 -> [Char]
findTyCon LocVar
want Exp2
c)
                          in if [Char]
tycon_b [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
tycon_c
                             then [Char]
tycon_b
                             else [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"findTyCon want: types don't match"
            CaseE Exp2
_scrt [([Char], [(LocVar, LocVar)], Exp2)]
brs -> let tycons :: [[Char]]
tycons = (([Char], [(LocVar, LocVar)], Exp2) -> [[Char]] -> [[Char]])
-> [[Char]] -> [([Char], [(LocVar, LocVar)], Exp2)] -> [[Char]]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\([Char]
_a,[(LocVar, LocVar)]
_b,Exp2
c) [[Char]]
acc -> LocVar -> Exp2 -> [Char]
findTyCon LocVar
want Exp2
c [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
acc) [] [([Char], [(LocVar, LocVar)], Exp2)]
brs
                               in if ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== ([[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
tycons)) [[Char]]
tycons
                                  then [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
tycons
                                  else [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"findTyCon want: types don't match"
            WithArenaE LocVar
_ar Exp2
bod -> (LocVar -> Exp2 -> [Char]
findTyCon LocVar
want Exp2
bod)
            TimeIt Exp2
e0 UrTy LocVar
_ty Bool
_b -> (LocVar -> Exp2 -> [Char]
findTyCon LocVar
want Exp2
e0)
            Ext E2Ext LocVar (UrTy LocVar)
ext ->
              case E2Ext LocVar (UrTy LocVar)
ext of
                L2.LetRegionE Region
_ RegionSize
_ Maybe RegionType
_ Exp2
bod -> (LocVar -> Exp2 -> [Char]
findTyCon LocVar
want Exp2
bod)
                L2.LetParRegionE Region
_ RegionSize
_ Maybe RegionType
_ Exp2
bod -> (LocVar -> Exp2 -> [Char]
findTyCon LocVar
want Exp2
bod)
                L2.LetLocE LocVar
_ PreLocExp LocVar
_ Exp2
bod -> (LocVar -> Exp2 -> [Char]
findTyCon LocVar
want Exp2
bod)
                L2.LetAvail [LocVar]
_ Exp2
bod -> (LocVar -> Exp2 -> [Char]
findTyCon LocVar
want Exp2
bod)
                E2Ext LocVar (UrTy LocVar)
_ -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"findTyCon: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LocVar -> [Char]
forall a. Show a => a -> [Char]
show LocVar
want [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (LocVar, Exp2) -> [Char]
forall a. Out a => a -> [Char]
sdoc (LocVar
want,Exp2
e)
            Exp2
_ -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"findTyCon: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LocVar -> [Char]
forall a. Show a => a -> [Char]
show LocVar
want [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (LocVar, Exp2) -> [Char]
forall a. Out a => a -> [Char]
sdoc (LocVar
want,Exp2
e)


-- | Do the values of scalar fields depend on the packed fields?
--   If they do the scalar allocations cannot be moved up.
checkScalarDeps :: L2.DDefs2 -> S.Set Var -> LocVar -> L2.Exp2 -> (S.Set Var, Bool)
checkScalarDeps :: DDefs2 -> Set LocVar -> LocVar -> Exp2 -> (Set LocVar, Bool)
checkScalarDeps DDefs2
ddefs Set LocVar
in_scope LocVar
tag_loc Exp2
ex0 =
    let (Map LocVar [LocVar]
_a,Set LocVar
b,Bool
c) = Map LocVar [LocVar]
-> Set LocVar
-> Bool
-> Exp2
-> (Map LocVar [LocVar], Set LocVar, Bool)
go ((LocVar -> Map LocVar [LocVar] -> Map LocVar [LocVar])
-> Map LocVar [LocVar] -> [LocVar] -> Map LocVar [LocVar]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\LocVar
v Map LocVar [LocVar]
move -> LocVar -> [LocVar] -> Map LocVar [LocVar] -> Map LocVar [LocVar]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert LocVar
v [LocVar
v] Map LocVar [LocVar]
move) Map LocVar [LocVar]
forall k a. Map k a
M.empty (Set LocVar -> [LocVar]
forall a. Set a -> [a]
S.toList Set LocVar
in_scope)) Set LocVar
forall a. Set a
S.empty Bool
True Exp2
ex0
    in (Set LocVar
b Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set LocVar
in_scope,Bool
c)
  where
    go :: M.Map Var [Var] -> S.Set Var -> Bool -> L2.Exp2 -> (M.Map Var [Var], S.Set Var, Bool)
    go :: Map LocVar [LocVar]
-> Set LocVar
-> Bool
-> Exp2
-> (Map LocVar [LocVar], Set LocVar, Bool)
go Map LocVar [LocVar]
dep_env Set LocVar
move_set Bool
move Exp2
ex =
      case Exp2
ex of
        VarE{}     -> (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
move)
        LitE{}     -> (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
move)
        CharE{}    -> (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
move)
        FloatE{}   -> (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
move)
        LitSymE{}  -> (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
move)
        AppE{}     -> (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
move)
        PrimAppE{} -> (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
move)
        --  -> do_dcon dep_env move loc dcon args
        LetE (LocVar
v,[LocVar]
_,UrTy LocVar
_,rhs :: Exp2
rhs@(DataConE LocVar
loc [Char]
dcon [Exp2]
args)) Exp2
bod
          | LocVar
loc LocVar -> LocVar -> Bool
forall a. Eq a => a -> a -> Bool
== LocVar
tag_loc -> Map LocVar [LocVar]
-> Set LocVar
-> Bool
-> LocVar
-> [Char]
-> [Exp2]
-> (Map LocVar [LocVar], Set LocVar, Bool)
do_dcon Map LocVar [LocVar]
dep_env Set LocVar
move_set Bool
move LocVar
loc [Char]
dcon [Exp2]
args
          | Bool
otherwise ->
            let free_vars :: [LocVar]
free_vars = Set LocVar -> [LocVar]
forall a. Set a -> [a]
S.toList (Set LocVar -> [LocVar]) -> Set LocVar -> [LocVar]
forall a b. (a -> b) -> a -> b
$ Exp2 -> Set LocVar
forall a. FreeVars a => a -> Set LocVar
gFreeVars Exp2
rhs Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set LocVar
in_scope
                (Map LocVar [LocVar]
dep_env',Set LocVar
move_set',Bool
move') = Map LocVar [LocVar]
-> Set LocVar
-> Bool
-> Exp2
-> (Map LocVar [LocVar], Set LocVar, Bool)
go (([LocVar] -> [LocVar] -> [LocVar])
-> LocVar -> [LocVar] -> Map LocVar [LocVar] -> Map LocVar [LocVar]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [LocVar] -> [LocVar] -> [LocVar]
forall a. [a] -> [a] -> [a]
(++) LocVar
v [LocVar]
free_vars Map LocVar [LocVar]
dep_env) Set LocVar
move_set Bool
move Exp2
bod
            in (Map LocVar [LocVar]
dep_env Map LocVar [LocVar] -> Map LocVar [LocVar] -> Map LocVar [LocVar]
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map LocVar [LocVar]
dep_env', Set LocVar
move_set Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set LocVar
move_set', Bool
move Bool -> Bool -> Bool
&& Bool
move')
        LetE (LocVar
v,[LocVar]
_locs,UrTy LocVar
_ty,Exp2
rhs) Exp2
bod ->
          let free_vars :: [LocVar]
free_vars = Set LocVar -> [LocVar]
forall a. Set a -> [a]
S.toList (Set LocVar -> [LocVar]) -> Set LocVar -> [LocVar]
forall a b. (a -> b) -> a -> b
$ Exp2 -> Set LocVar
forall a. FreeVars a => a -> Set LocVar
gFreeVars Exp2
rhs Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set LocVar
in_scope
              (Map LocVar [LocVar]
dep_env',Set LocVar
move_set',Bool
move') = Map LocVar [LocVar]
-> Set LocVar
-> Bool
-> Exp2
-> (Map LocVar [LocVar], Set LocVar, Bool)
go (([LocVar] -> [LocVar] -> [LocVar])
-> LocVar -> [LocVar] -> Map LocVar [LocVar] -> Map LocVar [LocVar]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [LocVar] -> [LocVar] -> [LocVar]
forall a. [a] -> [a] -> [a]
(++) LocVar
v [LocVar]
free_vars Map LocVar [LocVar]
dep_env) Set LocVar
move_set Bool
move Exp2
bod
          in (Map LocVar [LocVar]
dep_env Map LocVar [LocVar] -> Map LocVar [LocVar] -> Map LocVar [LocVar]
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map LocVar [LocVar]
dep_env', Set LocVar
move_set Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set LocVar
move_set', Bool
move Bool -> Bool -> Bool
&& Bool
move')
        IfE Exp2
a Exp2
b Exp2
c  ->
          let (Map LocVar [LocVar]
dep_env1,Set LocVar
move_set1,Bool
move1) = Map LocVar [LocVar]
-> Set LocVar
-> Bool
-> Exp2
-> (Map LocVar [LocVar], Set LocVar, Bool)
go Map LocVar [LocVar]
dep_env Set LocVar
move_set Bool
move Exp2
a
              (Map LocVar [LocVar]
dep_env2,Set LocVar
move_set2,Bool
move2) = Map LocVar [LocVar]
-> Set LocVar
-> Bool
-> Exp2
-> (Map LocVar [LocVar], Set LocVar, Bool)
go Map LocVar [LocVar]
dep_env Set LocVar
move_set Bool
move Exp2
b
              (Map LocVar [LocVar]
dep_env3,Set LocVar
move_set3,Bool
move3) = Map LocVar [LocVar]
-> Set LocVar
-> Bool
-> Exp2
-> (Map LocVar [LocVar], Set LocVar, Bool)
go Map LocVar [LocVar]
dep_env Set LocVar
move_set Bool
move Exp2
c
          in (Map LocVar [LocVar]
dep_env Map LocVar [LocVar] -> Map LocVar [LocVar] -> Map LocVar [LocVar]
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map LocVar [LocVar]
dep_env1 Map LocVar [LocVar] -> Map LocVar [LocVar] -> Map LocVar [LocVar]
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map LocVar [LocVar]
dep_env2 Map LocVar [LocVar] -> Map LocVar [LocVar] -> Map LocVar [LocVar]
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map LocVar [LocVar]
dep_env3,
              Set LocVar
move_set Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set LocVar
move_set1 Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set LocVar
move_set2 Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set LocVar
move_set3,
              Bool
move Bool -> Bool -> Bool
&& Bool
move1 Bool -> Bool -> Bool
&& Bool
move2 Bool -> Bool -> Bool
&& Bool
move3)
        MkProdE{}  -> (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
move)
        ProjE{}    -> (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
move)
        CaseE Exp2
scrt [([Char], [(LocVar, LocVar)], Exp2)]
brs ->
          let (VarE LocVar
v) = Exp2
scrt in
            (([Char], [(LocVar, LocVar)], Exp2)
 -> (Map LocVar [LocVar], Set LocVar, Bool)
 -> (Map LocVar [LocVar], Set LocVar, Bool))
-> (Map LocVar [LocVar], Set LocVar, Bool)
-> [([Char], [(LocVar, LocVar)], Exp2)]
-> (Map LocVar [LocVar], Set LocVar, Bool)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\([Char]
_,[(LocVar, LocVar)]
vlocs,Exp2
rhs) (Map LocVar [LocVar]
dep_env',Set LocVar
move_set',Bool
move') ->
                     let ([LocVar]
vars,[LocVar]
_locs) = [(LocVar, LocVar)] -> ([LocVar], [LocVar])
forall a b. [(a, b)] -> ([a], [b])
unzip [(LocVar, LocVar)]
vlocs
                         dep_env'' :: Map LocVar [LocVar]
dep_env'' = ([LocVar] -> [LocVar] -> [LocVar])
-> LocVar -> [LocVar] -> Map LocVar [LocVar] -> Map LocVar [LocVar]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [LocVar] -> [LocVar] -> [LocVar]
forall a. [a] -> [a] -> [a]
(++) LocVar
v [LocVar]
vars Map LocVar [LocVar]
dep_env'
                         (Map LocVar [LocVar]
dep_env''',Set LocVar
move_set'',Bool
move'') = Map LocVar [LocVar]
-> Set LocVar
-> Bool
-> Exp2
-> (Map LocVar [LocVar], Set LocVar, Bool)
go Map LocVar [LocVar]
dep_env' Set LocVar
move_set Bool
move' Exp2
rhs
                     in (Map LocVar [LocVar]
dep_env'' Map LocVar [LocVar] -> Map LocVar [LocVar] -> Map LocVar [LocVar]
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map LocVar [LocVar]
dep_env''',
                         Set LocVar
move_set' Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set LocVar
move_set'',
                         Bool
move' Bool -> Bool -> Bool
&& Bool
move''))
                  (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
move)
                  [([Char], [(LocVar, LocVar)], Exp2)]
brs
        DataConE LocVar
loc [Char]
dcon [Exp2]
args -> Map LocVar [LocVar]
-> Set LocVar
-> Bool
-> LocVar
-> [Char]
-> [Exp2]
-> (Map LocVar [LocVar], Set LocVar, Bool)
do_dcon Map LocVar [LocVar]
dep_env Set LocVar
move_set Bool
move LocVar
loc [Char]
dcon [Exp2]
args
        TimeIt{}   -> (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
move)
        WithArenaE LocVar
_ Exp2
bod ->
          let (Map LocVar [LocVar]
dep_env',Set LocVar
move_set',Bool
move') = Map LocVar [LocVar]
-> Set LocVar
-> Bool
-> Exp2
-> (Map LocVar [LocVar], Set LocVar, Bool)
go Map LocVar [LocVar]
dep_env Set LocVar
move_set Bool
move Exp2
bod
          in (Map LocVar [LocVar]
dep_env' Map LocVar [LocVar] -> Map LocVar [LocVar] -> Map LocVar [LocVar]
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map LocVar [LocVar]
dep_env, Set LocVar
move_set Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set LocVar
move_set', Bool
move Bool -> Bool -> Bool
&& Bool
move')
        SpawnE{} -> (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
move)
        Exp2
SyncE    -> (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
move)
        MapE{}   -> (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
move)
        FoldE{}  -> (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
move)
        Ext E2Ext LocVar (UrTy LocVar)
ext  ->
          case E2Ext LocVar (UrTy LocVar)
ext of
            L2.LetRegionE Region
_ RegionSize
_ Maybe RegionType
_ Exp2
bod ->
              let (Map LocVar [LocVar]
dep_env',Set LocVar
move_set',Bool
move') = Map LocVar [LocVar]
-> Set LocVar
-> Bool
-> Exp2
-> (Map LocVar [LocVar], Set LocVar, Bool)
go Map LocVar [LocVar]
dep_env Set LocVar
move_set Bool
move Exp2
bod
              in (Map LocVar [LocVar]
dep_env' Map LocVar [LocVar] -> Map LocVar [LocVar] -> Map LocVar [LocVar]
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map LocVar [LocVar]
dep_env, Set LocVar
move_set Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set LocVar
move_set', Bool
move Bool -> Bool -> Bool
&& Bool
move')
            L2.LetParRegionE Region
_ RegionSize
_ Maybe RegionType
_ Exp2
bod ->
              let (Map LocVar [LocVar]
dep_env',Set LocVar
move_set',Bool
move') = Map LocVar [LocVar]
-> Set LocVar
-> Bool
-> Exp2
-> (Map LocVar [LocVar], Set LocVar, Bool)
go Map LocVar [LocVar]
dep_env Set LocVar
move_set Bool
move Exp2
bod
              in (Map LocVar [LocVar]
dep_env' Map LocVar [LocVar] -> Map LocVar [LocVar] -> Map LocVar [LocVar]
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map LocVar [LocVar]
dep_env, Set LocVar
move_set Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set LocVar
move_set', Bool
move Bool -> Bool -> Bool
&& Bool
move')
            L2.LetLocE LocVar
_ PreLocExp LocVar
_ Exp2
bod ->
              let (Map LocVar [LocVar]
dep_env',Set LocVar
move_set',Bool
move') = Map LocVar [LocVar]
-> Set LocVar
-> Bool
-> Exp2
-> (Map LocVar [LocVar], Set LocVar, Bool)
go Map LocVar [LocVar]
dep_env Set LocVar
move_set Bool
move Exp2
bod
              in (Map LocVar [LocVar]
dep_env' Map LocVar [LocVar] -> Map LocVar [LocVar] -> Map LocVar [LocVar]
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map LocVar [LocVar]
dep_env, Set LocVar
move_set Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set LocVar
move_set', Bool
move Bool -> Bool -> Bool
&& Bool
move')
            L2.LetAvail [LocVar]
_ Exp2
bod ->
              let (Map LocVar [LocVar]
dep_env',Set LocVar
move_set',Bool
move') = Map LocVar [LocVar]
-> Set LocVar
-> Bool
-> Exp2
-> (Map LocVar [LocVar], Set LocVar, Bool)
go Map LocVar [LocVar]
dep_env Set LocVar
move_set Bool
move Exp2
bod
              in (Map LocVar [LocVar]
dep_env' Map LocVar [LocVar] -> Map LocVar [LocVar] -> Map LocVar [LocVar]
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map LocVar [LocVar]
dep_env, Set LocVar
move_set Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set LocVar
move_set', Bool
move Bool -> Bool -> Bool
&& Bool
move')
            E2Ext LocVar (UrTy LocVar)
_ -> (Map LocVar [LocVar]
dep_env, Set LocVar
move_set, Bool
move)

    to_vertex :: (LocVar -> Maybe a) -> PreExp ext loc dec -> a
to_vertex LocVar -> Maybe a
fn (VarE LocVar
v) =
      case LocVar -> Maybe a
fn LocVar
v of
        Just a
x  -> a
x
        Maybe a
Nothing -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"checkScalarDeps: No vertex for:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LocVar -> [Char]
forall a. Out a => a -> [Char]
sdoc LocVar
v
    to_vertex LocVar -> Maybe a
_ PreExp ext loc dec
e = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"checkScalarDeps: not in ANF " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PreExp ext loc dec -> [Char]
forall a. Out a => a -> [Char]
sdoc PreExp ext loc dec
e

    do_dcon :: Map LocVar [LocVar]
-> Set LocVar
-> Bool
-> LocVar
-> [Char]
-> [Exp2]
-> (Map LocVar [LocVar], Set LocVar, Bool)
do_dcon Map LocVar [LocVar]
dep_env Set LocVar
move_set Bool
move LocVar
loc [Char]
dcon [Exp2]
args
      | LocVar
loc LocVar -> LocVar -> Bool
forall a. Eq a => a -> a -> Bool
== LocVar
tag_loc =
            -- graphFromEdges :: Ord key => [(node, key, [key])]
            --                -> (Graph, Vertex -> (node, key, [key]), key -> Maybe Vertex)
            let edges :: [(LocVar, LocVar, [LocVar])]
edges = ((LocVar, [LocVar]) -> (LocVar, LocVar, [LocVar]))
-> [(LocVar, [LocVar])] -> [(LocVar, LocVar, [LocVar])]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(LocVar
a,[LocVar]
b) -> (LocVar
a,LocVar
a,[LocVar]
b)) ([(LocVar, [LocVar])] -> [(LocVar, LocVar, [LocVar])])
-> [(LocVar, [LocVar])] -> [(LocVar, LocVar, [LocVar])]
forall a b. (a -> b) -> a -> b
$ Map LocVar [LocVar] -> [(LocVar, [LocVar])]
forall k a. Map k a -> [(k, a)]
M.toList Map LocVar [LocVar]
dep_env
                (Graph
graph,Int -> (LocVar, LocVar, [LocVar])
keyFn,LocVar -> Maybe Int
vtxFn) = [(LocVar, LocVar, [LocVar])]
-> (Graph, Int -> (LocVar, LocVar, [LocVar]), LocVar -> Maybe Int)
forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
G.graphFromEdges [(LocVar, LocVar, [LocVar])]
edges
                arg_tys :: [UrTy LocVar]
arg_tys = DDefs2 -> [Char] -> [UrTy LocVar]
forall a. Out a => DDefs a -> [Char] -> [a]
lookupDataCon DDefs2
ddefs [Char]
dcon
                first_packed :: Int
first_packed = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (UrTy LocVar -> Bool) -> [UrTy LocVar] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
L.findIndex UrTy LocVar -> Bool
forall a. UrTy a -> Bool
isPackedTy [UrTy LocVar]
arg_tys
                ([Exp2]
scalars,[Exp2]
packed) = Int -> [Exp2] -> ([Exp2], [Exp2])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
first_packed [Exp2]
args
                packed_reachable :: Set Int
packed_reachable = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList ([Int] -> Set Int) -> [Int] -> Set Int
forall a b. (a -> b) -> a -> b
$
                                   (Int -> [Int]) -> [Int] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Graph -> Int -> [Int]
G.reachable Graph
graph) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$
                                   (Exp2 -> Int) -> [Exp2] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((LocVar -> Maybe Int) -> Exp2 -> Int
forall {loc} {dec} {ext :: * -> * -> *} {a}.
(Out loc, Out dec, Out (ext loc dec)) =>
(LocVar -> Maybe a) -> PreExp ext loc dec -> a
to_vertex LocVar -> Maybe Int
vtxFn) [Exp2]
packed
            in case [Exp2]
scalars of
                 [] -> (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
False)
                 [Exp2]
_ ->
                   let (Set LocVar
move_set0, Bool
move0) =
                         (Exp2 -> (Set LocVar, Bool) -> (Set LocVar, Bool))
-> (Set LocVar, Bool) -> [Exp2] -> (Set LocVar, Bool)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Exp2
sc (Set LocVar
move_set', Bool
move') ->
                             case Exp2
sc of
                               VarE{} ->
                                 let sc_vertex :: Int
sc_vertex = (LocVar -> Maybe Int) -> Exp2 -> Int
forall {loc} {dec} {ext :: * -> * -> *} {a}.
(Out loc, Out dec, Out (ext loc dec)) =>
(LocVar -> Maybe a) -> PreExp ext loc dec -> a
to_vertex LocVar -> Maybe Int
vtxFn Exp2
sc
                                     sc_reachable :: Set Int
sc_reachable = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList (Graph -> Int -> [Int]
G.reachable Graph
graph Int
sc_vertex)
                                     move'' :: Bool
move'' = Bool
move' Bool -> Bool -> Bool
&& Set Int
packed_reachable Set Int -> Set Int -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.disjoint` Set Int
sc_reachable
                                 in if Bool
move''
                                    then (((Int -> LocVar) -> Set Int -> Set LocVar
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map ((LocVar, LocVar, [LocVar]) -> LocVar
forall a b c. (a, b, c) -> a
fst3 ((LocVar, LocVar, [LocVar]) -> LocVar)
-> (Int -> (LocVar, LocVar, [LocVar])) -> Int -> LocVar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (LocVar, LocVar, [LocVar])
keyFn) Set Int
sc_reachable) Set LocVar -> Set LocVar -> Set LocVar
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set LocVar
move_set',
                                          Bool
move'')
                                    else (Set LocVar
move_set', Bool
move'')
                               Exp2
_ -> (Set LocVar
move_set', Bool
move'))
                          (Set LocVar
move_set, Bool
move)
                          [Exp2]
scalars
                   in (Map LocVar [LocVar]
dep_env, Set LocVar
move_set0, Bool
move0)
      | Bool
otherwise = (Map LocVar [LocVar]
dep_env,Set LocVar
move_set,Bool
move)

type StoreEnv = M.Map Var Var
type RegEnv = M.Map LocVar L2.Region
type AllocEnv = M.Map L2.Region RegionLocs
data RegionLocs = RegionLocs { RegionLocs -> [LocVar]
locs :: [LocVar], RegionLocs -> Set LocVar
allocated_to :: S.Set LocVar }
  deriving Int -> RegionLocs -> [Char] -> [Char]
[RegionLocs] -> [Char] -> [Char]
RegionLocs -> [Char]
(Int -> RegionLocs -> [Char] -> [Char])
-> (RegionLocs -> [Char])
-> ([RegionLocs] -> [Char] -> [Char])
-> Show RegionLocs
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> RegionLocs -> [Char] -> [Char]
showsPrec :: Int -> RegionLocs -> [Char] -> [Char]
$cshow :: RegionLocs -> [Char]
show :: RegionLocs -> [Char]
$cshowList :: [RegionLocs] -> [Char] -> [Char]
showList :: [RegionLocs] -> [Char] -> [Char]
Show

--------------------------------------------------------------------------------

reorderScalarWrites :: L3.Prog3 -> PassM L3.Prog3
reorderScalarWrites :: Prog3 -> PassM Prog3
reorderScalarWrites (Prog DDefs (TyOf Exp3)
ddefs FunDefs Exp3
fundefs Maybe (Exp3, TyOf Exp3)
mainExp) = do
    let fds' :: [FunDef Exp3]
fds' = (FunDef Exp3 -> FunDef Exp3) -> [FunDef Exp3] -> [FunDef Exp3]
forall a b. (a -> b) -> [a] -> [b]
map FunDef Exp3 -> FunDef Exp3
gofun (FunDefs Exp3 -> [FunDef Exp3]
forall k a. Map k a -> [a]
M.elems FunDefs Exp3
fundefs)
        fundefs' :: FunDefs Exp3
fundefs' = [(LocVar, FunDef Exp3)] -> FunDefs Exp3
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(LocVar, FunDef Exp3)] -> FunDefs Exp3)
-> [(LocVar, FunDef Exp3)] -> FunDefs Exp3
forall a b. (a -> b) -> a -> b
$ (FunDef Exp3 -> (LocVar, FunDef Exp3))
-> [FunDef Exp3] -> [(LocVar, FunDef Exp3)]
forall a b. (a -> b) -> [a] -> [b]
map (\FunDef Exp3
f -> (FunDef Exp3 -> LocVar
forall ex. FunDef ex -> LocVar
funName FunDef Exp3
f,FunDef Exp3
f)) [FunDef Exp3]
fds'
        mainExp' :: Maybe (Exp3, UrTy ())
mainExp' = case Maybe (Exp3, TyOf Exp3)
mainExp of
                    Just (Exp3
e,TyOf Exp3
ty) -> (Exp3, UrTy ()) -> Maybe (Exp3, UrTy ())
forall a. a -> Maybe a
Just (Exp3 -> Exp3
go Exp3
e, TyOf Exp3
UrTy ()
ty)
                    Maybe (Exp3, TyOf Exp3)
Nothing     -> Maybe (Exp3, UrTy ())
forall a. Maybe a
Nothing
    Prog3 -> PassM Prog3
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Prog3 -> PassM Prog3) -> Prog3 -> PassM Prog3
forall a b. (a -> b) -> a -> b
$ DDefs (TyOf Exp3)
-> FunDefs Exp3 -> Maybe (Exp3, TyOf Exp3) -> Prog3
forall ex.
DDefs (TyOf ex) -> FunDefs ex -> Maybe (ex, TyOf ex) -> Prog ex
Prog DDefs (TyOf Exp3)
ddefs FunDefs Exp3
fundefs' Maybe (Exp3, TyOf Exp3)
Maybe (Exp3, UrTy ())
mainExp'

  where
    gofun :: FunDef Exp3 -> FunDef Exp3
gofun f :: FunDef Exp3
f@FunDef{Exp3
funBody :: forall ex. FunDef ex -> ex
funBody :: Exp3
funBody} =
      let funBody' :: Exp3
funBody' = Exp3 -> Exp3
go Exp3
funBody
      in FunDef Exp3
f { funBody :: Exp3
funBody = Exp3
funBody' }

    go :: L3.Exp3 -> L3.Exp3
    go :: Exp3 -> Exp3
go Exp3
ex =
      case Exp3
ex of
        LetE (LocVar
v,[()]
locs,UrTy ()
ty,Exp3
rhs) Exp3
bod ->
          case Exp3
rhs of
            Ext (L3.AllocateTagHere LocVar
loc [Char]
_) ->
              let ([(LocVar, [()], UrTy (), Exp3)]
binds,Exp3
bod') = Collect
-> LocVar -> Exp3 -> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
collectBinds Collect
Tag LocVar
loc Exp3
bod
              in ([(LocVar, [()], UrTy (), Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(LocVar, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(LocVar, [()], UrTy (), Exp3)]
binds (Exp3 -> Exp3
go Exp3
bod'))
            Ext (L3.AllocateScalarsHere LocVar
loc) ->
              let ([(LocVar, [()], UrTy (), Exp3)]
binds,Exp3
bod') = Collect
-> LocVar -> Exp3 -> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
collectBinds Collect
Scalars LocVar
loc Exp3
bod
              in ([(LocVar, [()], UrTy (), Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(LocVar, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(LocVar, [()], UrTy (), Exp3)]
binds (Exp3 -> Exp3
go Exp3
bod'))
            Ext (L3.StartTagAllocation{})     -> Exp3 -> Exp3
go Exp3
bod
            Ext (L3.EndTagAllocation{})       -> Exp3 -> Exp3
go Exp3
bod
            Ext (L3.StartScalarsAllocation{}) -> Exp3 -> Exp3
go Exp3
bod
            Ext (L3.EndScalarsAllocation{})   -> Exp3 -> Exp3
go Exp3
bod
            Exp3
_ -> (LocVar, [()], UrTy (), Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(LocVar, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (LocVar
v,[()]
locs,UrTy ()
ty, Exp3 -> Exp3
go Exp3
rhs) (Exp3 -> Exp3
go Exp3
bod)
        IfE Exp3
a Exp3
b Exp3
c  -> Exp3 -> Exp3 -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec
IfE (Exp3 -> Exp3
go Exp3
a) (Exp3 -> Exp3
go Exp3
b) (Exp3 -> Exp3
go Exp3
c)
        CaseE Exp3
scrt [([Char], [(LocVar, ())], Exp3)]
brs -> Exp3 -> [([Char], [(LocVar, ())], Exp3)] -> Exp3
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> [([Char], [(LocVar, loc)], PreExp ext loc dec)]
-> PreExp ext loc dec
CaseE (Exp3 -> Exp3
go Exp3
scrt) ((([Char], [(LocVar, ())], Exp3) -> ([Char], [(LocVar, ())], Exp3))
-> [([Char], [(LocVar, ())], Exp3)]
-> [([Char], [(LocVar, ())], Exp3)]
forall a b. (a -> b) -> [a] -> [b]
map (\([Char]
a,[(LocVar, ())]
b,Exp3
c) -> ([Char]
a,[(LocVar, ())]
b,Exp3 -> Exp3
go Exp3
c)) [([Char], [(LocVar, ())], Exp3)]
brs)
        WithArenaE LocVar
ar Exp3
bod -> LocVar -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
LocVar -> PreExp ext loc dec -> PreExp ext loc dec
WithArenaE LocVar
ar (Exp3 -> Exp3
go Exp3
bod)
        TimeIt Exp3
e UrTy ()
ty Bool
b -> Exp3 -> UrTy () -> Bool -> Exp3
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> dec -> Bool -> PreExp ext loc dec
TimeIt (Exp3 -> Exp3
go Exp3
e) UrTy ()
ty Bool
b
        Exp3
_ -> Exp3
ex

data Collect = Tag | Scalars
  deriving Collect -> Collect -> Bool
(Collect -> Collect -> Bool)
-> (Collect -> Collect -> Bool) -> Eq Collect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Collect -> Collect -> Bool
== :: Collect -> Collect -> Bool
$c/= :: Collect -> Collect -> Bool
/= :: Collect -> Collect -> Bool
Eq

data Mode = Search L3.Exp3 | SearchAndStore L3.Exp3
  deriving (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
/= :: Mode -> Mode -> Bool
Eq, Int -> Mode -> [Char] -> [Char]
[Mode] -> [Char] -> [Char]
Mode -> [Char]
(Int -> Mode -> [Char] -> [Char])
-> (Mode -> [Char]) -> ([Mode] -> [Char] -> [Char]) -> Show Mode
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> Mode -> [Char] -> [Char]
showsPrec :: Int -> Mode -> [Char] -> [Char]
$cshow :: Mode -> [Char]
show :: Mode -> [Char]
$cshowList :: [Mode] -> [Char] -> [Char]
showList :: [Mode] -> [Char] -> [Char]
Show, (forall x. Mode -> Rep Mode x)
-> (forall x. Rep Mode x -> Mode) -> Generic Mode
forall x. Rep Mode x -> Mode
forall x. Mode -> Rep Mode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Mode -> Rep Mode x
from :: forall x. Mode -> Rep Mode x
$cto :: forall x. Rep Mode x -> Mode
to :: forall x. Rep Mode x -> Mode
Generic)

instance Out Mode where
  doc :: Mode -> Doc
doc = [Char] -> Doc
text ([Char] -> Doc) -> (Mode -> [Char]) -> Mode -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode -> [Char]
forall a. Show a => a -> [Char]
show

collectBinds :: Collect -> Var -> L3.Exp3 -> ([(Var,[()],L3.Ty3,L3.Exp3)], L3.Exp3)
collectBinds :: Collect
-> LocVar -> Exp3 -> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
collectBinds Collect
collect LocVar
loc Exp3
ex0 =
  case Collect
collect of
    Collect
Tag -> Mode
-> [(LocVar, [()], UrTy (), Exp3)]
-> Exp3
-> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
go (Exp3 -> Mode
Search (E3Ext () (UrTy ()) -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (LocVar -> E3Ext () (UrTy ())
forall loc dec. LocVar -> E3Ext loc dec
L3.StartTagAllocation LocVar
loc))) [] Exp3
ex0
    Collect
Scalars -> Mode
-> [(LocVar, [()], UrTy (), Exp3)]
-> Exp3
-> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
go (Exp3 -> Mode
Search (E3Ext () (UrTy ()) -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (LocVar -> E3Ext () (UrTy ())
forall loc dec. LocVar -> E3Ext loc dec
L3.StartScalarsAllocation LocVar
loc))) [] Exp3
ex0
  where
    invert :: PreExp E3Ext loc dec -> PreExp E3Ext loc dec
invert (Ext (L3.StartTagAllocation LocVar
loc2)) = (E3Ext loc dec -> PreExp E3Ext loc dec
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (LocVar -> E3Ext loc dec
forall loc dec. LocVar -> E3Ext loc dec
L3.EndTagAllocation LocVar
loc2))
    invert (Ext (L3.StartScalarsAllocation LocVar
loc2)) = (E3Ext loc dec -> PreExp E3Ext loc dec
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (LocVar -> E3Ext loc dec
forall loc dec. LocVar -> E3Ext loc dec
L3.EndScalarsAllocation LocVar
loc2))
    invert PreExp E3Ext loc dec
oth = [Char] -> PreExp E3Ext loc dec
forall a. HasCallStack => [Char] -> a
error ([Char] -> PreExp E3Ext loc dec) -> [Char] -> PreExp E3Ext loc dec
forall a b. (a -> b) -> a -> b
$ [Char]
"collectBinds: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PreExp E3Ext loc dec -> [Char]
forall a. Out a => a -> [Char]
sdoc PreExp E3Ext loc dec
oth

    go :: Mode -> [(Var,[()],L3.Ty3,L3.Exp3)] -> L3.Exp3
       -> ([(Var,[()],L3.Ty3,L3.Exp3)], L3.Exp3)
    go :: Mode
-> [(LocVar, [()], UrTy (), Exp3)]
-> Exp3
-> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
go Mode
mode [(LocVar, [()], UrTy (), Exp3)]
acc Exp3
ex =
      case Exp3
ex of
        LetE (LocVar
v,[()]
locs,UrTy ()
ty,Exp3
rhs) Exp3
bod ->
          case Mode
mode of
            Search Exp3
s ->
              if Exp3
s Exp3 -> Exp3 -> Bool
forall a. Eq a => a -> a -> Bool
== Exp3
rhs
              then Mode
-> [(LocVar, [()], UrTy (), Exp3)]
-> Exp3
-> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
go (Exp3 -> Mode
SearchAndStore (Exp3 -> Exp3
forall {loc} {dec} {loc} {dec}.
(Out loc, Out dec) =>
PreExp E3Ext loc dec -> PreExp E3Ext loc dec
invert Exp3
s)) [(LocVar, [()], UrTy (), Exp3)]
acc Exp3
bod
              else
                let ([(LocVar, [()], UrTy (), Exp3)]
acc1,Exp3
rhs') = Mode
-> [(LocVar, [()], UrTy (), Exp3)]
-> Exp3
-> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
go Mode
mode [(LocVar, [()], UrTy (), Exp3)]
acc Exp3
rhs
                    ([(LocVar, [()], UrTy (), Exp3)]
acc2,Exp3
bod') = Mode
-> [(LocVar, [()], UrTy (), Exp3)]
-> Exp3
-> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
go Mode
mode [(LocVar, [()], UrTy (), Exp3)]
acc1 Exp3
bod
                in ([(LocVar, [()], UrTy (), Exp3)]
acc2, (LocVar, [()], UrTy (), Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(LocVar, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (LocVar
v,[()]
locs,UrTy ()
ty,Exp3
rhs') Exp3
bod')
            SearchAndStore Exp3
s ->
              if Exp3
s Exp3 -> Exp3 -> Bool
forall a. Eq a => a -> a -> Bool
== Exp3
rhs
              then ([(LocVar, [()], UrTy (), Exp3)]
acc,Exp3
ex)
              else
                let ([(LocVar, [()], UrTy (), Exp3)]
acc1,Exp3
bod') = Mode
-> [(LocVar, [()], UrTy (), Exp3)]
-> Exp3
-> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
go Mode
mode [(LocVar, [()], UrTy (), Exp3)]
acc Exp3
bod
                in ((LocVar
v,[()]
locs,UrTy ()
ty,Exp3
rhs) (LocVar, [()], UrTy (), Exp3)
-> [(LocVar, [()], UrTy (), Exp3)]
-> [(LocVar, [()], UrTy (), Exp3)]
forall a. a -> [a] -> [a]
: [(LocVar, [()], UrTy (), Exp3)]
acc1, Exp3
bod')
        IfE Exp3
a Exp3
b Exp3
c  ->
          let ([(LocVar, [()], UrTy (), Exp3)]
acc1,Exp3
a') = Mode
-> [(LocVar, [()], UrTy (), Exp3)]
-> Exp3
-> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
go Mode
mode [(LocVar, [()], UrTy (), Exp3)]
acc Exp3
a
              ([(LocVar, [()], UrTy (), Exp3)]
acc2,Exp3
b') = Mode
-> [(LocVar, [()], UrTy (), Exp3)]
-> Exp3
-> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
go Mode
mode [(LocVar, [()], UrTy (), Exp3)]
acc1 Exp3
b
              ([(LocVar, [()], UrTy (), Exp3)]
acc3,Exp3
c') = Mode
-> [(LocVar, [()], UrTy (), Exp3)]
-> Exp3
-> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
go Mode
mode [(LocVar, [()], UrTy (), Exp3)]
acc1 Exp3
c
          in ([(LocVar, [()], UrTy (), Exp3)]
acc2[(LocVar, [()], UrTy (), Exp3)]
-> [(LocVar, [()], UrTy (), Exp3)]
-> [(LocVar, [()], UrTy (), Exp3)]
forall a. [a] -> [a] -> [a]
++[(LocVar, [()], UrTy (), Exp3)]
acc3, Exp3 -> Exp3 -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec
IfE Exp3
a' Exp3
b' Exp3
c')
        CaseE Exp3
scrt [([Char], [(LocVar, ())], Exp3)]
brs ->
          let ([(LocVar, [()], UrTy (), Exp3)]
acc0,[([Char], [(LocVar, ())], Exp3)]
brs') =
                (([Char], [(LocVar, ())], Exp3)
 -> ([(LocVar, [()], UrTy (), Exp3)],
     [([Char], [(LocVar, ())], Exp3)])
 -> ([(LocVar, [()], UrTy (), Exp3)],
     [([Char], [(LocVar, ())], Exp3)]))
-> ([(LocVar, [()], UrTy (), Exp3)],
    [([Char], [(LocVar, ())], Exp3)])
-> [([Char], [(LocVar, ())], Exp3)]
-> ([(LocVar, [()], UrTy (), Exp3)],
    [([Char], [(LocVar, ())], Exp3)])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\([Char]
a,[(LocVar, ())]
b,Exp3
c) ([(LocVar, [()], UrTy (), Exp3)]
acc',[([Char], [(LocVar, ())], Exp3)]
es) ->
                         let ([(LocVar, [()], UrTy (), Exp3)]
acc'',Exp3
c') = Mode
-> [(LocVar, [()], UrTy (), Exp3)]
-> Exp3
-> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
go Mode
mode [(LocVar, [()], UrTy (), Exp3)]
acc' Exp3
c
                         in ([(LocVar, [()], UrTy (), Exp3)]
acc'', ([Char]
a,[(LocVar, ())]
b,Exp3
c')([Char], [(LocVar, ())], Exp3)
-> [([Char], [(LocVar, ())], Exp3)]
-> [([Char], [(LocVar, ())], Exp3)]
forall a. a -> [a] -> [a]
:[([Char], [(LocVar, ())], Exp3)]
es))
                      ([(LocVar, [()], UrTy (), Exp3)]
acc,[])
                      [([Char], [(LocVar, ())], Exp3)]
brs
          in ([(LocVar, [()], UrTy (), Exp3)]
acc0, Exp3 -> [([Char], [(LocVar, ())], Exp3)] -> Exp3
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> [([Char], [(LocVar, loc)], PreExp ext loc dec)]
-> PreExp ext loc dec
CaseE Exp3
scrt [([Char], [(LocVar, ())], Exp3)]
brs')
        WithArenaE LocVar
ar Exp3
bod ->
          let ([(LocVar, [()], UrTy (), Exp3)]
acc',Exp3
bod') = Mode
-> [(LocVar, [()], UrTy (), Exp3)]
-> Exp3
-> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
go Mode
mode [(LocVar, [()], UrTy (), Exp3)]
acc Exp3
bod
          in ([(LocVar, [()], UrTy (), Exp3)]
acc', LocVar -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
LocVar -> PreExp ext loc dec -> PreExp ext loc dec
WithArenaE LocVar
ar Exp3
bod')
        TimeIt Exp3
e UrTy ()
ty Bool
b ->
          let ([(LocVar, [()], UrTy (), Exp3)]
acc', Exp3
e') = Mode
-> [(LocVar, [()], UrTy (), Exp3)]
-> Exp3
-> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
go Mode
mode [(LocVar, [()], UrTy (), Exp3)]
acc Exp3
e
          in ([(LocVar, [()], UrTy (), Exp3)]
acc', Exp3 -> UrTy () -> Bool -> Exp3
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> dec -> Bool -> PreExp ext loc dec
TimeIt Exp3
e' UrTy ()
ty Bool
b)
        Ext (L3.LetAvail [LocVar]
vs Exp3
bod) ->
          let ([(LocVar, [()], UrTy (), Exp3)]
acc',Exp3
bod') = Mode
-> [(LocVar, [()], UrTy (), Exp3)]
-> Exp3
-> ([(LocVar, [()], UrTy (), Exp3)], Exp3)
go Mode
mode [(LocVar, [()], UrTy (), Exp3)]
acc Exp3
bod
          in ([(LocVar, [()], UrTy (), Exp3)]
acc', E3Ext () (UrTy ()) -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext ([LocVar] -> Exp3 -> E3Ext () (UrTy ())
forall loc dec. [LocVar] -> PreExp E3Ext loc dec -> E3Ext loc dec
L3.LetAvail [LocVar]
vs Exp3
bod'))
        Exp3
_ -> ([(LocVar, [()], UrTy (), Exp3)]
acc,Exp3
ex)


--------------------------------------------------------------------------------