{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances  #-}

-- | An intermediate language which makes cursors explicit

module Gibbon.L3.Syntax
  (
    -- * Extended language
    E3Ext(..), Prog3, DDef3, DDefs3, FunDef3, FunDefs3 , Exp3, Ty3
  , Scalar(..), mkScalar, scalarToTy

    -- * Functions
  , eraseLocMarkers, mapMExprs, cursorizeTy, toL3Prim, updateAvailVars

  , module Gibbon.Language
  )
where

import Control.DeepSeq
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.List as L
import Text.PrettyPrint.GenericPretty

import           Gibbon.Common
-- import qualified Gibbon.L2.Syntax               as L2
import           Gibbon.Language                hiding (mapMExprs)
import qualified Gibbon.NewL2.Syntax as L2


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

type Prog3 = Prog Exp3

type DDef3  = DDef Ty3
type DDefs3 = DDefs Ty3

type FunDefs3 = FunDefs Exp3

type FunDef3 = FunDef Exp3

-- GHC uses the instance defined for L1.Ty1
-- instance FunctionTy Ty3 where

type Exp3 = PreExp E3Ext () Ty3

type Ty3 = UrTy ()

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

-- | The extension that turns L1 into L3.
data E3Ext loc dec =
    ReadScalar  Scalar Var                        -- ^ One cursor in, (int, cursor') out
  | WriteScalar Scalar Var (PreExp E3Ext loc dec) -- ^ Write int at cursor, and return a cursor
  | ReadTag Var                            -- ^ One cursor in, (tag,cursor) out
  | WriteTag DataCon Var                   -- ^ Write Tag at Cursor, and return a cursor
  | TagCursor Var Var                      -- ^ Create a tagged cursor
  | WriteTaggedCursor Var (PreExp E3Ext loc dec) -- ^ Write a tagged cursor
  | ReadTaggedCursor Var                   -- ^ Reads and returns a tagged cursor at Var
  | ReadCursor Var                         -- ^ Reads and returns the cursor at Var
  | WriteCursor Var (PreExp E3Ext loc dec) -- ^ Write a cursor, and return a cursor
  | ReadList Var dec                       -- ^ Read a pointer to a linked list
  | WriteList Var (PreExp E3Ext loc dec) dec       -- ^ Write a pointer to a linked list
  | ReadVector Var dec                             -- ^ Read a pointer to a vector
  | WriteVector Var (PreExp E3Ext loc dec) dec     -- ^ Write a pointer to a vector
  | AddCursor Var (PreExp E3Ext loc dec)           -- ^ Add a constant offset to a cursor variable
  | SubPtr Var Var                                 -- ^ Pointer subtraction
  | NewBuffer L2.Multiplicity         -- ^ Create a new buffer, and return a cursor
  | ScopedBuffer L2.Multiplicity      -- ^ Create a temporary scoped buffer, and return a cursor
  | NewParBuffer L2.Multiplicity         -- ^ Create a new buffer for parallel allocations, and return a cursor
  | ScopedParBuffer L2.Multiplicity      -- ^ Create a temporary scoped buffer for parallel allocations, and return a cursor
  | EndOfBuffer L2.Multiplicity
  | MMapFileSize Var
  | SizeOfPacked Var Var           -- ^ Takes in start and end cursors, and returns an Int
                                   --   we'll probably represent (sizeof x) as (end_x - start_x) / INT
  | SizeOfScalar Var               -- ^ sizeof(var)
  | BoundsCheck Int Var Var        -- ^ Bytes required, region, write cursor
  | IndirectionBarrier TyCon (Var,Var,Var,Var)
    -- ^ Do one of the following:
    -- (1) If it's a old-to-young indirection, record it in the remembered set.
    -- (2) Otherwise, bump the refcount and update the outset.
  | BumpArenaRefCount Var Var      -- ^ Given an arena and end-of-region ptr, add a
                                   --   reference from the arena to the region
  | NullCursor                     -- ^ Constant null cursor value (hack?).
                                   --   Used for dict lookup, which returns a packed value but
                                   --   no end witness.
  | RetE [(PreExp E3Ext loc dec)]  -- ^ Analogous to L2's RetE.
  | GetCilkWorkerNum               -- ^ Translates to  __cilkrts_get_worker_number().
  | LetAvail [Var] (PreExp E3Ext loc dec) -- ^ These variables are available to use before the join point
  | AllocateTagHere Var TyCon  -- ^ Analogous to L2's extension.
  | AllocateScalarsHere Var    -- ^ Analogous to L2's extension.
  | StartTagAllocation Var     -- ^ Marks the beginning of tag allocation.
  | EndTagAllocation Var       -- ^ Marks the end of tag allocation.
  | StartScalarsAllocation Var -- ^ Marks the beginning of scalar allocation.
  | EndScalarsAllocation Var   -- ^ Marks the end of scalar allocation.
  | SSPush SSModality Var Var TyCon
  | SSPop SSModality Var Var
  | Assert (PreExp E3Ext loc dec) -- ^ Translates to assert statements in C.
    -- ^ Analogous to L2's extensions.
  deriving (Int -> E3Ext loc dec -> ShowS
[E3Ext loc dec] -> ShowS
E3Ext loc dec -> String
(Int -> E3Ext loc dec -> ShowS)
-> (E3Ext loc dec -> String)
-> ([E3Ext loc dec] -> ShowS)
-> Show (E3Ext loc dec)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall loc dec.
(Show loc, Show dec) =>
Int -> E3Ext loc dec -> ShowS
forall loc dec. (Show loc, Show dec) => [E3Ext loc dec] -> ShowS
forall loc dec. (Show loc, Show dec) => E3Ext loc dec -> String
$cshowsPrec :: forall loc dec.
(Show loc, Show dec) =>
Int -> E3Ext loc dec -> ShowS
showsPrec :: Int -> E3Ext loc dec -> ShowS
$cshow :: forall loc dec. (Show loc, Show dec) => E3Ext loc dec -> String
show :: E3Ext loc dec -> String
$cshowList :: forall loc dec. (Show loc, Show dec) => [E3Ext loc dec] -> ShowS
showList :: [E3Ext loc dec] -> ShowS
Show, Eq (E3Ext loc dec)
Eq (E3Ext loc dec)
-> (E3Ext loc dec -> E3Ext loc dec -> Ordering)
-> (E3Ext loc dec -> E3Ext loc dec -> Bool)
-> (E3Ext loc dec -> E3Ext loc dec -> Bool)
-> (E3Ext loc dec -> E3Ext loc dec -> Bool)
-> (E3Ext loc dec -> E3Ext loc dec -> Bool)
-> (E3Ext loc dec -> E3Ext loc dec -> E3Ext loc dec)
-> (E3Ext loc dec -> E3Ext loc dec -> E3Ext loc dec)
-> Ord (E3Ext loc dec)
E3Ext loc dec -> E3Ext loc dec -> Bool
E3Ext loc dec -> E3Ext loc dec -> Ordering
E3Ext loc dec -> E3Ext loc dec -> E3Ext loc dec
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 {loc} {dec}. (Ord loc, Ord dec) => Eq (E3Ext loc dec)
forall loc dec.
(Ord loc, Ord dec) =>
E3Ext loc dec -> E3Ext loc dec -> Bool
forall loc dec.
(Ord loc, Ord dec) =>
E3Ext loc dec -> E3Ext loc dec -> Ordering
forall loc dec.
(Ord loc, Ord dec) =>
E3Ext loc dec -> E3Ext loc dec -> E3Ext loc dec
$ccompare :: forall loc dec.
(Ord loc, Ord dec) =>
E3Ext loc dec -> E3Ext loc dec -> Ordering
compare :: E3Ext loc dec -> E3Ext loc dec -> Ordering
$c< :: forall loc dec.
(Ord loc, Ord dec) =>
E3Ext loc dec -> E3Ext loc dec -> Bool
< :: E3Ext loc dec -> E3Ext loc dec -> Bool
$c<= :: forall loc dec.
(Ord loc, Ord dec) =>
E3Ext loc dec -> E3Ext loc dec -> Bool
<= :: E3Ext loc dec -> E3Ext loc dec -> Bool
$c> :: forall loc dec.
(Ord loc, Ord dec) =>
E3Ext loc dec -> E3Ext loc dec -> Bool
> :: E3Ext loc dec -> E3Ext loc dec -> Bool
$c>= :: forall loc dec.
(Ord loc, Ord dec) =>
E3Ext loc dec -> E3Ext loc dec -> Bool
>= :: E3Ext loc dec -> E3Ext loc dec -> Bool
$cmax :: forall loc dec.
(Ord loc, Ord dec) =>
E3Ext loc dec -> E3Ext loc dec -> E3Ext loc dec
max :: E3Ext loc dec -> E3Ext loc dec -> E3Ext loc dec
$cmin :: forall loc dec.
(Ord loc, Ord dec) =>
E3Ext loc dec -> E3Ext loc dec -> E3Ext loc dec
min :: E3Ext loc dec -> E3Ext loc dec -> E3Ext loc dec
Ord, E3Ext loc dec -> E3Ext loc dec -> Bool
(E3Ext loc dec -> E3Ext loc dec -> Bool)
-> (E3Ext loc dec -> E3Ext loc dec -> Bool) -> Eq (E3Ext loc dec)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall loc dec.
(Eq loc, Eq dec) =>
E3Ext loc dec -> E3Ext loc dec -> Bool
$c== :: forall loc dec.
(Eq loc, Eq dec) =>
E3Ext loc dec -> E3Ext loc dec -> Bool
== :: E3Ext loc dec -> E3Ext loc dec -> Bool
$c/= :: forall loc dec.
(Eq loc, Eq dec) =>
E3Ext loc dec -> E3Ext loc dec -> Bool
/= :: E3Ext loc dec -> E3Ext loc dec -> Bool
Eq, ReadPrec [E3Ext loc dec]
ReadPrec (E3Ext loc dec)
Int -> ReadS (E3Ext loc dec)
ReadS [E3Ext loc dec]
(Int -> ReadS (E3Ext loc dec))
-> ReadS [E3Ext loc dec]
-> ReadPrec (E3Ext loc dec)
-> ReadPrec [E3Ext loc dec]
-> Read (E3Ext loc dec)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall loc dec. (Read loc, Read dec) => ReadPrec [E3Ext loc dec]
forall loc dec. (Read loc, Read dec) => ReadPrec (E3Ext loc dec)
forall loc dec.
(Read loc, Read dec) =>
Int -> ReadS (E3Ext loc dec)
forall loc dec. (Read loc, Read dec) => ReadS [E3Ext loc dec]
$creadsPrec :: forall loc dec.
(Read loc, Read dec) =>
Int -> ReadS (E3Ext loc dec)
readsPrec :: Int -> ReadS (E3Ext loc dec)
$creadList :: forall loc dec. (Read loc, Read dec) => ReadS [E3Ext loc dec]
readList :: ReadS [E3Ext loc dec]
$creadPrec :: forall loc dec. (Read loc, Read dec) => ReadPrec (E3Ext loc dec)
readPrec :: ReadPrec (E3Ext loc dec)
$creadListPrec :: forall loc dec. (Read loc, Read dec) => ReadPrec [E3Ext loc dec]
readListPrec :: ReadPrec [E3Ext loc dec]
Read, (forall x. E3Ext loc dec -> Rep (E3Ext loc dec) x)
-> (forall x. Rep (E3Ext loc dec) x -> E3Ext loc dec)
-> Generic (E3Ext loc dec)
forall x. Rep (E3Ext loc dec) x -> E3Ext loc dec
forall x. E3Ext loc dec -> Rep (E3Ext loc dec) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall loc dec x. Rep (E3Ext loc dec) x -> E3Ext loc dec
forall loc dec x. E3Ext loc dec -> Rep (E3Ext loc dec) x
$cfrom :: forall loc dec x. E3Ext loc dec -> Rep (E3Ext loc dec) x
from :: forall x. E3Ext loc dec -> Rep (E3Ext loc dec) x
$cto :: forall loc dec x. Rep (E3Ext loc dec) x -> E3Ext loc dec
to :: forall x. Rep (E3Ext loc dec) x -> E3Ext loc dec
Generic, E3Ext loc dec -> ()
(E3Ext loc dec -> ()) -> NFData (E3Ext loc dec)
forall a. (a -> ()) -> NFData a
forall loc dec. (NFData loc, NFData dec) => E3Ext loc dec -> ()
$crnf :: forall loc dec. (NFData loc, NFData dec) => E3Ext loc dec -> ()
rnf :: E3Ext loc dec -> ()
NFData)

instance FreeVars (E3Ext l d) where
  gFreeVars :: E3Ext l d -> Set Var
gFreeVars  E3Ext l d
e =
    case E3Ext l d
e of
      ReadScalar Scalar
_  Var
v     -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
      WriteScalar Scalar
_ Var
v PreExp E3Ext l d
ex  -> Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
S.insert Var
v (PreExp E3Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E3Ext l d
ex)
      ReadTag Var
v      -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
      WriteTag String
_ Var
v   -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
      TagCursor Var
a Var
b      -> [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var
a,Var
b]
      ReadTaggedCursor Var
v -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
      WriteTaggedCursor Var
v PreExp E3Ext l d
ex -> Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
S.insert Var
v (PreExp E3Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E3Ext l d
ex)
      ReadCursor Var
v       -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
      WriteCursor Var
c PreExp E3Ext l d
ex   -> Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
S.insert Var
c (PreExp E3Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E3Ext l d
ex)
      ReadList Var
v d
_       -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
      WriteList Var
c PreExp E3Ext l d
ex  d
_  -> Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
S.insert Var
c (PreExp E3Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E3Ext l d
ex)
      AddCursor Var
v PreExp E3Ext l d
ex -> Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
S.insert Var
v (PreExp E3Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E3Ext l d
ex)
      SubPtr Var
v Var
w     -> [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var
v, Var
w]
      NewBuffer{}    -> Set Var
forall a. Set a
S.empty
      NewParBuffer{}     -> Set Var
forall a. Set a
S.empty
      ScopedBuffer{}     -> Set Var
forall a. Set a
S.empty
      ScopedParBuffer{}  -> Set Var
forall a. Set a
S.empty
      EndOfBuffer{}      -> Set Var
forall a. Set a
S.empty
      MMapFileSize Var
v     -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
      SizeOfPacked Var
c1 Var
c2 -> [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var
c1, Var
c2]
      SizeOfScalar Var
v     -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
      BoundsCheck{}      -> Set Var
forall a. Set a
S.empty
      IndirectionBarrier String
_tycon (Var
l1,Var
r1,Var
l2,Var
r2) -> [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var
l1,Var
r1,Var
l2,Var
r2]
      E3Ext l d
NullCursor         -> Set Var
forall a. Set a
S.empty
      BumpArenaRefCount Var
v Var
w -> [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var
v, Var
w]
      RetE [PreExp E3Ext l d]
ls -> [Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ((PreExp E3Ext l d -> Set Var) -> [PreExp E3Ext l d] -> [Set Var]
forall a b. (a -> b) -> [a] -> [b]
L.map PreExp E3Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars [PreExp E3Ext l d]
ls)
      E3Ext l d
GetCilkWorkerNum   -> Set Var
forall a. Set a
S.empty
      LetAvail [Var]
ls PreExp E3Ext l d
b      -> ([Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var]
ls) Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.union` PreExp E3Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E3Ext l d
b
      ReadVector{}  -> String -> Set Var
forall a. HasCallStack => String -> a
error String
"gFreeVars: ReadVector"
      WriteVector{} -> String -> Set Var
forall a. HasCallStack => String -> a
error String
"gFreeVars: WriteVector"
      AllocateTagHere Var
v String
_ -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
      AllocateScalarsHere Var
v -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
      StartTagAllocation Var
v -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
      EndTagAllocation Var
v -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
      StartScalarsAllocation Var
v -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
      EndScalarsAllocation Var
v -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
      SSPush SSModality
_ Var
a Var
b String
_ -> [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var
a,Var
b]
      SSPop SSModality
_ Var
a Var
b -> [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var
a,Var
b]
      Assert PreExp E3Ext l d
a -> PreExp E3Ext l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E3Ext l d
a


instance (Out l, Out d, Show l, Show d) => Expression (E3Ext l d) where
  type LocOf (E3Ext l d) = l
  type TyOf  (E3Ext l d) = UrTy l
  isTrivial :: E3Ext l d -> Bool
isTrivial E3Ext l d
_ = Bool
False

instance (Out l, Show l, Typeable (PreExp E3Ext l (UrTy l))) => Typeable (E3Ext l (UrTy l)) where
    gRecoverType :: DDefs (TyOf (E3Ext l (UrTy l)))
-> Env2 (TyOf (E3Ext l (UrTy l)))
-> E3Ext l (UrTy l)
-> TyOf (E3Ext l (UrTy l))
gRecoverType DDefs (TyOf (E3Ext l (UrTy l)))
_ddfs Env2 (TyOf (E3Ext l (UrTy l)))
_env2 E3Ext l (UrTy l)
NullCursor = TyOf (E3Ext l (UrTy l))
UrTy l
forall loc. UrTy loc
CursorTy
    gRecoverType DDefs (TyOf (E3Ext l (UrTy l)))
ddfs Env2 (TyOf (E3Ext l (UrTy l)))
env2 (RetE [PreExp E3Ext l (UrTy l)]
ls)    = [UrTy l] -> UrTy l
forall loc. [UrTy loc] -> UrTy loc
ProdTy ([UrTy l] -> UrTy l) -> [UrTy l] -> UrTy l
forall a b. (a -> b) -> a -> b
$ (PreExp E3Ext l (UrTy l) -> UrTy l)
-> [PreExp E3Ext l (UrTy l)] -> [UrTy l]
forall a b. (a -> b) -> [a] -> [b]
L.map (DDefs (TyOf (PreExp E3Ext l (UrTy l)))
-> Env2 (TyOf (PreExp E3Ext l (UrTy l)))
-> PreExp E3Ext l (UrTy l)
-> TyOf (PreExp E3Ext l (UrTy l))
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf (PreExp E3Ext l (UrTy l)))
DDefs (TyOf (E3Ext l (UrTy l)))
ddfs Env2 (TyOf (PreExp E3Ext l (UrTy l)))
Env2 (TyOf (E3Ext l (UrTy l)))
env2) [PreExp E3Ext l (UrTy l)]
ls
    gRecoverType DDefs (TyOf (E3Ext l (UrTy l)))
_ Env2 (TyOf (E3Ext l (UrTy l)))
_ E3Ext l (UrTy l)
_ = String -> UrTy l
forall a. HasCallStack => String -> a
error String
"L3.gRecoverType"

instance (Show l, Out l) => Flattenable (E3Ext l (UrTy l)) where
    gFlattenGatherBinds :: DDefs (TyOf (E3Ext l (UrTy l)))
-> Env2 (TyOf (E3Ext l (UrTy l)))
-> E3Ext l (UrTy l)
-> PassM ([Binds (E3Ext l (UrTy l))], E3Ext l (UrTy l))
gFlattenGatherBinds DDefs (TyOf (E3Ext l (UrTy l)))
_ddfs Env2 (TyOf (E3Ext l (UrTy l)))
_env E3Ext l (UrTy l)
ex = ([(Var, [l], UrTy l, E3Ext l (UrTy l))], E3Ext l (UrTy l))
-> PassM ([(Var, [l], UrTy l, E3Ext l (UrTy l))], E3Ext l (UrTy l))
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], E3Ext l (UrTy l)
ex)
    gFlattenExp :: DDefs (TyOf (E3Ext l (UrTy l)))
-> Env2 (TyOf (E3Ext l (UrTy l)))
-> E3Ext l (UrTy l)
-> PassM (E3Ext l (UrTy l))
gFlattenExp DDefs (TyOf (E3Ext l (UrTy l)))
_ddfs Env2 (TyOf (E3Ext l (UrTy l)))
_env E3Ext l (UrTy l)
ex = E3Ext l (UrTy l) -> PassM (E3Ext l (UrTy l))
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return E3Ext l (UrTy l)
ex

instance HasSimplifiableExt E3Ext l d => SimplifiableExt (PreExp E3Ext l d) (E3Ext l d) where
  gInlineTrivExt :: Map Var (PreExp E3Ext l d) -> E3Ext l d -> E3Ext l d
gInlineTrivExt Map Var (PreExp E3Ext l d)
_ E3Ext l d
_ = String -> E3Ext l d
forall a. HasCallStack => String -> a
error (String -> E3Ext l d) -> String -> E3Ext l d
forall a b. (a -> b) -> a -> b
$ String
"InlineTriv is not a safe operation to perform on L3." String -> ShowS
forall a. [a] -> [a] -> [a]
++
                               String
" A lot of L3 extensions can only use values" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                               String
" via variable references. So those variables" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                               String
" should *not* be inlined." String -> ShowS
forall a. [a] -> [a] -> [a]
++
                               String
" Running copy-propogation should be OK."


instance HasSubstitutableExt E3Ext l d => SubstitutableExt (PreExp E3Ext l d) (E3Ext l d) where
  gSubstExt :: Var -> PreExp E3Ext l d -> E3Ext l d -> E3Ext l d
gSubstExt Var
old PreExp E3Ext l d
new E3Ext l d
ext =
    case E3Ext l d
ext of
      WriteScalar Scalar
s Var
v PreExp E3Ext l d
bod  -> Scalar -> Var -> PreExp E3Ext l d -> E3Ext l d
forall loc dec.
Scalar -> Var -> PreExp E3Ext loc dec -> E3Ext loc dec
WriteScalar Scalar
s Var
v (Var -> PreExp E3Ext l d -> PreExp E3Ext l d -> PreExp E3Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E3Ext l d
new PreExp E3Ext l d
bod)
      WriteCursor Var
v PreExp E3Ext l d
bod    -> Var -> PreExp E3Ext l d -> E3Ext l d
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
WriteCursor Var
v (Var -> PreExp E3Ext l d -> PreExp E3Ext l d -> PreExp E3Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E3Ext l d
new PreExp E3Ext l d
bod)
      AddCursor Var
v PreExp E3Ext l d
bod      -> Var -> PreExp E3Ext l d -> E3Ext l d
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
AddCursor Var
v (Var -> PreExp E3Ext l d -> PreExp E3Ext l d -> PreExp E3Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E3Ext l d
new PreExp E3Ext l d
bod)
      SubPtr Var
v Var
w           -> Var -> Var -> E3Ext l d
forall loc dec. Var -> Var -> E3Ext loc dec
SubPtr Var
v Var
w
      LetAvail [Var]
ls PreExp E3Ext l d
bod      -> [Var] -> PreExp E3Ext l d -> E3Ext l d
forall loc dec. [Var] -> PreExp E3Ext loc dec -> E3Ext loc dec
LetAvail [Var]
ls (Var -> PreExp E3Ext l d -> PreExp E3Ext l d -> PreExp E3Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E3Ext l d
new PreExp E3Ext l d
bod)
      E3Ext l d
_ -> E3Ext l d
ext

  gSubstEExt :: PreExp E3Ext l d -> PreExp E3Ext l d -> E3Ext l d -> E3Ext l d
gSubstEExt PreExp E3Ext l d
old PreExp E3Ext l d
new E3Ext l d
ext =
    case E3Ext l d
ext of
      WriteScalar Scalar
s Var
v PreExp E3Ext l d
bod    -> Scalar -> Var -> PreExp E3Ext l d -> E3Ext l d
forall loc dec.
Scalar -> Var -> PreExp E3Ext loc dec -> E3Ext loc dec
WriteScalar Scalar
s Var
v (PreExp E3Ext l d
-> PreExp E3Ext l d -> PreExp E3Ext l d -> PreExp E3Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E3Ext l d
old PreExp E3Ext l d
new PreExp E3Ext l d
bod)
      WriteCursor Var
v PreExp E3Ext l d
bod -> Var -> PreExp E3Ext l d -> E3Ext l d
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
WriteCursor Var
v (PreExp E3Ext l d
-> PreExp E3Ext l d -> PreExp E3Ext l d -> PreExp E3Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E3Ext l d
old PreExp E3Ext l d
new PreExp E3Ext l d
bod)
      AddCursor Var
v PreExp E3Ext l d
bod   -> Var -> PreExp E3Ext l d -> E3Ext l d
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
AddCursor Var
v (PreExp E3Ext l d
-> PreExp E3Ext l d -> PreExp E3Ext l d -> PreExp E3Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E3Ext l d
old PreExp E3Ext l d
new PreExp E3Ext l d
bod)
      SubPtr Var
v Var
w        -> Var -> Var -> E3Ext l d
forall loc dec. Var -> Var -> E3Ext loc dec
SubPtr Var
v Var
w
      LetAvail [Var]
ls PreExp E3Ext l d
b     -> [Var] -> PreExp E3Ext l d -> E3Ext l d
forall loc dec. [Var] -> PreExp E3Ext loc dec -> E3Ext loc dec
LetAvail [Var]
ls (PreExp E3Ext l d
-> PreExp E3Ext l d -> PreExp E3Ext l d -> PreExp E3Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E3Ext l d
old PreExp E3Ext l d
new PreExp E3Ext l d
b)
      E3Ext l d
_ -> E3Ext l d
ext

instance HasRenamable E3Ext l d => Renamable (E3Ext l d) where
  gRename :: Map Var Var -> E3Ext l d -> E3Ext l d
gRename Map Var Var
env E3Ext l d
ext =
    case E3Ext l d
ext of
      ReadScalar Scalar
s Var
v     -> Scalar -> Var -> E3Ext l d
forall loc dec. Scalar -> Var -> E3Ext loc dec
ReadScalar Scalar
s (Var -> Var
forall a. Renamable a => a -> a
go Var
v)
      WriteScalar Scalar
s Var
v PreExp E3Ext l d
bod-> Scalar -> Var -> PreExp E3Ext l d -> E3Ext l d
forall loc dec.
Scalar -> Var -> PreExp E3Ext loc dec -> E3Ext loc dec
WriteScalar Scalar
s (Var -> Var
forall a. Renamable a => a -> a
go Var
v) (PreExp E3Ext l d -> PreExp E3Ext l d
forall a. Renamable a => a -> a
go PreExp E3Ext l d
bod)
      TagCursor Var
a Var
b      -> Var -> Var -> E3Ext l d
forall loc dec. Var -> Var -> E3Ext loc dec
TagCursor (Var -> Var
forall a. Renamable a => a -> a
go Var
a) (Var -> Var
forall a. Renamable a => a -> a
go Var
b)
      ReadTaggedCursor Var
v -> Var -> E3Ext l d
forall loc dec. Var -> E3Ext loc dec
ReadTaggedCursor (Var -> Var
forall a. Renamable a => a -> a
go Var
v)
      WriteTaggedCursor Var
v PreExp E3Ext l d
bod -> Var -> PreExp E3Ext l d -> E3Ext l d
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
WriteTaggedCursor (Var -> Var
forall a. Renamable a => a -> a
go Var
v) (PreExp E3Ext l d -> PreExp E3Ext l d
forall a. Renamable a => a -> a
go PreExp E3Ext l d
bod)
      ReadCursor Var
v       -> Var -> E3Ext l d
forall loc dec. Var -> E3Ext loc dec
ReadCursor (Var -> Var
forall a. Renamable a => a -> a
go Var
v)
      WriteCursor Var
v PreExp E3Ext l d
bod  -> Var -> PreExp E3Ext l d -> E3Ext l d
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
WriteCursor (Var -> Var
forall a. Renamable a => a -> a
go Var
v) (PreExp E3Ext l d -> PreExp E3Ext l d
forall a. Renamable a => a -> a
go PreExp E3Ext l d
bod)
      ReadList Var
v d
el_ty      -> Var -> d -> E3Ext l d
forall loc dec. Var -> dec -> E3Ext loc dec
ReadList (Var -> Var
forall a. Renamable a => a -> a
go Var
v) d
el_ty
      WriteList Var
v PreExp E3Ext l d
bod d
el_ty -> Var -> PreExp E3Ext l d -> d -> E3Ext l d
forall loc dec. Var -> PreExp E3Ext loc dec -> dec -> E3Ext loc dec
WriteList (Var -> Var
forall a. Renamable a => a -> a
go Var
v) (PreExp E3Ext l d -> PreExp E3Ext l d
forall a. Renamable a => a -> a
go PreExp E3Ext l d
bod) d
el_ty
      ReadVector Var
v d
el_ty      -> Var -> d -> E3Ext l d
forall loc dec. Var -> dec -> E3Ext loc dec
ReadVector (Var -> Var
forall a. Renamable a => a -> a
go Var
v) d
el_ty
      WriteVector Var
v PreExp E3Ext l d
bod d
el_ty -> Var -> PreExp E3Ext l d -> d -> E3Ext l d
forall loc dec. Var -> PreExp E3Ext loc dec -> dec -> E3Ext loc dec
WriteVector (Var -> Var
forall a. Renamable a => a -> a
go Var
v) (PreExp E3Ext l d -> PreExp E3Ext l d
forall a. Renamable a => a -> a
go PreExp E3Ext l d
bod) d
el_ty
      ReadTag Var
v          -> Var -> E3Ext l d
forall loc dec. Var -> E3Ext loc dec
ReadTag (Var -> Var
forall a. Renamable a => a -> a
go Var
v)
      WriteTag String
dcon Var
v    -> String -> Var -> E3Ext l d
forall loc dec. String -> Var -> E3Ext loc dec
WriteTag String
dcon (Var -> Var
forall a. Renamable a => a -> a
go Var
v)
      AddCursor Var
v PreExp E3Ext l d
bod    -> Var -> PreExp E3Ext l d -> E3Ext l d
forall loc dec. Var -> PreExp E3Ext loc dec -> E3Ext loc dec
AddCursor (Var -> Var
forall a. Renamable a => a -> a
go Var
v) (PreExp E3Ext l d -> PreExp E3Ext l d
forall a. Renamable a => a -> a
go PreExp E3Ext l d
bod)
      SubPtr Var
v Var
w         -> Var -> Var -> E3Ext l d
forall loc dec. Var -> Var -> E3Ext loc dec
SubPtr (Var -> Var
forall a. Renamable a => a -> a
go Var
v) (Var -> Var
forall a. Renamable a => a -> a
go Var
w)
      NewBuffer{}        -> E3Ext l d
ext
      ScopedBuffer{}     -> E3Ext l d
ext
      NewParBuffer{}     -> E3Ext l d
ext
      ScopedParBuffer{}  -> E3Ext l d
ext
      EndOfBuffer{}      -> E3Ext l d
ext
      MMapFileSize Var
v     -> Var -> E3Ext l d
forall loc dec. Var -> E3Ext loc dec
MMapFileSize (Var -> Var
forall a. Renamable a => a -> a
go Var
v)
      SizeOfPacked Var
a Var
b   -> Var -> Var -> E3Ext l d
forall loc dec. Var -> Var -> E3Ext loc dec
SizeOfPacked (Var -> Var
forall a. Renamable a => a -> a
go Var
a) (Var -> Var
forall a. Renamable a => a -> a
go Var
b)
      SizeOfScalar Var
v     -> Var -> E3Ext l d
forall loc dec. Var -> E3Ext loc dec
SizeOfScalar (Var -> Var
forall a. Renamable a => a -> a
go Var
v)
      BoundsCheck Int
i Var
a Var
b  -> Int -> Var -> Var -> E3Ext l d
forall loc dec. Int -> Var -> Var -> E3Ext loc dec
BoundsCheck Int
i (Var -> Var
forall a. Renamable a => a -> a
go Var
a) (Var -> Var
forall a. Renamable a => a -> a
go Var
b)
      IndirectionBarrier String
tycon (Var
a,Var
b,Var
c,Var
d) ->
        String -> (Var, Var, Var, Var) -> E3Ext l d
forall loc dec. String -> (Var, Var, Var, Var) -> E3Ext loc dec
IndirectionBarrier String
tycon (Var -> Var
forall a. Renamable a => a -> a
go Var
a, Var -> Var
forall a. Renamable a => a -> a
go Var
b, Var -> Var
forall a. Renamable a => a -> a
go Var
c, Var -> Var
forall a. Renamable a => a -> a
go Var
d)
      BumpArenaRefCount Var
v Var
w -> Var -> Var -> E3Ext l d
forall loc dec. Var -> Var -> E3Ext loc dec
BumpArenaRefCount (Var -> Var
forall a. Renamable a => a -> a
go Var
v) (Var -> Var
forall a. Renamable a => a -> a
go Var
w)
      E3Ext l d
NullCursor         -> E3Ext l d
ext
      RetE [PreExp E3Ext l d]
ls            -> [PreExp E3Ext l d] -> E3Ext l d
forall loc dec. [PreExp E3Ext loc dec] -> E3Ext loc dec
RetE ((PreExp E3Ext l d -> PreExp E3Ext l d)
-> [PreExp E3Ext l d] -> [PreExp E3Ext l d]
forall a b. (a -> b) -> [a] -> [b]
L.map PreExp E3Ext l d -> PreExp E3Ext l d
forall a. Renamable a => a -> a
go [PreExp E3Ext l d]
ls)
      E3Ext l d
GetCilkWorkerNum   -> E3Ext l d
forall loc dec. E3Ext loc dec
GetCilkWorkerNum
      LetAvail [Var]
ls PreExp E3Ext l d
b      -> [Var] -> PreExp E3Ext l d -> E3Ext l d
forall loc dec. [Var] -> PreExp E3Ext loc dec -> E3Ext loc dec
LetAvail ((Var -> Var) -> [Var] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
L.map Var -> Var
forall a. Renamable a => a -> a
go [Var]
ls) (PreExp E3Ext l d -> PreExp E3Ext l d
forall a. Renamable a => a -> a
go PreExp E3Ext l d
b)
      AllocateTagHere Var
v String
tycon -> Var -> String -> E3Ext l d
forall loc dec. Var -> String -> E3Ext loc dec
AllocateTagHere (Var -> Var
forall a. Renamable a => a -> a
go Var
v) String
tycon
      AllocateScalarsHere Var
v  -> Var -> E3Ext l d
forall loc dec. Var -> E3Ext loc dec
AllocateScalarsHere (Var -> Var
forall a. Renamable a => a -> a
go Var
v)
      StartTagAllocation Var
v -> Var -> E3Ext l d
forall loc dec. Var -> E3Ext loc dec
StartTagAllocation (Var -> Var
forall a. Renamable a => a -> a
go Var
v)
      EndTagAllocation Var
v -> Var -> E3Ext l d
forall loc dec. Var -> E3Ext loc dec
EndTagAllocation (Var -> Var
forall a. Renamable a => a -> a
go Var
v)
      StartScalarsAllocation Var
v -> Var -> E3Ext l d
forall loc dec. Var -> E3Ext loc dec
StartScalarsAllocation (Var -> Var
forall a. Renamable a => a -> a
go Var
v)
      EndScalarsAllocation Var
v -> Var -> E3Ext l d
forall loc dec. Var -> E3Ext loc dec
EndScalarsAllocation (Var -> Var
forall a. Renamable a => a -> a
go Var
v)
      SSPush SSModality
a Var
b Var
c String
d -> SSModality -> Var -> Var -> String -> E3Ext l d
forall loc dec. SSModality -> Var -> Var -> String -> E3Ext loc dec
SSPush SSModality
a (Var -> Var
forall a. Renamable a => a -> a
go Var
b) (Var -> Var
forall a. Renamable a => a -> a
go Var
c) String
d
      SSPop SSModality
a Var
b Var
c -> SSModality -> Var -> Var -> E3Ext l d
forall loc dec. SSModality -> Var -> Var -> E3Ext loc dec
SSPop SSModality
a (Var -> Var
forall a. Renamable a => a -> a
go Var
b) (Var -> Var
forall a. Renamable a => a -> a
go Var
c)
      Assert PreExp E3Ext l d
e -> PreExp E3Ext l d -> E3Ext l d
forall loc dec. PreExp E3Ext loc dec -> E3Ext loc dec
Assert (PreExp E3Ext l d -> PreExp E3Ext l d
forall a. Renamable a => a -> a
go PreExp E3Ext l d
e)
    where
      go :: forall a. Renamable a => a -> a
      go :: forall a. Renamable a => a -> a
go = Map Var Var -> a -> a
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env

data Scalar = IntS | CharS | FloatS | SymS | BoolS
  deriving (Int -> Scalar -> ShowS
[Scalar] -> ShowS
Scalar -> String
(Int -> Scalar -> ShowS)
-> (Scalar -> String) -> ([Scalar] -> ShowS) -> Show Scalar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scalar -> ShowS
showsPrec :: Int -> Scalar -> ShowS
$cshow :: Scalar -> String
show :: Scalar -> String
$cshowList :: [Scalar] -> ShowS
showList :: [Scalar] -> ShowS
Show, Eq Scalar
Eq Scalar
-> (Scalar -> Scalar -> Ordering)
-> (Scalar -> Scalar -> Bool)
-> (Scalar -> Scalar -> Bool)
-> (Scalar -> Scalar -> Bool)
-> (Scalar -> Scalar -> Bool)
-> (Scalar -> Scalar -> Scalar)
-> (Scalar -> Scalar -> Scalar)
-> Ord Scalar
Scalar -> Scalar -> Bool
Scalar -> Scalar -> Ordering
Scalar -> Scalar -> Scalar
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
$ccompare :: Scalar -> Scalar -> Ordering
compare :: Scalar -> Scalar -> Ordering
$c< :: Scalar -> Scalar -> Bool
< :: Scalar -> Scalar -> Bool
$c<= :: Scalar -> Scalar -> Bool
<= :: Scalar -> Scalar -> Bool
$c> :: Scalar -> Scalar -> Bool
> :: Scalar -> Scalar -> Bool
$c>= :: Scalar -> Scalar -> Bool
>= :: Scalar -> Scalar -> Bool
$cmax :: Scalar -> Scalar -> Scalar
max :: Scalar -> Scalar -> Scalar
$cmin :: Scalar -> Scalar -> Scalar
min :: Scalar -> Scalar -> Scalar
Ord, Scalar -> Scalar -> Bool
(Scalar -> Scalar -> Bool)
-> (Scalar -> Scalar -> Bool) -> Eq Scalar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scalar -> Scalar -> Bool
== :: Scalar -> Scalar -> Bool
$c/= :: Scalar -> Scalar -> Bool
/= :: Scalar -> Scalar -> Bool
Eq, ReadPrec [Scalar]
ReadPrec Scalar
Int -> ReadS Scalar
ReadS [Scalar]
(Int -> ReadS Scalar)
-> ReadS [Scalar]
-> ReadPrec Scalar
-> ReadPrec [Scalar]
-> Read Scalar
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Scalar
readsPrec :: Int -> ReadS Scalar
$creadList :: ReadS [Scalar]
readList :: ReadS [Scalar]
$creadPrec :: ReadPrec Scalar
readPrec :: ReadPrec Scalar
$creadListPrec :: ReadPrec [Scalar]
readListPrec :: ReadPrec [Scalar]
Read, (forall x. Scalar -> Rep Scalar x)
-> (forall x. Rep Scalar x -> Scalar) -> Generic Scalar
forall x. Rep Scalar x -> Scalar
forall x. Scalar -> Rep Scalar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Scalar -> Rep Scalar x
from :: forall x. Scalar -> Rep Scalar x
$cto :: forall x. Rep Scalar x -> Scalar
to :: forall x. Rep Scalar x -> Scalar
Generic, Scalar -> ()
(Scalar -> ()) -> NFData Scalar
forall a. (a -> ()) -> NFData a
$crnf :: Scalar -> ()
rnf :: Scalar -> ()
NFData, Int -> Scalar -> Doc
[Scalar] -> Doc
Scalar -> Doc
(Int -> Scalar -> Doc)
-> (Scalar -> Doc) -> ([Scalar] -> Doc) -> Out Scalar
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> Scalar -> Doc
docPrec :: Int -> Scalar -> Doc
$cdoc :: Scalar -> Doc
doc :: Scalar -> Doc
$cdocList :: [Scalar] -> Doc
docList :: [Scalar] -> Doc
Out)

mkScalar :: Out a => UrTy a -> Scalar
mkScalar :: forall a. Out a => UrTy a -> Scalar
mkScalar UrTy a
IntTy  = Scalar
IntS
mkScalar UrTy a
CharTy = Scalar
CharS
mkScalar UrTy a
FloatTy= Scalar
FloatS
mkScalar UrTy a
SymTy  = Scalar
SymS
mkScalar UrTy a
BoolTy = Scalar
BoolS
mkScalar UrTy a
ty = String -> Scalar
forall a. HasCallStack => String -> a
error (String -> Scalar) -> String -> Scalar
forall a b. (a -> b) -> a -> b
$ String
"mkScalar: Not a scalar type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ UrTy a -> String
forall a. Out a => a -> String
sdoc UrTy a
ty

scalarToTy :: Scalar -> UrTy a
scalarToTy :: forall a. Scalar -> UrTy a
scalarToTy Scalar
IntS  = UrTy a
forall loc. UrTy loc
IntTy
scalarToTy Scalar
CharS = UrTy a
forall loc. UrTy loc
CharTy
scalarToTy Scalar
FloatS= UrTy a
forall loc. UrTy loc
FloatTy
scalarToTy Scalar
SymS  = UrTy a
forall loc. UrTy loc
SymTy
scalarToTy Scalar
BoolS = UrTy a
forall loc. UrTy loc
BoolTy


-----------------------------------------------------------------------------------------
-- Do this manually to get prettier formatting: (Issue #90)

instance (Out l, Out d) => Out (E3Ext l d)

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

-- | Erase LocVar markers from the data definition
eraseLocMarkers :: DDef L2.Ty2 -> DDef Ty3
eraseLocMarkers :: DDef Ty2 -> DDef Ty3
eraseLocMarkers (DDef Var
tyargs [TyVar]
tyname [(String, [(Bool, Ty2)])]
ls) = Var -> [TyVar] -> [(String, [(Bool, Ty3)])] -> DDef Ty3
forall a. Var -> [TyVar] -> [(String, [(Bool, a)])] -> DDef a
DDef Var
tyargs [TyVar]
tyname ([(String, [(Bool, Ty3)])] -> DDef Ty3)
-> [(String, [(Bool, Ty3)])] -> DDef Ty3
forall a b. (a -> b) -> a -> b
$ ((String, [(Bool, Ty2)]) -> (String, [(Bool, Ty3)]))
-> [(String, [(Bool, Ty2)])] -> [(String, [(Bool, Ty3)])]
forall a b. (a -> b) -> [a] -> [b]
L.map (String, [(Bool, Ty2)]) -> (String, [(Bool, Ty3)])
go [(String, [(Bool, Ty2)])]
ls
  where go :: (DataCon,[(IsBoxed,L2.Ty2)]) -> (DataCon,[(IsBoxed,Ty3)])
        go :: (String, [(Bool, Ty2)]) -> (String, [(Bool, Ty3)])
go (String
dcon,[(Bool, Ty2)]
ls') = (String
dcon, ((Bool, Ty2) -> (Bool, Ty3)) -> [(Bool, Ty2)] -> [(Bool, Ty3)]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(Bool
b,Ty2
ty) -> (Bool
b,UrTy Var -> Ty3
forall a. UrTy a -> Ty3
L2.stripTyLocs (Ty2 -> UrTy Var
L2.unTy2 Ty2
ty))) [(Bool, Ty2)]
ls')

cursorizeTy :: UrTy a -> UrTy b
cursorizeTy :: forall a b. UrTy a -> UrTy b
cursorizeTy 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
cursorizeTy [UrTy a]
ls
    SymDictTy Maybe Var
v Ty3
_ -> Maybe Var -> Ty3 -> UrTy b
forall loc. Maybe Var -> Ty3 -> UrTy loc
SymDictTy Maybe Var
v 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
cursorizeTy UrTy a
k) (UrTy a -> UrTy b
forall a b. UrTy a -> UrTy b
cursorizeTy UrTy a
v)
    PackedTy{}    -> [UrTy b] -> UrTy b
forall loc. [UrTy loc] -> UrTy loc
ProdTy [UrTy b
forall loc. UrTy loc
CursorTy, 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
cursorizeTy 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
cursorizeTy 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

-- | Map exprs with an initial type environment:
-- Exactly the same function that was in L2 before
mapMExprs :: Monad m => (Env2 Ty3 -> Exp3 -> m Exp3) -> Prog3 -> m Prog3
mapMExprs :: forall (m :: * -> *).
Monad m =>
(Env2 Ty3 -> Exp3 -> m Exp3) -> Prog3 -> m Prog3
mapMExprs Env2 Ty3 -> Exp3 -> m Exp3
fn (Prog DDefs (TyOf Exp3)
ddfs FunDefs Exp3
fundefs Maybe (Exp3, TyOf Exp3)
mainExp) =
  DDefs (TyOf Exp3)
-> FunDefs Exp3 -> Maybe (Exp3, TyOf Exp3) -> Prog3
forall ex.
DDefs (TyOf ex) -> FunDefs ex -> Maybe (ex, TyOf ex) -> Prog ex
Prog DDefs (TyOf Exp3)
ddfs (FunDefs Exp3 -> Maybe (Exp3, Ty3) -> Prog3)
-> m (FunDefs Exp3) -> m (Maybe (Exp3, Ty3) -> Prog3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ((FunDef Exp3 -> m (FunDef Exp3))
-> FunDefs Exp3 -> m (FunDefs 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) -> Map Var a -> m (Map Var b)
mapM (\f :: FunDef Exp3
f@FunDef{[Var]
funArgs :: [Var]
funArgs :: forall ex. FunDef ex -> [Var]
funArgs,ArrowTy (TyOf Exp3)
funTy :: ArrowTy (TyOf Exp3)
funTy :: forall ex. FunDef ex -> ArrowTy (TyOf ex)
funTy,Exp3
funBody :: Exp3
funBody :: forall ex. FunDef ex -> ex
funBody} ->
              let env :: Env2 Ty3
env = TyEnv Ty3 -> TyEnv (ArrowTy Ty3) -> Env2 Ty3
forall a. TyEnv a -> TyEnv (ArrowTy a) -> Env2 a
Env2 ([(Var, Ty3)] -> TyEnv Ty3
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Var, Ty3)] -> TyEnv Ty3) -> [(Var, Ty3)] -> TyEnv Ty3
forall a b. (a -> b) -> a -> b
$ [Var] -> [Ty3] -> [(Var, Ty3)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
funArgs (([Ty3], Ty3) -> [Ty3]
forall a b. (a, b) -> a
fst ([Ty3], Ty3)
ArrowTy (TyOf Exp3)
funTy)) Map Var ([Ty3], Ty3)
TyEnv (ArrowTy Ty3)
funEnv
              in do
                Exp3
bod' <- Env2 Ty3 -> Exp3 -> m Exp3
fn Env2 Ty3
env Exp3
funBody
                FunDef Exp3 -> m (FunDef Exp3)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FunDef Exp3 -> m (FunDef Exp3)) -> FunDef Exp3 -> m (FunDef Exp3)
forall a b. (a -> b) -> a -> b
$ FunDef Exp3
f { funBody :: Exp3
funBody =  Exp3
bod' })
     FunDefs Exp3
fundefs)
    m (Maybe (Exp3, Ty3) -> Prog3) -> m (Maybe (Exp3, Ty3)) -> m Prog3
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    (((Exp3, Ty3) -> m (Exp3, Ty3))
-> Maybe (Exp3, Ty3) -> m (Maybe (Exp3, Ty3))
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) -> Maybe a -> m (Maybe b)
mapM (\ (Exp3
e,Ty3
t) -> (,Ty3
t) (Exp3 -> (Exp3, Ty3)) -> m Exp3 -> m (Exp3, Ty3)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env2 Ty3 -> Exp3 -> m Exp3
fn (TyEnv Ty3 -> TyEnv (ArrowTy Ty3) -> Env2 Ty3
forall a. TyEnv a -> TyEnv (ArrowTy a) -> Env2 a
Env2 TyEnv Ty3
forall k a. Map k a
M.empty Map Var ([Ty3], Ty3)
TyEnv (ArrowTy Ty3)
funEnv) Exp3
e) Maybe (Exp3, TyOf Exp3)
Maybe (Exp3, Ty3)
mainExp)
  where funEnv :: Map Var ([Ty3], Ty3)
funEnv = (FunDef Exp3 -> ([Ty3], Ty3))
-> FunDefs Exp3 -> Map Var ([Ty3], Ty3)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map FunDef Exp3 -> ([Ty3], Ty3)
FunDef Exp3 -> ArrowTy (TyOf Exp3)
forall ex. FunDef ex -> ArrowTy (TyOf ex)
funTy FunDefs Exp3
fundefs

toL3Prim :: Prim L2.Ty2 -> Prim Ty3
toL3Prim :: Prim Ty2 -> Prim Ty3
toL3Prim (DictEmptyP  Ty2
_ty) = Ty3 -> Prim Ty3
forall ty. ty -> Prim ty
DictEmptyP  Ty3
forall loc. UrTy loc
CursorTy
toL3Prim (DictInsertP Ty2
_ty) = Ty3 -> Prim Ty3
forall ty. ty -> Prim ty
DictInsertP Ty3
forall loc. UrTy loc
CursorTy
toL3Prim (DictLookupP Ty2
_ty) = Ty3 -> Prim Ty3
forall ty. ty -> Prim ty
DictLookupP Ty3
forall loc. UrTy loc
CursorTy
toL3Prim (DictHasKeyP Ty2
_ty) = Ty3 -> Prim Ty3
forall ty. ty -> Prim ty
DictHasKeyP Ty3
forall loc. UrTy loc
CursorTy
toL3Prim Prim Ty2
pr = (Ty2 -> Ty3) -> Prim Ty2 -> Prim Ty3
forall a b. (a -> b) -> Prim a -> Prim b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UrTy Var -> Ty3
forall a. UrTy a -> Ty3
L2.stripTyLocs (UrTy Var -> Ty3) -> (Ty2 -> UrTy Var) -> Ty2 -> Ty3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ty2 -> UrTy Var
L2.unTy2) Prim Ty2
pr

-- |
updateAvailVars :: [Var] -> [Var] -> Exp3 -> Exp3
updateAvailVars :: [Var] -> [Var] -> Exp3 -> Exp3
updateAvailVars [Var]
froms [Var]
tos Exp3
ex =
  case Exp3
ex of
    VarE Var
v          -> Var -> Exp3
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v
    LitE Int
_          -> Exp3
ex
    CharE Char
_         -> Exp3
ex
    FloatE{}        -> Exp3
ex
    LitSymE Var
_       -> Exp3
ex
    AppE Var
v [()]
loc [Exp3]
ls   -> Var -> [()] -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
v [()]
loc ((Exp3 -> Exp3) -> [Exp3] -> [Exp3]
forall a b. (a -> b) -> [a] -> [b]
map Exp3 -> Exp3
go [Exp3]
ls)
    PrimAppE Prim Ty3
p [Exp3]
ls   -> Prim Ty3 -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE Prim Ty3
p ([Exp3] -> Exp3) -> [Exp3] -> Exp3
forall a b. (a -> b) -> a -> b
$ (Exp3 -> Exp3) -> [Exp3] -> [Exp3]
forall a b. (a -> b) -> [a] -> [b]
L.map Exp3 -> Exp3
go [Exp3]
ls
    LetE (Var
v,[()]
loc,Ty3
t,Exp3
rhs) Exp3
bod -> (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,[()]
loc,Ty3
t,Exp3 -> Exp3
go Exp3
rhs) (Exp3 -> Exp3
go Exp3
bod)
    ProjE Int
i Exp3
e         -> Int -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
Int -> PreExp ext loc dec -> PreExp ext loc dec
ProjE Int
i (Exp3 -> Exp3
go Exp3
e)
    CaseE Exp3
e [(String, [(Var, ())], Exp3)]
ls        -> Exp3 -> [(String, [(Var, ())], Exp3)] -> Exp3
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> [(String, [(Var, loc)], PreExp ext loc dec)]
-> PreExp ext loc dec
CaseE (Exp3 -> Exp3
go Exp3
e) (((String, [(Var, ())], Exp3) -> (String, [(Var, ())], Exp3))
-> [(String, [(Var, ())], Exp3)] -> [(String, [(Var, ())], Exp3)]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(String
c,[(Var, ())]
vs,Exp3
er) -> (String
c,[(Var, ())]
vs,Exp3 -> Exp3
go Exp3
er)) [(String, [(Var, ())], Exp3)]
ls)
    MkProdE [Exp3]
ls        -> [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
$ (Exp3 -> Exp3) -> [Exp3] -> [Exp3]
forall a b. (a -> b) -> [a] -> [b]
L.map Exp3 -> Exp3
go [Exp3]
ls
    DataConE ()
loc String
k [Exp3]
ls -> () -> String -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
loc -> String -> [PreExp ext loc dec] -> PreExp ext loc dec
DataConE ()
loc String
k ([Exp3] -> Exp3) -> [Exp3] -> Exp3
forall a b. (a -> b) -> a -> b
$ (Exp3 -> Exp3) -> [Exp3] -> [Exp3]
forall a b. (a -> b) -> [a] -> [b]
L.map Exp3 -> Exp3
go [Exp3]
ls
    TimeIt Exp3
e Ty3
t Bool
b      -> Exp3 -> Ty3 -> Bool -> Exp3
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> dec -> Bool -> PreExp ext loc dec
TimeIt (Exp3 -> Exp3
go Exp3
e) Ty3
t Bool
b
    IfE Exp3
a Exp3
b Exp3
c         -> Exp3 -> Exp3 -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec
IfE (Exp3 -> Exp3
go Exp3
a) (Exp3 -> Exp3
go Exp3
b) (Exp3 -> Exp3
go Exp3
c)
    SpawnE Var
v [()]
loc [Exp3]
ls   -> Var -> [()] -> [Exp3] -> Exp3
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
SpawnE Var
v [()]
loc ((Exp3 -> Exp3) -> [Exp3] -> [Exp3]
forall a b. (a -> b) -> [a] -> [b]
map Exp3 -> Exp3
go [Exp3]
ls)
    Exp3
SyncE             -> Exp3
forall (ext :: * -> * -> *) loc dec. PreExp ext loc dec
SyncE
    WithArenaE Var
v Exp3
e    -> Var -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
Var -> PreExp ext loc dec -> PreExp ext loc dec
WithArenaE Var
v (Exp3 -> Exp3
go Exp3
e)
    MapE (Var
v,Ty3
t,Exp3
rhs) Exp3
bod -> (Var, Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
MapE (Var
v,Ty3
t, Exp3 -> Exp3
go Exp3
rhs) (Exp3 -> Exp3
go Exp3
bod)
    FoldE (Var
v1,Ty3
t1,Exp3
r1) (Var
v2,Ty3
t2,Exp3
r2) Exp3
bod ->
      (Var, Ty3, Exp3) -> (Var, Ty3, Exp3) -> Exp3 -> Exp3
forall (ext :: * -> * -> *) loc dec.
(Var, dec, PreExp ext loc dec)
-> (Var, dec, PreExp ext loc dec)
-> PreExp ext loc dec
-> PreExp ext loc dec
FoldE (Var
v1,Ty3
t1,Exp3 -> Exp3
go Exp3
r1) (Var
v2,Ty3
t2,Exp3 -> Exp3
go Exp3
r2) (Exp3 -> Exp3
go Exp3
bod)
    Ext E3Ext () Ty3
ext ->
      case E3Ext () Ty3
ext of
        LetAvail [Var]
vs Exp3
bod ->
          let n :: Var -> [Var]
n Var
o = if Var
o Var -> [Var] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Var]
froms then [Var]
tos else [Var
o]
              vs' :: [Var]
vs' = (Var -> [Var] -> [Var]) -> [Var] -> [Var] -> [Var]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Var
v [Var]
acc -> Var -> [Var]
n Var
v [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
acc) [] [Var]
vs
          in 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
LetAvail [Var]
vs' (Exp3 -> Exp3
go Exp3
bod)
        E3Ext () Ty3
_ -> Exp3
ex
  where
    go :: Exp3 -> Exp3
go = [Var] -> [Var] -> Exp3 -> Exp3
updateAvailVars [Var]
froms [Var]
tos