module Gibbon.Passes.Cursorize
  (cursorize) where

import           Control.Monad (forM)
import qualified Data.List as L
import qualified Data.Map as M
import           Data.Maybe (fromJust)
import           Text.PrettyPrint.GenericPretty
import           Data.Foldable ( foldrM )

import           Gibbon.DynFlags
import           Gibbon.Common
import           Gibbon.NewL2.Syntax
import           Gibbon.L3.Syntax hiding ( BoundsCheck, RetE, GetCilkWorkerNum, LetAvail,
                                           AllocateTagHere, AllocateScalarsHere, SSPush, SSPop,
                                           TagCursor )
import qualified Gibbon.L3.Syntax as L3
import           Gibbon.Passes.AddRAN ( numRANsDataCon )

{-

Cursor insertion, strategy one:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Here we go to a "dilated" representation of packed values, where
every `Packed T` is represented by a pair, `(Cursor,Cursor)`,
i.e. start/end. Except function arguments, and variables bound by
by a pattern match. They're just `start` cursors.

REASONING: Why the dilated convention?  In a word: conditionals.  At the
end of each function body we need to return the appropriate end cursors.
But during the computation, we may need to add an arbitrary amount of
extra state to the return type of a conditional.  Thus it's difficult to
do this routing of information without changing the types of intermediate
expressions significantly.  Dilation is the current strategy.

We proceed with two loops, corresponding to packed and unpacked
context.  When the type of the current expression satisfies
`hasPacked`, that's when we're in packed context.  And, when in
packed context, we return dilated values.


E.g.

    add1 :: Tree -> Tree
    add1 tr =
      case tr of
        Leaf n   -> Leaf (n + 1)
        Node l r -> Node (add1 l) (add1 r)

becomes

    -- char*
    type Cursor = Ptr Char

    add1 :: Cursor -> Cursor -> (Cursor, (Cursor, Cursor))
    add1 lout lin =
      let tag = readTag lin
      in case tag of
           Leaf -> let n  = readInt tag
                       wt = writeTag lout Leaf
                       wi = writeInt wt   (n+1)
                   in (lin + 8, (lout, wi))
           Node -> ...

Every packed input becomes a read cursor. And it takes additional output cursors
for every packed type in the return value. Every packed return value becomes a
(Cursor,Cursor) i.e (start,end). And it returns additional end_of_read cursors
if the functions "traverses" it's input (more details in the paer).

-}


-- | Track variables depending on location variables.
--
--   If we have to create binding of the form `let v = loc` (in case expressions for example),
--   but `loc` is not bound yet, we'll add the variable to this map.
--   This is a stupid/simple way to get rid of FindWitnesses.
--   See `FindWitnesses.hs` for why that is needed.
type DepEnv = M.Map LocVar [(Var,[()],Ty3,Exp3)]

-- | Things we cannot define until we see a join point. There's a Ty2 to so that
-- we can extend the environment.
type SyncEnv = M.Map Var [(Var,[()],Ty3,Ty2,Exp3)]

type OldTy2 = UrTy LocVar

-- |
cursorize :: Prog2 -> PassM Prog3
cursorize :: Prog2 -> PassM Prog3
cursorize Prog{DDefs (TyOf Exp2)
ddefs :: DDefs (TyOf Exp2)
ddefs :: forall ex. Prog ex -> DDefs (TyOf ex)
ddefs,FunDefs Exp2
fundefs :: FunDefs Exp2
fundefs :: forall ex. Prog ex -> FunDefs ex
fundefs,Maybe (Exp2, TyOf Exp2)
mainExp :: Maybe (Exp2, TyOf Exp2)
mainExp :: forall ex. Prog ex -> Maybe (ex, TyOf ex)
mainExp} = do
  [FunDef3]
fns' <- ((Var, FunDef2) -> PassM FunDef3)
-> [(Var, FunDef2)] -> PassM [FunDef3]
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 (DDefs Ty2 -> FunDefs Exp2 -> FunDef2 -> PassM FunDef3
cursorizeFunDef DDefs (TyOf Exp2)
DDefs Ty2
ddefs FunDefs Exp2
fundefs (FunDef2 -> PassM FunDef3)
-> ((Var, FunDef2) -> FunDef2) -> (Var, FunDef2) -> PassM FunDef3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var, FunDef2) -> FunDef2
forall a b. (a, b) -> b
snd) (FunDefs Exp2 -> [(Var, FunDef2)]
forall k a. Map k a -> [(k, a)]
M.toList FunDefs Exp2
fundefs)
  let fundefs' :: Map Var FunDef3
fundefs' = [(Var, FunDef3)] -> Map Var FunDef3
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Var, FunDef3)] -> Map Var FunDef3)
-> [(Var, FunDef3)] -> Map Var FunDef3
forall a b. (a -> b) -> a -> b
$ (FunDef3 -> (Var, FunDef3)) -> [FunDef3] -> [(Var, FunDef3)]
forall a b. (a -> b) -> [a] -> [b]
L.map (\FunDef3
f -> (FunDef3 -> Var
forall ex. FunDef ex -> Var
funName FunDef3
f, FunDef3
f)) [FunDef3]
fns'
      ddefs' :: Map Var (DDef Ty3)
ddefs'   = (DDef Ty2 -> DDef Ty3) -> DDefs Ty2 -> Map Var (DDef Ty3)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map DDef Ty2 -> DDef Ty3
eraseLocMarkers DDefs (TyOf Exp2)
DDefs Ty2
ddefs
  Maybe (Exp3, Ty3)
mainExp' <- case Maybe (Exp2, TyOf Exp2)
mainExp of
                Maybe (Exp2, TyOf Exp2)
Nothing -> Maybe (Exp3, Ty3) -> PassM (Maybe (Exp3, Ty3))
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Exp3, Ty3)
forall a. Maybe a
Nothing
                Just (Exp2
e,TyOf Exp2
ty) -> do
                  if UrTy Var -> Bool
forall a. Show a => UrTy a -> Bool
hasPacked (Ty2 -> UrTy Var
unTy2 TyOf Exp2
Ty2
ty)
                  then (Exp3, Ty3) -> Maybe (Exp3, Ty3)
forall a. a -> Maybe a
Just ((Exp3, Ty3) -> Maybe (Exp3, Ty3))
-> (Exp3 -> (Exp3, Ty3)) -> Exp3 -> Maybe (Exp3, Ty3)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs (Ty2 -> UrTy Var
unTy2 TyOf Exp2
Ty2
ty)) (Exp3 -> Maybe (Exp3, Ty3))
-> (DiExp Exp3 -> Exp3) -> DiExp Exp3 -> Maybe (Exp3, Ty3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Maybe (Exp3, Ty3))
-> PassM (DiExp Exp3) -> PassM (Maybe (Exp3, Ty3))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs (TyOf Exp2)
DDefs Ty2
ddefs FunDefs Exp2
fundefs DepEnv
forall k a. Map k a
M.empty TyEnv Ty2
forall k a. Map k a
M.empty SyncEnv
forall k a. Map k a
M.empty Exp2
e
                  else (Exp3, Ty3) -> Maybe (Exp3, Ty3)
forall a. a -> Maybe a
Just ((Exp3, Ty3) -> Maybe (Exp3, Ty3))
-> (Exp3 -> (Exp3, Ty3)) -> Exp3 -> Maybe (Exp3, Ty3)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs (Ty2 -> UrTy Var
unTy2 TyOf Exp2
Ty2
ty)) (Exp3 -> Maybe (Exp3, Ty3))
-> PassM Exp3 -> PassM (Maybe (Exp3, Ty3))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs (TyOf Exp2)
DDefs Ty2
ddefs FunDefs Exp2
fundefs DepEnv
forall k a. Map k a
M.empty TyEnv Ty2
forall k a. Map k a
M.empty SyncEnv
forall k a. Map k a
M.empty Exp2
e
  Prog3 -> PassM Prog3
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DDefs (TyOf Exp3)
-> Map Var FunDef3 -> Maybe (Exp3, TyOf Exp3) -> Prog3
forall ex.
DDefs (TyOf ex) -> FunDefs ex -> Maybe (ex, TyOf ex) -> Prog ex
Prog DDefs (TyOf Exp3)
Map Var (DDef Ty3)
ddefs' Map Var FunDef3
fundefs' Maybe (Exp3, TyOf Exp3)
Maybe (Exp3, Ty3)
mainExp')

-- |
cursorizeFunDef :: DDefs Ty2 -> FunDefs2 -> FunDef2 -> PassM FunDef3
cursorizeFunDef :: DDefs Ty2 -> FunDefs Exp2 -> FunDef2 -> PassM FunDef3
cursorizeFunDef DDefs Ty2
ddefs FunDefs Exp2
fundefs FunDef{Var
funName :: forall ex. FunDef ex -> Var
funName :: Var
funName,ArrowTy (TyOf Exp2)
funTy :: ArrowTy (TyOf Exp2)
funTy :: forall ex. FunDef ex -> ArrowTy (TyOf ex)
funTy,[Var]
funArgs :: [Var]
funArgs :: forall ex. FunDef ex -> [Var]
funArgs,Exp2
funBody :: Exp2
funBody :: forall ex. FunDef ex -> ex
funBody,FunMeta
funMeta :: FunMeta
funMeta :: forall ex. FunDef ex -> FunMeta
funMeta} = do
  let inLocs :: [Var]
inLocs  = ArrowTy2 Ty2 -> [Var]
forall ty2. ArrowTy2 ty2 -> [Var]
inLocVars ArrowTy (TyOf Exp2)
ArrowTy2 Ty2
funTy
      outLocs :: [Var]
outLocs = ArrowTy2 Ty2 -> [Var]
forall ty2. ArrowTy2 ty2 -> [Var]
outLocVars ArrowTy (TyOf Exp2)
ArrowTy2 Ty2
funTy
      outRegs :: [Var]
outRegs = ArrowTy2 Ty2 -> [Var]
forall ty2. ArrowTy2 ty2 -> [Var]
outRegVars ArrowTy (TyOf Exp2)
ArrowTy2 Ty2
funTy
      inRegs :: [Var]
inRegs  = ArrowTy2 Ty2 -> [Var]
forall ty2. ArrowTy2 ty2 -> [Var]
inRegVars ArrowTy (TyOf Exp2)
ArrowTy2 Ty2
funTy
      in_tys :: [Ty2]
in_tys  = ArrowTy2 Ty2 -> [Ty2]
forall ty2. ArrowTy2 ty2 -> [ty2]
arrIns ArrowTy (TyOf Exp2)
ArrowTy2 Ty2
funTy
      out_ty :: Ty2
out_ty  = ArrowTy2 Ty2 -> Ty2
forall ty2. ArrowTy2 ty2 -> ty2
arrOut ArrowTy (TyOf Exp2)
ArrowTy2 Ty2
funTy
      funTy' :: ([Ty3], Ty3)
funTy'  = ArrowTy2 Ty2 -> ([Ty3], Ty3)
cursorizeArrowTy ArrowTy (TyOf Exp2)
ArrowTy2 Ty2
funTy

      -- [2019.03.04] CSK: the order of these new cursor/region arguments isn't
      -- intuitive and can be improved.

      -- Input & output regions are always inserted before all other arguments.
      regBinds :: [Var]
regBinds = (Var -> Var) -> [Var] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map Var -> Var
toEndV ([Var]
inRegs [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
outRegs)

      -- Output cursors after that.
      outCurBinds :: [Var]
outCurBinds = [Var]
outLocs

      -- Then the input cursors. Bind an input cursor for every packed argument.
      inCurBinds :: Exp3 -> Exp3
inCurBinds = case [Var]
inLocs of
                     [] -> [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets []
                     [Var]
_  ->
                           let projs :: [Exp3]
projs = ((Exp3, Ty2) -> [Exp3]) -> [(Exp3, Ty2)] -> [Exp3]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Exp3
e,Ty2
t) -> Exp3 -> Ty2 -> [Exp3]
mkInProjs Exp3
e Ty2
t) ([Exp3] -> [Ty2] -> [(Exp3, Ty2)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Var -> Exp3) -> [Var] -> [Exp3]
forall a b. (a -> b) -> [a] -> [b]
map Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE [Var]
funArgs) [Ty2]
in_tys)
                               bnds :: [(Var, [()], Ty3, Exp3)]
bnds  = [(Var
loc,[],Ty3
forall loc. UrTy loc
CursorTy,Exp3
proj) | (Var
loc,Exp3
proj) <- [Var] -> [Exp3] -> [(Var, Exp3)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
inLocs [Exp3]
projs]
                           in [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
bnds

      initTyEnv :: TyEnv Ty2
initTyEnv = [(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Var, Ty2)] -> TyEnv Ty2) -> [(Var, Ty2)] -> TyEnv Ty2
forall a b. (a -> b) -> a -> b
$ (((Var, Ty2) -> (Var, Ty2)) -> [(Var, Ty2)] -> [(Var, Ty2)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Var
a,Ty2
b) -> (Var
a,UrTy Var -> Ty2
MkTy2 (UrTy Var -> UrTy Var
forall a b. UrTy a -> UrTy b
cursorizeInTy (Ty2 -> UrTy Var
unTy2 Ty2
b)))) ([(Var, Ty2)] -> [(Var, Ty2)]) -> [(Var, Ty2)] -> [(Var, Ty2)]
forall a b. (a -> b) -> a -> b
$ [Var] -> [Ty2] -> [(Var, Ty2)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
funArgs [Ty2]
in_tys) [(Var, Ty2)] -> [(Var, Ty2)] -> [(Var, Ty2)]
forall a. [a] -> [a] -> [a]
++
                               [(Var
a, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) | (LRM Var
a Region
_ Modality
_) <- ArrowTy2 Ty2 -> [LRM]
forall ty2. ArrowTy2 ty2 -> [LRM]
locVars ArrowTy (TyOf Exp2)
ArrowTy2 Ty2
funTy]

      funargs :: [Var]
funargs = [Var]
regBinds [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
outCurBinds [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
funArgs

  Exp3
bod <- if UrTy Var -> Bool
forall a. Show a => UrTy a -> Bool
hasPacked (Ty2 -> UrTy Var
unTy2 Ty2
out_ty)
         then DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Exp3) -> PassM (DiExp Exp3) -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddefs FunDefs Exp2
fundefs DepEnv
forall k a. Map k a
M.empty TyEnv Ty2
initTyEnv SyncEnv
forall k a. Map k a
M.empty Exp2
funBody
         else DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddefs FunDefs Exp2
fundefs DepEnv
forall k a. Map k a
M.empty TyEnv Ty2
initTyEnv SyncEnv
forall k a. Map k a
M.empty Exp2
funBody
  let bod' :: Exp3
bod' = Exp3 -> Exp3
inCurBinds Exp3
bod
      fn :: FunDef3
fn = Var -> [Var] -> ArrowTy (TyOf Exp3) -> Exp3 -> FunMeta -> FunDef3
forall ex.
Var -> [Var] -> ArrowTy (TyOf ex) -> ex -> FunMeta -> FunDef ex
FunDef Var
funName [Var]
funargs ([Ty3], Ty3)
ArrowTy (TyOf Exp3)
funTy' Exp3
bod' FunMeta
funMeta
  FunDef3 -> PassM FunDef3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return FunDef3
fn

  where
    -- | The only difference between this and L3.cursorizeTy is that here,
    --   packed types are replaced by a single CursorTy instead of
    --   a tuple (CursorTy,CursorTy). This is because only `start` cursors are
    --   passed in for packed function arguments.
    cursorizeInTy :: UrTy a -> UrTy b
    cursorizeInTy :: forall a b. UrTy a -> UrTy b
cursorizeInTy UrTy a
ty =
      case UrTy a
ty of
        UrTy a
IntTy     -> UrTy b
forall loc. UrTy loc
IntTy
        UrTy a
CharTy    -> UrTy b
forall loc. UrTy loc
CharTy
        UrTy a
FloatTy   -> UrTy b
forall loc. UrTy loc
FloatTy
        UrTy a
SymTy     -> UrTy b
forall loc. UrTy loc
SymTy
        UrTy a
BoolTy    -> UrTy b
forall loc. UrTy loc
BoolTy
        ProdTy [UrTy a]
ls -> [UrTy b] -> UrTy b
forall loc. [UrTy loc] -> UrTy loc
ProdTy ([UrTy b] -> UrTy b) -> [UrTy b] -> UrTy b
forall a b. (a -> b) -> a -> b
$ (UrTy a -> UrTy b) -> [UrTy a] -> [UrTy b]
forall a b. (a -> b) -> [a] -> [b]
L.map UrTy a -> UrTy b
forall a b. UrTy a -> UrTy b
cursorizeInTy [UrTy a]
ls
        SymDictTy Maybe Var
ar Ty3
_ty -> Maybe Var -> Ty3 -> UrTy b
forall loc. Maybe Var -> Ty3 -> UrTy loc
SymDictTy Maybe Var
ar Ty3
forall loc. UrTy loc
CursorTy
        PDictTy UrTy a
k UrTy a
v -> UrTy b -> UrTy b -> UrTy b
forall loc. UrTy loc -> UrTy loc -> UrTy loc
PDictTy (UrTy a -> UrTy b
forall a b. UrTy a -> UrTy b
cursorizeInTy UrTy a
k) (UrTy a -> UrTy b
forall a b. UrTy a -> UrTy b
cursorizeInTy UrTy a
v)
        PackedTy{}    -> UrTy b
forall loc. UrTy loc
CursorTy
        VectorTy UrTy a
el_ty -> UrTy b -> UrTy b
forall loc. UrTy loc -> UrTy loc
VectorTy (UrTy b -> UrTy b) -> UrTy b -> UrTy b
forall a b. (a -> b) -> a -> b
$ UrTy a -> UrTy b
forall a b. UrTy a -> UrTy b
cursorizeInTy UrTy a
el_ty
        ListTy UrTy a
el_ty -> UrTy b -> UrTy b
forall loc. UrTy loc -> UrTy loc
ListTy (UrTy b -> UrTy b) -> UrTy b -> UrTy b
forall a b. (a -> b) -> a -> b
$ UrTy a -> UrTy b
forall a b. UrTy a -> UrTy b
cursorizeInTy UrTy a
el_ty
        UrTy a
PtrTy -> UrTy b
forall loc. UrTy loc
PtrTy
        UrTy a
CursorTy  -> UrTy b
forall loc. UrTy loc
CursorTy
        UrTy a
ArenaTy   -> UrTy b
forall loc. UrTy loc
ArenaTy
        UrTy a
SymSetTy  -> UrTy b
forall loc. UrTy loc
SymSetTy
        UrTy a
SymHashTy -> UrTy b
forall loc. UrTy loc
SymHashTy
        UrTy a
IntHashTy -> UrTy b
forall loc. UrTy loc
IntHashTy

{-

Build projections for packed values in the input type
This is used to create bindings for input location variables.

    >>> mkInProjs e (PackedTy "T" "l")
    [VarE (Var "funArg")]

    >>> mkInProjs e (ProdTy [IntTy,PackedTy "T" "l"])
    [ProjE 1 VarE (Var "funArg")]

    >>> mkInProje e (ProdTy [ProdTy [PackedTy "T" "l", PackedTy "T" "l"], IntTy])
    [ProjE 0 ProjE 0 e, ProjE 1 ProjE 0 e]

    >>> mkInProje e (ProdTy [PackedTy "T" "l",
                             IntTy,
                             ProdTy [PackedTy "T" "l",
                                     ProdTy [PackedTy "T" "l", PackedTy "T" "l"]]])
    [ProjE 0 e,ProjE 0 ProjE 2 e,ProjE 0 ProjE 1 ProjE 2 e,ProjE 1 ProjE 1 ProjE 2 e]

-}
    mkInProjs :: Exp3 -> Ty2 -> [Exp3]
    mkInProjs :: Exp3 -> Ty2 -> [Exp3]
mkInProjs Exp3
e0 Ty2
ty0 = [Exp3] -> Exp3 -> Ty2 -> [Exp3]
go [] Exp3
e0 Ty2
ty0
     where
       go :: [Exp3] -> Exp3 -> Ty2 -> [Exp3]
       go :: [Exp3] -> Exp3 -> Ty2 -> [Exp3]
go [Exp3]
acc Exp3
e Ty2
ty =
         case Ty2 -> UrTy Var
unTy2 Ty2
ty of
           PackedTy{} -> [Exp3]
acc [Exp3] -> [Exp3] -> [Exp3]
forall a. [a] -> [a] -> [a]
++ [Exp3
e]
           ProdTy [UrTy Var]
tys -> ([Exp3] -> (Ty2, Int) -> [Exp3])
-> [Exp3] -> [(Ty2, Int)] -> [Exp3]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl (\[Exp3]
acc2 (Ty2
ty',Int
n) -> [Exp3] -> Exp3 -> Ty2 -> [Exp3]
go [Exp3]
acc2 (Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
n Exp3
e) Ty2
ty')
                                 [Exp3]
acc ([Ty2] -> [Int] -> [(Ty2, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((UrTy Var -> Ty2) -> [UrTy Var] -> [Ty2]
forall a b. (a -> b) -> [a] -> [b]
map UrTy Var -> Ty2
MkTy2 [UrTy Var]
tys) [Int
0..])
           UrTy Var
_ -> [Exp3]
acc

    cursorizeArrowTy :: ArrowTy2 Ty2 -> ([Ty3] , Ty3)
    cursorizeArrowTy :: ArrowTy2 Ty2 -> ([Ty3], Ty3)
cursorizeArrowTy ty :: ArrowTy2 Ty2
ty@ArrowTy2{[Ty2]
arrIns :: forall ty2. ArrowTy2 ty2 -> [ty2]
arrIns :: [Ty2]
arrIns,Ty2
arrOut :: forall ty2. ArrowTy2 ty2 -> ty2
arrOut :: Ty2
arrOut,[LRM]
locVars :: forall ty2. ArrowTy2 ty2 -> [LRM]
locVars :: [LRM]
locVars,[LocRet]
locRets :: [LocRet]
locRets :: forall ty2. ArrowTy2 ty2 -> [LocRet]
locRets} =
      let
          -- Regions corresponding to ouput cursors. (See [Threading regions])
          numOutRegs :: Int
numOutRegs = [Var] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ArrowTy2 Ty2 -> [Var]
forall ty2. ArrowTy2 ty2 -> [Var]
outRegVars ArrowTy2 Ty2
ty)
          outRegs :: [UrTy Var]
outRegs = (Int -> UrTy Var) -> [Int] -> [UrTy Var]
forall a b. (a -> b) -> [a] -> [b]
L.map (\Int
_ -> UrTy Var
forall loc. UrTy loc
CursorTy) [Int
1..Int
numOutRegs]

          -- Adding additional outputs corresponding to end-of-input-value witnesses
          -- We've already computed additional location return value in RouteEnds
          ret_curs :: [UrTy Var]
ret_curs = (LocRet -> UrTy Var) -> [LocRet] -> [UrTy Var]
forall a b. (a -> b) -> [a] -> [b]
L.map (\LocRet
_ -> UrTy Var
forall loc. UrTy loc
CursorTy) [LocRet]
locRets
          out_curs :: [UrTy Var]
out_curs = [UrTy Var]
inRegs [UrTy Var] -> [UrTy Var] -> [UrTy Var]
forall a. [a] -> [a] -> [a]
++ [UrTy Var]
outRegs [UrTy Var] -> [UrTy Var] -> [UrTy Var]
forall a. [a] -> [a] -> [a]
++ [UrTy Var]
ret_curs
          out_ty :: UrTy Var
out_ty = case [UrTy Var]
out_curs of
                     [] -> Ty2 -> UrTy Var
unTy2 Ty2
arrOut
                     [UrTy Var]
_  -> [UrTy Var] -> UrTy Var
forall loc. [UrTy loc] -> UrTy loc
ProdTy ([UrTy Var] -> UrTy Var) -> [UrTy Var] -> UrTy Var
forall a b. (a -> b) -> a -> b
$ [UrTy Var]
out_curs [UrTy Var] -> [UrTy Var] -> [UrTy Var]
forall a. [a] -> [a] -> [a]
++ [Ty2 -> UrTy Var
unTy2 Ty2
arrOut]

          -- Packed types in the output then become end-cursors for those same destinations.
          newOut :: UrTy Var
newOut = (Var -> Var -> UrTy Var) -> UrTy Var -> UrTy Var
forall l. (Var -> l -> UrTy l) -> UrTy l -> UrTy l
mapPacked (\Var
_ Var
_ -> [UrTy Var] -> UrTy Var
forall loc. [UrTy loc] -> UrTy loc
ProdTy [UrTy Var
forall loc. UrTy loc
CursorTy, UrTy Var
forall loc. UrTy loc
CursorTy]) UrTy Var
out_ty

          newOut' :: UrTy Var
newOut' = case UrTy Var
newOut of
                      SymDictTy Maybe Var
a Ty3
_ -> Maybe Var -> Ty3 -> UrTy Var
forall loc. Maybe Var -> Ty3 -> UrTy loc
SymDictTy Maybe Var
a Ty3
forall loc. UrTy loc
CursorTy
                      UrTy Var
_ -> UrTy Var
newOut

          -- Adding additional input arguments for the destination cursors to which outputs
          -- are written.
          outCurs :: [LRM]
outCurs   = (LRM -> Bool) -> [LRM] -> [LRM]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(LRM Var
_ Region
_ Modality
m) -> Modality
m Modality -> Modality -> Bool
forall a. Eq a => a -> a -> Bool
== Modality
Output) [LRM]
locVars
          outCurTys :: [UrTy Var]
outCurTys = (LRM -> UrTy Var) -> [LRM] -> [UrTy Var]
forall a b. (a -> b) -> [a] -> [b]
map (\LRM
_ -> UrTy Var
forall loc. UrTy loc
CursorTy) [LRM]
outCurs
          inRegs :: [UrTy Var]
inRegs    = (Var -> UrTy Var) -> [Var] -> [UrTy Var]
forall a b. (a -> b) -> [a] -> [b]
map (\Var
_ -> UrTy Var
forall loc. UrTy loc
CursorTy) (ArrowTy2 Ty2 -> [Var]
forall ty2. ArrowTy2 ty2 -> [Var]
inRegVars ArrowTy2 Ty2
ty)
          in_tys :: [UrTy Var]
in_tys    = [UrTy Var]
inRegs [UrTy Var] -> [UrTy Var] -> [UrTy Var]
forall a. [a] -> [a] -> [a]
++ [UrTy Var]
outRegs [UrTy Var] -> [UrTy Var] -> [UrTy Var]
forall a. [a] -> [a] -> [a]
++ [UrTy Var]
outCurTys [UrTy Var] -> [UrTy Var] -> [UrTy Var]
forall a. [a] -> [a] -> [a]
++ ((Ty2 -> UrTy Var) -> [Ty2] -> [UrTy Var]
forall a b. (a -> b) -> [a] -> [b]
map Ty2 -> UrTy Var
unTy2 [Ty2]
arrIns)

          -- Packed types in the input now become (read-only) cursors.
          newIns :: [UrTy Any]
newIns    = (UrTy Var -> UrTy Any) -> [UrTy Var] -> [UrTy Any]
forall a b. (a -> b) -> [a] -> [b]
map (UrTy Any -> UrTy Var -> UrTy Any
forall a1 a2. UrTy a1 -> UrTy a2 -> UrTy a1
constPacked UrTy Any
forall loc. UrTy loc
CursorTy) [UrTy Var]
in_tys

      in ((UrTy Any -> Ty3) -> [UrTy Any] -> [Ty3]
forall a b. (a -> b) -> [a] -> [b]
map UrTy Any -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs [UrTy Any]
newIns, UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
newOut')


-- | Cursorize expressions NOT producing `Packed` values
cursorizeExp :: DDefs Ty2 -> FunDefs2 -> DepEnv -> TyEnv Ty2 -> SyncEnv -> Exp2
             -> PassM Exp3
cursorizeExp :: DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex =
  case Exp2
ex of
    VarE Var
v    -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v
    LitE Int
n    -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ Int -> Exp3
forall (ext :: * -> * -> *) loc dec. Int -> PreExp ext loc dec
LitE Int
n
    CharE Char
c   -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ Char -> Exp3
forall (ext :: * -> * -> *) loc dec. Char -> PreExp ext loc dec
CharE Char
c
    FloatE Double
n  -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ Double -> Exp3
forall (ext :: * -> * -> *) loc dec. Double -> PreExp ext loc dec
FloatE Double
n
    LitSymE Var
n -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
LitSymE Var
n

    AppE{} -> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeAppE DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex

    PrimAppE Prim Ty2
RequestSizeOf [Exp2
arg] -> do
      let (VarE Var
v) = Exp2
arg
      case Var -> TyEnv Ty2 -> Maybe Ty2
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v TyEnv Ty2
tenv of
        Maybe Ty2
Nothing -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"cursorizeExp: Unbound variable: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Var -> [Char]
forall a. Out a => a -> [Char]
sdoc Var
v
        Just Ty2
ty -> if UrTy Var -> Bool
forall a. UrTy a -> Bool
isPackedTy (Ty2 -> UrTy Var
unTy2 Ty2
ty)
                   then Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Var -> E3Ext () Ty3
forall loc dec. Var -> Var -> E3Ext loc dec
SubPtr (Var -> Var
toEndV Var
v) Var
v
                   else Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ Int -> Exp3
forall (ext :: * -> * -> *) loc dec. Int -> PreExp ext loc dec
LitE (Int -> Exp3) -> Int -> Exp3
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ UrTy Var -> Maybe Int
forall a. UrTy a -> Maybe Int
sizeOfTy (Ty2 -> UrTy Var
unTy2 Ty2
ty)

    PrimAppE Prim Ty2
pr [Exp2]
args -> Prim Ty3 -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Prim Ty2 -> Prim Ty3
toL3Prim Prim Ty2
pr) ([Exp3] -> Exp3) -> PassM [Exp3] -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Exp2 -> PassM Exp3) -> [Exp2] -> PassM [Exp3]
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 Exp2 -> PassM Exp3
go [Exp2]
args

    LetE (Var
v,[LocArg]
_locs, Ty2
_ty, (PrimAppE (ReadPackedFile Maybe [Char]
path [Char]
tyc Maybe Var
reg Ty2
ty2) [])) Exp2
bod ->
      DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Bool
-> Var
-> Maybe [Char]
-> [Char]
-> Maybe Var
-> Ty2
-> Exp2
-> PassM Exp3
cursorizeReadPackedFile DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Bool
True Var
v Maybe [Char]
path [Char]
tyc Maybe Var
reg Ty2
ty2 Exp2
bod

    LetE (Var
_v,[LocArg]
_locs,Ty2
_ty, (MkProdE [Exp2]
_ls)) Exp2
_bod ->
      Bool
-> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeProd Bool
False DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex

    LetE (Var
_v,[LocArg]
_locs, Ty2
ty, ProjE{}) Exp2
_bod | UrTy Var -> Bool
forall a. UrTy a -> Bool
isPackedTy (Ty2 -> UrTy Var
unTy2 Ty2
ty) ->
       Bool
-> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeProj Bool
False DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex

    LetE (Var
_v,[LocArg]
_locs, Ty2
_ty, SpawnE{}) Exp2
_bod ->
      Bool
-> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeSpawn Bool
False DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex

    LetE (Var
_v,[LocArg]
_locs, Ty2
_ty, Exp2
SyncE) Exp2
_bod ->
      Bool
-> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeSync Bool
False DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex

    LetE (Var
v,[LocArg]
_locs,Ty2
ty, rhs :: Exp2
rhs@(Ext (SSPush SSModality
_ Var
start Var
_ [Char]
_))) Exp2
bod ->
      case Var -> TyEnv Ty2 -> Maybe Ty2
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
start TyEnv Ty2
tenv of
        Maybe Ty2
Nothing -> Exp2 -> PassM Exp3
go Exp2
bod
        Just{}  -> do
          Exp3
rhs' <- Exp2 -> PassM Exp3
go Exp2
rhs
          Exp3
bod' <- Exp2 -> PassM Exp3
go Exp2
bod
          let ty' :: Ty3
ty' = UrTy Var -> Ty3
forall a b. UrTy a -> UrTy b
cursorizeTy (Ty2 -> UrTy Var
unTy2 Ty2
ty)
          Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
v,[],Ty3
ty',Exp3
rhs') Exp3
bod'

    LetE (Var
v,[LocArg]
_locs,Ty2
ty, rhs :: Exp2
rhs@(Ext (SSPop SSModality
_ Var
start Var
_))) Exp2
bod ->
      case Var -> TyEnv Ty2 -> Maybe Ty2
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
start TyEnv Ty2
tenv of
        Maybe Ty2
Nothing -> Exp2 -> PassM Exp3
go Exp2
bod
        Just{}  -> do
          Exp3
rhs' <- Exp2 -> PassM Exp3
go Exp2
rhs
          Exp3
bod' <- Exp2 -> PassM Exp3
go Exp2
bod
          let ty' :: Ty3
ty' = UrTy Var -> Ty3
forall a b. UrTy a -> UrTy b
cursorizeTy (Ty2 -> UrTy Var
unTy2 Ty2
ty)
          Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
v,[],Ty3
ty',Exp3
rhs') Exp3
bod'

    LetE (Var, [LocArg], Ty2, Exp2)
bnd Exp2
bod -> Bool
-> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> (Var, [LocArg], Ty2, Exp2)
-> Exp2
-> PassM Exp3
cursorizeLet Bool
False DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv (Var, [LocArg], Ty2, Exp2)
bnd Exp2
bod

    IfE Exp2
a Exp2
b Exp2
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 -> Exp3 -> Exp3)
-> PassM Exp3 -> PassM (Exp3 -> Exp3 -> Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp2 -> PassM Exp3
go Exp2
a PassM (Exp3 -> Exp3 -> Exp3) -> PassM Exp3 -> PassM (Exp3 -> Exp3)
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 Exp3
go Exp2
b PassM (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
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 Exp3
go Exp2
c

    MkProdE [Exp2]
ls -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE ([Exp3] -> Exp3) -> PassM [Exp3] -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Exp2 -> PassM Exp3) -> [Exp2] -> PassM [Exp3]
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 Exp2 -> PassM Exp3
go [Exp2]
ls

    ProjE Int
i Exp2
e  -> Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
i (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp2 -> PassM Exp3
go Exp2
e

    -- Eg. leftmost
    CaseE Exp2
scrt [([Char], [(Var, LocArg)], Exp2)]
brs -> do
      -- ASSUMPTION: scrt is flat
      let (VarE  Var
v) = Exp2
scrt
      Exp3 -> [([Char], [(Var, ())], Exp3)] -> Exp3
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> [([Char], [(Var, loc)], PreExp ext loc dec)]
-> PreExp ext loc dec
CaseE (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE (Var -> Exp3) -> Var -> Exp3
forall a b. (a -> b) -> a -> b
$ Var
v) ([([Char], [(Var, ())], Exp3)] -> Exp3)
-> PassM [([Char], [(Var, ())], Exp3)] -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (([Char], [(Var, LocArg)], Exp2)
 -> PassM ([Char], [(Var, ())], Exp3))
-> [([Char], [(Var, LocArg)], Exp2)]
-> PassM [([Char], [(Var, ())], Exp3)]
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 (DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Bool
-> Var
-> ([Char], [(Var, LocArg)], Exp2)
-> PassM ([Char], [(Var, ())], Exp3)
forall t.
DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Bool
-> Var
-> ([Char], [(Var, LocArg)], Exp2)
-> PassM ([Char], [t], Exp3)
unpackDataCon DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Bool
False Var
v) [([Char], [(Var, LocArg)], Exp2)]
brs

    DataConE LocArg
_ [Char]
_ [Exp2]
_ -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"cursorizeExp: Should not have encountered DataConE if type is not packed: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Exp2 -> [Char]
forall a. Out a => a -> [Char]
ndoc Exp2
ex

    TimeIt Exp2
e Ty2
ty Bool
b -> Exp3 -> Ty3 -> Bool -> Exp3
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> dec -> Bool -> PreExp ext loc dec
TimeIt (Exp3 -> Ty3 -> Bool -> Exp3)
-> PassM Exp3 -> PassM (Ty3 -> Bool -> Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp2 -> PassM Exp3
go Exp2
e PassM (Ty3 -> Bool -> Exp3) -> PassM Ty3 -> PassM (Bool -> Exp3)
forall a b. PassM (a -> b) -> PassM a -> PassM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ty3 -> PassM Ty3
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs (Ty2 -> UrTy Var
unTy2 Ty2
ty)) PassM (Bool -> Exp3) -> PassM Bool -> PassM Exp3
forall a b. PassM (a -> b) -> PassM a -> PassM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> PassM Bool
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b

    WithArenaE Var
v Exp2
e -> do
      Exp3
e' <- DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
ArenaTy) TyEnv Ty2
tenv) SyncEnv
senv Exp2
e
      Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
Var -> PreExp ext loc dec -> PreExp ext loc dec
WithArenaE Var
v Exp3
e'

    SpawnE{} -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error [Char]
"cursorizeExp: Unbound SpawnE"
    SyncE{}  -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error [Char]
"cursorizeExp: Unbound SyncE"

    -- Eg. leftmost
    Ext E2Ext LocArg Ty2
ext ->
      case E2Ext LocArg Ty2
ext of
        AddFixed Var
v Int
i -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3 -> E3Ext () Ty3
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
L3.AddCursor Var
v (Int -> Exp3
forall (ext :: * -> * -> *) loc dec. Int -> PreExp ext loc dec
L3.LitE Int
i)
        RetE [LocArg]
locs Var
v ->
          case [LocArg]
locs of
              [] -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v)
              [LocArg]
_  -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
L3.MkProdE ([Exp3] -> Exp3) -> [Exp3] -> Exp3
forall a b. (a -> b) -> a -> b
$ [Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE (LocArg -> Var
toLocVar LocArg
loc) | LocArg
loc <- [LocArg]
locs] [Exp3] -> [Exp3] -> [Exp3]
forall a. [a] -> [a] -> [a]
++ [Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v]

        StartOfPkdCursor Var
cur -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
cur)

        TagCursor Var
a Var
b -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Var -> E3Ext () Ty3
forall loc dec. Var -> Var -> E3Ext loc dec
L3.TagCursor Var
a Var
b

        -- All locations are transformed into cursors here. Location arithmetic
        -- is expressed in terms of corresponding cursor operations.
        -- See `cursorizeLocExp`
        LetLocE Var
loc PreLocExp LocArg
rhs Exp2
bod -> do
          let rhs_either :: Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv)
rhs_either = DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Var
-> PreLocExp LocArg
-> Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv)
cursorizeLocExp DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Var
loc PreLocExp LocArg
rhs
              ([(Var, [()], Ty3, Exp3)]
bnds,TyEnv Ty2
tenv') = case Var -> DepEnv -> Maybe [(Var, [()], Ty3, Exp3)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
loc DepEnv
denv of
                               Maybe [(Var, [()], Ty3, Exp3)]
Nothing -> ([],TyEnv Ty2
tenv)
                               Just [(Var, [()], Ty3, Exp3)]
vs -> let extended :: TyEnv Ty2
extended = [(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (Var
v,UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) | (Var
v,[()]
_,Ty3
CursorTy,Exp3
_) <- [(Var, [()], Ty3, Exp3)]
vs]
                                          in ([(Var, [()], Ty3, Exp3)]
vs, TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union TyEnv Ty2
extended TyEnv Ty2
tenv)
          case Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv)
rhs_either of
            -- Check if the location is already bound before. If so, don't
            -- create a duplicate binding. This only happens when we
            -- have indirection _and_ a end-witness for a particular value.
            -- For example, consider a pattern like
            --     (Node^ [(ind_y2, loc_ind_y2), (x1, loc_x1), (y2, loc_y2)] BODY)
            --
            -- occuring in a function like sum-tree.
            --
            -- While unpacking this constructor, we bind y2 to ind_y2.
            -- But since sum-tree traverses it's input, we will enconter
            -- (y2 = end_x1) sometime later in the AST (due to RouteEnds).
            -- We just ignore the second binding for now.
            --
            Right (Exp3
rhs', [Binds Exp3]
bnds', TyEnv Ty2
tenv'', SyncEnv
senv') -> do
              let tenv''' :: TyEnv Ty2
tenv''' = TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union TyEnv Ty2
tenv' TyEnv Ty2
tenv''
              case PreLocExp LocArg
rhs of
                FromEndLE{} ->
                  if Var -> TyEnv Ty2 -> Bool
isBound Var
loc TyEnv Ty2
tenv
                  then DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
loc (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv''') SyncEnv
senv' Exp2
bod
                  -- Discharge bindings that were waiting on 'loc'.
                  else [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets ([(Var, [()], Ty3, Exp3)]
[Binds Exp3]
bnds' [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
++ [(Var
loc,[],Ty3
forall loc. UrTy loc
CursorTy,Exp3
rhs')] [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
++ [(Var, [()], Ty3, Exp3)]
bnds) (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
loc (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv''') SyncEnv
senv' Exp2
bod
                -- Discharge bindings that were waiting on 'loc'.
                PreLocExp LocArg
_ -> [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets ([(Var, [()], Ty3, Exp3)]
[Binds Exp3]
bnds' [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
++ [(Var
loc,[],Ty3
forall loc. UrTy loc
CursorTy,Exp3
rhs')] [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
++ [(Var, [()], Ty3, Exp3)]
bnds) (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
loc (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv''') SyncEnv
senv Exp2
bod
            Left DepEnv
denv' -> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv' TyEnv Ty2
tenv' SyncEnv
senv Exp2
bod

        -- Exactly same as cursorizePackedExp
        LetRegionE Region
reg RegionSize
sz Maybe RegionType
_ Exp2
bod -> do
          [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets (Bool -> Region -> RegionSize -> [(Var, [()], Ty3, Exp3)]
regionToBinds Bool
False Region
reg RegionSize
sz) (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp2 -> PassM Exp3
go Exp2
bod

        LetParRegionE Region
reg RegionSize
sz Maybe RegionType
_ Exp2
bod -> do
          [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets (Bool -> Region -> RegionSize -> [(Var, [()], Ty3, Exp3)]
regionToBinds Bool
True Region
reg RegionSize
sz) (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp2 -> PassM Exp3
go Exp2
bod

        BoundsCheck Int
i LocArg
bound LocArg
cur -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Int -> Var -> Var -> E3Ext () Ty3
forall loc dec. Int -> Var -> Var -> E3Ext loc dec
L3.BoundsCheck Int
i (LocArg -> Var
toLocVar LocArg
bound) (LocArg -> Var
toLocVar LocArg
cur)

        FromEndE{} -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"cursorizeExp: TODO FromEndE" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ E2Ext LocArg Ty2 -> [Char]
forall a. Out a => a -> [Char]
sdoc E2Ext LocArg Ty2
ext

        IndirectionE{} -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"cursorizeExp: Unexpected IndirectionE"

        E2Ext LocArg Ty2
GetCilkWorkerNum -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ E3Ext () Ty3
forall loc dec. E3Ext loc dec
L3.GetCilkWorkerNum

        LetAvail [Var]
vs Exp2
bod  -> E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> (Exp3 -> E3Ext () Ty3) -> Exp3 -> Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Var] -> Exp3 -> E3Ext () Ty3
forall loc dec. [Var] -> PreExp E3Ext loc dec -> E3Ext loc dec
L3.LetAvail [Var]
vs (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp2 -> PassM Exp3
go Exp2
bod

        AllocateTagHere Var
v [Char]
tycon -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> [Char] -> E3Ext () Ty3
forall loc dec. Var -> [Char] -> E3Ext loc dec
L3.AllocateTagHere Var
v [Char]
tycon

        AllocateScalarsHere Var
v -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> E3Ext () Ty3
forall loc dec. Var -> E3Ext loc dec
L3.AllocateScalarsHere Var
v

        SSPush SSModality
a Var
b Var
c [Char]
d -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ SSModality -> Var -> Var -> [Char] -> E3Ext () Ty3
forall loc dec. SSModality -> Var -> Var -> [Char] -> E3Ext loc dec
L3.SSPush SSModality
a Var
b Var
c [Char]
d
        SSPop SSModality
a Var
b Var
c -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ SSModality -> Var -> Var -> E3Ext () Ty3
forall loc dec. SSModality -> Var -> Var -> E3Ext loc dec
L3.SSPop SSModality
a Var
b Var
c

    MapE{} -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"TODO: cursorizeExp MapE"
    FoldE{} -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"TODO: cursorizeExp FoldE"

  where
    go :: Exp2 -> PassM Exp3
go = DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv


-- Cursorize expressions producing `Packed` values
cursorizePackedExp :: DDefs Ty2 -> FunDefs2 -> DepEnv -> TyEnv Ty2 -> SyncEnv -> Exp2
                   -> PassM (DiExp Exp3)
cursorizePackedExp :: DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex =
  case Exp2
ex of
    -- Here the allocation has already been performed:
    -- To follow the calling convention, we are reponsible for tagging on the
    -- end here:
    VarE Var
v -> do
      let ty :: Ty2
ty = case Var -> TyEnv Ty2 -> Maybe Ty2
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v TyEnv Ty2
tenv of
                 Just Ty2
t -> Ty2
t
                 Maybe Ty2
Nothing -> [Char] -> Ty2
forall a. HasCallStack => [Char] -> a
error ([Char] -> Ty2) -> [Char] -> Ty2
forall a b. (a -> b) -> a -> b
$ Var -> [Char]
forall a. Out a => a -> [Char]
sdoc Var
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found."
      if UrTy Var -> Bool
forall a. UrTy a -> Bool
isPackedTy (Ty2 -> UrTy Var
unTy2 Ty2
ty)
      then DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiExp Exp3 -> PassM (DiExp Exp3))
-> DiExp Exp3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Exp3 -> [Exp3] -> DiExp Exp3
mkDi (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v) [ Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE (Var -> Var
toEndV Var
v) ]
      else DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiExp Exp3 -> PassM (DiExp Exp3))
-> DiExp Exp3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> DiExp Exp3) -> Exp3 -> DiExp Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v

    LitE Int
_n    -> [Char] -> PassM (DiExp Exp3)
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM (DiExp Exp3)) -> [Char] -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ [Char]
"Shouldn't encounter LitE in packed context:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp2 -> [Char]
forall a. Out a => a -> [Char]
sdoc Exp2
ex
    CharE Char
_n   -> [Char] -> PassM (DiExp Exp3)
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM (DiExp Exp3)) -> [Char] -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ [Char]
"Shouldn't encounter CharE in packed context:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp2 -> [Char]
forall a. Out a => a -> [Char]
sdoc Exp2
ex
    FloatE{}   -> [Char] -> PassM (DiExp Exp3)
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM (DiExp Exp3)) -> [Char] -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ [Char]
"Shouldn't encounter FloatE in packed context:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp2 -> [Char]
forall a. Out a => a -> [Char]
sdoc Exp2
ex
    LitSymE Var
_n -> [Char] -> PassM (DiExp Exp3)
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM (DiExp Exp3)) -> [Char] -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ [Char]
"Shouldn't encounter LitSymE in packed context:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp2 -> [Char]
forall a. Out a => a -> [Char]
sdoc Exp2
ex

    AppE{} -> Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> DiExp Exp3) -> PassM Exp3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeAppE DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex

    -- DictLookup returns a packed value bound to a free location.
    -- PrimAppE (DictLookupP (PackedTy _ ploc)) vs ->
    --     do vs' <- forM vs $ \v -> cursorizeExp ddfs fundefs denv tenv v
    --        return $ mkDi (PrimAppE (DictLookupP CursorTy) vs') [ Ext NullCursor ]

    PrimAppE Prim Ty2
_ [Exp2]
_ -> [Char] -> PassM (DiExp Exp3)
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM (DiExp Exp3)) -> [Char] -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ [Char]
"cursorizePackedExp: unexpected PrimAppE in packed context:" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp2 -> [Char]
forall a. Out a => a -> [Char]
sdoc Exp2
ex

    -- The only (other) primitive that returns packed data is ReadPackedFile:
    -- This is simpler than TimeIt below.  While it's out-of-line,
    -- it doesn't need memory allocation (NewBuffer/ScopedBuffer).
    -- This is more like the witness case below.
    LetE (Var
v,[LocArg]
_locs, Ty2
_ty, (PrimAppE (ReadPackedFile Maybe [Char]
path [Char]
tyc Maybe Var
reg Ty2
ty2) [])) Exp2
bod ->
       Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
Di (Exp3 -> DiExp Exp3) -> PassM Exp3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Bool
-> Var
-> Maybe [Char]
-> [Char]
-> Maybe Var
-> Ty2
-> Exp2
-> PassM Exp3
cursorizeReadPackedFile DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Bool
True Var
v Maybe [Char]
path [Char]
tyc Maybe Var
reg Ty2
ty2 Exp2
bod

    LetE (Var
v,[LocArg]
_locs,Ty2
_ty, (PrimAppE (DictLookupP (MkTy2 (PackedTy [Char]
_ Var
ploc))) [Exp2]
vs)) Exp2
bod ->
        do [Exp3]
vs' <- [Exp2] -> (Exp2 -> PassM Exp3) -> PassM [Exp3]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Exp2]
vs ((Exp2 -> PassM Exp3) -> PassM [Exp3])
-> (Exp2 -> PassM Exp3) -> PassM [Exp3]
forall a b. (a -> b) -> a -> b
$ \Exp2
w -> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
w
           let bnd :: Exp3 -> Exp3
bnd = [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var
ploc, [], Ty3
forall loc. UrTy loc
CursorTy, (Prim Ty3 -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Ty3 -> Prim Ty3
forall ty. ty -> Prim ty
DictLookupP Ty3
forall loc. UrTy loc
CursorTy) [Exp3]
vs'))
                            ,(Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
ploc)]
               tenv' :: TyEnv Ty2
tenv' = Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
ploc (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) (TyEnv Ty2 -> TyEnv Ty2) -> TyEnv Ty2 -> TyEnv Ty2
forall a b. (a -> b) -> a -> b
$ Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv
           (Exp3 -> Exp3) -> DiExp Exp3 -> DiExp Exp3
forall ex. (ex -> ex) -> DiExp ex -> DiExp ex
onDi Exp3 -> Exp3
bnd (DiExp Exp3 -> DiExp Exp3)
-> PassM (DiExp Exp3) -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go TyEnv Ty2
tenv' SyncEnv
senv Exp2
bod

    LetE (Var
_v,[LocArg]
_locs,Ty2
_ty, (MkProdE [Exp2]
_ls)) Exp2
_bod ->
      Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> DiExp Exp3) -> PassM Exp3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeProd Bool
True DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex

    LetE (Var
_v,[LocArg]
_locs,Ty2
ty, ProjE{}) Exp2
_bod | UrTy Var -> Bool
forall a. UrTy a -> Bool
isPackedTy (Ty2 -> UrTy Var
unTy2 Ty2
ty) ->
      Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> DiExp Exp3) -> PassM Exp3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeProj Bool
True DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex


    MkProdE [Exp2]
ls -> do
      let tys :: [Ty2]
tys = (Exp2 -> Ty2) -> [Exp2] -> [Ty2]
forall a b. (a -> b) -> [a] -> [b]
L.map (DDefs (TyOf Exp2) -> Env2 (TyOf Exp2) -> Exp2 -> TyOf Exp2
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf Exp2)
DDefs Ty2
ddfs (TyEnv Ty2 -> TyEnv (ArrowTy Ty2) -> Env2 Ty2
forall a. TyEnv a -> TyEnv (ArrowTy a) -> Env2 a
Env2 TyEnv Ty2
tenv TyEnv (ArrowTy Ty2)
Map Var (ArrowTy2 Ty2)
forall k a. Map k a
M.empty)) [Exp2]
ls
      [Exp3]
es <- [(Ty2, Exp2)] -> ((Ty2, Exp2) -> PassM Exp3) -> PassM [Exp3]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Ty2] -> [Exp2] -> [(Ty2, Exp2)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Ty2]
tys [Exp2]
ls) (((Ty2, Exp2) -> PassM Exp3) -> PassM [Exp3])
-> ((Ty2, Exp2) -> PassM Exp3) -> PassM [Exp3]
forall a b. (a -> b) -> a -> b
$ \(Ty2
ty,Exp2
e) -> do
              case Ty2
ty of
                  Ty2
_ | UrTy Var -> Bool
forall a. UrTy a -> Bool
isPackedTy (Ty2 -> UrTy Var
unTy2 Ty2
ty) -> DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Exp3) -> PassM (DiExp Exp3) -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
e
                  Ty2
_ -> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
e
      let rhs' :: Exp3
rhs' = [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE [Exp3]
es
      DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiExp Exp3 -> PassM (DiExp Exp3))
-> DiExp Exp3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
Di Exp3
rhs'

    -- Not sure if we need to replicate all the checks from Cursorize1
    ProjE Int
i Exp2
e -> Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> DiExp Exp3) -> (Exp3 -> Exp3) -> Exp3 -> DiExp Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
i (Exp3 -> DiExp Exp3)
-> (DiExp Exp3 -> Exp3) -> DiExp Exp3 -> DiExp Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> DiExp Exp3)
-> PassM (DiExp Exp3) -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go TyEnv Ty2
tenv SyncEnv
senv Exp2
e

    LetE (Var
_v,[LocArg]
_locs, Ty2
_ty, SpawnE{}) Exp2
_bod ->
      Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> DiExp Exp3) -> PassM Exp3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeSpawn Bool
True DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex

    LetE (Var
_v,[LocArg]
_locs, Ty2
_ty, Exp2
SyncE) Exp2
_bod ->
      Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> DiExp Exp3) -> PassM Exp3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeSync Bool
True DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex

    LetE (Var
v,[LocArg]
_locs,Ty2
ty, rhs :: Exp2
rhs@(Ext (SSPush SSModality
_ Var
start Var
_ [Char]
_))) Exp2
bod ->
      case Var -> TyEnv Ty2 -> Maybe Ty2
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
start TyEnv Ty2
tenv of
        Maybe Ty2
Nothing -> TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go TyEnv Ty2
tenv SyncEnv
senv Exp2
bod
        Just{}  -> do
          DiExp Exp3
rhs' <- TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go TyEnv Ty2
tenv SyncEnv
senv Exp2
rhs
          let ty' :: Ty3
ty' = UrTy Var -> Ty3
forall a b. UrTy a -> UrTy b
cursorizeTy (Ty2 -> UrTy Var
unTy2 Ty2
ty)
          DiExp Exp3
bod' <- TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v Ty2
ty TyEnv Ty2
tenv) SyncEnv
senv Exp2
bod
          DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiExp Exp3 -> PassM (DiExp Exp3))
-> DiExp Exp3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
Di ((Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
v,[], Ty3
ty', DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi DiExp Exp3
rhs') (DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi DiExp Exp3
bod'))

    LetE (Var
v,[LocArg]
_locs,Ty2
ty, rhs :: Exp2
rhs@(Ext (SSPop SSModality
_ Var
start Var
_))) Exp2
bod ->
      case Var -> TyEnv Ty2 -> Maybe Ty2
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
start TyEnv Ty2
tenv of
        Maybe Ty2
Nothing -> TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go TyEnv Ty2
tenv SyncEnv
senv Exp2
bod
        Just{}  -> do
          DiExp Exp3
rhs' <- TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go TyEnv Ty2
tenv SyncEnv
senv Exp2
rhs
          let ty' :: Ty3
ty' = UrTy Var -> Ty3
forall a b. UrTy a -> UrTy b
cursorizeTy (Ty2 -> UrTy Var
unTy2 Ty2
ty)
          DiExp Exp3
bod' <- TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v Ty2
ty TyEnv Ty2
tenv) SyncEnv
senv Exp2
bod
          DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiExp Exp3 -> PassM (DiExp Exp3))
-> DiExp Exp3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
Di ((Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
v,[],Ty3
ty', DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi DiExp Exp3
rhs') (DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi DiExp Exp3
bod'))

    LetE (Var, [LocArg], Ty2, Exp2)
bnd Exp2
bod -> Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> DiExp Exp3) -> PassM Exp3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> (Var, [LocArg], Ty2, Exp2)
-> Exp2
-> PassM Exp3
cursorizeLet Bool
True DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv (Var, [LocArg], Ty2, Exp2)
bnd Exp2
bod

    -- Here we route the dest cursor to both braches.  We switch
    -- back to the other mode for the (non-packed) test condition.
    IfE Exp2
a Exp2
b Exp2
c -> do
      Di Exp3
b' <- TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go TyEnv Ty2
tenv SyncEnv
senv Exp2
b
      Di Exp3
c' <- TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go TyEnv Ty2
tenv SyncEnv
senv Exp2
c
      Exp3
a'    <- DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
a
      DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiExp Exp3 -> PassM (DiExp Exp3))
-> DiExp Exp3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
Di (Exp3 -> DiExp Exp3) -> Exp3 -> DiExp Exp3
forall a b. (a -> b) -> a -> b
$ 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'

    -- A case expression is eventually transformed into a ReadTag + switch stmt.
    -- We first retrieve the cursor referred to by the scrutinee, and unpack
    -- the first bound variable 1 byte after that cursor. Thats all we need to do
    -- here, because we've already computed other locations in InferLocations and
    -- RouteEnds
    CaseE Exp2
scrt [([Char], [(Var, LocArg)], Exp2)]
brs -> do
      -- ASSUMPTION: scrutinee is always flat
      let (VarE Var
v) = Exp2
scrt
      Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> DiExp Exp3)
-> ([([Char], [(Var, ())], Exp3)] -> Exp3)
-> [([Char], [(Var, ())], Exp3)]
-> DiExp Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Exp3 -> [([Char], [(Var, ())], Exp3)] -> Exp3
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> [([Char], [(Var, loc)], PreExp ext loc dec)]
-> PreExp ext loc dec
CaseE (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE (Var -> Exp3) -> Var -> Exp3
forall a b. (a -> b) -> a -> b
$ Var
v) ([([Char], [(Var, ())], Exp3)] -> DiExp Exp3)
-> PassM [([Char], [(Var, ())], Exp3)] -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          (([Char], [(Var, LocArg)], Exp2)
 -> PassM ([Char], [(Var, ())], Exp3))
-> [([Char], [(Var, LocArg)], Exp2)]
-> PassM [([Char], [(Var, ())], Exp3)]
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 (DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Bool
-> Var
-> ([Char], [(Var, LocArg)], Exp2)
-> PassM ([Char], [(Var, ())], Exp3)
forall t.
DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Bool
-> Var
-> ([Char], [(Var, LocArg)], Exp2)
-> PassM ([Char], [t], Exp3)
unpackDataCon DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Bool
True Var
v) [([Char], [(Var, LocArg)], Exp2)]
brs

    DataConE LocArg
slocarg [Char]
dcon [Exp2]
args -> do
      let sloc :: Var
sloc = LocArg -> Var
toLocVar LocArg
slocarg
          -- Return (start,end) cursors
          -- The final return value lives at the position of the out cursors:
          go2 :: Bool -> Var -> [(Exp2, Ty2)] -> PassM Exp3
          go2 :: Bool -> Var -> [(Exp2, Ty2)] -> PassM Exp3
go2 Bool
marker_added Var
d [] =
            if Bool -> Bool
not (Bool
marker_added)
            then do
              Var
end_scalars_alloc <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"end_scalars_alloc"
              Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
end_scalars_alloc,[],[Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [],E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> E3Ext () Ty3
forall loc dec. Var -> E3Ext loc dec
EndScalarsAllocation Var
sloc)
                           ([Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE [Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
sloc, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
d]))
            else Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE [Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
sloc, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
d])

          go2 Bool
marker_added Var
d ((Exp2
rnd, (MkTy2 UrTy Var
ty)):[(Exp2, Ty2)]
rst) = do
            Var
d' <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"writecur"
            case UrTy Var
ty of
              UrTy Var
_ | UrTy Var -> Bool
forall a. UrTy a -> Bool
isPackedTy UrTy Var
ty -> do

                 DiExp Exp3
rnd' <- TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go TyEnv Ty2
tenv SyncEnv
senv Exp2
rnd
                 Var
end_scalars_alloc <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"end_scalars_alloc"
                 (if Bool -> Bool
not Bool
marker_added
                  then (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
end_scalars_alloc,[],[Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [],E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> E3Ext () Ty3
forall loc dec. Var -> E3Ext loc dec
EndScalarsAllocation Var
sloc)
                  else Exp3 -> Exp3
forall a. a -> a
id) (Exp3 -> Exp3) -> (Exp3 -> Exp3) -> Exp3 -> Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
d',[], Ty3
forall loc. UrTy loc
CursorTy, DiExp Exp3 -> Exp3
projEnds DiExp Exp3
rnd') (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   Bool -> Var -> [(Exp2, Ty2)] -> PassM Exp3
go2 Bool
True Var
d' [(Exp2, Ty2)]
rst

              -- Int, Float, Sym, or Bool
              UrTy Var
_ | UrTy Var -> Bool
forall a. UrTy a -> Bool
isScalarTy UrTy Var
ty -> do
                Exp3
rnd' <- DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
rnd
                (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
d',[], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Scalar -> Var -> Exp3 -> E3Ext () Ty3
forall loc dec.
Scalar -> Var -> PreExp E3Ext loc dec -> E3Ext loc dec
WriteScalar (UrTy Var -> Scalar
forall a. Out a => UrTy a -> Scalar
mkScalar UrTy Var
ty) Var
d Exp3
rnd') (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  Bool -> Var -> [(Exp2, Ty2)] -> PassM Exp3
go2 Bool
marker_added Var
d' [(Exp2, Ty2)]
rst

              -- Write a pointer to a vector
              VectorTy UrTy Var
el_ty -> do
                Exp3
rnd' <- DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
rnd
                (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
d',[], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3 -> Ty3 -> E3Ext () Ty3
forall loc dec. Var -> PreExp E3Ext loc dec -> dec -> E3Ext loc dec
WriteVector Var
d Exp3
rnd' (UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
el_ty)) (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  Bool -> Var -> [(Exp2, Ty2)] -> PassM Exp3
go2 Bool
marker_added Var
d' [(Exp2, Ty2)]
rst

              -- Write a pointer to a vector
              ListTy UrTy Var
el_ty -> do
                Exp3
rnd' <- DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
rnd
                (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
d',[], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3 -> Ty3 -> E3Ext () Ty3
forall loc dec. Var -> PreExp E3Ext loc dec -> dec -> E3Ext loc dec
WriteList Var
d Exp3
rnd' (UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
el_ty)) (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  Bool -> Var -> [(Exp2, Ty2)] -> PassM Exp3
go2 Bool
marker_added Var
d' [(Exp2, Ty2)]
rst

              -- shortcut pointer
              UrTy Var
CursorTy -> do
                Exp3
rnd' <- DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
rnd
                (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
d',[], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3 -> E3Ext () Ty3
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
WriteTaggedCursor Var
d Exp3
rnd') (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  Bool -> Var -> [(Exp2, Ty2)] -> PassM Exp3
go2 Bool
marker_added Var
d' [(Exp2, Ty2)]
rst
              UrTy Var
_ -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown type encounterred while cursorizing DataConE. Type was " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UrTy Var -> [Char]
forall a. Show a => a -> [Char]
show UrTy Var
ty

      Var
writetag <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"writetag"
      Var
after_tag <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"after_tag"
      Var
start_tag_alloc <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"start_tag_alloc"
      Var
end_tag_alloc <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"end_tag_alloc"
      Var
start_scalars_alloc <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"start_scalars_alloc"
      Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> DiExp Exp3) -> (Exp3 -> Exp3) -> Exp3 -> DiExp Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
start_tag_alloc,[],[Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [], E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> E3Ext () Ty3
forall loc dec. Var -> E3Ext loc dec
StartTagAllocation Var
sloc) (Exp3 -> DiExp Exp3) -> (Exp3 -> Exp3) -> Exp3 -> DiExp Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
writetag,[], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ [Char] -> Var -> E3Ext () Ty3
forall loc dec. [Char] -> Var -> E3Ext loc dec
WriteTag [Char]
dcon Var
sloc) (Exp3 -> DiExp Exp3) -> (Exp3 -> Exp3) -> Exp3 -> DiExp Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
end_tag_alloc,[],[Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [], E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> E3Ext () Ty3
forall loc dec. Var -> E3Ext loc dec
EndTagAllocation Var
sloc) (Exp3 -> DiExp Exp3) -> (Exp3 -> Exp3) -> Exp3 -> DiExp Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
start_scalars_alloc,[],[Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [], E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> E3Ext () Ty3
forall loc dec. Var -> E3Ext loc dec
StartScalarsAllocation Var
sloc) (Exp3 -> DiExp Exp3) -> (Exp3 -> Exp3) -> Exp3 -> DiExp Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
after_tag,[], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3 -> E3Ext () Ty3
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
AddCursor Var
sloc (Int -> Exp3
forall (ext :: * -> * -> *) loc dec. Int -> PreExp ext loc dec
L3.LitE Int
1)) (Exp3 -> DiExp Exp3) -> PassM Exp3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          Bool -> Var -> [(Exp2, Ty2)] -> PassM Exp3
go2 Bool
False Var
after_tag ([Exp2] -> [Ty2] -> [(Exp2, Ty2)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Exp2]
args (DDefs Ty2 -> [Char] -> [Ty2]
forall a. Out a => DDefs a -> [Char] -> [a]
lookupDataCon DDefs Ty2
ddfs [Char]
dcon))

    TimeIt Exp2
e Ty2
t Bool
b -> do
      Di Exp3
e' <- TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go TyEnv Ty2
tenv SyncEnv
senv Exp2
e
      DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiExp Exp3 -> PassM (DiExp Exp3))
-> DiExp Exp3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
Di (Exp3 -> DiExp Exp3) -> Exp3 -> DiExp Exp3
forall a b. (a -> b) -> a -> b
$ Exp3 -> Ty3 -> Bool -> Exp3
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> dec -> Bool -> PreExp ext loc dec
TimeIt Exp3
e' (UrTy Var -> Ty3
forall a b. UrTy a -> UrTy b
cursorizeTy (Ty2 -> UrTy Var
unTy2 Ty2
t)) Bool
b

    WithArenaE Var
v Exp2
e -> do
      Di Exp3
e' <- TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
ArenaTy) TyEnv Ty2
tenv) SyncEnv
senv Exp2
e
      DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiExp Exp3 -> PassM (DiExp Exp3))
-> DiExp Exp3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
Di (Exp3 -> DiExp Exp3) -> Exp3 -> DiExp Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
Var -> PreExp ext loc dec -> PreExp ext loc dec
WithArenaE Var
v Exp3
e'

    SpawnE{} -> [Char] -> PassM (DiExp Exp3)
forall a. HasCallStack => [Char] -> a
error [Char]
"cursorizePackedExp: Unbound SpawnE"
    SyncE{}  -> [Char] -> PassM (DiExp Exp3)
forall a. HasCallStack => [Char] -> a
error [Char]
"cursorizePackedExp: Unbound SyncE"

    Ext E2Ext LocArg Ty2
ext ->
      case E2Ext LocArg Ty2
ext of
        -- All locations are transformed into cursors here. Location arithmetic
        -- is expressed in terms of corresponding cursor operations.
        -- See `cursorizeLocExp`
        LetLocE Var
loc PreLocExp LocArg
rhs Exp2
bod -> do
          let rhs_either :: Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv)
rhs_either = DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Var
-> PreLocExp LocArg
-> Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv)
cursorizeLocExp DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Var
loc PreLocExp LocArg
rhs
              ([(Var, [()], Ty3, Exp3)]
bnds,TyEnv Ty2
tenv') = case Var -> DepEnv -> Maybe [(Var, [()], Ty3, Exp3)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
loc DepEnv
denv of
                               Maybe [(Var, [()], Ty3, Exp3)]
Nothing -> ([],TyEnv Ty2
tenv)
                               Just [(Var, [()], Ty3, Exp3)]
vs -> let extended :: TyEnv Ty2
extended = [(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (Var
v, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) | (Var
v,[()]
_,Ty3
CursorTy,Exp3
_) <- [(Var, [()], Ty3, Exp3)]
vs]
                                          in ([(Var, [()], Ty3, Exp3)]
vs, TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union TyEnv Ty2
extended TyEnv Ty2
tenv)
          case Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv)
rhs_either of
            Right (Exp3
rhs', [Binds Exp3]
bnds', TyEnv Ty2
tenv'', SyncEnv
senv') -> do
              let tenv''' :: TyEnv Ty2
tenv''' = TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union TyEnv Ty2
tenv' TyEnv Ty2
tenv''
              case PreLocExp LocArg
rhs of
                FromEndLE{} ->
                  if Var -> TyEnv Ty2 -> Bool
isBound Var
loc TyEnv Ty2
tenv
                  then TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
loc (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv''') SyncEnv
senv' Exp2
bod
                    -- Discharge bindings that were waiting on 'loc'.
                  else (Exp3 -> Exp3) -> DiExp Exp3 -> DiExp Exp3
forall ex. (ex -> ex) -> DiExp ex -> DiExp ex
onDi ([(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets ([(Var, [()], Ty3, Exp3)]
[Binds Exp3]
bnds' [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
++ [(Var
loc,[],Ty3
forall loc. UrTy loc
CursorTy,Exp3
rhs')] [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
++ [(Var, [()], Ty3, Exp3)]
bnds)) (DiExp Exp3 -> DiExp Exp3)
-> PassM (DiExp Exp3) -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
loc (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv') SyncEnv
senv' Exp2
bod
                -- Discharge bindings that were waiting on 'loc'.
                PreLocExp LocArg
_ -> (Exp3 -> Exp3) -> DiExp Exp3 -> DiExp Exp3
forall ex. (ex -> ex) -> DiExp ex -> DiExp ex
onDi ([(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets ([(Var, [()], Ty3, Exp3)]
[Binds Exp3]
bnds' [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
++ [(Var
loc,[],Ty3
forall loc. UrTy loc
CursorTy,Exp3
rhs')] [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
++ [(Var, [()], Ty3, Exp3)]
bnds)) (DiExp Exp3 -> DiExp Exp3)
-> PassM (DiExp Exp3) -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
loc (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv''') SyncEnv
senv' Exp2
bod
            Left DepEnv
denv' -> (Exp3 -> Exp3) -> DiExp Exp3 -> DiExp Exp3
forall ex. (ex -> ex) -> DiExp ex -> DiExp ex
onDi ([(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
bnds) (DiExp Exp3 -> DiExp Exp3)
-> PassM (DiExp Exp3) -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                            DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv' TyEnv Ty2
tenv' SyncEnv
senv Exp2
bod


        StartOfPkdCursor Var
cur -> DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiExp Exp3 -> PassM (DiExp Exp3))
-> DiExp Exp3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> DiExp Exp3) -> Exp3 -> DiExp Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
cur

        TagCursor Var
a Var
b -> DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiExp Exp3 -> PassM (DiExp Exp3))
-> DiExp Exp3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> DiExp Exp3) -> Exp3 -> DiExp Exp3
forall a b. (a -> b) -> a -> b
$ E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Var -> E3Ext () Ty3
forall loc dec. Var -> Var -> E3Ext loc dec
L3.TagCursor Var
a Var
b

        -- ASSUMPTION: RetE forms are inserted at the tail position of functions,
        -- and we safely just return ends-witnesses & ends of the dilated expressions
        RetE [LocArg]
locs Var
v -> do
          DiExp Exp3
v' <- TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go TyEnv Ty2
tenv SyncEnv
senv (Var -> Exp2
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v)
          case [LocArg]
locs of
            []    -> DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return DiExp Exp3
v'
            [LocArg
loc] ->  DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiExp Exp3 -> PassM (DiExp Exp3))
-> DiExp Exp3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Exp3 -> [Exp3] -> DiExp Exp3
mkDi (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE (LocArg -> Var
toLocVar LocArg
loc)) [ DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi DiExp Exp3
v' ]
            [LocArg]
_ -> DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiExp Exp3 -> PassM (DiExp Exp3))
-> DiExp Exp3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
Di (Exp3 -> DiExp Exp3) -> Exp3 -> DiExp Exp3
forall a b. (a -> b) -> a -> b
$ [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
L3.MkProdE ([Exp3] -> Exp3) -> [Exp3] -> Exp3
forall a b. (a -> b) -> a -> b
$ (LocArg -> [Exp3] -> [Exp3]) -> [Exp3] -> [LocArg] -> [Exp3]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr (\LocArg
loc [Exp3]
acc -> (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE (LocArg -> Var
toLocVar LocArg
loc))Exp3 -> [Exp3] -> [Exp3]
forall a. a -> [a] -> [a]
:[Exp3]
acc) [DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi DiExp Exp3
v'] [LocArg]
locs

        LetRegionE Region
r RegionSize
sz Maybe RegionType
_ Exp2
bod -> do
          (Exp3 -> Exp3) -> DiExp Exp3 -> DiExp Exp3
forall ex. (ex -> ex) -> DiExp ex -> DiExp ex
onDi ([(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets (Bool -> Region -> RegionSize -> [(Var, [()], Ty3, Exp3)]
regionToBinds Bool
False Region
r RegionSize
sz)) (DiExp Exp3 -> DiExp Exp3)
-> PassM (DiExp Exp3) -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go TyEnv Ty2
tenv SyncEnv
senv Exp2
bod

        LetParRegionE Region
r RegionSize
sz Maybe RegionType
_ Exp2
bod -> do
          (Exp3 -> Exp3) -> DiExp Exp3 -> DiExp Exp3
forall ex. (ex -> ex) -> DiExp ex -> DiExp ex
onDi ([(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets (Bool -> Region -> RegionSize -> [(Var, [()], Ty3, Exp3)]
regionToBinds Bool
True Region
r RegionSize
sz)) (DiExp Exp3 -> DiExp Exp3)
-> PassM (DiExp Exp3) -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go TyEnv Ty2
tenv SyncEnv
senv Exp2
bod

        FromEndE{} -> [Char] -> PassM (DiExp Exp3)
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM (DiExp Exp3)) -> [Char] -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ [Char]
"cursorizePackedExp: TODO " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ E2Ext LocArg Ty2 -> [Char]
forall a. Out a => a -> [Char]
sdoc E2Ext LocArg Ty2
ext

        BoundsCheck Int
i LocArg
bound LocArg
cur -> DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiExp Exp3 -> PassM (DiExp Exp3))
-> (Exp3 -> DiExp Exp3) -> Exp3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> PassM (DiExp Exp3))
-> (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> PassM (DiExp Exp3))
-> E3Ext () Ty3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Int -> Var -> Var -> E3Ext () Ty3
forall loc dec. Int -> Var -> Var -> E3Ext loc dec
L3.BoundsCheck Int
i (LocArg -> Var
toLocVar LocArg
bound) (LocArg -> Var
toLocVar LocArg
cur)

        IndirectionE [Char]
tycon [Char]
dcon (LocArg
from,LocArg
from_reg) (LocArg
to,LocArg
to_reg) Exp2
_ -> do
          DynFlags
dflags <- PassM DynFlags
forall (m :: * -> *). MonadReader Config m => m DynFlags
getDynFlags
          if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_DisableGC DynFlags
dflags
             -- || (from_reg == "dummy" || to_reg == "dummy") -- HACK!!!
             -- [2022.03.02]: ckoparkar:WTH does this hack enable?
          then TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go TyEnv Ty2
tenv SyncEnv
senv (LocArg -> [Char] -> [Exp2] -> Exp2
forall (ext :: * -> * -> *) loc dec.
loc -> [Char] -> [PreExp ext loc dec] -> PreExp ext loc dec
DataConE LocArg
from [Char]
dcon [Var -> Exp2
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE (LocArg -> Var
toLocVar LocArg
to)])
          else do
            Var
start <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"start"
            Var
end <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"end"
            DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiExp Exp3 -> PassM (DiExp Exp3))
-> DiExp Exp3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
Di (Exp3 -> DiExp Exp3) -> Exp3 -> DiExp Exp3
forall a b. (a -> b) -> a -> b
$
              ([(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var
"_",[],[Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [],E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext ([Char] -> (Var, Var, Var, Var) -> E3Ext () Ty3
forall loc dec. [Char] -> (Var, Var, Var, Var) -> E3Ext loc dec
IndirectionBarrier [Char]
tycon ((LocArg -> Var
toLocVar LocArg
from),(LocArg -> Var
toLocVar LocArg
from_reg),(LocArg -> Var
toLocVar LocArg
to),(LocArg -> Var
toLocVar LocArg
to_reg)))),
                       (Var
start, [], Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE (LocArg -> Var
toLocVar LocArg
from)),
                       (Var
end, [], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3 -> E3Ext () Ty3
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
AddCursor (LocArg -> Var
toLocVar LocArg
from) (Int -> Exp3
forall (ext :: * -> * -> *) loc dec. Int -> PreExp ext loc dec
L3.LitE Int
9))]
                 ([Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE [Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
start, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
end]))

        AddFixed{} -> [Char] -> PassM (DiExp Exp3)
forall a. HasCallStack => [Char] -> a
error [Char]
"cursorizePackedExp: AddFixed not handled."

        E2Ext LocArg Ty2
GetCilkWorkerNum -> DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiExp Exp3 -> PassM (DiExp Exp3))
-> DiExp Exp3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
Di (E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext E3Ext () Ty3
forall loc dec. E3Ext loc dec
L3.GetCilkWorkerNum)

        LetAvail [Var]
vs Exp2
bod  -> do
          (Exp3 -> Exp3) -> DiExp Exp3 -> DiExp Exp3
forall ex. (ex -> ex) -> DiExp ex -> DiExp ex
onDi (E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> (Exp3 -> E3Ext () Ty3) -> Exp3 -> Exp3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Var] -> Exp3 -> E3Ext () Ty3
forall loc dec. [Var] -> PreExp E3Ext loc dec -> E3Ext loc dec
L3.LetAvail [Var]
vs) (DiExp Exp3 -> DiExp Exp3)
-> PassM (DiExp Exp3) -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go TyEnv Ty2
tenv SyncEnv
senv Exp2
bod

        AllocateTagHere Var
v [Char]
tycon -> DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiExp Exp3 -> PassM (DiExp Exp3))
-> (Exp3 -> DiExp Exp3) -> Exp3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> PassM (DiExp Exp3))
-> (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> PassM (DiExp Exp3))
-> E3Ext () Ty3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Var -> [Char] -> E3Ext () Ty3
forall loc dec. Var -> [Char] -> E3Ext loc dec
L3.AllocateTagHere Var
v [Char]
tycon

        AllocateScalarsHere Var
v -> DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiExp Exp3 -> PassM (DiExp Exp3))
-> (Exp3 -> DiExp Exp3) -> Exp3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> PassM (DiExp Exp3))
-> (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> PassM (DiExp Exp3))
-> E3Ext () Ty3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ Var -> E3Ext () Ty3
forall loc dec. Var -> E3Ext loc dec
L3.AllocateScalarsHere Var
v

        SSPush SSModality
a Var
b Var
c [Char]
d -> DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiExp Exp3 -> PassM (DiExp Exp3))
-> (Exp3 -> DiExp Exp3) -> Exp3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> PassM (DiExp Exp3))
-> (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> PassM (DiExp Exp3))
-> E3Ext () Ty3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ SSModality -> Var -> Var -> [Char] -> E3Ext () Ty3
forall loc dec. SSModality -> Var -> Var -> [Char] -> E3Ext loc dec
L3.SSPush SSModality
a Var
b Var
c [Char]
d
        SSPop SSModality
a Var
b Var
c -> DiExp Exp3 -> PassM (DiExp Exp3)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiExp Exp3 -> PassM (DiExp Exp3))
-> (Exp3 -> DiExp Exp3) -> Exp3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
dl (Exp3 -> PassM (DiExp Exp3))
-> (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> PassM (DiExp Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> PassM (DiExp Exp3))
-> E3Ext () Ty3 -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ SSModality -> Var -> Var -> E3Ext () Ty3
forall loc dec. SSModality -> Var -> Var -> E3Ext loc dec
L3.SSPop SSModality
a Var
b Var
c

    MapE{}  -> [Char] -> PassM (DiExp Exp3)
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM (DiExp Exp3)) -> [Char] -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ [Char]
"TODO: cursorizePackedExp MapE"
    FoldE{} -> [Char] -> PassM (DiExp Exp3)
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM (DiExp Exp3)) -> [Char] -> PassM (DiExp Exp3)
forall a b. (a -> b) -> a -> b
$ [Char]
"TODO: cursorizePackedExp FoldE"

  where go :: TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM (DiExp Exp3)
go = DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv
        dl :: ex -> DiExp ex
dl = ex -> DiExp ex
forall {ex}. ex -> DiExp ex
Di


cursorizeReadPackedFile :: DDefs Ty2 -> FunDefs2 -> DepEnv -> TyEnv Ty2 -> SyncEnv -> Bool -> Var
                        -> Maybe FilePath -> TyCon -> Maybe Var -> Ty2 -> Exp2
                        -> PassM Exp3
cursorizeReadPackedFile :: DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Bool
-> Var
-> Maybe [Char]
-> [Char]
-> Maybe Var
-> Ty2
-> Exp2
-> PassM Exp3
cursorizeReadPackedFile DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Bool
isPackedContext Var
v Maybe [Char]
path [Char]
tyc Maybe Var
reg Ty2
ty2 Exp2
bod = do
  case Maybe Var
reg of
    Maybe Var
Nothing -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"cursorizePackedExp: InferLocations did not set the reg for ReadPackedFile."
    Just Var
reg_var ->
      [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [ (Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, Prim Ty3 -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Prim Ty2 -> Prim Ty3
toL3Prim (Prim Ty2 -> Prim Ty3) -> Prim Ty2 -> Prim Ty3
forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> [Char] -> Maybe Var -> Ty2 -> Prim Ty2
forall ty. Maybe [Char] -> [Char] -> Maybe Var -> ty -> Prim ty
ReadPackedFile Maybe [Char]
path [Char]
tyc Maybe Var
reg Ty2
ty2) [])
             , (Var
reg_var, [], Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v)
             , (Var -> Var
toEndV Var
reg_var, [], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext(E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3 -> E3Ext () Ty3
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
AddCursor Var
reg_var (E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> E3Ext () Ty3
forall loc dec. Var -> E3Ext loc dec
MMapFileSize Var
v))] (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
         TyEnv Ty2 -> Exp2 -> PassM Exp3
go (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv) Exp2
bod

  where
    go :: TyEnv Ty2 -> Exp2 -> PassM Exp3
go TyEnv Ty2
t Exp2
e = if Bool
isPackedContext
             then DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Exp3) -> PassM (DiExp Exp3) -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
t SyncEnv
senv Exp2
e
             else DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
t SyncEnv
senv Exp2
e

-- We may sometimes encounter a letloc which uses an unbound location.
--
--     letloc loc_b = loc_a + 1
--
-- i.e `loc_a` may not always be bound. If that's the case, don't process `loc_b`
-- now. Instead, add it to the dependency environment.
cursorizeLocExp :: DepEnv -> TyEnv Ty2 -> SyncEnv -> LocVar -> LocExp -> Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv)
cursorizeLocExp :: DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Var
-> PreLocExp LocArg
-> Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv)
cursorizeLocExp DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Var
lvar PreLocExp LocArg
locExp =
  case PreLocExp LocArg
locExp of
    AfterConstantLE Int
i LocArg
loc ->
      let rhs :: Exp3
rhs = E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3 -> E3Ext () Ty3
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
AddCursor (LocArg -> Var
toLocVar LocArg
loc) (Int -> Exp3
forall (ext :: * -> * -> *) loc dec. Int -> PreExp ext loc dec
LitE Int
i)
      in if Var -> TyEnv Ty2 -> Bool
isBound (LocArg -> Var
toLocVar LocArg
loc) TyEnv Ty2
tenv
         then (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
-> Either
     DepEnv (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
forall a b. b -> Either a b
Right (Exp3
rhs, [], TyEnv Ty2
tenv, SyncEnv
senv)
         else DepEnv -> Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv)
forall a b. a -> Either a b
Left(DepEnv -> Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv))
-> DepEnv -> Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv)
forall a b. (a -> b) -> a -> b
$ ([(Var, [()], Ty3, Exp3)]
 -> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)])
-> Var -> [(Var, [()], Ty3, Exp3)] -> DepEnv -> DepEnv
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
(++) (LocArg -> Var
toLocVar LocArg
loc) [(Var
lvar,[],Ty3
forall loc. UrTy loc
CursorTy,Exp3
rhs)] DepEnv
denv
    -- TODO: handle product types here

{- [2018.03.07]:

Changing it's meaning to just be "after a variable", but not offset from any
particular location. Such an offset requires calculating the size of the variable.
For BigInfinite regions, this is simple:

    size = (endof v) - v

But Infinite regions do not support sizes yet. Re-enable this later.
-}
    AfterVariableLE Var
v LocArg
locarg Bool
was_stolen -> do
      let vty :: Ty2
vty = case Var -> TyEnv Ty2 -> Maybe Ty2
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v TyEnv Ty2
tenv of
                  Just Ty2
ty -> Ty2
ty
                  Maybe Ty2
Nothing -> case Var -> SyncEnv -> Maybe [(Var, [()], Ty3, Ty2, Exp3)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v SyncEnv
senv of
                               Just [(Var, [()], Ty3, Ty2, Exp3)]
pending_bnds ->
                                 let tenv' :: TyEnv Ty2
tenv' = ((Var, [()], Ty3, Ty2, Exp3) -> TyEnv Ty2 -> TyEnv Ty2)
-> TyEnv Ty2 -> [(Var, [()], Ty3, Ty2, Exp3)] -> TyEnv Ty2
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Var
v1,[()]
_,Ty3
_,Ty2
ty2,Exp3
_) TyEnv Ty2
env -> Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v1 Ty2
ty2 TyEnv Ty2
env) TyEnv Ty2
tenv [(Var, [()], Ty3, Ty2, Exp3)]
pending_bnds
                                 in case Var -> TyEnv Ty2 -> Maybe Ty2
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v TyEnv Ty2
tenv' of
                                      Maybe Ty2
Nothing -> [Char] -> Ty2
forall a. HasCallStack => [Char] -> a
error ([Char]
"cursorizeLocExp: AfterVariableLE, undound var: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Var -> [Char]
forall a. Out a => a -> [Char]
sdoc Var
v)
                                      Just Ty2
ty -> Ty2
ty
                               Maybe [(Var, [()], Ty3, Ty2, Exp3)]
Nothing -> [Char] -> Ty2
forall a. HasCallStack => [Char] -> a
error ([Char] -> Ty2) -> [Char] -> Ty2
forall a b. (a -> b) -> a -> b
$ [Char]
"cursorizeLocExp: Var " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Var -> [Char]
forall a. Out a => a -> [Char]
sdoc Var
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found. "
          loc :: Var
loc = LocArg -> Var
toLocVar LocArg
locarg
          bod :: Exp3
bod = case Ty2 -> UrTy Var
unTy2 Ty2
vty of
                  PackedTy{} -> Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE (Var -> Var
toEndV Var
v)
                  UrTy Var
CursorTy   -> Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE (Var -> Var
toEndV Var
v)
{-
                  IntTy -> let sizeVal = LitE (fromJust $ sizeOfTy IntTy)
                               rhs = Ext $ AddCursor loc sizeVal
                           in rhs
                  FloatTy -> let sizeVal = LitE (fromJust $ sizeOfTy FloatTy)
                                 rhs = Ext $ AddCursor loc sizeVal
                             in rhs
                  BoolTy -> let sizeVal = LitE (fromJust $ sizeOfTy BoolTy)
                                rhs = Ext $ AddCursor loc sizeVal
                            in rhs
                  CharTy -> let sizeVal = LitE (fromJust $ sizeOfTy CharTy)
                                rhs = Ext $ AddCursor loc sizeVal
                            in rhs
                  SymTy -> let sizeVal = LitE (fromJust $ sizeOfTy SymTy)
                               rhs = Ext $ AddCursor loc sizeVal
                           in rhs
                  VectorTy elty -> let sizeVal = LitE (fromJust $ sizeOfTy (VectorTy elty))
                                       rhs = Ext $ AddCursor loc sizeVal
                                   in rhs
                  ListTy elty -> let sizeVal = LitE (fromJust $ sizeOfTy (ListTy elty))
                                     rhs = Ext $ AddCursor loc sizeVal
                                 in rhs
-}
                  UrTy Var
oth -> [Char] -> Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> Exp3) -> [Char] -> Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"cursorizeLocExp: AfterVariable TODO " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UrTy Var -> [Char]
forall a. Out a => a -> [Char]
sdoc UrTy Var
oth
      if Var -> TyEnv Ty2 -> Bool
isBound Var
loc TyEnv Ty2
tenv
      then if Bool
was_stolen
           then (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
-> Either
     DepEnv (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
forall a b. b -> Either a b
Right (Exp3
bod, [], TyEnv Ty2
tenv, SyncEnv
senv)
           -- The continuation was not stolen. It's safe to discharge all
           -- pending bindings of this particular variable.
           else do
              case Var -> SyncEnv -> Maybe [(Var, [()], Ty3, Ty2, Exp3)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v SyncEnv
senv of
                Maybe [(Var, [()], Ty3, Ty2, Exp3)]
Nothing -> (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
-> Either
     DepEnv (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
forall a b. b -> Either a b
Right (Exp3
bod, [], TyEnv Ty2
tenv, SyncEnv
senv)
                Just [(Var, [()], Ty3, Ty2, Exp3)]
pending_bnds -> do
                  let tenv' :: TyEnv Ty2
tenv' = ((Var, [()], Ty3, Ty2, Exp3) -> TyEnv Ty2 -> TyEnv Ty2)
-> TyEnv Ty2 -> [(Var, [()], Ty3, Ty2, Exp3)] -> TyEnv Ty2
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Var
v1,[()]
_,Ty3
_,Ty2
ty2,Exp3
_) TyEnv Ty2
env -> Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v1 Ty2
ty2 TyEnv Ty2
env) TyEnv Ty2
tenv [(Var, [()], Ty3, Ty2, Exp3)]
pending_bnds
                      bnds :: [(Var, [()], Ty3, Exp3)]
bnds  = ((Var, [()], Ty3, Ty2, Exp3) -> (Var, [()], Ty3, Exp3))
-> [(Var, [()], Ty3, Ty2, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Var
a,[()]
b,Ty3
c,Ty2
_,Exp3
e) -> (Var
a,[()]
b,Ty3
c,Exp3
e)) [(Var, [()], Ty3, Ty2, Exp3)]
pending_bnds
                  (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
-> Either
     DepEnv (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
forall a b. b -> Either a b
Right (Exp3
bod, [(Var, [()], Ty3, Exp3)]
bnds, TyEnv Ty2
tenv', Var -> SyncEnv -> SyncEnv
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Var
v SyncEnv
senv)
      else DepEnv -> Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv)
forall a b. a -> Either a b
Left (DepEnv -> Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv))
-> DepEnv -> Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv)
forall a b. (a -> b) -> a -> b
$ ([(Var, [()], Ty3, Exp3)]
 -> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)])
-> Var -> [(Var, [()], Ty3, Exp3)] -> DepEnv -> DepEnv
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
(++) Var
loc [(Var
lvar,[],Ty3
forall loc. UrTy loc
CursorTy,Exp3
bod)] DepEnv
denv

    FromEndLE LocArg
locarg ->
                   let loc :: Var
loc = LocArg -> Var
toLocVar LocArg
locarg in
                     if Var -> TyEnv Ty2 -> Bool
isBound Var
loc TyEnv Ty2
tenv
                     then (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
-> Either
     DepEnv (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
forall a b. b -> Either a b
Right (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
loc, [], TyEnv Ty2
tenv, SyncEnv
senv)
                     else DepEnv -> Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv)
forall a b. a -> Either a b
Left(DepEnv -> Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv))
-> DepEnv -> Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv)
forall a b. (a -> b) -> a -> b
$ ([(Var, [()], Ty3, Exp3)]
 -> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)])
-> Var -> [(Var, [()], Ty3, Exp3)] -> DepEnv -> DepEnv
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
(++) Var
loc [(Var
lvar,[],Ty3
forall loc. UrTy loc
CursorTy,Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
loc)] DepEnv
denv
    StartOfRegionLE Region
r   -> case Region
r of
                       GlobR Var
v Multiplicity
_ -> (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
-> Either
     DepEnv (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
forall a b. b -> Either a b
Right (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v, [], TyEnv Ty2
tenv, SyncEnv
senv)
                       VarR Var
v    -> (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
-> Either
     DepEnv (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
forall a b. b -> Either a b
Right (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v, [], TyEnv Ty2
tenv, SyncEnv
senv)
                       DynR Var
v Multiplicity
_  -> (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
-> Either
     DepEnv (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
forall a b. b -> Either a b
Right (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v, [], TyEnv Ty2
tenv, SyncEnv
senv)
                       -- TODO: docs
                       MMapR Var
_v   -> DepEnv
-> Either
     DepEnv (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
forall a b. a -> Either a b
Left DepEnv
denv


    PreLocExp LocArg
FreeLE -> DepEnv
-> Either
     DepEnv (Exp3, [(Var, [()], Ty3, Exp3)], TyEnv Ty2, SyncEnv)
forall a b. a -> Either a b
Left DepEnv
denv -- AUDIT: should we just throw away this information?

    InRegionLE{}  -> [Char] -> Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv))
-> [Char] -> Either DepEnv (Exp3, [Binds Exp3], TyEnv Ty2, SyncEnv)
forall a b. (a -> b) -> a -> b
$ [Char]
"cursorizeExp: TODO InRegionLE"


-- ASSUMPTIONS:
-- (1) `locs` has [in_regions, out_regions, in_locs, out_locs] for the function.
--     But after Cursorize, the calling convention changes so that input
--     locations appear last. Plus, `arg` would supply those. So we can
--     safely drop them from `locs`.
--
-- (2) We update `arg` so that all packed values in it only have start cursors.
cursorizeAppE :: DDefs Ty2 -> FunDefs2 -> DepEnv -> TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM Exp3
cursorizeAppE :: DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeAppE DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex =
  case Exp2
ex of
    AppE Var
f [LocArg]
locs [Exp2]
args -> do
      let fnTy :: ArrowTy (TyOf Exp2)
fnTy   = case Var -> FunDefs Exp2 -> Maybe FunDef2
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
f FunDefs Exp2
fundefs of
                     Just FunDef2
g -> FunDef2 -> ArrowTy (TyOf Exp2)
forall ex. FunDef ex -> ArrowTy (TyOf ex)
funTy FunDef2
g
                     Maybe FunDef2
Nothing -> [Char] -> ArrowTy2 Ty2
forall a. HasCallStack => [Char] -> a
error ([Char] -> ArrowTy2 Ty2) -> [Char] -> ArrowTy2 Ty2
forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown function: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Var -> [Char]
forall a. Out a => a -> [Char]
sdoc Var
f
          in_tys :: [Ty2]
in_tys  = ArrowTy2 Ty2 -> [Ty2]
forall ty2. ArrowTy2 ty2 -> [ty2]
arrIns ArrowTy (TyOf Exp2)
ArrowTy2 Ty2
fnTy
          inLocs :: [Var]
inLocs  = ArrowTy2 Ty2 -> [Var]
forall ty2. ArrowTy2 ty2 -> [Var]
inLocVars ArrowTy (TyOf Exp2)
ArrowTy2 Ty2
fnTy
          numRegs :: Int
numRegs = [Var] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ArrowTy2 Ty2 -> [Var]
forall ty2. ArrowTy2 ty2 -> [Var]
outRegVars ArrowTy (TyOf Exp2)
ArrowTy2 Ty2
fnTy) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Var] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ArrowTy2 Ty2 -> [Var]
forall ty2. ArrowTy2 ty2 -> [Var]
inRegVars ArrowTy (TyOf Exp2)
ArrowTy2 Ty2
fnTy)
          -- Drop input locations, but keep everything else
          outs :: [LocArg]
outs    = (Int -> [LocArg] -> [LocArg]
forall a. Int -> [a] -> [a]
L.take Int
numRegs [LocArg]
locs) [LocArg] -> [LocArg] -> [LocArg]
forall a. [a] -> [a] -> [a]
++  (Int -> [LocArg] -> [LocArg]
forall a. Int -> [a] -> [a]
L.drop Int
numRegs ([LocArg] -> [LocArg]) -> [LocArg] -> [LocArg]
forall a b. (a -> b) -> a -> b
$ Int -> [LocArg] -> [LocArg]
forall a. Int -> [a] -> [a]
L.drop ([Var] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Var]
inLocs) ([LocArg] -> [LocArg]) -> [LocArg] -> [LocArg]
forall a b. (a -> b) -> a -> b
$ [LocArg]
locs)
          argTys :: [Ty2]
argTys  = (Exp2 -> Ty2) -> [Exp2] -> [Ty2]
forall a b. (a -> b) -> [a] -> [b]
map (DDefs (TyOf Exp2) -> Env2 (TyOf Exp2) -> Exp2 -> TyOf Exp2
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf Exp2)
DDefs Ty2
ddfs (TyEnv Ty2 -> TyEnv (ArrowTy Ty2) -> Env2 Ty2
forall a. TyEnv a -> TyEnv (ArrowTy a) -> Env2 a
Env2 TyEnv Ty2
tenv TyEnv (ArrowTy Ty2)
Map Var (ArrowTy2 Ty2)
forall k a. Map k a
M.empty)) [Exp2]
args
      [Exp3]
args' <- ((Ty2, Exp2) -> PassM Exp3) -> [(Ty2, Exp2)] -> PassM [Exp3]
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
                 (\(Ty2
t,Exp2
a) -> if UrTy Var -> Bool
forall a. Show a => UrTy a -> Bool
hasPacked (Ty2 -> UrTy Var
unTy2 Ty2
t)
                            then DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Exp3) -> PassM (DiExp Exp3) -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
a
                            else DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
a)
                 ([Ty2] -> [Exp2] -> [(Ty2, Exp2)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Ty2]
in_tys [Exp2]
args)
      let starts :: [Exp3]
starts = (UrTy Var -> Exp3 -> Exp3) -> [UrTy Var] -> [Exp3] -> [Exp3]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith UrTy Var -> Exp3 -> Exp3
giveStarts ((Ty2 -> UrTy Var) -> [Ty2] -> [UrTy Var]
forall a b. (a -> b) -> [a] -> [b]
map Ty2 -> UrTy Var
unTy2 [Ty2]
argTys) [Exp3]
args'
      let bod :: Exp3
bod = case [LocArg]
locs of
                  [] -> Var -> [()] -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
f [] [Exp3]
starts
                  [LocArg]
_  -> Var -> [()] -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
f [] ([Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE (LocArg -> Var
toLocVar LocArg
loc) | LocArg
loc <- [LocArg]
outs] [Exp3] -> [Exp3] -> [Exp3]
forall a. [a] -> [a] -> [a]
++ [Exp3]
starts)
      Exp3
asserts <- (LocArg -> Exp3 -> PassM Exp3) -> Exp3 -> [LocArg] -> PassM Exp3
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM (\LocArg
loc Exp3
acc ->
                           case LocArg
loc of
                             Loc LREM{Var
lremEndReg :: Var
lremEndReg :: LREM -> Var
lremEndReg,Var
lremLoc :: Var
lremLoc :: LREM -> Var
lremLoc} -> do
                               Var
chk <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"chk"
                               Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$
                                 (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
chk,[],Ty3
forall loc. UrTy loc
BoolTy,Prim Ty3 -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE Prim Ty3
forall ty. Prim ty
LtP [Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
lremLoc, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
lremEndReg]) (Exp3 -> Exp3) -> Exp3 -> Exp3
forall a b. (a -> b) -> a -> b
$
                                 (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
"_",[],[Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [], E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Exp3 -> E3Ext () Ty3
forall loc dec. PreExp E3Ext loc dec -> E3Ext loc dec
Assert (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
chk)) (Exp3 -> Exp3) -> Exp3 -> Exp3
forall a b. (a -> b) -> a -> b
$
                                 Exp3
acc
                             LocArg
_ -> Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp3
acc)
                        Exp3
bod [LocArg]
locs
      DynFlags
dflags <- PassM DynFlags
forall (m :: * -> *). MonadReader Config m => m DynFlags
getDynFlags
      if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_RtsDebug DynFlags
dflags
        then Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp3
asserts
        else Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp3
bod
    Exp2
_ -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"cursorizeAppE: Unexpected " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp2 -> [Char]
forall a. Out a => a -> [Char]
sdoc Exp2
ex

{-

Cursorizing projections
~~~~~~~~~~~~~~~~~~~~~~~

There are two ways in which projections can be cursorized:

    let pakd_tup = projE n something in
    let x        = projE 0 pakd_tup in
    let end_x    = projE 1 pakd_tup

    OR

    let x     = projE 0 (projE n something) in
    let end_x = projE 1 (projE n something)

`cursorizeLet` creates the former, while the special case here outputs the latter.
Reason: unariser can only eliminate direct projections of this form.
-}
cursorizeProj :: Bool -> DDefs Ty2 -> FunDefs2 -> DepEnv -> TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM Exp3
cursorizeProj :: Bool
-> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeProj Bool
isPackedContext DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex =
  case Exp2
ex of
    LetE (Var
v,[LocArg]
_locs,Ty2
ty, rhs :: Exp2
rhs@ProjE{}) Exp2
bod | UrTy Var -> Bool
forall a. UrTy a -> Bool
isPackedTy (Ty2 -> UrTy Var
unTy2 Ty2
ty) -> do
      Exp3
rhs' <- TyEnv Ty2 -> Exp2 -> PassM Exp3
go TyEnv Ty2
tenv Exp2
rhs
      let ty' :: TyOf Exp2
ty'  = DDefs (TyOf Exp2) -> Env2 (TyOf Exp2) -> Exp2 -> TyOf Exp2
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf Exp2)
DDefs Ty2
ddfs (TyEnv Ty2 -> TyEnv (ArrowTy Ty2) -> Env2 Ty2
forall a. TyEnv a -> TyEnv (ArrowTy a) -> Env2 a
Env2 TyEnv Ty2
tenv TyEnv (ArrowTy Ty2)
Map Var (ArrowTy2 Ty2)
forall k a. Map k a
M.empty) Exp2
rhs
          ty'' :: Ty3
ty'' = UrTy Var -> Ty3
forall a b. UrTy a -> UrTy b
cursorizeTy (Ty2 -> UrTy Var
unTy2 TyOf Exp2
Ty2
ty')
          bnds :: [(Var, [()], Ty3, Exp3)]
bnds = if UrTy Var -> Bool
forall a. UrTy a -> Bool
isPackedTy (Ty2 -> UrTy Var
unTy2 TyOf Exp2
Ty2
ty')
                 then [ (Var
v       ,[], Ty3 -> Ty3
forall a. Out a => UrTy a -> UrTy a
projValTy Ty3
ty'' , Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
0 Exp3
rhs')
                      , (Var -> Var
toEndV Var
v,[], Ty3 -> Ty3
forall a. Out a => UrTy a -> UrTy a
projEndsTy Ty3
ty'', Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
1 Exp3
rhs') ]
                 else [(Var
v,[], Ty3
ty'', Exp3
rhs')]
          tenv' :: TyEnv Ty2
tenv' = if UrTy Var -> Bool
forall a. UrTy a -> Bool
isPackedTy (Ty2 -> UrTy Var
unTy2 TyOf Exp2
Ty2
ty')
                  then TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Var
v,TyOf Exp2
Ty2
ty'), (Var -> Var
toEndV Var
v, UrTy Var -> Ty2
MkTy2 (UrTy Var -> UrTy Var
forall a. Out a => UrTy a -> UrTy a
projEndsTy (Ty2 -> UrTy Var
unTy2 TyOf Exp2
Ty2
ty')))]) TyEnv Ty2
tenv
                  else Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v TyOf Exp2
Ty2
ty' TyEnv Ty2
tenv
      Exp3
bod' <- TyEnv Ty2 -> Exp2 -> PassM Exp3
go TyEnv Ty2
tenv' Exp2
bod
      Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
bnds Exp3
bod'

    Exp2
_ -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"cursorizeProj: Unexpected expression: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp2 -> [Char]
forall a. Out a => a -> [Char]
sdoc Exp2
ex

  where
    go :: TyEnv Ty2 -> Exp2 -> PassM Exp3
go TyEnv Ty2
t Exp2
x = if Bool
isPackedContext
             then DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Exp3) -> PassM (DiExp Exp3) -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
t SyncEnv
senv Exp2
x
             else DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
t SyncEnv
senv Exp2
x


{-

Products and projections
~~~~~~~~~~~~~~~~~~~~~~~~

As per the dilated representation, all packed values are (start,end) tuples.
Except fn arguments and pattern matched vars (which are just start cursors).
So instead of using the type from the AST, which will always be `Packed`,
we recover type of RHS in the current type environment using gRecoverType.
If it's just `CursorTy`, this packed value doesn't have an end cursor,
otherwise, the type is `PackedTy{}`, and it also has an end cursor.

-}
cursorizeProd :: Bool -> DDefs Ty2 -> FunDefs2 -> DepEnv -> TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM Exp3
cursorizeProd :: Bool
-> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeProd Bool
isPackedContext DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex =
  case Exp2
ex of
    LetE (Var
v, [LocArg]
_locs, MkTy2 (ProdTy [UrTy Var]
tys), rhs :: Exp2
rhs@(MkProdE [Exp2]
ls)) Exp2
bod -> do
      [Exp3]
es <- [(UrTy Var, Exp2)]
-> ((UrTy Var, Exp2) -> PassM Exp3) -> PassM [Exp3]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([UrTy Var] -> [Exp2] -> [(UrTy Var, Exp2)]
forall a b. [a] -> [b] -> [(a, b)]
zip [UrTy Var]
tys [Exp2]
ls) (((UrTy Var, Exp2) -> PassM Exp3) -> PassM [Exp3])
-> ((UrTy Var, Exp2) -> PassM Exp3) -> PassM [Exp3]
forall a b. (a -> b) -> a -> b
$ \(UrTy Var
ty,Exp2
e) -> do
              case UrTy Var
ty of
                  UrTy Var
_ | UrTy Var -> Bool
forall a. UrTy a -> Bool
isPackedTy UrTy Var
ty -> DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Exp3) -> PassM (DiExp Exp3) -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
e
                  UrTy Var
_ | UrTy Var -> Bool
forall a. Show a => UrTy a -> Bool
hasPacked UrTy Var
ty  -> DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Exp3) -> PassM (DiExp Exp3) -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
e
                  UrTy Var
_ -> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
e
      let rhs' :: Exp3
rhs' = [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE [Exp3]
es
          ty :: TyOf Exp2
ty   = DDefs (TyOf Exp2) -> Env2 (TyOf Exp2) -> Exp2 -> TyOf Exp2
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf Exp2)
DDefs Ty2
ddfs (TyEnv Ty2 -> TyEnv (ArrowTy Ty2) -> Env2 Ty2
forall a. TyEnv a -> TyEnv (ArrowTy a) -> Env2 a
Env2 TyEnv Ty2
tenv TyEnv (ArrowTy Ty2)
Map Var (ArrowTy2 Ty2)
forall k a. Map k a
M.empty) Exp2
rhs
          ty' :: Ty3
ty'  = UrTy Var -> Ty3
forall a b. UrTy a -> UrTy b
cursorizeTy (Ty2 -> UrTy Var
unTy2 TyOf Exp2
Ty2
ty)
          tenv' :: TyEnv Ty2
tenv' = Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v TyOf Exp2
Ty2
ty TyEnv Ty2
tenv
      Exp3
bod' <- TyEnv Ty2 -> Exp2 -> PassM Exp3
go TyEnv Ty2
tenv' Exp2
bod
      Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var
v,[], Ty3
ty', Exp3
rhs')] Exp3
bod'

    Exp2
_ -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"cursorizeProj: Unexpected expression: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp2 -> [Char]
forall a. Out a => a -> [Char]
sdoc Exp2
ex

  where
    go :: TyEnv Ty2 -> Exp2 -> PassM Exp3
go TyEnv Ty2
t Exp2
x = if Bool
isPackedContext
             then DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Exp3) -> PassM (DiExp Exp3) -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
t SyncEnv
senv Exp2
x
             else DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
t SyncEnv
senv Exp2
x


{-

Spawn and sync
~~~~~~~~~~~~~~

This is almost identical to a cursorizeLet case below. Except we bind fewer things
and add fewer things to the type environemnt because we have to wait until the
join point.

-}
cursorizeSpawn :: Bool -> DDefs Ty2 -> FunDefs2 -> DepEnv -> TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM Exp3
cursorizeSpawn :: Bool
-> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeSpawn Bool
isPackedContext DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex = do
  case Exp2
ex of
    LetE (Var
v, [LocArg]
locs, MkTy2 UrTy Var
ty, (SpawnE Var
fn [LocArg]
applocs [Exp2]
args)) Exp2
bod

      | UrTy Var -> Bool
forall a. UrTy a -> Bool
isPackedTy UrTy Var
ty -> do
          Exp3
rhs' <- DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Exp3) -> PassM (DiExp Exp3) -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv (Var -> [LocArg] -> [Exp2] -> Exp2
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
fn [LocArg]
applocs [Exp2]
args)
          let rhs'' :: Exp3
rhs'' = case Exp3
rhs' of
                        AppE Var
fn' [()]
applocs' [Exp3]
args' -> Var -> [()] -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
SpawnE Var
fn' [()]
applocs' [Exp3]
args'
                        Exp3
_ -> [Char] -> Exp3
forall a. HasCallStack => [Char] -> a
error [Char]
"cursorizeSpawn"
          Var
fresh <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"tup_packed"
          let ty' :: UrTy Var
ty' = case [LocArg]
locs of
                      [] -> UrTy Var -> UrTy Var
forall a b. UrTy a -> UrTy b
cursorizeTy UrTy Var
ty
                      [LocArg]
xs -> [UrTy Var] -> UrTy Var
forall loc. [UrTy loc] -> UrTy loc
ProdTy ([UrTy Var
forall loc. UrTy loc
CursorTy | LocArg
_ <- [LocArg]
xs] [UrTy Var] -> [UrTy Var] -> [UrTy Var]
forall a. [a] -> [a] -> [a]
++ [UrTy Var -> UrTy Var
forall a b. UrTy a -> UrTy b
cursorizeTy UrTy Var
ty])
              tenv' :: TyEnv Ty2
tenv' = TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Var
fresh, UrTy Var -> Ty2
MkTy2 UrTy Var
ty')]) TyEnv Ty2
tenv
                      -- L.foldr (\(a,b) acc -> M.insert a b acc) tenv $
                      --   [(v, ty),(fresh, ty'),(toEndV v, projTy 1 ty')] ++ [(loc,CursorTy) | loc <- locs]
              -- TyEnv Ty2 and L3 expresssions are tagged with different types
              ty'' :: Ty3
ty''  = Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
curDict (Ty3 -> Ty3) -> Ty3 -> Ty3
forall a b. (a -> b) -> a -> b
$ UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
ty'
              fresh_rhs :: Exp3
fresh_rhs = Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
fresh
              ([(Var, [()], Ty3, Exp3)]
bnds, [(Var, [()], Ty3, Ty2, Exp3)]
pending_bnds) =
                      case [LocArg]
locs of
                        []    -> ([ (Var
fresh   , [], Ty3
ty''          , Exp3
rhs'' ) ],
                                  [ (Var
v       , [], Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
0 Ty3
ty'', UrTy Var -> Ty2
MkTy2 UrTy Var
ty            , Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
0 Exp3
fresh_rhs)
                                  , (Var -> Var
toEndV Var
v, [], Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
1 Ty3
ty'', UrTy Var -> Ty2
MkTy2 (Int -> UrTy Var -> UrTy Var
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
1 UrTy Var
ty'), Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
1 Exp3
fresh_rhs)])
                        [LocArg]
_ -> let nLocs :: Int
nLocs = [LocArg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LocArg]
locs
                                 locBnds :: [(Var, [()], Ty3, Ty2, Exp3)]
locBnds = [(LocArg -> Var
toLocVar LocArg
loc  ,[], Ty3
forall loc. UrTy loc
CursorTy, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy, Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
n Exp3
fresh_rhs)
                                           | (LocArg
loc,Int
n) <- [LocArg] -> [Int] -> [(LocArg, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LocArg]
locs [Int
0..]]
                                 bnds' :: [(Var, [()], Ty3, Exp3)]
bnds' = [(Var
fresh ,[], Ty3
ty'', Exp3
rhs'') ]
                                 pending_bnds' :: [(Var, [()], Ty3, Ty2, Exp3)]
pending_bnds' = [(Var
v       ,[], Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
0 (Ty3 -> Ty3) -> Ty3 -> Ty3
forall a b. (a -> b) -> a -> b
$ Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
nLocs Ty3
ty'', UrTy Var -> Ty2
MkTy2 UrTy Var
ty,                            Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
0 (Exp3 -> Exp3) -> Exp3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
nLocs Exp3
fresh_rhs)
                                                 ,(Var -> Var
toEndV Var
v,[], Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
1 (Ty3 -> Ty3) -> Ty3 -> Ty3
forall a b. (a -> b) -> a -> b
$ Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
nLocs Ty3
ty'', UrTy Var -> Ty2
MkTy2 (Int -> UrTy Var -> UrTy Var
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
0 (UrTy Var -> UrTy Var) -> UrTy Var -> UrTy Var
forall a b. (a -> b) -> a -> b
$ Int -> UrTy Var -> UrTy Var
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
nLocs UrTy Var
ty'), Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
1 (Exp3 -> Exp3) -> Exp3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
nLocs Exp3
fresh_rhs)]
                                                 [(Var, [()], Ty3, Ty2, Exp3)]
-> [(Var, [()], Ty3, Ty2, Exp3)] -> [(Var, [()], Ty3, Ty2, Exp3)]
forall a. [a] -> [a] -> [a]
++ [(Var, [()], Ty3, Ty2, Exp3)]
locBnds
                             in ([(Var, [()], Ty3, Exp3)]
bnds', [(Var, [()], Ty3, Ty2, Exp3)]
pending_bnds')
          case Var -> DepEnv -> Maybe [(Var, [()], Ty3, Exp3)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Var -> Var
toEndV Var
v) DepEnv
denv of
            Just [(Var, [()], Ty3, Exp3)]
xs -> [Char] -> PassM ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM ()) -> [Char] -> PassM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"cursorizeSpawn todo: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [(Var, [()], Ty3, Exp3)] -> [Char]
forall a. Out a => a -> [Char]
sdoc [(Var, [()], Ty3, Exp3)]
xs
            Maybe [(Var, [()], Ty3, Exp3)]
Nothing -> () -> PassM ()
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          let senv' :: SyncEnv
senv' = Var -> [(Var, [()], Ty3, Ty2, Exp3)] -> SyncEnv -> SyncEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v [(Var, [()], Ty3, Ty2, Exp3)]
pending_bnds SyncEnv
senv
          Exp3
bod'  <- TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM Exp3
go TyEnv Ty2
tenv' SyncEnv
senv' Exp2
bod
          let bod'' :: Exp3
bod'' = [Var] -> [Var] -> Exp3 -> Exp3
updateAvailVars [Var
v] [Var
fresh] Exp3
bod'
          Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
bnds Exp3
bod''

      | UrTy Var -> Bool
forall a. Show a => UrTy a -> Bool
hasPacked UrTy Var
ty -> do
          Exp3
rhs' <- DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Exp3) -> PassM (DiExp Exp3) -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv (Var -> [LocArg] -> [Exp2] -> Exp2
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
fn [LocArg]
applocs [Exp2]
args)
          let rhs'' :: Exp3
rhs'' = case Exp3
rhs' of
                        AppE Var
fn' [()]
applocs' [Exp3]
args' -> Var -> [()] -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
SpawnE Var
fn' [()]
applocs' [Exp3]
args'
                        Exp3
_ -> [Char] -> Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> Exp3) -> [Char] -> Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"cursorizeSpawn: this should've been an AppE. Got" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Exp3 -> [Char]
forall a. Out a => a -> [Char]
sdoc Exp3
rhs'
          Var
fresh <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"tup_haspacked"
          let ty' :: UrTy Any
ty' = case [LocArg]
locs of
                      [] -> UrTy Var -> UrTy Any
forall a b. UrTy a -> UrTy b
cursorizeTy UrTy Var
ty
                      [LocArg]
xs -> [UrTy Any] -> UrTy Any
forall loc. [UrTy loc] -> UrTy loc
ProdTy ([UrTy Any
forall loc. UrTy loc
CursorTy | LocArg
_ <- [LocArg]
xs] [UrTy Any] -> [UrTy Any] -> [UrTy Any]
forall a. [a] -> [a] -> [a]
++ [UrTy Var -> UrTy Any
forall a b. UrTy a -> UrTy b
cursorizeTy UrTy Var
ty])
              ty'' :: Ty3
ty''  = UrTy Any -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Any
ty'
              tenv' :: TyEnv Ty2
tenv' = Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v (UrTy Var -> Ty2
MkTy2 UrTy Var
ty) TyEnv Ty2
tenv
          case [LocArg]
locs of
            [] -> (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
v,[], Ty3
ty'', Exp3
rhs'') (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM Exp3
go TyEnv Ty2
tenv' SyncEnv
senv Exp2
bod
            [LocArg]
_  -> do
              let ([(Var, [()], Ty3, Exp3)]
bnds, [(Var, [()], Ty3, Ty2, Exp3)]
pending_bnds) =
                    ([(Var
fresh, [], Ty3
ty'', Exp3
rhs'')],
                     [(LocArg -> Var
toLocVar LocArg
loc,[],Ty3
forall loc. UrTy loc
CursorTy, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy, Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
n (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
fresh)) | (LocArg
loc,Int
n) <- ([LocArg] -> [Int] -> [(LocArg, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LocArg]
locs [Int
0..])] [(Var, [()], Ty3, Ty2, Exp3)]
-> [(Var, [()], Ty3, Ty2, Exp3)] -> [(Var, [()], Ty3, Ty2, Exp3)]
forall a. [a] -> [a] -> [a]
++
                     [(Var
v           ,[], Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy ([LocArg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LocArg]
locs) Ty3
ty'', UrTy Var -> Ty2
MkTy2 UrTy Var
ty, Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE ([LocArg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LocArg]
locs) (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
fresh))])
                  senv' :: SyncEnv
senv' = Var -> [(Var, [()], Ty3, Ty2, Exp3)] -> SyncEnv -> SyncEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v [(Var, [()], Ty3, Ty2, Exp3)]
pending_bnds SyncEnv
senv
              [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
bnds (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM Exp3
go TyEnv Ty2
tenv' SyncEnv
senv' Exp2
bod

      | Bool
otherwise -> do
          Exp3
rhs' <- DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv (Var -> [LocArg] -> [Exp2] -> Exp2
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
fn [LocArg]
applocs [Exp2]
args)
          let rhs'' :: Exp3
rhs'' = case Exp3
rhs' of
                        AppE Var
fn' [()]
applocs' [Exp3]
args' -> Var -> [()] -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
SpawnE Var
fn' [()]
applocs' [Exp3]
args'
                        Exp3
_ -> [Char] -> Exp3
forall a. HasCallStack => [Char] -> a
error [Char]
"cursorizeSpawn"
          case [LocArg]
locs of
            [] -> (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
v,[],Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
curDict (Ty3 -> Ty3) -> Ty3 -> Ty3
forall a b. (a -> b) -> a -> b
$ UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
ty, Exp3
rhs'') (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM Exp3
go (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v (UrTy Var -> Ty2
MkTy2 UrTy Var
ty) TyEnv Ty2
tenv) SyncEnv
senv Exp2
bod
            [LocArg
loc] -> do
              Var
fresh <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"par_tup_scalar"
              let ty' :: OldTy2
                  ty' :: UrTy Var
ty'  = [UrTy Var] -> UrTy Var
forall loc. [UrTy loc] -> UrTy loc
ProdTy ([UrTy Var
forall loc. UrTy loc
CursorTy | LocArg
_ <- [LocArg]
locs] [UrTy Var] -> [UrTy Var] -> [UrTy Var]
forall a. [a] -> [a] -> [a]
++ [UrTy Var -> UrTy Var
forall a b. UrTy a -> UrTy b
cursorizeTy UrTy Var
ty])
                  tenv' :: TyEnv Ty2
tenv' = TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Var
fresh, UrTy Var -> Ty2
MkTy2 UrTy Var
ty')]) TyEnv Ty2
tenv
                  ty'' :: Ty3
                  ty'' :: Ty3
ty'' = UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
ty'
                  rhs''' :: DiExp Exp3
rhs''' = Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
Di (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
fresh)
                  pending_bnds :: [(Var, [()], Ty3, Ty2, Exp3)]
pending_bnds = [ (LocArg -> Var
toLocVar LocArg
loc ,[] , Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
0 Ty3
ty'', UrTy Var -> Ty2
MkTy2 (Int -> UrTy Var -> UrTy Var
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
0 UrTy Var
ty') , DiExp Exp3 -> Exp3
projVal DiExp Exp3
rhs''')
                                 -- [2022.09.21]: Shouldn't this be projTy 1 ty'?
                                 , (Var
v            ,[] , Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
1 Ty3
ty'', UrTy Var -> Ty2
MkTy2 (Int -> UrTy Var -> UrTy Var
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
1 UrTy Var
ty') , DiExp Exp3 -> Exp3
projEnds DiExp Exp3
rhs''')]
                  senv' :: SyncEnv
senv' = Var -> [(Var, [()], Ty3, Ty2, Exp3)] -> SyncEnv -> SyncEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v [(Var, [()], Ty3, Ty2, Exp3)]
pending_bnds SyncEnv
senv
              Exp3
bod' <- TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM Exp3
go TyEnv Ty2
tenv' SyncEnv
senv' Exp2
bod
              Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var
fresh,[] , Ty3
ty'', Exp3
rhs'')] Exp3
bod'

            [LocArg]
_ -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error [Char]
"TODO: cursorizeSpawn"

    Exp2
_ -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error [Char]
"cursorizeSpawn: Unbound SpawnE"

  where go :: TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM Exp3
go TyEnv Ty2
t SyncEnv
s Exp2
x = if Bool
isPackedContext
                   then DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Exp3) -> PassM (DiExp Exp3) -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
t SyncEnv
s Exp2
x
                   else DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
t SyncEnv
s Exp2
x

cursorizeSync :: Bool -> DDefs Ty2 -> FunDefs2 -> DepEnv -> TyEnv Ty2 -> SyncEnv -> Exp2 -> PassM Exp3
cursorizeSync :: Bool
-> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeSync Bool
isPackedContext DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
ex = do
  case Exp2
ex of
    LetE (Var
v, [LocArg]
_locs, MkTy2 UrTy Var
ty, Exp2
SyncE) Exp2
bod -> do
      let pending_bnds :: [(Var, [()], Ty3, Ty2, Exp3)]
pending_bnds = [[(Var, [()], Ty3, Ty2, Exp3)]] -> [(Var, [()], Ty3, Ty2, Exp3)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (SyncEnv -> [[(Var, [()], Ty3, Ty2, Exp3)]]
forall k a. Map k a -> [a]
M.elems SyncEnv
senv)
          tenv' :: TyEnv Ty2
tenv' = ((Var, [()], Ty3, Ty2, Exp3) -> TyEnv Ty2 -> TyEnv Ty2)
-> TyEnv Ty2 -> [(Var, [()], Ty3, Ty2, Exp3)] -> TyEnv Ty2
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Var
v1,[()]
_,Ty3
_,Ty2
ty2,Exp3
_) TyEnv Ty2
env -> Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v1 Ty2
ty2 TyEnv Ty2
env) TyEnv Ty2
tenv [(Var, [()], Ty3, Ty2, Exp3)]
pending_bnds
          -- Discharge bindings that depending on the join point.
          bnds :: [(Var, [()], Ty3, Exp3)]
bnds  = ((Var, [()], Ty3, Ty2, Exp3) -> (Var, [()], Ty3, Exp3))
-> [(Var, [()], Ty3, Ty2, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Var
a,[()]
b,Ty3
c,Ty2
_,Exp3
e) -> (Var
a,[()]
b,Ty3
c,Exp3
e)) [(Var, [()], Ty3, Ty2, Exp3)]
pending_bnds
          bnds' :: [(Var, [()], Ty3, Exp3)]
bnds' = (Var
v,[],UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
ty, Exp3
forall (ext :: * -> * -> *) loc dec. PreExp ext loc dec
SyncE) (Var, [()], Ty3, Exp3)
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. a -> [a] -> [a]
: [(Var, [()], Ty3, Exp3)]
bnds
      Exp3
bod' <- TyEnv Ty2 -> Exp2 -> PassM Exp3
go TyEnv Ty2
tenv' Exp2
bod
      Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
bnds' Exp3
bod'
    Exp2
_ -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error [Char]
"cursorizeSpawn: Unbound SyncE"
  where go :: TyEnv Ty2 -> Exp2 -> PassM Exp3
go TyEnv Ty2
t Exp2
x = if Bool
isPackedContext
                 then DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Exp3) -> PassM (DiExp Exp3) -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
t SyncEnv
forall k a. Map k a
M.empty Exp2
x
                 else DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
t SyncEnv
forall k a. Map k a
M.empty Exp2
x


{-

Cursorizing let expressions
~~~~~~~~~~~~~~~~~~~~~~~~~~~

Process RHS and bind the following cursors

     v     -> start_write
     end_v -> end_write
     loc   -> end_read     (only if it's available)

An expression returning packed value can either be a `DataConE` or a `AppE`.
DataConE returns a (start_write,end_write) tuple whereas
AppE returns (end_read,end_write).

So we cannot always rely on the RHS to return a start_write cursor.
But since the types of all packed expressions are already annotated with locations,
we can take a shortcut here and directly bind `v` to the tagged location.

Other bindings are straightforward projections of the processed RHS.

-}
cursorizeLet :: Bool -> DDefs Ty2 -> FunDefs2 -> DepEnv -> TyEnv Ty2 -> SyncEnv
             -> (Var, [LocArg], Ty2, Exp2) -> Exp2 -> PassM Exp3
cursorizeLet :: Bool
-> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> (Var, [LocArg], Ty2, Exp2)
-> Exp2
-> PassM Exp3
cursorizeLet Bool
isPackedContext DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv (Var
v,[LocArg]
locs,(MkTy2 UrTy Var
ty),Exp2
rhs) Exp2
bod
    | UrTy Var -> Bool
forall a. UrTy a -> Bool
isPackedTy UrTy Var
ty = do
        Exp3
rhs' <- DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Exp3) -> PassM (DiExp Exp3) -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
rhs
        Var
fresh <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"tup_packed"
        let ty' :: UrTy Var
ty' = case [LocArg]
locs of
                    [] -> UrTy Var -> UrTy Var
forall a b. UrTy a -> UrTy b
cursorizeTy UrTy Var
ty
                    [LocArg]
xs -> [UrTy Var] -> UrTy Var
forall loc. [UrTy loc] -> UrTy loc
ProdTy ([UrTy Var
forall loc. UrTy loc
CursorTy | LocArg
_ <- [LocArg]
xs] [UrTy Var] -> [UrTy Var] -> [UrTy Var]
forall a. [a] -> [a] -> [a]
++ [UrTy Var -> UrTy Var
forall a b. UrTy a -> UrTy b
cursorizeTy UrTy Var
ty])

            tenv' :: TyEnv Ty2
tenv' = ((Var, Ty2) -> TyEnv Ty2 -> TyEnv Ty2)
-> TyEnv Ty2 -> [(Var, Ty2)] -> TyEnv Ty2
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr (\(Var
a,Ty2
b) TyEnv Ty2
acc -> Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
a Ty2
b TyEnv Ty2
acc) TyEnv Ty2
tenv ([(Var, Ty2)] -> TyEnv Ty2) -> [(Var, Ty2)] -> TyEnv Ty2
forall a b. (a -> b) -> a -> b
$
                      [(Var
v, UrTy Var -> Ty2
MkTy2 UrTy Var
ty),(Var
fresh, UrTy Var -> Ty2
MkTy2 UrTy Var
ty'),(Var -> Var
toEndV Var
v, UrTy Var -> Ty2
MkTy2 (Int -> UrTy Var -> UrTy Var
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
1 UrTy Var
ty'))] [(Var, Ty2)] -> [(Var, Ty2)] -> [(Var, Ty2)]
forall a. [a] -> [a] -> [a]
++
                      [(LocArg -> Var
toLocVar LocArg
loc,UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) | LocArg
loc <- [LocArg]
locs]

            -- TyEnv Ty2 and L3 expresssions are tagged with different types
            ty'' :: Ty3
ty''  = Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
curDict (Ty3 -> Ty3) -> Ty3 -> Ty3
forall a b. (a -> b) -> a -> b
$ UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
ty'
            rhs'' :: Exp3
rhs'' = Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
fresh

            bnds :: [(Var, [()], Ty3, Exp3)]
bnds = case [LocArg]
locs of
                      []    -> [ (Var
fresh   , [], Ty3
ty''          , Exp3
rhs' )
                               , (Var
v       , [], Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
0 Ty3
ty'' , Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
0 Exp3
rhs'')
                               , (Var -> Var
toEndV Var
v, [], Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
1 Ty3
ty'' , Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
1 Exp3
rhs'')]

                      [LocArg]
_ -> let nLocs :: Int
nLocs = [LocArg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LocArg]
locs
                               locBnds :: [(Var, [()], Ty3, Exp3)]
locBnds = [(LocArg -> Var
toLocVar LocArg
loc  ,[], Ty3
forall loc. UrTy loc
CursorTy, Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
n Exp3
rhs'')
                                         | (LocArg
loc,Int
n) <- [LocArg] -> [Int] -> [(LocArg, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LocArg]
locs [Int
0..]]
                               bnds' :: [(Var, [()], Ty3, Exp3)]
bnds' = [(Var
fresh   ,[], Ty3
ty''                         , Exp3
rhs')
                                       ,(Var
v       ,[], Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
0 (Ty3 -> Ty3) -> Ty3 -> Ty3
forall a b. (a -> b) -> a -> b
$ Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
nLocs Ty3
ty'' , Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
0 (Exp3 -> Exp3) -> Exp3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
nLocs Exp3
rhs'')
                                       ,(Var -> Var
toEndV Var
v,[], Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
1 (Ty3 -> Ty3) -> Ty3 -> Ty3
forall a b. (a -> b) -> a -> b
$ Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
nLocs Ty3
ty'' , Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
1 (Exp3 -> Exp3) -> Exp3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
nLocs Exp3
rhs'')]
                           in [(Var, [()], Ty3, Exp3)]
bnds' [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
++ [(Var, [()], Ty3, Exp3)]
locBnds
        case Var -> DepEnv -> Maybe [(Var, [()], Ty3, Exp3)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Var -> Var
toEndV Var
v) DepEnv
denv of
          Just [(Var, [()], Ty3, Exp3)]
xs -> [Char] -> PassM ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM ()) -> [Char] -> PassM ()
forall a b. (a -> b) -> a -> b
$ [Char]
"todo: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [(Var, [()], Ty3, Exp3)] -> [Char]
forall a. Out a => a -> [Char]
sdoc [(Var, [()], Ty3, Exp3)]
xs
          Maybe [(Var, [()], Ty3, Exp3)]
Nothing -> () -> PassM ()
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Exp3
bod' <- TyEnv Ty2 -> Exp2 -> PassM Exp3
go TyEnv Ty2
tenv' Exp2
bod
        Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
bnds Exp3
bod'

    | UrTy Var -> Bool
forall a. Show a => UrTy a -> Bool
hasPacked UrTy Var
ty = do
        Exp3
rhs' <- DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Exp3) -> PassM (DiExp Exp3) -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
rhs
        Var
fresh <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"tup_haspacked"
        let ty' :: UrTy Any
ty' = case [LocArg]
locs of
                    [] -> UrTy Var -> UrTy Any
forall a b. UrTy a -> UrTy b
cursorizeTy UrTy Var
ty
                    [LocArg]
xs -> [UrTy Any] -> UrTy Any
forall loc. [UrTy loc] -> UrTy loc
ProdTy ([UrTy Any
forall loc. UrTy loc
CursorTy | LocArg
_ <- [LocArg]
xs] [UrTy Any] -> [UrTy Any] -> [UrTy Any]
forall a. [a] -> [a] -> [a]
++ [UrTy Var -> UrTy Any
forall a b. UrTy a -> UrTy b
cursorizeTy UrTy Var
ty])
            ty'' :: Ty3
ty''  = UrTy Any -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Any
ty'
            tenv' :: TyEnv Ty2
tenv' = TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v (UrTy Var -> Ty2
MkTy2 UrTy Var
ty) TyEnv Ty2
tenv) ([(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(LocArg -> Var
toLocVar LocArg
loc,UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) | LocArg
loc <- [LocArg]
locs])
        case [LocArg]
locs of
          [] -> (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
v,[], Ty3
ty'', Exp3
rhs') (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  TyEnv Ty2 -> Exp2 -> PassM Exp3
go TyEnv Ty2
tenv' Exp2
bod
          [LocArg]
_  -> do
            let tenv'' :: TyEnv Ty2
tenv'' =  TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union TyEnv Ty2
tenv' (TyEnv Ty2 -> TyEnv Ty2) -> TyEnv Ty2 -> TyEnv Ty2
forall a b. (a -> b) -> a -> b
$
                          [(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(LocArg -> Var
toLocVar LocArg
loc, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) | LocArg
loc <- [LocArg]
locs]

                bnds :: [(Var, [()], Ty3, Exp3)]
bnds  = [(Var
fresh, [], Ty3
ty'', Exp3
rhs')] [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
++
                        [(LocArg -> Var
toLocVar LocArg
loc,[],Ty3
forall loc. UrTy loc
CursorTy, Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
n (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
fresh)) | (LocArg
loc,Int
n) <- ([LocArg] -> [Int] -> [(LocArg, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LocArg]
locs [Int
0..])]
                        [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
++ [(Var
v,[], Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy ([LocArg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LocArg]
locs) Ty3
ty'', Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE ([LocArg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LocArg]
locs) (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
fresh))]
            [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
bnds (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyEnv Ty2 -> Exp2 -> PassM Exp3
go TyEnv Ty2
tenv'' Exp2
bod

  {-

This was a scalar binding before, but now has been transformed to
also return an end_read cursor. So the type of the binding now
becomes:

    ProdTy [CursorTy, old_ty]

Also, the binding itself now changes to:

    end_read -> ProjE 0 RHS'
    v        -> ProjE 1 RHS'

`rightmost` is an example of a program that does this.

-}

    | Bool
otherwise = do
        Exp3
rhs' <- DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
tenv SyncEnv
senv Exp2
rhs
        case [LocArg]
locs of
            [] -> (Var, [()], Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
v,[],Ty3 -> Ty3
forall loc. UrTy loc -> UrTy loc
curDict (Ty3 -> Ty3) -> Ty3 -> Ty3
forall a b. (a -> b) -> a -> b
$ UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
ty, Exp3
rhs') (Exp3 -> Exp3) -> PassM Exp3 -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    TyEnv Ty2 -> Exp2 -> PassM Exp3
go (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v (UrTy Var -> Ty2
MkTy2 UrTy Var
ty) TyEnv Ty2
tenv) Exp2
bod
            [LocArg]
_ -> do
              Var
fresh <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"tup_scalar"
              let rhs'' :: Exp3
rhs'' = Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
fresh
                  ty' :: UrTy Any
ty'  = [UrTy Any] -> UrTy Any
forall loc. [UrTy loc] -> UrTy loc
ProdTy ([UrTy Any
forall loc. UrTy loc
CursorTy | LocArg
_ <- [LocArg]
locs] [UrTy Any] -> [UrTy Any] -> [UrTy Any]
forall a. [a] -> [a] -> [a]
++ [UrTy Var -> UrTy Any
forall a b. UrTy a -> UrTy b
cursorizeTy UrTy Var
ty])
                  -- We cannot resuse ty' here because TyEnv Ty2 and expresssions are
                  -- tagged with different
                  ty'' :: Ty3
ty'' = UrTy Any -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Any
ty'
                  tenv' :: TyEnv Ty2
tenv' =  TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v (UrTy Var -> Ty2
MkTy2 UrTy Var
ty) TyEnv Ty2
tenv) (TyEnv Ty2 -> TyEnv Ty2) -> TyEnv Ty2 -> TyEnv Ty2
forall a b. (a -> b) -> a -> b
$
                           [(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(LocArg -> Var
toLocVar LocArg
loc,UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) | LocArg
loc <- [LocArg]
locs]
                  bnds :: [(Var, [()], Ty3, Exp3)]
bnds  = [ (Var
fresh, [] , Ty3
ty''          , Exp3
rhs') ] [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
++
                          [ (LocArg -> Var
toLocVar LocArg
loc,[],Ty3
forall loc. UrTy loc
CursorTy, Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
n Exp3
rhs'') | (LocArg
loc,Int
n) <- ([LocArg] -> [Int] -> [(LocArg, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LocArg]
locs [Int
0..]) ] [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
++
                          [ (Var
v,[], Int -> Ty3 -> Ty3
forall a. Out a => Int -> UrTy a -> UrTy a
projTy ([LocArg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LocArg]
locs) Ty3
ty'', Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE ([LocArg] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LocArg]
locs) Exp3
rhs'') ]
              Exp3
bod' <- TyEnv Ty2 -> Exp2 -> PassM Exp3
go TyEnv Ty2
tenv' Exp2
bod
              Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
bnds Exp3
bod'

  where go :: TyEnv Ty2 -> Exp2 -> PassM Exp3
go TyEnv Ty2
t Exp2
x = if Bool
isPackedContext
                 then DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Exp3) -> PassM (DiExp Exp3) -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
t SyncEnv
senv Exp2
x
                 else DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
t SyncEnv
senv Exp2
x

{-

Unpacking constructors
~~~~~~~~~~~~~~~~~~~~~~

(1) Take a cursor pointing to the start of the tag, and advance it by 1 byte.
(2) If this DataCon has random access nodes, unpack those.
(3) If the first bound varaible is a scalar (IntTy), read it using the newly
returned cursor. Otherwise, just process the body. it'll have the correct
instructions to process other bound locations

Consider an example of unpacking of a Node^ pattern:

    (Node^ [(ind_y3, loc_ind_y3), (n1, loc_n1) , (x2 , loc_x2), (y3 , loc_y3)]
      BODY)

..TODO..

-}
unpackDataCon :: DDefs Ty2 -> FunDefs2 -> DepEnv -> TyEnv Ty2 -> SyncEnv -> Bool -> Var
              -> (DataCon, [(Var, LocArg)], Exp2) -> PassM (DataCon, [t], Exp3)
unpackDataCon :: forall t.
DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Bool
-> Var
-> ([Char], [(Var, LocArg)], Exp2)
-> PassM ([Char], [t], Exp3)
unpackDataCon DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv1 TyEnv Ty2
tenv1 SyncEnv
senv Bool
isPacked Var
scrtCur ([Char]
dcon,[(Var, LocArg)]
vlocs1,Exp2
rhs) = do
  Var
field_cur <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"field_cur"

  ([Char]
dcon, [],)
    -- Advance the cursor by 1 byte so that it points to the first field
    (Exp3 -> ([Char], [t], Exp3))
-> (Exp3 -> Exp3) -> Exp3 -> ([Char], [t], Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var
field_cur,[],Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3 -> E3Ext () Ty3
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
AddCursor Var
scrtCur (Int -> Exp3
forall (ext :: * -> * -> *) loc dec. Int -> PreExp ext loc dec
LitE Int
1))]
    (Exp3 -> ([Char], [t], Exp3))
-> PassM Exp3 -> PassM ([Char], [t], Exp3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (if [Char] -> Bool
isAbsRANDataCon [Char]
dcon
         then Var -> PassM Exp3
unpackWithAbsRAN Var
field_cur
         else if [Char] -> Bool
isRelRANDataCon [Char]
dcon
         then Var -> PassM Exp3
unpackWithRelRAN Var
field_cur
         else Var -> PassM Exp3
unpackRegularDataCon Var
field_cur)

  where
    tys1 :: [Ty2]
tys1 = DDefs Ty2 -> [Char] -> [Ty2]
forall a. Out a => DDefs a -> [Char] -> [a]
lookupDataCon DDefs Ty2
ddfs [Char]
dcon
    processRhs :: DepEnv -> TyEnv Ty2 -> PassM Exp3
processRhs DepEnv
denv TyEnv Ty2
env = if Bool
isPacked
                          then DiExp Exp3 -> Exp3
forall ex. DiExp ex -> ex
fromDi (DiExp Exp3 -> Exp3) -> PassM (DiExp Exp3) -> PassM Exp3
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM (DiExp Exp3)
cursorizePackedExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
env SyncEnv
senv Exp2
rhs
                          else DDefs Ty2
-> FunDefs Exp2
-> DepEnv
-> TyEnv Ty2
-> SyncEnv
-> Exp2
-> PassM Exp3
cursorizeExp DDefs Ty2
ddfs FunDefs Exp2
fundefs DepEnv
denv TyEnv Ty2
env SyncEnv
senv Exp2
rhs

    -- Since this constructor does not have random access nodes, we may not be able
    -- to unpack all the fields. Basically, anything after the first packed
    -- value isn't accessible since we have no way to reach it without knowing
    -- the end of the packed value. So we punt on creating bindings for such
    -- variables, and add them to the dependency environment instead. Later, when
    -- the appropriate end locations become available (see the LetLocE cases),
    -- these bindings are discharged from the dependency environment.
    --
    -- We recurse over the fields in `go`, and create bindings as long as we `canBind`.
    -- Otherwise, we add things to the dependency environment. `canBind` is set
    -- to true initially, and we flip it as soon as we see a packed value.
    --
    unpackRegularDataCon :: Var -> PassM Exp3
    unpackRegularDataCon :: Var -> PassM Exp3
unpackRegularDataCon Var
field_cur = Var
-> [(Var, LocArg)]
-> [Ty2]
-> Bool
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go Var
field_cur [(Var, LocArg)]
vlocs1 [Ty2]
tys1 Bool
True DepEnv
denv1 (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
field_cur (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv1)
      where
        go :: Var -> [(Var, LocArg)] -> [Ty2] -> Bool -> DepEnv -> TyEnv Ty2 -> PassM Exp3
        go :: Var
-> [(Var, LocArg)]
-> [Ty2]
-> Bool
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go Var
cur [(Var, LocArg)]
vlocs [Ty2]
tys Bool
canBind DepEnv
denv TyEnv Ty2
tenv =
          case ([(Var, LocArg)]
vlocs, [Ty2]
tys) of
            ([],[]) -> DepEnv -> TyEnv Ty2 -> PassM Exp3
processRhs DepEnv
denv TyEnv Ty2
tenv
            ((Var
v,LocArg
locarg):[(Var, LocArg)]
rst_vlocs, (MkTy2 UrTy Var
ty):[Ty2]
rst_tys) ->
              let loc :: Var
loc = LocArg -> Var
toLocVar LocArg
locarg in
              case UrTy Var
ty of
                -- Int, Float, Sym, or Bool
                UrTy Var
_ | UrTy Var -> Bool
forall a. UrTy a -> Bool
isScalarTy UrTy Var
ty -> do
                  (TyEnv Ty2
tenv', [(Var, [()], Ty3, Exp3)]
binds) <- UrTy Var
-> Var
-> Var
-> TyEnv Ty2
-> PassM (TyEnv Ty2, [(Var, [()], Ty3, Exp3)])
scalarBinds UrTy Var
ty Var
v Var
loc TyEnv Ty2
tenv
                  if Bool
canBind
                  then do
                    -- If the location exists in the environment, it indicates that the
                    -- corresponding variable was also bound and we shouldn't create duplicate
                    -- bindings (checked in the LetLocE cases).
                    let binds' :: [(Var, [()], Ty3, Exp3)]
binds' = (Var
loc,[],Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
cur)(Var, [()], Ty3, Exp3)
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. a -> [a] -> [a]
:[(Var, [()], Ty3, Exp3)]
binds
                        tenv'' :: TyEnv Ty2
tenv'' = Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
loc (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv'
                    Exp3
bod <- Var
-> [(Var, LocArg)]
-> [Ty2]
-> Bool
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go (Var -> Var
toEndV Var
v) [(Var, LocArg)]
rst_vlocs [Ty2]
rst_tys Bool
canBind DepEnv
denv TyEnv Ty2
tenv''
                    Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
binds' Exp3
bod
                  else do
                    -- Cannot read this int. Instead, we add it to DepEnv.
                    let denv' :: DepEnv
denv' = ([(Var, [()], Ty3, Exp3)]
 -> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)])
-> Var -> [(Var, [()], Ty3, Exp3)] -> DepEnv -> DepEnv
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
(++) Var
loc [(Var, [()], Ty3, Exp3)]
binds DepEnv
denv
                    Var
-> [(Var, LocArg)]
-> [Ty2]
-> Bool
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go (Var -> Var
toEndV Var
v) [(Var, LocArg)]
rst_vlocs [Ty2]
rst_tys Bool
canBind DepEnv
denv' TyEnv Ty2
tenv'

                -- An indirection or redirection pointer.
                -- ASSUMPTION: We can always bind it, since it occurs immediately after the tag.
                UrTy Var
CursorTy -> do
                  Var
tmp <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"readcursor_indir"
                  let tenv' :: TyEnv Ty2
tenv' = TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Var
tmp     , UrTy Var -> Ty2
MkTy2 ([UrTy Var] -> UrTy Var
forall loc. [UrTy loc] -> UrTy loc
ProdTy [UrTy Var
forall loc. UrTy loc
CursorTy, UrTy Var
forall loc. UrTy loc
CursorTy, UrTy Var
forall loc. UrTy loc
IntTy])),
                                                   (Var
loc     , UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy),
                                                   (Var
v       , UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy),
                                                   (Var -> Var
toEndV Var
v, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy),
                                                   (Var -> Var
toTagV Var
v, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
IntTy),
                                                   (Var -> Var
toEndFromTaggedV Var
v, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy)])
                              TyEnv Ty2
tenv
                      read_cursor :: Exp3
read_cursor = if [Char] -> Bool
isIndirectionTag [Char]
dcon Bool -> Bool -> Bool
|| [Char] -> Bool
isRedirectionTag [Char]
dcon
                                    then E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Var -> E3Ext () Ty3
forall loc dec. Var -> E3Ext loc dec
ReadTaggedCursor Var
cur)
                                    else [Char] -> Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> Exp3) -> [Char] -> Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"unpackRegularDataCon: cursorty without indirection/redirection."
                      binds :: [(Var, [()], Ty3, Exp3)]
binds = [(Var
tmp     , [], [Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Ty3
forall loc. UrTy loc
CursorTy, Ty3
forall loc. UrTy loc
CursorTy, Ty3
forall loc. UrTy loc
IntTy], Exp3
read_cursor),
                               (Var
loc     , [], Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
cur),
                               (Var
v       , [], Ty3
forall loc. UrTy loc
CursorTy, Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
0 (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tmp)),
                               (Var -> Var
toEndV Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
1 (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tmp)),
                               (Var -> Var
toTagV Var
v, [], Ty3
forall loc. UrTy loc
IntTy   , Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
2 (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tmp)),
                               (Var -> Var
toEndFromTaggedV Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3 -> E3Ext () Ty3
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
AddCursor Var
v (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE (Var -> Var
toTagV Var
v)))]
                  Exp3
bod <- Var
-> [(Var, LocArg)]
-> [Ty2]
-> Bool
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go (Var -> Var
toEndV Var
v) [(Var, LocArg)]
rst_vlocs [Ty2]
rst_tys Bool
canBind DepEnv
denv TyEnv Ty2
tenv'
                  Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
binds Exp3
bod


                VectorTy UrTy Var
el_ty -> do
                  Var
tmp <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"read_vec_tuple"
                  let tenv' :: TyEnv Ty2
tenv' = TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Var
tmp     , UrTy Var -> Ty2
MkTy2 ([UrTy Var] -> UrTy Var
forall loc. [UrTy loc] -> UrTy loc
ProdTy [UrTy Var -> UrTy Var
forall loc. UrTy loc -> UrTy loc
VectorTy UrTy Var
el_ty, UrTy Var
forall loc. UrTy loc
CursorTy])),
                                                   (Var
v       , UrTy Var -> Ty2
MkTy2 (UrTy Var -> UrTy Var
forall loc. UrTy loc -> UrTy loc
VectorTy UrTy Var
el_ty)),
                                                   (Var -> Var
toEndV Var
v, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy)])
                              TyEnv Ty2
tenv
                      ty' :: Ty3
ty'   = UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
ty
                      binds :: [(Var, [()], Ty3, Exp3)]
binds = [(Var
tmp     , [], [Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Ty3
ty', Ty3
forall loc. UrTy loc
CursorTy], E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Ty3 -> E3Ext () Ty3
forall loc dec. Var -> dec -> E3Ext loc dec
ReadVector Var
loc (UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
el_ty)),
                               (Var
v       , [], Ty3
ty'     , Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
0 (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tmp)),
                               (Var -> Var
toEndV Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
1 (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tmp))]
                  if Bool
canBind
                  then do
                    -- If the location exists in the environment, it indicates that the
                    -- corresponding variable was also bound and we shouldn't create duplicate
                    -- bindings (checked in the LetLocE cases).
                    let binds' :: [(Var, [()], Ty3, Exp3)]
binds' = (Var
loc,[],Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
cur)(Var, [()], Ty3, Exp3)
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. a -> [a] -> [a]
:[(Var, [()], Ty3, Exp3)]
binds
                        tenv'' :: TyEnv Ty2
tenv'' = Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
loc (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv'
                    Exp3
bod <- Var
-> [(Var, LocArg)]
-> [Ty2]
-> Bool
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go (Var -> Var
toEndV Var
v) [(Var, LocArg)]
rst_vlocs [Ty2]
rst_tys Bool
canBind DepEnv
denv TyEnv Ty2
tenv''
                    Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
binds' Exp3
bod
                  else do
                    -- Cannot read this int. Instead, we add it to DepEnv.
                    let denv' :: DepEnv
denv' = ([(Var, [()], Ty3, Exp3)]
 -> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)])
-> Var -> [(Var, [()], Ty3, Exp3)] -> DepEnv -> DepEnv
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
(++) Var
loc [(Var, [()], Ty3, Exp3)]
binds DepEnv
denv
                    Var
-> [(Var, LocArg)]
-> [Ty2]
-> Bool
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go (Var -> Var
toEndV Var
v) [(Var, LocArg)]
rst_vlocs [Ty2]
rst_tys Bool
canBind DepEnv
denv' TyEnv Ty2
tenv'


                ListTy UrTy Var
el_ty -> do
                  Var
tmp <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"read_list_tuple"
                  let tenv' :: TyEnv Ty2
tenv' = TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Var
tmp     , UrTy Var -> Ty2
MkTy2 ([UrTy Var] -> UrTy Var
forall loc. [UrTy loc] -> UrTy loc
ProdTy [UrTy Var -> UrTy Var
forall loc. UrTy loc -> UrTy loc
ListTy UrTy Var
el_ty, UrTy Var
forall loc. UrTy loc
CursorTy])),
                                                   (Var
v       , UrTy Var -> Ty2
MkTy2 (UrTy Var -> UrTy Var
forall loc. UrTy loc -> UrTy loc
ListTy UrTy Var
el_ty)),
                                                   (Var -> Var
toEndV Var
v, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy)])
                              TyEnv Ty2
tenv
                      ty' :: Ty3
ty'   = UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
ty
                      binds :: [(Var, [()], Ty3, Exp3)]
binds = [(Var
tmp     , [], [Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Ty3
ty', Ty3
forall loc. UrTy loc
CursorTy], E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Ty3 -> E3Ext () Ty3
forall loc dec. Var -> dec -> E3Ext loc dec
ReadList Var
loc (UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
el_ty)),
                               (Var
v       , [], Ty3
ty'     , Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
0 (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tmp)),
                               (Var -> Var
toEndV Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
1 (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tmp))]
                  if Bool
canBind
                  then do
                    -- If the location exists in the environment, it indicates that the
                    -- corresponding variable was also bound and we shouldn't create duplicate
                    -- bindings (checked in the LetLocE cases).
                    let binds' :: [(Var, [()], Ty3, Exp3)]
binds' = (Var
loc,[],Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
cur)(Var, [()], Ty3, Exp3)
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. a -> [a] -> [a]
:[(Var, [()], Ty3, Exp3)]
binds
                        tenv'' :: TyEnv Ty2
tenv'' = Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
loc (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv'
                    Exp3
bod <- Var
-> [(Var, LocArg)]
-> [Ty2]
-> Bool
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go (Var -> Var
toEndV Var
v) [(Var, LocArg)]
rst_vlocs [Ty2]
rst_tys Bool
canBind DepEnv
denv TyEnv Ty2
tenv''
                    Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
binds' Exp3
bod
                  else do
                    -- Cannot read this int. Instead, we add it to DepEnv.
                    let denv' :: DepEnv
denv' = ([(Var, [()], Ty3, Exp3)]
 -> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)])
-> Var -> [(Var, [()], Ty3, Exp3)] -> DepEnv -> DepEnv
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
(++) Var
loc [(Var, [()], Ty3, Exp3)]
binds DepEnv
denv
                    Var
-> [(Var, LocArg)]
-> [Ty2]
-> Bool
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go (Var -> Var
toEndV Var
v) [(Var, LocArg)]
rst_vlocs [Ty2]
rst_tys Bool
canBind DepEnv
denv' TyEnv Ty2
tenv'

                PackedTy{} -> do
                  let tenv' :: TyEnv Ty2
tenv' = Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv
                  if Bool
canBind
                  then do
                    let tenv'' :: TyEnv Ty2
tenv'' = Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
loc (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv'
                    -- Flip canBind to indicate that the subsequent fields
                    -- should be added to the dependency environment.
                    Exp3
bod <- Var
-> [(Var, LocArg)]
-> [Ty2]
-> Bool
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go (Var -> Var
toEndV Var
v) [(Var, LocArg)]
rst_vlocs [Ty2]
rst_tys Bool
False DepEnv
denv TyEnv Ty2
tenv''
                    Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var
loc, [], Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
cur)
                                    ,(Var
v  , [], Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
loc)]
                             Exp3
bod
                  else do
                    -- Cannot read this. Instead, we add it to DepEnv.
                    let denv' :: DepEnv
denv' = ([(Var, [()], Ty3, Exp3)]
 -> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)])
-> Var -> [(Var, [()], Ty3, Exp3)] -> DepEnv -> DepEnv
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
(++) Var
loc [(Var
v,[],Ty3
forall loc. UrTy loc
CursorTy,Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
loc)] DepEnv
denv
                    Var
-> [(Var, LocArg)]
-> [Ty2]
-> Bool
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go (Var -> Var
toEndV Var
v) [(Var, LocArg)]
rst_vlocs [Ty2]
rst_tys Bool
False DepEnv
denv' TyEnv Ty2
tenv'

                UrTy Var
_ -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"unpackRegularDataCon: Unexpected field " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Var, Var) -> [Char]
forall a. Out a => a -> [Char]
sdoc (Var
v,Var
loc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UrTy Var -> [Char]
forall a. Out a => a -> [Char]
sdoc UrTy Var
ty

            ([(Var, LocArg)], [Ty2])
_ -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"unpackRegularDataCon: Unexpected numnber of varible, type pairs: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([(Var, LocArg)], [Ty2]) -> [Char]
forall a. Show a => a -> [Char]
show ([(Var, LocArg)]
vlocs,[Ty2]
tys)

    -- We have access to all fields in this constructor, and can create
    -- bindings for everything. We begin by unpacking the random access nodes.
    unpackWithAbsRAN :: Var -> PassM Exp3
    unpackWithAbsRAN :: Var -> PassM Exp3
unpackWithAbsRAN Var
field_cur =
        -- A map from a variable to a tuple containing it's location and
        -- the RAN field it depends on. Consider this constructor:
        --
        --     (Node^ [(ran_y3, loc_ran_y3), (n1, loc_n1) , (x2 , loc_x2), (y3 , loc_y3)] ...),
        --
        -- it will be the map:
        --
        --     (y3 -> (loc_y3, ran_y3))
        let ran_mp :: Map Var (Var, Var)
ran_mp =
              case DDefs (UrTy Var) -> [Char] -> Int
forall a. Out a => DDefs (UrTy a) -> [Char] -> Int
numRANsDataCon ((DDef Ty2 -> DDef (UrTy Var)) -> DDefs Ty2 -> DDefs (UrTy Var)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((Ty2 -> UrTy Var) -> DDef Ty2 -> DDef (UrTy Var)
forall a b. (a -> b) -> DDef a -> DDef b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ty2 -> UrTy Var
unTy2) DDefs Ty2
ddfs) ([Char] -> [Char]
fromRANDataCon [Char]
dcon) of
                Int
0 -> Map Var (Var, Var)
forall k a. Map k a
M.empty
                Int
n -> let -- Random access nodes occur immediately after the tag
                         ind_vars :: [Var]
ind_vars = ((Var, LocArg) -> Var) -> [(Var, LocArg)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
L.map (Var, LocArg) -> Var
forall a b. (a, b) -> a
fst ([(Var, LocArg)] -> [Var]) -> [(Var, LocArg)] -> [Var]
forall a b. (a -> b) -> a -> b
$ Int -> [(Var, LocArg)] -> [(Var, LocArg)]
forall a. Int -> [a] -> [a]
L.take Int
n [(Var, LocArg)]
vlocs1
                         -- Everything else is a regular consturctor field,
                         -- which depends on some random access node
                         data_fields :: [(Var, LocArg)]
data_fields = [(Var, LocArg)] -> [(Var, LocArg)]
forall a. [a] -> [a]
reverse ([(Var, LocArg)] -> [(Var, LocArg)])
-> [(Var, LocArg)] -> [(Var, LocArg)]
forall a b. (a -> b) -> a -> b
$ Int -> [(Var, LocArg)] -> [(Var, LocArg)]
forall a. Int -> [a] -> [a]
L.take Int
n ([(Var, LocArg)] -> [(Var, LocArg)]
forall a. [a] -> [a]
reverse [(Var, LocArg)]
vlocs1)
                         ([Var]
vars, [LocArg]
var_locargs) = [(Var, LocArg)] -> ([Var], [LocArg])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Var, LocArg)]
data_fields
                         var_locs :: [Var]
var_locs = (LocArg -> Var) -> [LocArg] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map LocArg -> Var
toLocVar [LocArg]
var_locargs
                     in [(Var, (Var, Var))] -> Map Var (Var, Var)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Var, (Var, Var))] -> Map Var (Var, Var))
-> [(Var, (Var, Var))] -> Map Var (Var, Var)
forall a b. (a -> b) -> a -> b
$ [Var] -> [(Var, Var)] -> [(Var, (Var, Var))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
vars ([Var] -> [Var] -> [(Var, Var)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
var_locs [Var]
ind_vars)
        in Var
-> [(Var, LocArg)]
-> [Ty2]
-> Map Var (Var, Var)
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go Var
field_cur [(Var, LocArg)]
vlocs1 [Ty2]
tys1 Map Var (Var, Var)
ran_mp DepEnv
denv1 (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
field_cur (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv1)
      where
        go :: Var -> [(Var, LocArg)] -> [Ty2] -> M.Map Var (Var,Var) -> DepEnv -> TyEnv Ty2 -> PassM Exp3
        go :: Var
-> [(Var, LocArg)]
-> [Ty2]
-> Map Var (Var, Var)
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go Var
cur [(Var, LocArg)]
vlocs [Ty2]
tys Map Var (Var, Var)
indirections_env DepEnv
denv TyEnv Ty2
tenv = do
          case ([(Var, LocArg)]
vlocs, [Ty2]
tys) of
            ([], []) -> DepEnv -> TyEnv Ty2 -> PassM Exp3
processRhs DepEnv
denv TyEnv Ty2
tenv
            ((Var
v,LocArg
locarg):[(Var, LocArg)]
rst_vlocs, (MkTy2 UrTy Var
ty):[Ty2]
rst_tys) ->
              let loc :: Var
loc = LocArg -> Var
toLocVar LocArg
locarg in
              case UrTy Var
ty of
                -- The random access pointer
                -- ASSUMPTION: We can always bind it, since it occurs immediately after the tag.
{-
                CursorTy -> do
                  tmp <- gensym "readcursor_shortcut"
                  let tenv' = M.union (M.fromList [(tmp     , MkTy2 (ProdTy [CursorTy, CursorTy])),
                                                   (loc     , MkTy2 CursorTy),
                                                   (v       , MkTy2 CursorTy),
                                                   (toEndV v, MkTy2 CursorTy)])
                              tenv

                      binds = [(tmp     , [], ProdTy [CursorTy, CursorTy], Ext $ ReadCursor cur),
                               (loc     , [], CursorTy, VarE cur),
                               (v       , [], CursorTy, ProjE 0 (VarE tmp)),
                               (toEndV v, [], CursorTy, ProjE 1 (VarE tmp))]
                  bod <- go (toEndV v) rst_vlocs rst_tys indirections_env denv tenv'
                  return $ mkLets binds bod
-}

                UrTy Var
CursorTy -> do
                  Var
tmp <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"readcursor_shortcut"
                  let tenv' :: TyEnv Ty2
tenv' = TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Var
tmp     , UrTy Var -> Ty2
MkTy2 ([UrTy Var] -> UrTy Var
forall loc. [UrTy loc] -> UrTy loc
ProdTy [UrTy Var
forall loc. UrTy loc
CursorTy, UrTy Var
forall loc. UrTy loc
CursorTy, UrTy Var
forall loc. UrTy loc
IntTy])),
                                                   (Var
loc     , UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy),
                                                   (Var
v       , UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy),
                                                   (Var -> Var
toEndV Var
v, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy),
                                                   (Var -> Var
toTagV Var
v, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
IntTy),
                                                   (Var -> Var
toEndFromTaggedV Var
v, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy)])
                              TyEnv Ty2
tenv
                      read_cursor :: Exp3
read_cursor = E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Var -> E3Ext () Ty3
forall loc dec. Var -> E3Ext loc dec
ReadTaggedCursor Var
cur)
                      binds :: [(Var, [()], Ty3, Exp3)]
binds = [(Var
tmp     , [], [Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Ty3
forall loc. UrTy loc
CursorTy, Ty3
forall loc. UrTy loc
CursorTy, Ty3
forall loc. UrTy loc
IntTy], Exp3
read_cursor),
                               (Var
loc     , [], Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
cur),
                               (Var
v       , [], Ty3
forall loc. UrTy loc
CursorTy, Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
0 (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tmp)),
                               (Var -> Var
toEndV Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
1 (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tmp)),
                               (Var -> Var
toTagV Var
v, [], Ty3
forall loc. UrTy loc
IntTy   , Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
2 (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tmp)),
                               (Var -> Var
toEndFromTaggedV Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3 -> E3Ext () Ty3
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
AddCursor Var
v (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE (Var -> Var
toTagV Var
v)))]
                  Exp3
bod <- Var
-> [(Var, LocArg)]
-> [Ty2]
-> Map Var (Var, Var)
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go (Var -> Var
toEndV Var
v) [(Var, LocArg)]
rst_vlocs [Ty2]
rst_tys Map Var (Var, Var)
indirections_env DepEnv
denv TyEnv Ty2
tenv'
                  Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
binds Exp3
bod


                -- Int, Sym, or Bool
                UrTy Var
_ | UrTy Var -> Bool
forall a. UrTy a -> Bool
isScalarTy UrTy Var
ty -> do
                  (TyEnv Ty2
tenv', [(Var, [()], Ty3, Exp3)]
binds) <- UrTy Var
-> Var
-> Var
-> TyEnv Ty2
-> PassM (TyEnv Ty2, [(Var, [()], Ty3, Exp3)])
scalarBinds UrTy Var
ty Var
v Var
loc TyEnv Ty2
tenv
                  let loc_bind :: (Var, [()], Ty3, Exp3)
loc_bind = case Var -> Map Var (Var, Var) -> Maybe (Var, Var)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v Map Var (Var, Var)
indirections_env of
                                   Maybe (Var, Var)
Nothing ->
                                     (Var
loc,[],Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
cur)
                                   -- Read this using a random access node
                                   Just (Var
_var_loc, Var
ind_var) ->
                                     (Var
loc,[],Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
ind_var)
                      binds' :: [(Var, [()], Ty3, Exp3)]
binds' = (Var, [()], Ty3, Exp3)
loc_bind(Var, [()], Ty3, Exp3)
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. a -> [a] -> [a]
:[(Var, [()], Ty3, Exp3)]
binds
                      tenv'' :: TyEnv Ty2
tenv'' = Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
loc (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv'
                  Exp3
bod <- Var
-> [(Var, LocArg)]
-> [Ty2]
-> Map Var (Var, Var)
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go (Var -> Var
toEndV Var
v) [(Var, LocArg)]
rst_vlocs [Ty2]
rst_tys Map Var (Var, Var)
indirections_env DepEnv
denv TyEnv Ty2
tenv''
                  Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
binds' Exp3
bod

                VectorTy UrTy Var
el_ty -> do
                  Var
tmp <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"read_vec_tuple"
                  let tenv' :: TyEnv Ty2
tenv' = TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Var
tmp     , UrTy Var -> Ty2
MkTy2 ([UrTy Var] -> UrTy Var
forall loc. [UrTy loc] -> UrTy loc
ProdTy [UrTy Var -> UrTy Var
forall loc. UrTy loc -> UrTy loc
VectorTy UrTy Var
el_ty, UrTy Var
forall loc. UrTy loc
CursorTy])),
                                                   (Var
v       , UrTy Var -> Ty2
MkTy2 (UrTy Var -> UrTy Var
forall loc. UrTy loc -> UrTy loc
VectorTy UrTy Var
el_ty)),
                                                   (Var -> Var
toEndV Var
v, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy)])
                              TyEnv Ty2
tenv
                      ty' :: Ty3
ty'   = UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
ty
                      binds :: [(Var, [()], Ty3, Exp3)]
binds = [(Var
tmp     , [], [Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Ty3
ty', Ty3
forall loc. UrTy loc
CursorTy], E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Ty3 -> E3Ext () Ty3
forall loc dec. Var -> dec -> E3Ext loc dec
ReadVector Var
loc (UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
el_ty)),
                               (Var
v       , [], Ty3
ty'     , Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
0 (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tmp)),
                               (Var -> Var
toEndV Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
1 (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tmp))]
                      loc_bind :: (Var, [()], Ty3, Exp3)
loc_bind = case Var -> Map Var (Var, Var) -> Maybe (Var, Var)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v Map Var (Var, Var)
indirections_env of
                                   Maybe (Var, Var)
Nothing ->
                                     (Var
loc, [], Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
cur)
                                   Just (Var
_var_loc, Var
ind_var) ->
                                     (Var
loc, [], Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
ind_var)
                      binds' :: [(Var, [()], Ty3, Exp3)]
binds' = (Var, [()], Ty3, Exp3)
loc_bind (Var, [()], Ty3, Exp3)
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. a -> [a] -> [a]
: [(Var, [()], Ty3, Exp3)]
binds
                      tenv'' :: TyEnv Ty2
tenv'' = Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
loc (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv'
                  Exp3
bod <- Var
-> [(Var, LocArg)]
-> [Ty2]
-> Map Var (Var, Var)
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go (Var -> Var
toEndV Var
v) [(Var, LocArg)]
rst_vlocs [Ty2]
rst_tys Map Var (Var, Var)
indirections_env DepEnv
denv TyEnv Ty2
tenv''
                  Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
binds' Exp3
bod

                ListTy UrTy Var
el_ty -> do
                  Var
tmp <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"read_list_tuple"
                  let tenv' :: TyEnv Ty2
tenv' = TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Var
tmp     , UrTy Var -> Ty2
MkTy2 ([UrTy Var] -> UrTy Var
forall loc. [UrTy loc] -> UrTy loc
ProdTy [UrTy Var -> UrTy Var
forall loc. UrTy loc -> UrTy loc
VectorTy UrTy Var
el_ty, UrTy Var
forall loc. UrTy loc
CursorTy])),
                                                   (Var
v       , UrTy Var -> Ty2
MkTy2 (UrTy Var -> UrTy Var
forall loc. UrTy loc -> UrTy loc
ListTy UrTy Var
el_ty)),
                                                   (Var -> Var
toEndV Var
v, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy)])
                              TyEnv Ty2
tenv
                      ty' :: Ty3
ty'   = UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
ty
                      binds :: [(Var, [()], Ty3, Exp3)]
binds = [(Var
tmp     , [], [Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Ty3
ty', Ty3
forall loc. UrTy loc
CursorTy], E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Ty3 -> E3Ext () Ty3
forall loc dec. Var -> dec -> E3Ext loc dec
ReadList Var
loc (UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
el_ty)),
                               (Var
v       , [], Ty3
ty'     , Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
0 (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tmp)),
                               (Var -> Var
toEndV Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
1 (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tmp))]
                      loc_bind :: (Var, [()], Ty3, Exp3)
loc_bind = case Var -> Map Var (Var, Var) -> Maybe (Var, Var)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v Map Var (Var, Var)
indirections_env of
                                   Maybe (Var, Var)
Nothing ->
                                     (Var
loc, [], Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
cur)
                                   Just (Var
_var_loc, Var
ind_var) ->
                                     (Var
loc, [], Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
ind_var)
                      binds' :: [(Var, [()], Ty3, Exp3)]
binds' = (Var, [()], Ty3, Exp3)
loc_bind (Var, [()], Ty3, Exp3)
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. a -> [a] -> [a]
: [(Var, [()], Ty3, Exp3)]
binds
                      tenv'' :: TyEnv Ty2
tenv'' = Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
loc (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv'
                  Exp3
bod <- Var
-> [(Var, LocArg)]
-> [Ty2]
-> Map Var (Var, Var)
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go (Var -> Var
toEndV Var
v) [(Var, LocArg)]
rst_vlocs [Ty2]
rst_tys Map Var (Var, Var)
indirections_env DepEnv
denv TyEnv Ty2
tenv''
                  Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
binds' Exp3
bod

                PackedTy{} -> do
                  let tenv' :: TyEnv Ty2
tenv' = TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (Var
loc, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy)
                                                  , (Var
v,   UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) ])
                              TyEnv Ty2
tenv
                      loc_bind :: (Var, [()], Ty3, Exp3)
loc_bind = case Var -> Map Var (Var, Var) -> Maybe (Var, Var)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v Map Var (Var, Var)
indirections_env of
                                   -- This is the first packed value. We can unpack this.
                                   Maybe (Var, Var)
Nothing ->
                                     (Var
loc, [], Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
cur)
                                   -- We need to access this using a random access node
                                   Just (Var
_var_loc, Var
ind_var) ->
                                     (Var
loc, [], Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
ind_var)
                  Exp3
bod <- Var
-> [(Var, LocArg)]
-> [Ty2]
-> Map Var (Var, Var)
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go (Var -> Var
toEndV Var
v) [(Var, LocArg)]
rst_vlocs [Ty2]
rst_tys Map Var (Var, Var)
indirections_env DepEnv
denv TyEnv Ty2
tenv'
                  Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [ (Var, [()], Ty3, Exp3)
loc_bind, (Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
loc) ] Exp3
bod

                UrTy Var
_ -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"unpackWitnAbsRAN: Unexpected field " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Var, Var) -> [Char]
forall a. Out a => a -> [Char]
sdoc (Var
v,Var
loc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UrTy Var -> [Char]
forall a. Out a => a -> [Char]
sdoc UrTy Var
ty

            ([(Var, LocArg)], [Ty2])
_ -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"unpackWitnAbsRAN: Unexpected numnber of varible, type pairs: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([(Var, LocArg)], [Ty2]) -> [Char]
forall a. Show a => a -> [Char]
show ([(Var, LocArg)]
vlocs,[Ty2]
tys)

    -- We have access to all fields in this constructor, and can create
    -- bindings for everything. We begin by unpacking the random access nodes.
    unpackWithRelRAN :: Var -> PassM Exp3
    unpackWithRelRAN :: Var -> PassM Exp3
unpackWithRelRAN Var
field_cur =
        -- ran_mp is a map from a variable to a tuple containing it's location and
        -- the RAN field it depends on. Consider this constructor:
        --
        --     (Node* [(ran_y3, loc_ran_y3), (n1, loc_n1) , (x2 , loc_x2), (y3 , loc_y3)] ...),
        --
        -- it will be the map:
        --
        --     (y3 -> (loc_y3, ran_y3))
        let ran_mp :: Map Var (Var, (Var, Var))
ran_mp =
              case DDefs (UrTy Var) -> [Char] -> Int
forall a. Out a => DDefs (UrTy a) -> [Char] -> Int
numRANsDataCon ((DDef Ty2 -> DDef (UrTy Var)) -> DDefs Ty2 -> DDefs (UrTy Var)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((Ty2 -> UrTy Var) -> DDef Ty2 -> DDef (UrTy Var)
forall a b. (a -> b) -> DDef a -> DDef b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ty2 -> UrTy Var
unTy2) DDefs Ty2
ddfs) ([Char] -> [Char]
fromRANDataCon [Char]
dcon) of
                Int
0 -> Map Var (Var, (Var, Var))
forall k a. Map k a
M.empty
                Int
n -> let -- Random access nodes occur immediately after the tag
                         inds :: [(Var, LocArg)]
inds = Int -> [(Var, LocArg)] -> [(Var, LocArg)]
forall a. Int -> [a] -> [a]
L.take Int
n ([(Var, LocArg)] -> [(Var, LocArg)])
-> [(Var, LocArg)] -> [(Var, LocArg)]
forall a b. (a -> b) -> a -> b
$ Int -> [(Var, LocArg)] -> [(Var, LocArg)]
forall a. Int -> [a] -> [a]
L.drop Int
1 [(Var, LocArg)]
vlocs1
                         -- Everything else is a regular consturctor field,
                         -- which depends on some random access node
                         data_fields :: [(Var, LocArg)]
data_fields = [(Var, LocArg)] -> [(Var, LocArg)]
forall a. [a] -> [a]
reverse ([(Var, LocArg)] -> [(Var, LocArg)])
-> [(Var, LocArg)] -> [(Var, LocArg)]
forall a b. (a -> b) -> a -> b
$ Int -> [(Var, LocArg)] -> [(Var, LocArg)]
forall a. Int -> [a] -> [a]
L.take Int
n ([(Var, LocArg)] -> [(Var, LocArg)]
forall a. [a] -> [a]
reverse [(Var, LocArg)]
vlocs1)
                         ([Var]
vars, [LocArg]
var_locargs) = [(Var, LocArg)] -> ([Var], [LocArg])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Var, LocArg)]
data_fields
                         var_locs :: [Var]
var_locs = (LocArg -> Var) -> [LocArg] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map LocArg -> Var
toLocVar [LocArg]
var_locargs
                     in [(Var, (Var, (Var, Var)))] -> Map Var (Var, (Var, Var))
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Var, (Var, (Var, Var)))] -> Map Var (Var, (Var, Var)))
-> [(Var, (Var, (Var, Var)))] -> Map Var (Var, (Var, Var))
forall a b. (a -> b) -> a -> b
$ [Var] -> [(Var, (Var, Var))] -> [(Var, (Var, (Var, Var)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
vars ([Var] -> [(Var, Var)] -> [(Var, (Var, Var))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
var_locs (((Var, LocArg) -> (Var, Var)) -> [(Var, LocArg)] -> [(Var, Var)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Var
x,LocArg
y) -> (Var
x,LocArg -> Var
toLocVar LocArg
y)) [(Var, LocArg)]
inds))
        in Var
-> [(Var, LocArg)]
-> [Ty2]
-> Map Var (Var, (Var, Var))
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go Var
field_cur [(Var, LocArg)]
vlocs1 [Ty2]
tys1 Map Var (Var, (Var, Var))
ran_mp DepEnv
denv1 (Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
field_cur (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv1)
      where
        go :: Var -> [(Var, LocArg)] -> [Ty2] -> M.Map Var (Var,(Var,Var)) -> DepEnv -> TyEnv Ty2 -> PassM Exp3
        go :: Var
-> [(Var, LocArg)]
-> [Ty2]
-> Map Var (Var, (Var, Var))
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go Var
cur [(Var, LocArg)]
vlocs [Ty2]
tys Map Var (Var, (Var, Var))
indirections_env DepEnv
denv TyEnv Ty2
tenv = do
          case ([(Var, LocArg)]
vlocs, [Ty2]
tys) of
            ([], []) -> DepEnv -> TyEnv Ty2 -> PassM Exp3
processRhs DepEnv
denv TyEnv Ty2
tenv
            ((Var
v,LocArg
locarg):[(Var, LocArg)]
rst_vlocs, (MkTy2 UrTy Var
ty):[Ty2]
rst_tys) ->
              let loc :: Var
loc = LocArg -> Var
toLocVar LocArg
locarg in
              case UrTy Var
ty of
                -- Int, Sym, or Bool
                UrTy Var
_ | UrTy Var -> Bool
forall a. UrTy a -> Bool
isScalarTy UrTy Var
ty -> do
                  (TyEnv Ty2
tenv', [(Var, [()], Ty3, Exp3)]
binds) <- UrTy Var
-> Var
-> Var
-> TyEnv Ty2
-> PassM (TyEnv Ty2, [(Var, [()], Ty3, Exp3)])
scalarBinds UrTy Var
ty Var
v Var
loc TyEnv Ty2
tenv
                  let loc_bind :: (Var, [()], Ty3, Exp3)
loc_bind = case Var -> Map Var (Var, (Var, Var)) -> Maybe (Var, (Var, Var))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v Map Var (Var, (Var, Var))
indirections_env of
                                   -- This appears before the first packed field. Unpack it
                                   -- in the usual way.
                                   Maybe (Var, (Var, Var))
Nothing ->
                                     (Var
loc,[],Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
cur)
                                   -- We need to read this using a random access node
                                   Just (Var
_var_loc, (Var
ind_var, Var
ind_loc)) ->
                                     (Var
loc,[],Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3 -> E3Ext () Ty3
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
AddCursor Var
ind_loc (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
ind_var))
                      binds' :: [(Var, [()], Ty3, Exp3)]
binds' = (Var, [()], Ty3, Exp3)
loc_bind(Var, [()], Ty3, Exp3)
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. a -> [a] -> [a]
:[(Var, [()], Ty3, Exp3)]
binds
                      tenv'' :: TyEnv Ty2
tenv'' = Var -> Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
loc (UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) TyEnv Ty2
tenv'
                  Exp3
bod <- Var
-> [(Var, LocArg)]
-> [Ty2]
-> Map Var (Var, (Var, Var))
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go (Var -> Var
toEndV Var
v) [(Var, LocArg)]
rst_vlocs [Ty2]
rst_tys Map Var (Var, (Var, Var))
indirections_env DepEnv
denv TyEnv Ty2
tenv''
                  Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets [(Var, [()], Ty3, Exp3)]
binds' Exp3
bod

                PackedTy{} -> do
                  Var
tmp_loc <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"loc"
                  let tenv' :: TyEnv Ty2
tenv' = TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (Var
loc, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy)
                                                  , (Var
v,   UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy) ])
                              TyEnv Ty2
tenv
                      loc_binds :: [(Var, [()], Ty3, Exp3)]
loc_binds = case Var -> Map Var (Var, (Var, Var)) -> Maybe (Var, (Var, Var))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v Map Var (Var, (Var, Var))
indirections_env of
                                    -- This is the first packed value. We can unpack this.
                                    Maybe (Var, (Var, Var))
Nothing ->
                                      [(Var
loc, [], Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
cur)]
                                    -- We need to access this using a random access node
                                    Just (Var
_var_loc, (Var
ind_var, Var
ind_loc)) ->
                                      [ (Var
tmp_loc,[],Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3 -> E3Ext () Ty3
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
AddCursor Var
ind_loc (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
ind_var))
                                      , (Var
loc,[],Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Var -> Exp3 -> E3Ext () Ty3
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
AddCursor Var
tmp_loc (Int -> Exp3
forall (ext :: * -> * -> *) loc dec. Int -> PreExp ext loc dec
LitE Int
8)) ]
                  Exp3
bod <- Var
-> [(Var, LocArg)]
-> [Ty2]
-> Map Var (Var, (Var, Var))
-> DepEnv
-> TyEnv Ty2
-> PassM Exp3
go (Var -> Var
toEndV Var
v) [(Var, LocArg)]
rst_vlocs [Ty2]
rst_tys Map Var (Var, (Var, Var))
indirections_env DepEnv
denv TyEnv Ty2
tenv'
                  Exp3 -> PassM Exp3
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp3 -> PassM Exp3) -> Exp3 -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [(Var, [()], Ty3, Exp3)] -> Exp3 -> Exp3
forall loc dec (ext :: * -> * -> *).
[(Var, [loc], dec, PreExp ext loc dec)]
-> PreExp ext loc dec -> PreExp ext loc dec
mkLets  ([(Var, [()], Ty3, Exp3)]
loc_binds [(Var, [()], Ty3, Exp3)]
-> [(Var, [()], Ty3, Exp3)] -> [(Var, [()], Ty3, Exp3)]
forall a. [a] -> [a] -> [a]
++ [(Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
loc)]) Exp3
bod

                UrTy Var
_ -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"unpackWithRelRAN: Unexpected field " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Var, Var) -> [Char]
forall a. Out a => a -> [Char]
sdoc (Var
v,Var
loc) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ UrTy Var -> [Char]
forall a. Out a => a -> [Char]
sdoc UrTy Var
ty

            ([(Var, LocArg)], [Ty2])
_ -> [Char] -> PassM Exp3
forall a. HasCallStack => [Char] -> a
error ([Char] -> PassM Exp3) -> [Char] -> PassM Exp3
forall a b. (a -> b) -> a -> b
$ [Char]
"unpackWithRelRAN: Unexpected numnber of varible, type pairs: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([(Var, LocArg)], [Ty2]) -> [Char]
forall a. Show a => a -> [Char]
show ([(Var, LocArg)]
vlocs,[Ty2]
tys)

    -- Generate bindings for unpacking int fields. A convenient
    scalarBinds :: OldTy2 -> Var -> LocVar -> TyEnv Ty2 -> PassM (TyEnv Ty2, [(Var, [()], Ty3, Exp3)])
    scalarBinds :: UrTy Var
-> Var
-> Var
-> TyEnv Ty2
-> PassM (TyEnv Ty2, [(Var, [()], Ty3, Exp3)])
scalarBinds UrTy Var
ty Var
v Var
loc TyEnv Ty2
tenv = do
      Var
tmp <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
"read_scalar_tuple"
      -- Note that the location is not added to the type environment here.
      -- The caller of this fn will do that later, depending on whether we're
      -- binding the location now or later via DepEnv.
      let s :: Scalar
s     = UrTy Var -> Scalar
forall a. Out a => UrTy a -> Scalar
mkScalar UrTy Var
ty
          tenv' :: TyEnv Ty2
tenv' = TyEnv Ty2 -> TyEnv Ty2 -> TyEnv Ty2
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union ([(Var, Ty2)] -> TyEnv Ty2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Var
tmp     , UrTy Var -> Ty2
MkTy2 ([UrTy Var] -> UrTy Var
forall loc. [UrTy loc] -> UrTy loc
ProdTy [UrTy Var
ty, UrTy Var
forall loc. UrTy loc
CursorTy])),
                                       (Var
v       , UrTy Var -> Ty2
MkTy2 UrTy Var
ty),
                                       (Var -> Var
toEndV Var
v, UrTy Var -> Ty2
MkTy2 UrTy Var
forall loc. UrTy loc
CursorTy)])
                  TyEnv Ty2
tenv

          ty' :: Ty3
ty'   = UrTy Var -> Ty3
forall a. UrTy a -> Ty3
stripTyLocs UrTy Var
ty

          binds :: [(Var, [()], Ty3, Exp3)]
binds = [(Var
tmp     , [], [Ty3] -> Ty3
forall loc. [UrTy loc] -> UrTy loc
ProdTy [Ty3
ty', Ty3
forall loc. UrTy loc
CursorTy], E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Scalar -> Var -> E3Ext () Ty3
forall loc dec. Scalar -> Var -> E3Ext loc dec
ReadScalar Scalar
s Var
loc),
                   (Var
v       , [], Ty3
ty'     , Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
0 (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tmp)),
                   (Var -> Var
toEndV Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
ProjE Int
1 (Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
tmp))]
      (TyEnv Ty2, [(Var, [()], Ty3, Exp3)])
-> PassM (TyEnv Ty2, [(Var, [()], Ty3, Exp3)])
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (TyEnv Ty2
tenv', [(Var, [()], Ty3, Exp3)]
binds)

giveStarts :: OldTy2 -> Exp3 -> Exp3
giveStarts :: UrTy Var -> Exp3 -> Exp3
giveStarts UrTy Var
ty Exp3
e =
  case UrTy Var
ty of
    PackedTy{} -> Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
0 Exp3
e
    -- NOTE : mkProj . MkProdE == id
    ProdTy [UrTy Var]
tys -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE ([Exp3] -> Exp3) -> [Exp3] -> Exp3
forall a b. (a -> b) -> a -> b
$ (UrTy Var -> Int -> Exp3) -> [UrTy Var] -> [Int] -> [Exp3]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ UrTy Var
ty' Int
n -> UrTy Var -> Exp3 -> Exp3
giveStarts UrTy Var
ty' (Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
n Exp3
e)) [UrTy Var]
tys [Int
0..]
    UrTy Var
_ -> Exp3
e


projValTy :: (Out a) => UrTy a -> UrTy a
projValTy :: forall a. Out a => UrTy a -> UrTy a
projValTy = Int -> UrTy a -> UrTy a
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
0

projEndsTy :: (Out a) => UrTy a -> UrTy a
projEndsTy :: forall a. Out a => UrTy a -> UrTy a
projEndsTy = Int -> UrTy a -> UrTy a
forall a. Out a => Int -> UrTy a -> UrTy a
projTy Int
1


-- | Bindings for a letregion
regionToBinds :: Bool -> Region -> RegionSize -> [(Var, [()], Ty3, Exp3)]
regionToBinds :: Bool -> Region -> RegionSize -> [(Var, [()], Ty3, Exp3)]
regionToBinds Bool
for_parallel_allocs Region
r RegionSize
sz =
  case Region
r of
    VarR{} -> [Char] -> [(Var, [()], Ty3, Exp3)]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [(Var, [()], Ty3, Exp3)])
-> [Char] -> [(Var, [()], Ty3, Exp3)]
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected VarR in Cursorize." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Region -> [Char]
forall a. Out a => a -> [Char]
sdoc Region
r
    GlobR Var
v Multiplicity
mul -> let mul' :: Multiplicity
mul' = Multiplicity -> Multiplicity
go Multiplicity
mul in
                   if Bool
for_parallel_allocs
                   then [ (Var
v       , [], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext(E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Multiplicity -> E3Ext () Ty3
forall loc dec. Multiplicity -> E3Ext loc dec
NewParBuffer Multiplicity
mul')
                        , (Var -> Var
toEndV Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext(E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Multiplicity -> E3Ext () Ty3
forall loc dec. Multiplicity -> E3Ext loc dec
EndOfBuffer Multiplicity
mul')]
                   else [ (Var
v       , [], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext(E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Multiplicity -> E3Ext () Ty3
forall loc dec. Multiplicity -> E3Ext loc dec
NewBuffer Multiplicity
mul')
                        , (Var -> Var
toEndV Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext(E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Multiplicity -> E3Ext () Ty3
forall loc dec. Multiplicity -> E3Ext loc dec
EndOfBuffer Multiplicity
mul')]
    DynR Var
v Multiplicity
mul  -> let mul' :: Multiplicity
mul' = Multiplicity -> Multiplicity
go Multiplicity
mul in
                   if Bool
for_parallel_allocs
                   then [ (Var
v       , [], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext(E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Multiplicity -> E3Ext () Ty3
forall loc dec. Multiplicity -> E3Ext loc dec
ScopedParBuffer Multiplicity
mul')
                        , (Var -> Var
toEndV Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext(E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Multiplicity -> E3Ext () Ty3
forall loc dec. Multiplicity -> E3Ext loc dec
EndOfBuffer Multiplicity
mul')]
                   else [ (Var
v       , [], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext(E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Multiplicity -> E3Ext () Ty3
forall loc dec. Multiplicity -> E3Ext loc dec
ScopedBuffer Multiplicity
mul')
                        , (Var -> Var
toEndV Var
v, [], Ty3
forall loc. UrTy loc
CursorTy, E3Ext () Ty3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext(E3Ext () Ty3 -> Exp3) -> E3Ext () Ty3 -> Exp3
forall a b. (a -> b) -> a -> b
$ Multiplicity -> E3Ext () Ty3
forall loc dec. Multiplicity -> E3Ext loc dec
EndOfBuffer Multiplicity
mul')]
    -- TODO: docs
    MMapR Var
_v    -> []

 where
  go :: Multiplicity -> Multiplicity
go Multiplicity
mul =
    case RegionSize
sz of
      BoundedSize Int
0 -> Multiplicity
mul
      BoundedSize Int
x -> Int -> Multiplicity
Bounded Int
x
      RegionSize
Undefined     -> Multiplicity
mul


isBound :: LocVar -> TyEnv Ty2 -> Bool
isBound :: Var -> TyEnv Ty2 -> Bool
isBound = Var -> TyEnv Ty2 -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member

-- ================================================================================
--                         Dilation Conventions
-- ================================================================================
-- Everything to do with dilation.  It should be possible to change
-- the dilated format by changing only this section.


-- | If an expression `e` returns type `T`, then a dilated version of
-- `e` returns a tuple (T,Cursors), where cursors contains a flat
-- record of end-cursors corresponding exactly to all the components
-- of T which are PackedTy.
--
newtype DiExp ex = Di ex
  deriving ((forall x. DiExp ex -> Rep (DiExp ex) x)
-> (forall x. Rep (DiExp ex) x -> DiExp ex) -> Generic (DiExp ex)
forall x. Rep (DiExp ex) x -> DiExp ex
forall x. DiExp ex -> Rep (DiExp ex) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ex x. Rep (DiExp ex) x -> DiExp ex
forall ex x. DiExp ex -> Rep (DiExp ex) x
$cfrom :: forall ex x. DiExp ex -> Rep (DiExp ex) x
from :: forall x. DiExp ex -> Rep (DiExp ex) x
$cto :: forall ex x. Rep (DiExp ex) x -> DiExp ex
to :: forall x. Rep (DiExp ex) x -> DiExp ex
Generic, Int -> DiExp ex -> [Char] -> [Char]
[DiExp ex] -> [Char] -> [Char]
DiExp ex -> [Char]
(Int -> DiExp ex -> [Char] -> [Char])
-> (DiExp ex -> [Char])
-> ([DiExp ex] -> [Char] -> [Char])
-> Show (DiExp ex)
forall ex. Show ex => Int -> DiExp ex -> [Char] -> [Char]
forall ex. Show ex => [DiExp ex] -> [Char] -> [Char]
forall ex. Show ex => DiExp ex -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: forall ex. Show ex => Int -> DiExp ex -> [Char] -> [Char]
showsPrec :: Int -> DiExp ex -> [Char] -> [Char]
$cshow :: forall ex. Show ex => DiExp ex -> [Char]
show :: DiExp ex -> [Char]
$cshowList :: forall ex. Show ex => [DiExp ex] -> [Char] -> [Char]
showList :: [DiExp ex] -> [Char] -> [Char]
Show, ReadPrec [DiExp ex]
ReadPrec (DiExp ex)
Int -> ReadS (DiExp ex)
ReadS [DiExp ex]
(Int -> ReadS (DiExp ex))
-> ReadS [DiExp ex]
-> ReadPrec (DiExp ex)
-> ReadPrec [DiExp ex]
-> Read (DiExp ex)
forall ex. Read ex => ReadPrec [DiExp ex]
forall ex. Read ex => ReadPrec (DiExp ex)
forall ex. Read ex => Int -> ReadS (DiExp ex)
forall ex. Read ex => ReadS [DiExp ex]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall ex. Read ex => Int -> ReadS (DiExp ex)
readsPrec :: Int -> ReadS (DiExp ex)
$creadList :: forall ex. Read ex => ReadS [DiExp ex]
readList :: ReadS [DiExp ex]
$creadPrec :: forall ex. Read ex => ReadPrec (DiExp ex)
readPrec :: ReadPrec (DiExp ex)
$creadListPrec :: forall ex. Read ex => ReadPrec [DiExp ex]
readListPrec :: ReadPrec [DiExp ex]
Read, DiExp ex -> DiExp ex -> Bool
(DiExp ex -> DiExp ex -> Bool)
-> (DiExp ex -> DiExp ex -> Bool) -> Eq (DiExp ex)
forall ex. Eq ex => DiExp ex -> DiExp ex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall ex. Eq ex => DiExp ex -> DiExp ex -> Bool
== :: DiExp ex -> DiExp ex -> Bool
$c/= :: forall ex. Eq ex => DiExp ex -> DiExp ex -> Bool
/= :: DiExp ex -> DiExp ex -> Bool
Eq, Eq (DiExp ex)
Eq (DiExp ex)
-> (DiExp ex -> DiExp ex -> Ordering)
-> (DiExp ex -> DiExp ex -> Bool)
-> (DiExp ex -> DiExp ex -> Bool)
-> (DiExp ex -> DiExp ex -> Bool)
-> (DiExp ex -> DiExp ex -> Bool)
-> (DiExp ex -> DiExp ex -> DiExp ex)
-> (DiExp ex -> DiExp ex -> DiExp ex)
-> Ord (DiExp ex)
DiExp ex -> DiExp ex -> Bool
DiExp ex -> DiExp ex -> Ordering
DiExp ex -> DiExp ex -> DiExp ex
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {ex}. Ord ex => Eq (DiExp ex)
forall ex. Ord ex => DiExp ex -> DiExp ex -> Bool
forall ex. Ord ex => DiExp ex -> DiExp ex -> Ordering
forall ex. Ord ex => DiExp ex -> DiExp ex -> DiExp ex
$ccompare :: forall ex. Ord ex => DiExp ex -> DiExp ex -> Ordering
compare :: DiExp ex -> DiExp ex -> Ordering
$c< :: forall ex. Ord ex => DiExp ex -> DiExp ex -> Bool
< :: DiExp ex -> DiExp ex -> Bool
$c<= :: forall ex. Ord ex => DiExp ex -> DiExp ex -> Bool
<= :: DiExp ex -> DiExp ex -> Bool
$c> :: forall ex. Ord ex => DiExp ex -> DiExp ex -> Bool
> :: DiExp ex -> DiExp ex -> Bool
$c>= :: forall ex. Ord ex => DiExp ex -> DiExp ex -> Bool
>= :: DiExp ex -> DiExp ex -> Bool
$cmax :: forall ex. Ord ex => DiExp ex -> DiExp ex -> DiExp ex
max :: DiExp ex -> DiExp ex -> DiExp ex
$cmin :: forall ex. Ord ex => DiExp ex -> DiExp ex -> DiExp ex
min :: DiExp ex -> DiExp ex -> DiExp ex
Ord)
--type DiExp = Exp

instance (Out ex) => Out (DiExp ex)

onDi :: (ex -> ex) -> DiExp ex -> DiExp ex
onDi :: forall ex. (ex -> ex) -> DiExp ex -> DiExp ex
onDi ex -> ex
f (Di ex
x) = ex -> DiExp ex
forall {ex}. ex -> DiExp ex
Di (ex -> ex
f ex
x)

fromDi :: DiExp ex -> ex
fromDi :: forall ex. DiExp ex -> ex
fromDi (Di ex
x) = ex
x


-- | Project the cursor package from a dilated expression, contains pointers
-- to all the ENDs.
projEnds :: DiExp Exp3 -> Exp3
projEnds :: DiExp Exp3 -> Exp3
projEnds (Di Exp3
e) = Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
1 Exp3
e

-- | Project the original value from a dilated expression.
projVal :: DiExp Exp3 -> Exp3
projVal :: DiExp Exp3 -> Exp3
projVal (Di Exp3
e) = Int -> Exp3 -> Exp3
forall (e :: * -> * -> *) l d. Int -> PreExp e l d -> PreExp e l d
mkProj Int
0 Exp3
e

-- | Constructor that combines a regular expression with a list of
-- corresponding end cursors.
mkDi :: Exp3 -> [Exp3] -> DiExp Exp3
mkDi :: Exp3 -> [Exp3] -> DiExp Exp3
mkDi Exp3
x []  = Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
Di (Exp3 -> DiExp Exp3) -> Exp3 -> DiExp Exp3
forall a b. (a -> b) -> a -> b
$ [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE [Exp3
x,[Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE []]
mkDi Exp3
x [Exp3
o] = Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
Di (Exp3 -> DiExp Exp3) -> Exp3 -> DiExp Exp3
forall a b. (a -> b) -> a -> b
$ [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE [Exp3
x, Exp3
o]
mkDi Exp3
x [Exp3]
ls  = Exp3 -> DiExp Exp3
forall {ex}. ex -> DiExp ex
Di (Exp3 -> DiExp Exp3) -> Exp3 -> DiExp Exp3
forall a b. (a -> b) -> a -> b
$ [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE [Exp3
x, [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE [Exp3]
ls]

curDict :: UrTy a -> UrTy a
curDict :: forall loc. UrTy loc -> UrTy loc
curDict (SymDictTy Maybe Var
ar Ty3
_ty) = Maybe Var -> Ty3 -> UrTy a
forall loc. Maybe Var -> Ty3 -> UrTy loc
SymDictTy Maybe Var
ar Ty3
forall loc. UrTy loc
CursorTy
curDict UrTy a
ty = UrTy a
ty