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

{-# LANGUAGE DeriveAnyClass #-}

{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fdefer-typed-holes #-}

-- | An intermediate language with an effect system that captures traversals.

module Gibbon.L2.Syntax
    -- * Extended language L2 with location types.
  ( E2Ext(..)
  , Prog2
  , DDefs2
  , DDef2
  , FunDef2
  , FunDefs2
  , Exp2
  , E2
  , Ty2
  , Effect(..)
  , ArrowTy2(..)
  , LocRet(..)
  , LocExp
  , PreLocExp(..)

-- * Regions and locations
  , LocVar
  , Region(..)
  , Modality(..)
  , LRM(..)
  , dummyLRM
  , Multiplicity(..)
  , RegionSize(..)
  , RegionType(..)
  , regionToVar

-- * Operations on types
  , allLocVars
  , inLocVars
  , outLocVars
  , outRegVars
  , inRegVars
  , allRegVars
  , substLoc
  , substLocs
  , substEff
  , substEffs
  , extendPatternMatchEnv
  , locsInTy
  , dummyTyLocs
  , allFreeVars
  , freeLocVars

-- * Other helpers
  , revertToL1
  , occurs
  , mapPacked
  , constPacked
  , depList
  , changeAppToSpawn
  , module Gibbon.Language
  ) where

import           Control.DeepSeq
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Map as M
import           GHC.Stack (HasCallStack)
import           Text.PrettyPrint.GenericPretty

import           Gibbon.Common
import           Gibbon.Language
import           Text.PrettyPrint.HughesPJ
import           Gibbon.L1.Syntax hiding (AddFixed, StartOfPkdCursor)
import qualified Gibbon.L1.Syntax as L1

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

type Prog2    = Prog Exp2
type DDef2    = DDef Ty2
type DDefs2   = DDefs Ty2
type FunDef2  = FunDef Exp2
type FunDefs2 = FunDefs Exp2

-- | Function types know about locations and traversal effects.
instance FunctionTy Ty2 where
  type ArrowTy Ty2 = ArrowTy2 Ty2
  inTys :: ArrowTy Ty2 -> [Ty2]
inTys = ArrowTy Ty2 -> [Ty2]
ArrowTy2 Ty2 -> [Ty2]
forall ty2. ArrowTy2 ty2 -> [ty2]
arrIns
  outTy :: ArrowTy Ty2 -> Ty2
outTy = ArrowTy Ty2 -> Ty2
ArrowTy2 Ty2 -> Ty2
forall ty2. ArrowTy2 ty2 -> ty2
arrOut

-- | Extended expressions, L2.
--
--   By adding a `LocVar` decoration, all data constructors,
--   applications, and bindings gain a location annotation.
type Exp2 = E2 LocVar Ty2

-- | L1 Types extended with abstract Locations.
type Ty2 = UrTy LocVar

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

-- | Shorthand for recursions.
type E2 l d = PreExp E2Ext l d

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


-- | 'Undefined' is at the top of this lattice.
instance Ord RegionSize where
  <= :: RegionSize -> RegionSize -> Bool
(<=) (BoundedSize Int
sz1) (BoundedSize Int
sz2) = Int
sz1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
sz2
  (<=) RegionSize
Undefined         (BoundedSize{})   = Bool
False
  (<=) (BoundedSize{})   RegionSize
Undefined         = Bool
True
  (<=) RegionSize
Undefined         RegionSize
Undefined         = Bool
True

instance Semigroup RegionType where
  -- IndirectionFree < RightwardLocalIndirections < LocalIndirections < NoSharing
  <> :: RegionType -> RegionType -> RegionType
(<>) RegionType
IndirectionFree            RegionType
v                          = RegionType
v
  (<>) RegionType
v                          RegionType
IndirectionFree            = RegionType
v
  (<>) RegionType
RightwardLocalIndirections RegionType
v                          = RegionType
v
  (<>) RegionType
v                          RegionType
RightwardLocalIndirections = RegionType
v
  (<>) RegionType
LocalIndirections          RegionType
v                          = RegionType
v
  (<>) RegionType
v                          RegionType
LocalIndirections          = RegionType
v
  (<>) RegionType
NoSharing                  RegionType
v                          = RegionType
v

instance Semigroup RegionSize where
  <> :: RegionSize -> RegionSize -> RegionSize
(<>) (BoundedSize Int
sz1) (BoundedSize Int
sz2) = Int -> RegionSize
BoundedSize (Int
sz1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sz2)
  (<>) RegionSize
Undefined RegionSize
_         = RegionSize
Undefined
  (<>) RegionSize
_         RegionSize
Undefined = RegionSize
Undefined

instance Monoid RegionSize where
  mempty :: RegionSize
mempty = Int -> RegionSize
BoundedSize Int
0


-- | The extension that turns L1 into L2.
data E2Ext loc dec
  = LetRegionE    Region RegionSize (Maybe RegionType) (E2 loc dec) -- ^ Allocate a new region.
  | LetParRegionE Region RegionSize (Maybe RegionType) (E2 loc dec) -- ^ Allocate a new region for parallel allocations.
  | LetLocE LocVar (PreLocExp loc) (E2 loc dec) -- ^ Bind a new location.
  | RetE [loc] Var          -- ^ Return a value together with extra loc values.
  | FromEndE loc            -- ^ Bind a location from an EndOf location (for RouteEnds and after).
  | BoundsCheck Int -- Bytes required
                loc -- Region
                loc -- Write cursor
  | AddFixed Var Int
  | IndirectionE TyCon     -- Type of the data pointed to by this indirection.
                 DataCon   -- Constructor for an indirection in this type.
                 (loc,loc) -- Pointer.
                 (loc,loc) -- Pointee (the thing that the pointer points to).
                 (E2 loc dec) -- If this indirection was added to get rid
                              -- of a copy_Foo call, we keep the fn call
                              -- around in case we want to go back to it.
                              -- E.g. when reverting from L2 to L1.
    -- ^ A indirection node.

  | StartOfPkdCursor Var -- Cursor to a packed value, created by AddRAN.

  | TagCursor Var Var    -- Create a tagged cursor.

  | GetCilkWorkerNum
    -- ^ Translates to  __cilkrts_get_worker_number().
  | LetAvail [Var] (E2 loc dec) -- ^ These variables are available to use before the join point.
  | AllocateTagHere LocVar TyCon
  | AllocateScalarsHere LocVar
    -- ^ A marker which tells subsequent a compiler pass where to
    -- move the tag and scalar field allocations so that they happen
    -- before any of the subsequent packed fields.
  | SSPush SSModality LocVar LocVar TyCon
  | SSPop SSModality LocVar LocVar
    -- ^ Spill and restore from the shadow-stack.
  deriving (Int -> E2Ext loc dec -> ShowS
[E2Ext loc dec] -> ShowS
E2Ext loc dec -> String
(Int -> E2Ext loc dec -> ShowS)
-> (E2Ext loc dec -> String)
-> ([E2Ext loc dec] -> ShowS)
-> Show (E2Ext loc dec)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall loc dec.
(Show dec, Show loc) =>
Int -> E2Ext loc dec -> ShowS
forall loc dec. (Show dec, Show loc) => [E2Ext loc dec] -> ShowS
forall loc dec. (Show dec, Show loc) => E2Ext loc dec -> String
$cshowsPrec :: forall loc dec.
(Show dec, Show loc) =>
Int -> E2Ext loc dec -> ShowS
showsPrec :: Int -> E2Ext loc dec -> ShowS
$cshow :: forall loc dec. (Show dec, Show loc) => E2Ext loc dec -> String
show :: E2Ext loc dec -> String
$cshowList :: forall loc dec. (Show dec, Show loc) => [E2Ext loc dec] -> ShowS
showList :: [E2Ext loc dec] -> ShowS
Show, Eq (E2Ext loc dec)
Eq (E2Ext loc dec)
-> (E2Ext loc dec -> E2Ext loc dec -> Ordering)
-> (E2Ext loc dec -> E2Ext loc dec -> Bool)
-> (E2Ext loc dec -> E2Ext loc dec -> Bool)
-> (E2Ext loc dec -> E2Ext loc dec -> Bool)
-> (E2Ext loc dec -> E2Ext loc dec -> Bool)
-> (E2Ext loc dec -> E2Ext loc dec -> E2Ext loc dec)
-> (E2Ext loc dec -> E2Ext loc dec -> E2Ext loc dec)
-> Ord (E2Ext loc dec)
E2Ext loc dec -> E2Ext loc dec -> Bool
E2Ext loc dec -> E2Ext loc dec -> Ordering
E2Ext loc dec -> E2Ext loc dec -> E2Ext 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 dec, Ord loc) => Eq (E2Ext loc dec)
forall loc dec.
(Ord dec, Ord loc) =>
E2Ext loc dec -> E2Ext loc dec -> Bool
forall loc dec.
(Ord dec, Ord loc) =>
E2Ext loc dec -> E2Ext loc dec -> Ordering
forall loc dec.
(Ord dec, Ord loc) =>
E2Ext loc dec -> E2Ext loc dec -> E2Ext loc dec
$ccompare :: forall loc dec.
(Ord dec, Ord loc) =>
E2Ext loc dec -> E2Ext loc dec -> Ordering
compare :: E2Ext loc dec -> E2Ext loc dec -> Ordering
$c< :: forall loc dec.
(Ord dec, Ord loc) =>
E2Ext loc dec -> E2Ext loc dec -> Bool
< :: E2Ext loc dec -> E2Ext loc dec -> Bool
$c<= :: forall loc dec.
(Ord dec, Ord loc) =>
E2Ext loc dec -> E2Ext loc dec -> Bool
<= :: E2Ext loc dec -> E2Ext loc dec -> Bool
$c> :: forall loc dec.
(Ord dec, Ord loc) =>
E2Ext loc dec -> E2Ext loc dec -> Bool
> :: E2Ext loc dec -> E2Ext loc dec -> Bool
$c>= :: forall loc dec.
(Ord dec, Ord loc) =>
E2Ext loc dec -> E2Ext loc dec -> Bool
>= :: E2Ext loc dec -> E2Ext loc dec -> Bool
$cmax :: forall loc dec.
(Ord dec, Ord loc) =>
E2Ext loc dec -> E2Ext loc dec -> E2Ext loc dec
max :: E2Ext loc dec -> E2Ext loc dec -> E2Ext loc dec
$cmin :: forall loc dec.
(Ord dec, Ord loc) =>
E2Ext loc dec -> E2Ext loc dec -> E2Ext loc dec
min :: E2Ext loc dec -> E2Ext loc dec -> E2Ext loc dec
Ord, E2Ext loc dec -> E2Ext loc dec -> Bool
(E2Ext loc dec -> E2Ext loc dec -> Bool)
-> (E2Ext loc dec -> E2Ext loc dec -> Bool) -> Eq (E2Ext loc dec)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall loc dec.
(Eq dec, Eq loc) =>
E2Ext loc dec -> E2Ext loc dec -> Bool
$c== :: forall loc dec.
(Eq dec, Eq loc) =>
E2Ext loc dec -> E2Ext loc dec -> Bool
== :: E2Ext loc dec -> E2Ext loc dec -> Bool
$c/= :: forall loc dec.
(Eq dec, Eq loc) =>
E2Ext loc dec -> E2Ext loc dec -> Bool
/= :: E2Ext loc dec -> E2Ext loc dec -> Bool
Eq, ReadPrec [E2Ext loc dec]
ReadPrec (E2Ext loc dec)
Int -> ReadS (E2Ext loc dec)
ReadS [E2Ext loc dec]
(Int -> ReadS (E2Ext loc dec))
-> ReadS [E2Ext loc dec]
-> ReadPrec (E2Ext loc dec)
-> ReadPrec [E2Ext loc dec]
-> Read (E2Ext loc dec)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall loc dec. (Read dec, Read loc) => ReadPrec [E2Ext loc dec]
forall loc dec. (Read dec, Read loc) => ReadPrec (E2Ext loc dec)
forall loc dec.
(Read dec, Read loc) =>
Int -> ReadS (E2Ext loc dec)
forall loc dec. (Read dec, Read loc) => ReadS [E2Ext loc dec]
$creadsPrec :: forall loc dec.
(Read dec, Read loc) =>
Int -> ReadS (E2Ext loc dec)
readsPrec :: Int -> ReadS (E2Ext loc dec)
$creadList :: forall loc dec. (Read dec, Read loc) => ReadS [E2Ext loc dec]
readList :: ReadS [E2Ext loc dec]
$creadPrec :: forall loc dec. (Read dec, Read loc) => ReadPrec (E2Ext loc dec)
readPrec :: ReadPrec (E2Ext loc dec)
$creadListPrec :: forall loc dec. (Read dec, Read loc) => ReadPrec [E2Ext loc dec]
readListPrec :: ReadPrec [E2Ext loc dec]
Read, (forall x. E2Ext loc dec -> Rep (E2Ext loc dec) x)
-> (forall x. Rep (E2Ext loc dec) x -> E2Ext loc dec)
-> Generic (E2Ext loc dec)
forall x. Rep (E2Ext loc dec) x -> E2Ext loc dec
forall x. E2Ext loc dec -> Rep (E2Ext loc dec) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall loc dec x. Rep (E2Ext loc dec) x -> E2Ext loc dec
forall loc dec x. E2Ext loc dec -> Rep (E2Ext loc dec) x
$cfrom :: forall loc dec x. E2Ext loc dec -> Rep (E2Ext loc dec) x
from :: forall x. E2Ext loc dec -> Rep (E2Ext loc dec) x
$cto :: forall loc dec x. Rep (E2Ext loc dec) x -> E2Ext loc dec
to :: forall x. Rep (E2Ext loc dec) x -> E2Ext loc dec
Generic, E2Ext loc dec -> ()
(E2Ext loc dec -> ()) -> NFData (E2Ext loc dec)
forall a. (a -> ()) -> NFData a
forall loc dec. (NFData loc, NFData dec) => E2Ext loc dec -> ()
$crnf :: forall loc dec. (NFData loc, NFData dec) => E2Ext loc dec -> ()
rnf :: E2Ext loc dec -> ()
NFData)

-- | Define a location in terms of a different location.
data PreLocExp loc = StartOfRegionLE Region
                   | AfterConstantLE Int  -- Number of bytes after.
                                     loc  -- Location which this location is offset from.
                   | AfterVariableLE Var  -- Name of variable v. This loc is size(v) bytes after.
                                     loc  -- Location which this location is offset from.
                                     Bool -- Whether it's running in a stolen continuation i.e
                                          -- whether this should return an index in a fresh region or not.
                                          -- It's True by default and flipped by ParAlloc if required.
                   | InRegionLE Region
                   | FreeLE
                   | FromEndLE  loc
  deriving (ReadPrec [PreLocExp loc]
ReadPrec (PreLocExp loc)
Int -> ReadS (PreLocExp loc)
ReadS [PreLocExp loc]
(Int -> ReadS (PreLocExp loc))
-> ReadS [PreLocExp loc]
-> ReadPrec (PreLocExp loc)
-> ReadPrec [PreLocExp loc]
-> Read (PreLocExp loc)
forall loc. Read loc => ReadPrec [PreLocExp loc]
forall loc. Read loc => ReadPrec (PreLocExp loc)
forall loc. Read loc => Int -> ReadS (PreLocExp loc)
forall loc. Read loc => ReadS [PreLocExp loc]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall loc. Read loc => Int -> ReadS (PreLocExp loc)
readsPrec :: Int -> ReadS (PreLocExp loc)
$creadList :: forall loc. Read loc => ReadS [PreLocExp loc]
readList :: ReadS [PreLocExp loc]
$creadPrec :: forall loc. Read loc => ReadPrec (PreLocExp loc)
readPrec :: ReadPrec (PreLocExp loc)
$creadListPrec :: forall loc. Read loc => ReadPrec [PreLocExp loc]
readListPrec :: ReadPrec [PreLocExp loc]
Read, Int -> PreLocExp loc -> ShowS
[PreLocExp loc] -> ShowS
PreLocExp loc -> String
(Int -> PreLocExp loc -> ShowS)
-> (PreLocExp loc -> String)
-> ([PreLocExp loc] -> ShowS)
-> Show (PreLocExp loc)
forall loc. Show loc => Int -> PreLocExp loc -> ShowS
forall loc. Show loc => [PreLocExp loc] -> ShowS
forall loc. Show loc => PreLocExp loc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall loc. Show loc => Int -> PreLocExp loc -> ShowS
showsPrec :: Int -> PreLocExp loc -> ShowS
$cshow :: forall loc. Show loc => PreLocExp loc -> String
show :: PreLocExp loc -> String
$cshowList :: forall loc. Show loc => [PreLocExp loc] -> ShowS
showList :: [PreLocExp loc] -> ShowS
Show, PreLocExp loc -> PreLocExp loc -> Bool
(PreLocExp loc -> PreLocExp loc -> Bool)
-> (PreLocExp loc -> PreLocExp loc -> Bool) -> Eq (PreLocExp loc)
forall loc. Eq loc => PreLocExp loc -> PreLocExp loc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall loc. Eq loc => PreLocExp loc -> PreLocExp loc -> Bool
== :: PreLocExp loc -> PreLocExp loc -> Bool
$c/= :: forall loc. Eq loc => PreLocExp loc -> PreLocExp loc -> Bool
/= :: PreLocExp loc -> PreLocExp loc -> Bool
Eq, Eq (PreLocExp loc)
Eq (PreLocExp loc)
-> (PreLocExp loc -> PreLocExp loc -> Ordering)
-> (PreLocExp loc -> PreLocExp loc -> Bool)
-> (PreLocExp loc -> PreLocExp loc -> Bool)
-> (PreLocExp loc -> PreLocExp loc -> Bool)
-> (PreLocExp loc -> PreLocExp loc -> Bool)
-> (PreLocExp loc -> PreLocExp loc -> PreLocExp loc)
-> (PreLocExp loc -> PreLocExp loc -> PreLocExp loc)
-> Ord (PreLocExp loc)
PreLocExp loc -> PreLocExp loc -> Bool
PreLocExp loc -> PreLocExp loc -> Ordering
PreLocExp loc -> PreLocExp loc -> PreLocExp loc
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}. Ord loc => Eq (PreLocExp loc)
forall loc. Ord loc => PreLocExp loc -> PreLocExp loc -> Bool
forall loc. Ord loc => PreLocExp loc -> PreLocExp loc -> Ordering
forall loc.
Ord loc =>
PreLocExp loc -> PreLocExp loc -> PreLocExp loc
$ccompare :: forall loc. Ord loc => PreLocExp loc -> PreLocExp loc -> Ordering
compare :: PreLocExp loc -> PreLocExp loc -> Ordering
$c< :: forall loc. Ord loc => PreLocExp loc -> PreLocExp loc -> Bool
< :: PreLocExp loc -> PreLocExp loc -> Bool
$c<= :: forall loc. Ord loc => PreLocExp loc -> PreLocExp loc -> Bool
<= :: PreLocExp loc -> PreLocExp loc -> Bool
$c> :: forall loc. Ord loc => PreLocExp loc -> PreLocExp loc -> Bool
> :: PreLocExp loc -> PreLocExp loc -> Bool
$c>= :: forall loc. Ord loc => PreLocExp loc -> PreLocExp loc -> Bool
>= :: PreLocExp loc -> PreLocExp loc -> Bool
$cmax :: forall loc.
Ord loc =>
PreLocExp loc -> PreLocExp loc -> PreLocExp loc
max :: PreLocExp loc -> PreLocExp loc -> PreLocExp loc
$cmin :: forall loc.
Ord loc =>
PreLocExp loc -> PreLocExp loc -> PreLocExp loc
min :: PreLocExp loc -> PreLocExp loc -> PreLocExp loc
Ord, (forall a b. (a -> b) -> PreLocExp a -> PreLocExp b)
-> (forall a b. a -> PreLocExp b -> PreLocExp a)
-> Functor PreLocExp
forall a b. a -> PreLocExp b -> PreLocExp a
forall a b. (a -> b) -> PreLocExp a -> PreLocExp b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PreLocExp a -> PreLocExp b
fmap :: forall a b. (a -> b) -> PreLocExp a -> PreLocExp b
$c<$ :: forall a b. a -> PreLocExp b -> PreLocExp a
<$ :: forall a b. a -> PreLocExp b -> PreLocExp a
Functor, (forall x. PreLocExp loc -> Rep (PreLocExp loc) x)
-> (forall x. Rep (PreLocExp loc) x -> PreLocExp loc)
-> Generic (PreLocExp loc)
forall x. Rep (PreLocExp loc) x -> PreLocExp loc
forall x. PreLocExp loc -> Rep (PreLocExp loc) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall loc x. Rep (PreLocExp loc) x -> PreLocExp loc
forall loc x. PreLocExp loc -> Rep (PreLocExp loc) x
$cfrom :: forall loc x. PreLocExp loc -> Rep (PreLocExp loc) x
from :: forall x. PreLocExp loc -> Rep (PreLocExp loc) x
$cto :: forall loc x. Rep (PreLocExp loc) x -> PreLocExp loc
to :: forall x. Rep (PreLocExp loc) x -> PreLocExp loc
Generic, PreLocExp loc -> ()
(PreLocExp loc -> ()) -> NFData (PreLocExp loc)
forall loc. NFData loc => PreLocExp loc -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall loc. NFData loc => PreLocExp loc -> ()
rnf :: PreLocExp loc -> ()
NFData)

type LocExp = PreLocExp LocVar

-- | Locations (end-witnesses) returned from functions after RouteEnds.
data LocRet = EndOf LRM
              deriving (ReadPrec [LocRet]
ReadPrec LocRet
Int -> ReadS LocRet
ReadS [LocRet]
(Int -> ReadS LocRet)
-> ReadS [LocRet]
-> ReadPrec LocRet
-> ReadPrec [LocRet]
-> Read LocRet
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LocRet
readsPrec :: Int -> ReadS LocRet
$creadList :: ReadS [LocRet]
readList :: ReadS [LocRet]
$creadPrec :: ReadPrec LocRet
readPrec :: ReadPrec LocRet
$creadListPrec :: ReadPrec [LocRet]
readListPrec :: ReadPrec [LocRet]
Read, Int -> LocRet -> ShowS
[LocRet] -> ShowS
LocRet -> String
(Int -> LocRet -> ShowS)
-> (LocRet -> String) -> ([LocRet] -> ShowS) -> Show LocRet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LocRet -> ShowS
showsPrec :: Int -> LocRet -> ShowS
$cshow :: LocRet -> String
show :: LocRet -> String
$cshowList :: [LocRet] -> ShowS
showList :: [LocRet] -> ShowS
Show, LocRet -> LocRet -> Bool
(LocRet -> LocRet -> Bool)
-> (LocRet -> LocRet -> Bool) -> Eq LocRet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LocRet -> LocRet -> Bool
== :: LocRet -> LocRet -> Bool
$c/= :: LocRet -> LocRet -> Bool
/= :: LocRet -> LocRet -> Bool
Eq, Eq LocRet
Eq LocRet
-> (LocRet -> LocRet -> Ordering)
-> (LocRet -> LocRet -> Bool)
-> (LocRet -> LocRet -> Bool)
-> (LocRet -> LocRet -> Bool)
-> (LocRet -> LocRet -> Bool)
-> (LocRet -> LocRet -> LocRet)
-> (LocRet -> LocRet -> LocRet)
-> Ord LocRet
LocRet -> LocRet -> Bool
LocRet -> LocRet -> Ordering
LocRet -> LocRet -> LocRet
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 :: LocRet -> LocRet -> Ordering
compare :: LocRet -> LocRet -> Ordering
$c< :: LocRet -> LocRet -> Bool
< :: LocRet -> LocRet -> Bool
$c<= :: LocRet -> LocRet -> Bool
<= :: LocRet -> LocRet -> Bool
$c> :: LocRet -> LocRet -> Bool
> :: LocRet -> LocRet -> Bool
$c>= :: LocRet -> LocRet -> Bool
>= :: LocRet -> LocRet -> Bool
$cmax :: LocRet -> LocRet -> LocRet
max :: LocRet -> LocRet -> LocRet
$cmin :: LocRet -> LocRet -> LocRet
min :: LocRet -> LocRet -> LocRet
Ord, (forall x. LocRet -> Rep LocRet x)
-> (forall x. Rep LocRet x -> LocRet) -> Generic LocRet
forall x. Rep LocRet x -> LocRet
forall x. LocRet -> Rep LocRet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LocRet -> Rep LocRet x
from :: forall x. LocRet -> Rep LocRet x
$cto :: forall x. Rep LocRet x -> LocRet
to :: forall x. Rep LocRet x -> LocRet
Generic, LocRet -> ()
(LocRet -> ()) -> NFData LocRet
forall a. (a -> ()) -> NFData a
$crnf :: LocRet -> ()
rnf :: LocRet -> ()
NFData)


instance FreeVars (E2Ext l d) where
  gFreeVars :: E2Ext l d -> Set Var
gFreeVars E2Ext l d
e =
    case E2Ext l d
e of
     LetRegionE Region
_ RegionSize
_ Maybe RegionType
_ E2 l d
bod   -> E2 l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars E2 l d
bod
     LetParRegionE Region
_ RegionSize
_ Maybe RegionType
_ E2 l d
bod   -> E2 l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars E2 l d
bod
     LetLocE Var
_ PreLocExp l
rhs E2 l d
bod  -> (case PreLocExp l
rhs of
                              AfterVariableLE Var
v l
_loc Bool
_ -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
                              PreLocExp l
_ -> Set Var
forall a. Set a
S.empty)
                           Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.union`
                           E2 l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars E2 l d
bod
     StartOfPkdCursor Var
cur -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
cur
     TagCursor Var
a Var
b      -> [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var
a,Var
b]
     RetE [l]
_ Var
vr          -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
vr
     FromEndE l
_         -> Set Var
forall a. Set a
S.empty
     AddFixed Var
vr Int
_      -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
vr
     BoundsCheck{}      -> Set Var
forall a. Set a
S.empty
     IndirectionE String
_ String
_ (l, l)
_ (l, l)
_ E2 l d
e -> E2 l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars E2 l d
e
     E2Ext l d
GetCilkWorkerNum   -> Set Var
forall a. Set a
S.empty
     LetAvail [Var]
vs E2 l d
bod    -> [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var]
vs Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.union` E2 l d -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars E2 l d
bod
     AllocateTagHere{}  -> Set Var
forall a. Set a
S.empty
     AllocateScalarsHere{}  -> Set Var
forall a. Set a
S.empty
     SSPush{} -> Set Var
forall a. Set a
S.empty
     SSPop{} -> Set Var
forall a. Set a
S.empty


instance FreeVars LocExp where
  gFreeVars :: LocExp -> Set Var
gFreeVars LocExp
e =
    case LocExp
e of
      AfterConstantLE Int
_ Var
loc   -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
loc
      AfterVariableLE Var
v Var
loc Bool
_ -> [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var
v,Var
loc]
      LocExp
_ -> Set Var
forall a. Set a
S.empty

instance (Out l, Out d, Show l, Show d) => Expression (E2Ext l d) where
  type LocOf (E2Ext l d) = l
  type TyOf (E2Ext l d)  = d
  isTrivial :: E2Ext l d -> Bool
isTrivial E2Ext l d
e =
    case E2Ext l d
e of
      LetRegionE{} -> Bool
False
      LetParRegionE{} -> Bool
False
      LetLocE{}    -> Bool
False
      StartOfPkdCursor{} -> Bool
False
      TagCursor{} -> Bool
False
      RetE{}       -> Bool
False -- Umm... this one could be potentially.
      FromEndE{}   -> Bool
True
      AddFixed{}     -> Bool
True
      BoundsCheck{}  -> Bool
False
      IndirectionE{} -> Bool
False
      E2Ext l d
GetCilkWorkerNum-> Bool
False
      LetAvail{}      -> Bool
False
      AllocateTagHere{} -> Bool
False
      AllocateScalarsHere{} -> Bool
False
      SSPush{} -> Bool
False
      SSPop{} -> Bool
False

instance (Out l, Show l, Typeable (E2 l (UrTy l))) => Typeable (E2Ext l (UrTy l)) where
  gRecoverType :: DDefs (TyOf (E2Ext l (UrTy l)))
-> Env2 (TyOf (E2Ext l (UrTy l)))
-> E2Ext l (UrTy l)
-> TyOf (E2Ext l (UrTy l))
gRecoverType DDefs (TyOf (E2Ext l (UrTy l)))
ddfs Env2 (TyOf (E2Ext l (UrTy l)))
env2 E2Ext l (UrTy l)
ex =
    case E2Ext l (UrTy l)
ex of
      LetRegionE Region
_r RegionSize
_ Maybe RegionType
_ E2 l (UrTy l)
bod    -> DDefs (TyOf (E2 l (UrTy l)))
-> Env2 (TyOf (E2 l (UrTy l)))
-> E2 l (UrTy l)
-> TyOf (E2 l (UrTy l))
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf (E2 l (UrTy l)))
DDefs (TyOf (E2Ext l (UrTy l)))
ddfs Env2 (TyOf (E2 l (UrTy l)))
Env2 (TyOf (E2Ext l (UrTy l)))
env2 E2 l (UrTy l)
bod
      LetParRegionE Region
_r RegionSize
_ Maybe RegionType
_ E2 l (UrTy l)
bod -> DDefs (TyOf (E2 l (UrTy l)))
-> Env2 (TyOf (E2 l (UrTy l)))
-> E2 l (UrTy l)
-> TyOf (E2 l (UrTy l))
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf (E2 l (UrTy l)))
DDefs (TyOf (E2Ext l (UrTy l)))
ddfs Env2 (TyOf (E2 l (UrTy l)))
Env2 (TyOf (E2Ext l (UrTy l)))
env2 E2 l (UrTy l)
bod
      LetLocE Var
_l PreLocExp l
_rhs E2 l (UrTy l)
bod -> DDefs (TyOf (E2 l (UrTy l)))
-> Env2 (TyOf (E2 l (UrTy l)))
-> E2 l (UrTy l)
-> TyOf (E2 l (UrTy l))
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf (E2 l (UrTy l)))
DDefs (TyOf (E2Ext l (UrTy l)))
ddfs Env2 (TyOf (E2 l (UrTy l)))
Env2 (TyOf (E2Ext l (UrTy l)))
env2 E2 l (UrTy l)
bod
      StartOfPkdCursor{}  -> TyOf (E2Ext l (UrTy l))
UrTy l
forall loc. UrTy loc
CursorTy
      TagCursor{}         -> TyOf (E2Ext l (UrTy l))
UrTy l
forall loc. UrTy loc
CursorTy
      RetE [l]
_loc Var
var       -> case Var -> Map Var (UrTy l) -> Maybe (UrTy l)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
var (Env2 (UrTy l) -> Map Var (UrTy l)
forall a. Env2 a -> TyEnv a
vEnv Env2 (TyOf (E2Ext l (UrTy l)))
Env2 (UrTy l)
env2) of
                               Just UrTy l
ty -> TyOf (E2Ext l (UrTy l))
UrTy l
ty
                               Maybe (UrTy l)
Nothing -> String -> TyOf (E2Ext l (UrTy l))
forall a. HasCallStack => String -> a
error (String -> TyOf (E2Ext l (UrTy l)))
-> String -> TyOf (E2Ext l (UrTy l))
forall a b. (a -> b) -> a -> b
$ String
"gRecoverType: unbound variable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Var -> String
forall a. Out a => a -> String
sdoc Var
var
      FromEndE l
_loc       -> String -> UrTy l
forall a. HasCallStack => String -> a
error String
"Shouldn't enconter FromEndE in tail position"
      BoundsCheck{}       -> String -> UrTy l
forall a. HasCallStack => String -> a
error String
"Shouldn't enconter BoundsCheck in tail position"
      IndirectionE String
tycon String
_ (l, l)
_ (l
to,l
_) E2 l (UrTy l)
_ -> String -> l -> UrTy l
forall loc. String -> loc -> UrTy loc
PackedTy String
tycon l
to
      AddFixed{}          -> String -> UrTy l
forall a. HasCallStack => String -> a
error String
"Shouldn't enconter AddFixed in tail position"
      E2Ext l (UrTy l)
GetCilkWorkerNum    -> TyOf (E2Ext l (UrTy l))
UrTy l
forall loc. UrTy loc
IntTy
      LetAvail [Var]
_ E2 l (UrTy l)
bod -> DDefs (TyOf (E2 l (UrTy l)))
-> Env2 (TyOf (E2 l (UrTy l)))
-> E2 l (UrTy l)
-> TyOf (E2 l (UrTy l))
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf (E2 l (UrTy l)))
DDefs (TyOf (E2Ext l (UrTy l)))
ddfs Env2 (TyOf (E2 l (UrTy l)))
Env2 (TyOf (E2Ext l (UrTy l)))
env2 E2 l (UrTy l)
bod
      AllocateTagHere{} -> [UrTy l] -> UrTy l
forall loc. [UrTy loc] -> UrTy loc
ProdTy []
      AllocateScalarsHere{} -> [UrTy l] -> UrTy l
forall loc. [UrTy loc] -> UrTy loc
ProdTy []
      SSPush{} -> [UrTy l] -> UrTy l
forall loc. [UrTy loc] -> UrTy loc
ProdTy []
      SSPop{} -> [UrTy l] -> UrTy l
forall loc. [UrTy loc] -> UrTy loc
ProdTy []

instance (Typeable (E2Ext l d),
          Expression (E2Ext l d),
          Flattenable (E2 l d))
      => Flattenable (E2Ext l d) where

  gFlattenGatherBinds :: DDefs (TyOf (E2Ext l d))
-> Env2 (TyOf (E2Ext l d))
-> E2Ext l d
-> PassM ([Binds (E2Ext l d)], E2Ext l d)
gFlattenGatherBinds DDefs (TyOf (E2Ext l d))
ddfs Env2 (TyOf (E2Ext l d))
env E2Ext l d
ex =
      case E2Ext l d
ex of
          LetRegionE Region
r RegionSize
sz Maybe RegionType
ty E2 l d
bod -> do
                                ([(Var, [l], d, E2 l d)]
bnds,E2 l d
bod') <- E2 l d -> PassM ([Binds (E2 l d)], E2 l d)
go E2 l d
bod
                                ([(Var, [l], d, E2Ext l d)], E2Ext l d)
-> PassM ([(Var, [l], d, E2Ext l d)], E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Region -> RegionSize -> Maybe RegionType -> E2 l d -> E2Ext l d
forall loc dec.
Region
-> RegionSize -> Maybe RegionType -> E2 loc dec -> E2Ext loc dec
LetRegionE Region
r RegionSize
sz Maybe RegionType
ty ([(Var, [l], d, E2 l d)] -> E2 l d -> E2 l d
forall l d (e :: * -> * -> *).
[(Var, [l], d, PreExp e l d)] -> PreExp e l d -> PreExp e l d
flatLets [(Var, [l], d, E2 l d)]
bnds E2 l d
bod'))

          LetParRegionE Region
r RegionSize
sz Maybe RegionType
ty E2 l d
bod -> do
                                ([(Var, [l], d, E2 l d)]
bnds,E2 l d
bod') <- E2 l d -> PassM ([Binds (E2 l d)], E2 l d)
go E2 l d
bod
                                ([(Var, [l], d, E2Ext l d)], E2Ext l d)
-> PassM ([(Var, [l], d, E2Ext l d)], E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Region -> RegionSize -> Maybe RegionType -> E2 l d -> E2Ext l d
forall loc dec.
Region
-> RegionSize -> Maybe RegionType -> E2 loc dec -> E2Ext loc dec
LetParRegionE Region
r RegionSize
sz Maybe RegionType
ty ([(Var, [l], d, E2 l d)] -> E2 l d -> E2 l d
forall l d (e :: * -> * -> *).
[(Var, [l], d, PreExp e l d)] -> PreExp e l d -> PreExp e l d
flatLets [(Var, [l], d, E2 l d)]
bnds E2 l d
bod'))

          LetLocE Var
l PreLocExp l
rhs E2 l d
bod -> do ([(Var, [l], d, E2 l d)]
bnds,E2 l d
bod') <- E2 l d -> PassM ([Binds (E2 l d)], E2 l d)
go E2 l d
bod
                                  ([(Var, [l], d, E2Ext l d)], E2Ext l d)
-> PassM ([(Var, [l], d, E2Ext l d)], E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Var -> PreLocExp l -> E2 l d -> E2Ext l d
forall loc dec. Var -> PreLocExp loc -> E2 loc dec -> E2Ext loc dec
LetLocE Var
l PreLocExp l
rhs (E2 l d -> E2Ext l d) -> E2 l d -> E2Ext l d
forall a b. (a -> b) -> a -> b
$ [(Var, [l], d, E2 l d)] -> E2 l d -> E2 l d
forall l d (e :: * -> * -> *).
[(Var, [l], d, PreExp e l d)] -> PreExp e l d -> PreExp e l d
flatLets [(Var, [l], d, E2 l d)]
bnds E2 l d
bod')

          TagCursor{}-> ([(Var, [l], d, E2Ext l d)], E2Ext l d)
-> PassM ([(Var, [l], d, E2Ext l d)], E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],E2Ext l d
ex)
          StartOfPkdCursor{} -> ([(Var, [l], d, E2Ext l d)], E2Ext l d)
-> PassM ([(Var, [l], d, E2Ext l d)], E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],E2Ext l d
ex)
          RetE{}        -> ([(Var, [l], d, E2Ext l d)], E2Ext l d)
-> PassM ([(Var, [l], d, E2Ext l d)], E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],E2Ext l d
ex)
          FromEndE{}    -> ([(Var, [l], d, E2Ext l d)], E2Ext l d)
-> PassM ([(Var, [l], d, E2Ext l d)], E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],E2Ext l d
ex)
          AddFixed{}    -> ([(Var, [l], d, E2Ext l d)], E2Ext l d)
-> PassM ([(Var, [l], d, E2Ext l d)], E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],E2Ext l d
ex)
          BoundsCheck{} -> ([(Var, [l], d, E2Ext l d)], E2Ext l d)
-> PassM ([(Var, [l], d, E2Ext l d)], E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],E2Ext l d
ex)
          IndirectionE{}-> ([(Var, [l], d, E2Ext l d)], E2Ext l d)
-> PassM ([(Var, [l], d, E2Ext l d)], E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],E2Ext l d
ex)
          E2Ext l d
GetCilkWorkerNum-> ([(Var, [l], d, E2Ext l d)], E2Ext l d)
-> PassM ([(Var, [l], d, E2Ext l d)], E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],E2Ext l d
ex)
          LetAvail [Var]
vs E2 l d
bod -> do ([(Var, [l], d, E2 l d)]
bnds,E2 l d
bod') <- E2 l d -> PassM ([Binds (E2 l d)], E2 l d)
go E2 l d
bod
                                ([(Var, [l], d, E2Ext l d)], E2Ext l d)
-> PassM ([(Var, [l], d, E2Ext l d)], E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Var] -> E2 l d -> E2Ext l d
forall loc dec. [Var] -> E2 loc dec -> E2Ext loc dec
LetAvail [Var]
vs (E2 l d -> E2Ext l d) -> E2 l d -> E2Ext l d
forall a b. (a -> b) -> a -> b
$ [(Var, [l], d, E2 l d)] -> E2 l d -> E2 l d
forall l d (e :: * -> * -> *).
[(Var, [l], d, PreExp e l d)] -> PreExp e l d -> PreExp e l d
flatLets [(Var, [l], d, E2 l d)]
bnds E2 l d
bod')
          AllocateTagHere{} -> ([(Var, [l], d, E2Ext l d)], E2Ext l d)
-> PassM ([(Var, [l], d, E2Ext l d)], E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],E2Ext l d
ex)
          AllocateScalarsHere{} -> ([(Var, [l], d, E2Ext l d)], E2Ext l d)
-> PassM ([(Var, [l], d, E2Ext l d)], E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],E2Ext l d
ex)
          SSPush{} -> ([(Var, [l], d, E2Ext l d)], E2Ext l d)
-> PassM ([(Var, [l], d, E2Ext l d)], E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],E2Ext l d
ex)
          SSPop{} -> ([(Var, [l], d, E2Ext l d)], E2Ext l d)
-> PassM ([(Var, [l], d, E2Ext l d)], E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([],E2Ext l d
ex)

    where go :: E2 l d -> PassM ([Binds (E2 l d)], E2 l d)
go = DDefs (TyOf (E2 l d))
-> Env2 (TyOf (E2 l d))
-> E2 l d
-> PassM ([Binds (E2 l d)], E2 l d)
forall e.
Flattenable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> PassM ([Binds e], e)
gFlattenGatherBinds DDefs (TyOf (E2 l d))
DDefs (TyOf (E2Ext l d))
ddfs Env2 (TyOf (E2 l d))
Env2 (TyOf (E2Ext l d))
env

  gFlattenExp :: DDefs (TyOf (E2Ext l d))
-> Env2 (TyOf (E2Ext l d)) -> E2Ext l d -> PassM (E2Ext l d)
gFlattenExp DDefs (TyOf (E2Ext l d))
ddfs Env2 (TyOf (E2Ext l d))
env E2Ext l d
ex = do ([(Var, [l], d, E2Ext l d)]
_b,E2Ext l d
e') <- DDefs (TyOf (E2Ext l d))
-> Env2 (TyOf (E2Ext l d))
-> E2Ext l d
-> PassM ([Binds (E2Ext l d)], E2Ext l d)
forall e.
Flattenable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> PassM ([Binds e], e)
gFlattenGatherBinds DDefs (TyOf (E2Ext l d))
ddfs Env2 (TyOf (E2Ext l d))
env E2Ext l d
ex
                               E2Ext l d -> PassM (E2Ext l d)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return E2Ext l d
e'

instance HasSimplifiableExt E2Ext l d => SimplifiableExt (PreExp E2Ext l d) (E2Ext l d) where
  gInlineTrivExt :: Map Var (PreExp E2Ext l d) -> E2Ext l d -> E2Ext l d
gInlineTrivExt Map Var (PreExp E2Ext l d)
env E2Ext l d
ext =
    case E2Ext l d
ext of
      LetRegionE Region
r RegionSize
sz Maybe RegionType
ty PreExp E2Ext l d
bod   -> Region
-> RegionSize -> Maybe RegionType -> PreExp E2Ext l d -> E2Ext l d
forall loc dec.
Region
-> RegionSize -> Maybe RegionType -> E2 loc dec -> E2Ext loc dec
LetRegionE Region
r RegionSize
sz Maybe RegionType
ty (Map Var (PreExp E2Ext l d) -> PreExp E2Ext l d -> PreExp E2Ext l d
forall e. Simplifiable e => Map Var e -> e -> e
gInlineTrivExp Map Var (PreExp E2Ext l d)
env PreExp E2Ext l d
bod)
      LetParRegionE Region
r RegionSize
sz Maybe RegionType
ty PreExp E2Ext l d
bod -> Region
-> RegionSize -> Maybe RegionType -> PreExp E2Ext l d -> E2Ext l d
forall loc dec.
Region
-> RegionSize -> Maybe RegionType -> E2 loc dec -> E2Ext loc dec
LetParRegionE Region
r RegionSize
sz Maybe RegionType
ty (Map Var (PreExp E2Ext l d) -> PreExp E2Ext l d -> PreExp E2Ext l d
forall e. Simplifiable e => Map Var e -> e -> e
gInlineTrivExp Map Var (PreExp E2Ext l d)
env PreExp E2Ext l d
bod)
      LetLocE Var
loc PreLocExp l
le PreExp E2Ext l d
bod -> Var -> PreLocExp l -> PreExp E2Ext l d -> E2Ext l d
forall loc dec. Var -> PreLocExp loc -> E2 loc dec -> E2Ext loc dec
LetLocE Var
loc PreLocExp l
le (Map Var (PreExp E2Ext l d) -> PreExp E2Ext l d -> PreExp E2Ext l d
forall e. Simplifiable e => Map Var e -> e -> e
gInlineTrivExp Map Var (PreExp E2Ext l d)
env PreExp E2Ext l d
bod)
      TagCursor{} -> E2Ext l d
ext
      StartOfPkdCursor{} -> E2Ext l d
ext
      RetE{}         -> E2Ext l d
ext
      FromEndE{}     -> E2Ext l d
ext
      BoundsCheck{}  -> E2Ext l d
ext
      IndirectionE{} -> E2Ext l d
ext
      AddFixed{}     -> E2Ext l d
ext
      E2Ext l d
GetCilkWorkerNum-> E2Ext l d
ext
      LetAvail [Var]
vs PreExp E2Ext l d
bod -> [Var] -> PreExp E2Ext l d -> E2Ext l d
forall loc dec. [Var] -> E2 loc dec -> E2Ext loc dec
LetAvail [Var]
vs (Map Var (PreExp E2Ext l d) -> PreExp E2Ext l d -> PreExp E2Ext l d
forall e. Simplifiable e => Map Var e -> e -> e
gInlineTrivExp Map Var (PreExp E2Ext l d)
env PreExp E2Ext l d
bod)
      AllocateTagHere{} -> E2Ext l d
ext
      AllocateScalarsHere{} -> E2Ext l d
ext
      SSPush{} -> E2Ext l d
ext
      SSPop{} -> E2Ext l d
ext


instance HasSubstitutableExt E2Ext l d => SubstitutableExt (PreExp E2Ext l d) (E2Ext l d) where
  gSubstExt :: Var -> PreExp E2Ext l d -> E2Ext l d -> E2Ext l d
gSubstExt Var
old PreExp E2Ext l d
new E2Ext l d
ext =
    case E2Ext l d
ext of
      LetRegionE Region
r RegionSize
sz Maybe RegionType
ty PreExp E2Ext l d
bod -> Region
-> RegionSize -> Maybe RegionType -> PreExp E2Ext l d -> E2Ext l d
forall loc dec.
Region
-> RegionSize -> Maybe RegionType -> E2 loc dec -> E2Ext loc dec
LetRegionE Region
r RegionSize
sz Maybe RegionType
ty (Var -> PreExp E2Ext l d -> PreExp E2Ext l d -> PreExp E2Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E2Ext l d
new PreExp E2Ext l d
bod)
      LetParRegionE Region
r RegionSize
sz Maybe RegionType
ty PreExp E2Ext l d
bod -> Region
-> RegionSize -> Maybe RegionType -> PreExp E2Ext l d -> E2Ext l d
forall loc dec.
Region
-> RegionSize -> Maybe RegionType -> E2 loc dec -> E2Ext loc dec
LetParRegionE Region
r RegionSize
sz Maybe RegionType
ty (Var -> PreExp E2Ext l d -> PreExp E2Ext l d -> PreExp E2Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E2Ext l d
new PreExp E2Ext l d
bod)
      LetLocE Var
l PreLocExp l
le PreExp E2Ext l d
bod -> Var -> PreLocExp l -> PreExp E2Ext l d -> E2Ext l d
forall loc dec. Var -> PreLocExp loc -> E2 loc dec -> E2Ext loc dec
LetLocE Var
l PreLocExp l
le (Var -> PreExp E2Ext l d -> PreExp E2Ext l d -> PreExp E2Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E2Ext l d
new PreExp E2Ext l d
bod)
      TagCursor{}   -> E2Ext l d
ext
      StartOfPkdCursor{} -> E2Ext l d
ext
      RetE{}           -> E2Ext l d
ext
      FromEndE{}       -> E2Ext l d
ext
      BoundsCheck{}    -> E2Ext l d
ext
      IndirectionE{}   -> E2Ext l d
ext
      AddFixed{}       -> E2Ext l d
ext
      E2Ext l d
GetCilkWorkerNum -> E2Ext l d
ext
      LetAvail [Var]
vs PreExp E2Ext l d
bod  -> [Var] -> PreExp E2Ext l d -> E2Ext l d
forall loc dec. [Var] -> E2 loc dec -> E2Ext loc dec
LetAvail [Var]
vs (Var -> PreExp E2Ext l d -> PreExp E2Ext l d -> PreExp E2Ext l d
forall e. Substitutable e => Var -> e -> e -> e
gSubst Var
old PreExp E2Ext l d
new PreExp E2Ext l d
bod)
      AllocateTagHere{} -> E2Ext l d
ext
      AllocateScalarsHere{} -> E2Ext l d
ext
      SSPush{} -> E2Ext l d
ext
      SSPop{} -> E2Ext l d
ext

  gSubstEExt :: PreExp E2Ext l d -> PreExp E2Ext l d -> E2Ext l d -> E2Ext l d
gSubstEExt PreExp E2Ext l d
old PreExp E2Ext l d
new E2Ext l d
ext =
    case E2Ext l d
ext of
      LetRegionE Region
r RegionSize
sz Maybe RegionType
ty PreExp E2Ext l d
bod -> Region
-> RegionSize -> Maybe RegionType -> PreExp E2Ext l d -> E2Ext l d
forall loc dec.
Region
-> RegionSize -> Maybe RegionType -> E2 loc dec -> E2Ext loc dec
LetRegionE Region
r RegionSize
sz Maybe RegionType
ty (PreExp E2Ext l d
-> PreExp E2Ext l d -> PreExp E2Ext l d -> PreExp E2Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E2Ext l d
old PreExp E2Ext l d
new PreExp E2Ext l d
bod)
      LetParRegionE Region
r RegionSize
sz Maybe RegionType
ty PreExp E2Ext l d
bod -> Region
-> RegionSize -> Maybe RegionType -> PreExp E2Ext l d -> E2Ext l d
forall loc dec.
Region
-> RegionSize -> Maybe RegionType -> E2 loc dec -> E2Ext loc dec
LetParRegionE Region
r RegionSize
sz Maybe RegionType
ty (PreExp E2Ext l d
-> PreExp E2Ext l d -> PreExp E2Ext l d -> PreExp E2Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E2Ext l d
old PreExp E2Ext l d
new PreExp E2Ext l d
bod)
      LetLocE Var
l PreLocExp l
le PreExp E2Ext l d
bod -> Var -> PreLocExp l -> PreExp E2Ext l d -> E2Ext l d
forall loc dec. Var -> PreLocExp loc -> E2 loc dec -> E2Ext loc dec
LetLocE Var
l PreLocExp l
le (PreExp E2Ext l d
-> PreExp E2Ext l d -> PreExp E2Ext l d -> PreExp E2Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E2Ext l d
old PreExp E2Ext l d
new PreExp E2Ext l d
bod)
      TagCursor{}   -> E2Ext l d
ext
      StartOfPkdCursor{} -> E2Ext l d
ext
      RetE{}           -> E2Ext l d
ext
      FromEndE{}       -> E2Ext l d
ext
      BoundsCheck{}    -> E2Ext l d
ext
      IndirectionE{}   -> E2Ext l d
ext
      AddFixed{}       -> E2Ext l d
ext
      E2Ext l d
GetCilkWorkerNum -> E2Ext l d
ext
      LetAvail [Var]
vs PreExp E2Ext l d
bod  -> [Var] -> PreExp E2Ext l d -> E2Ext l d
forall loc dec. [Var] -> E2 loc dec -> E2Ext loc dec
LetAvail [Var]
vs (PreExp E2Ext l d
-> PreExp E2Ext l d -> PreExp E2Ext l d -> PreExp E2Ext l d
forall e. Substitutable e => e -> e -> e -> e
gSubstE PreExp E2Ext l d
old PreExp E2Ext l d
new PreExp E2Ext l d
bod)
      AllocateTagHere{} -> E2Ext l d
ext
      AllocateScalarsHere{} -> E2Ext l d
ext
      SSPush{} -> E2Ext l d
ext
      SSPop{} -> E2Ext l d
ext

instance HasRenamable E2Ext l d => Renamable (E2Ext l d) where
  gRename :: Map Var Var -> E2Ext l d -> E2Ext l d
gRename Map Var Var
env E2Ext l d
ext =
    case E2Ext l d
ext of
      LetRegionE Region
r RegionSize
sz Maybe RegionType
ty E2 l d
bod -> Region -> RegionSize -> Maybe RegionType -> E2 l d -> E2Ext l d
forall loc dec.
Region
-> RegionSize -> Maybe RegionType -> E2 loc dec -> E2Ext loc dec
LetRegionE Region
r RegionSize
sz Maybe RegionType
ty (Map Var Var -> E2 l d -> E2 l d
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env E2 l d
bod)
      LetParRegionE Region
r RegionSize
sz Maybe RegionType
ty E2 l d
bod -> Region -> RegionSize -> Maybe RegionType -> E2 l d -> E2Ext l d
forall loc dec.
Region
-> RegionSize -> Maybe RegionType -> E2 loc dec -> E2Ext loc dec
LetParRegionE Region
r RegionSize
sz Maybe RegionType
ty (Map Var Var -> E2 l d -> E2 l d
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env E2 l d
bod)
      LetLocE Var
l PreLocExp l
le E2 l d
bod -> Var -> PreLocExp l -> E2 l d -> E2Ext l d
forall loc dec. Var -> PreLocExp loc -> E2 loc dec -> E2Ext loc dec
LetLocE Var
l PreLocExp l
le (Map Var Var -> E2 l d -> E2 l d
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env E2 l d
bod)
      TagCursor Var
a Var
b -> Var -> Var -> E2Ext l d
forall loc dec. Var -> Var -> E2Ext loc dec
TagCursor (Map Var Var -> Var -> Var
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env Var
a) (Map Var Var -> Var -> Var
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env Var
b)
      StartOfPkdCursor Var
cur -> Var -> E2Ext l d
forall loc dec. Var -> E2Ext loc dec
StartOfPkdCursor (Map Var Var -> Var -> Var
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env Var
cur)
      RetE{}           -> E2Ext l d
ext
      FromEndE{}       -> E2Ext l d
ext
      BoundsCheck{}    -> E2Ext l d
ext
      IndirectionE{}   -> E2Ext l d
ext
      AddFixed{}       -> E2Ext l d
ext
      E2Ext l d
GetCilkWorkerNum -> E2Ext l d
ext
      LetAvail [Var]
vs E2 l d
bod  -> [Var] -> E2 l d -> E2Ext l d
forall loc dec. [Var] -> E2 loc dec -> E2Ext loc dec
LetAvail [Var]
vs (Map Var Var -> E2 l d -> E2 l d
forall e. Renamable e => Map Var Var -> e -> e
gRename Map Var Var
env E2 l d
bod)
      AllocateTagHere{} -> E2Ext l d
ext
      AllocateScalarsHere{} -> E2Ext l d
ext
      SSPush{} -> E2Ext l d
ext
      SSPop{} -> E2Ext l d
ext

-- | Our type for functions grows to include effects, and explicit universal
-- quantification over location/region variables.
data ArrowTy2 ty2 = ArrowTy2
    { forall ty2. ArrowTy2 ty2 -> [LRM]
locVars :: [LRM]          -- ^ Universally-quantified location params.
                                -- Only these should be referenced in arrIn/arrOut.
    , forall ty2. ArrowTy2 ty2 -> [ty2]
arrIns  :: [ty2]          -- ^ Input type for the function.
    , forall ty2. ArrowTy2 ty2 -> Set Effect
arrEffs :: (S.Set Effect) -- ^ These are present-but-empty initially,
                                -- and the populated by InferEffects.
    , forall ty2. ArrowTy2 ty2 -> ty2
arrOut  :: ty2            -- ^ Output type for the function.
    , forall ty2. ArrowTy2 ty2 -> [LocRet]
locRets :: [LocRet]       -- ^ L2B feature: multi-valued returns.
    , forall ty2. ArrowTy2 ty2 -> Bool
hasParallelism :: Bool        -- ^ Does this function have parallelism
    }
  deriving (ReadPrec [ArrowTy2 ty2]
ReadPrec (ArrowTy2 ty2)
Int -> ReadS (ArrowTy2 ty2)
ReadS [ArrowTy2 ty2]
(Int -> ReadS (ArrowTy2 ty2))
-> ReadS [ArrowTy2 ty2]
-> ReadPrec (ArrowTy2 ty2)
-> ReadPrec [ArrowTy2 ty2]
-> Read (ArrowTy2 ty2)
forall ty2. Read ty2 => ReadPrec [ArrowTy2 ty2]
forall ty2. Read ty2 => ReadPrec (ArrowTy2 ty2)
forall ty2. Read ty2 => Int -> ReadS (ArrowTy2 ty2)
forall ty2. Read ty2 => ReadS [ArrowTy2 ty2]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall ty2. Read ty2 => Int -> ReadS (ArrowTy2 ty2)
readsPrec :: Int -> ReadS (ArrowTy2 ty2)
$creadList :: forall ty2. Read ty2 => ReadS [ArrowTy2 ty2]
readList :: ReadS [ArrowTy2 ty2]
$creadPrec :: forall ty2. Read ty2 => ReadPrec (ArrowTy2 ty2)
readPrec :: ReadPrec (ArrowTy2 ty2)
$creadListPrec :: forall ty2. Read ty2 => ReadPrec [ArrowTy2 ty2]
readListPrec :: ReadPrec [ArrowTy2 ty2]
Read, Int -> ArrowTy2 ty2 -> ShowS
[ArrowTy2 ty2] -> ShowS
ArrowTy2 ty2 -> String
(Int -> ArrowTy2 ty2 -> ShowS)
-> (ArrowTy2 ty2 -> String)
-> ([ArrowTy2 ty2] -> ShowS)
-> Show (ArrowTy2 ty2)
forall ty2. Show ty2 => Int -> ArrowTy2 ty2 -> ShowS
forall ty2. Show ty2 => [ArrowTy2 ty2] -> ShowS
forall ty2. Show ty2 => ArrowTy2 ty2 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall ty2. Show ty2 => Int -> ArrowTy2 ty2 -> ShowS
showsPrec :: Int -> ArrowTy2 ty2 -> ShowS
$cshow :: forall ty2. Show ty2 => ArrowTy2 ty2 -> String
show :: ArrowTy2 ty2 -> String
$cshowList :: forall ty2. Show ty2 => [ArrowTy2 ty2] -> ShowS
showList :: [ArrowTy2 ty2] -> ShowS
Show, ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool
(ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool)
-> (ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool) -> Eq (ArrowTy2 ty2)
forall ty2. Eq ty2 => ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall ty2. Eq ty2 => ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool
== :: ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool
$c/= :: forall ty2. Eq ty2 => ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool
/= :: ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool
Eq, Eq (ArrowTy2 ty2)
Eq (ArrowTy2 ty2)
-> (ArrowTy2 ty2 -> ArrowTy2 ty2 -> Ordering)
-> (ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool)
-> (ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool)
-> (ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool)
-> (ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool)
-> (ArrowTy2 ty2 -> ArrowTy2 ty2 -> ArrowTy2 ty2)
-> (ArrowTy2 ty2 -> ArrowTy2 ty2 -> ArrowTy2 ty2)
-> Ord (ArrowTy2 ty2)
ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool
ArrowTy2 ty2 -> ArrowTy2 ty2 -> Ordering
ArrowTy2 ty2 -> ArrowTy2 ty2 -> ArrowTy2 ty2
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 {ty2}. Ord ty2 => Eq (ArrowTy2 ty2)
forall ty2. Ord ty2 => ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool
forall ty2. Ord ty2 => ArrowTy2 ty2 -> ArrowTy2 ty2 -> Ordering
forall ty2. Ord ty2 => ArrowTy2 ty2 -> ArrowTy2 ty2 -> ArrowTy2 ty2
$ccompare :: forall ty2. Ord ty2 => ArrowTy2 ty2 -> ArrowTy2 ty2 -> Ordering
compare :: ArrowTy2 ty2 -> ArrowTy2 ty2 -> Ordering
$c< :: forall ty2. Ord ty2 => ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool
< :: ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool
$c<= :: forall ty2. Ord ty2 => ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool
<= :: ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool
$c> :: forall ty2. Ord ty2 => ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool
> :: ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool
$c>= :: forall ty2. Ord ty2 => ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool
>= :: ArrowTy2 ty2 -> ArrowTy2 ty2 -> Bool
$cmax :: forall ty2. Ord ty2 => ArrowTy2 ty2 -> ArrowTy2 ty2 -> ArrowTy2 ty2
max :: ArrowTy2 ty2 -> ArrowTy2 ty2 -> ArrowTy2 ty2
$cmin :: forall ty2. Ord ty2 => ArrowTy2 ty2 -> ArrowTy2 ty2 -> ArrowTy2 ty2
min :: ArrowTy2 ty2 -> ArrowTy2 ty2 -> ArrowTy2 ty2
Ord, (forall a b. (a -> b) -> ArrowTy2 a -> ArrowTy2 b)
-> (forall a b. a -> ArrowTy2 b -> ArrowTy2 a) -> Functor ArrowTy2
forall a b. a -> ArrowTy2 b -> ArrowTy2 a
forall a b. (a -> b) -> ArrowTy2 a -> ArrowTy2 b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ArrowTy2 a -> ArrowTy2 b
fmap :: forall a b. (a -> b) -> ArrowTy2 a -> ArrowTy2 b
$c<$ :: forall a b. a -> ArrowTy2 b -> ArrowTy2 a
<$ :: forall a b. a -> ArrowTy2 b -> ArrowTy2 a
Functor, (forall x. ArrowTy2 ty2 -> Rep (ArrowTy2 ty2) x)
-> (forall x. Rep (ArrowTy2 ty2) x -> ArrowTy2 ty2)
-> Generic (ArrowTy2 ty2)
forall x. Rep (ArrowTy2 ty2) x -> ArrowTy2 ty2
forall x. ArrowTy2 ty2 -> Rep (ArrowTy2 ty2) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall ty2 x. Rep (ArrowTy2 ty2) x -> ArrowTy2 ty2
forall ty2 x. ArrowTy2 ty2 -> Rep (ArrowTy2 ty2) x
$cfrom :: forall ty2 x. ArrowTy2 ty2 -> Rep (ArrowTy2 ty2) x
from :: forall x. ArrowTy2 ty2 -> Rep (ArrowTy2 ty2) x
$cto :: forall ty2 x. Rep (ArrowTy2 ty2) x -> ArrowTy2 ty2
to :: forall x. Rep (ArrowTy2 ty2) x -> ArrowTy2 ty2
Generic, ArrowTy2 ty2 -> ()
(ArrowTy2 ty2 -> ()) -> NFData (ArrowTy2 ty2)
forall ty2. NFData ty2 => ArrowTy2 ty2 -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall ty2. NFData ty2 => ArrowTy2 ty2 -> ()
rnf :: ArrowTy2 ty2 -> ()
NFData)

-- | The side-effect of evaluating a function.
data Effect = Traverse LocVar
              -- ^ The function, during its execution, traverses all
              -- of the value living at this location.
  deriving (ReadPrec [Effect]
ReadPrec Effect
Int -> ReadS Effect
ReadS [Effect]
(Int -> ReadS Effect)
-> ReadS [Effect]
-> ReadPrec Effect
-> ReadPrec [Effect]
-> Read Effect
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Effect
readsPrec :: Int -> ReadS Effect
$creadList :: ReadS [Effect]
readList :: ReadS [Effect]
$creadPrec :: ReadPrec Effect
readPrec :: ReadPrec Effect
$creadListPrec :: ReadPrec [Effect]
readListPrec :: ReadPrec [Effect]
Read,Int -> Effect -> ShowS
[Effect] -> ShowS
Effect -> String
(Int -> Effect -> ShowS)
-> (Effect -> String) -> ([Effect] -> ShowS) -> Show Effect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Effect -> ShowS
showsPrec :: Int -> Effect -> ShowS
$cshow :: Effect -> String
show :: Effect -> String
$cshowList :: [Effect] -> ShowS
showList :: [Effect] -> ShowS
Show,Effect -> Effect -> Bool
(Effect -> Effect -> Bool)
-> (Effect -> Effect -> Bool) -> Eq Effect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Effect -> Effect -> Bool
== :: Effect -> Effect -> Bool
$c/= :: Effect -> Effect -> Bool
/= :: Effect -> Effect -> Bool
Eq,Eq Effect
Eq Effect
-> (Effect -> Effect -> Ordering)
-> (Effect -> Effect -> Bool)
-> (Effect -> Effect -> Bool)
-> (Effect -> Effect -> Bool)
-> (Effect -> Effect -> Bool)
-> (Effect -> Effect -> Effect)
-> (Effect -> Effect -> Effect)
-> Ord Effect
Effect -> Effect -> Bool
Effect -> Effect -> Ordering
Effect -> Effect -> Effect
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 :: Effect -> Effect -> Ordering
compare :: Effect -> Effect -> Ordering
$c< :: Effect -> Effect -> Bool
< :: Effect -> Effect -> Bool
$c<= :: Effect -> Effect -> Bool
<= :: Effect -> Effect -> Bool
$c> :: Effect -> Effect -> Bool
> :: Effect -> Effect -> Bool
$c>= :: Effect -> Effect -> Bool
>= :: Effect -> Effect -> Bool
$cmax :: Effect -> Effect -> Effect
max :: Effect -> Effect -> Effect
$cmin :: Effect -> Effect -> Effect
min :: Effect -> Effect -> Effect
Ord, (forall x. Effect -> Rep Effect x)
-> (forall x. Rep Effect x -> Effect) -> Generic Effect
forall x. Rep Effect x -> Effect
forall x. Effect -> Rep Effect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Effect -> Rep Effect x
from :: forall x. Effect -> Rep Effect x
$cto :: forall x. Rep Effect x -> Effect
to :: forall x. Rep Effect x -> Effect
Generic, Effect -> ()
(Effect -> ()) -> NFData Effect
forall a. (a -> ()) -> NFData a
$crnf :: Effect -> ()
rnf :: Effect -> ()
NFData)

--------------------------------------------------------------------------------
--
-- See https://github.com/iu-parfunc/gibbon/issues/79 for more details
-- | Region variants (multiplicities)
data Multiplicity
    = Bounded Int -- ^ Contain a finite number of values and can be
                  --   stack-allocated.

    | Infinite    -- ^ Consist of a linked list of buffers, spread
                  --   throughout memory (though possible constrained
                  --   to 4GB regions). Writing into these regions requires
                  --   bounds-checking. The buffers can start very small
                  --   at the head of the list, but probably grow
                  --   geometrically in size, making the cost of traversing
                  --   all of them logarithmic.

    | BigInfinite -- ^ These regions are infinite, but also have the
                  --   expectation of containing many values. Thus we give
                  --   them large initial page sizes. This is also could be
                  --   the appropriate place to use mmap to grow the region
                  --   and to establish guard places.
  deriving (ReadPrec [Multiplicity]
ReadPrec Multiplicity
Int -> ReadS Multiplicity
ReadS [Multiplicity]
(Int -> ReadS Multiplicity)
-> ReadS [Multiplicity]
-> ReadPrec Multiplicity
-> ReadPrec [Multiplicity]
-> Read Multiplicity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Multiplicity
readsPrec :: Int -> ReadS Multiplicity
$creadList :: ReadS [Multiplicity]
readList :: ReadS [Multiplicity]
$creadPrec :: ReadPrec Multiplicity
readPrec :: ReadPrec Multiplicity
$creadListPrec :: ReadPrec [Multiplicity]
readListPrec :: ReadPrec [Multiplicity]
Read,Int -> Multiplicity -> ShowS
[Multiplicity] -> ShowS
Multiplicity -> String
(Int -> Multiplicity -> ShowS)
-> (Multiplicity -> String)
-> ([Multiplicity] -> ShowS)
-> Show Multiplicity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Multiplicity -> ShowS
showsPrec :: Int -> Multiplicity -> ShowS
$cshow :: Multiplicity -> String
show :: Multiplicity -> String
$cshowList :: [Multiplicity] -> ShowS
showList :: [Multiplicity] -> ShowS
Show,Multiplicity -> Multiplicity -> Bool
(Multiplicity -> Multiplicity -> Bool)
-> (Multiplicity -> Multiplicity -> Bool) -> Eq Multiplicity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Multiplicity -> Multiplicity -> Bool
== :: Multiplicity -> Multiplicity -> Bool
$c/= :: Multiplicity -> Multiplicity -> Bool
/= :: Multiplicity -> Multiplicity -> Bool
Eq,Eq Multiplicity
Eq Multiplicity
-> (Multiplicity -> Multiplicity -> Ordering)
-> (Multiplicity -> Multiplicity -> Bool)
-> (Multiplicity -> Multiplicity -> Bool)
-> (Multiplicity -> Multiplicity -> Bool)
-> (Multiplicity -> Multiplicity -> Bool)
-> (Multiplicity -> Multiplicity -> Multiplicity)
-> (Multiplicity -> Multiplicity -> Multiplicity)
-> Ord Multiplicity
Multiplicity -> Multiplicity -> Bool
Multiplicity -> Multiplicity -> Ordering
Multiplicity -> Multiplicity -> Multiplicity
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 :: Multiplicity -> Multiplicity -> Ordering
compare :: Multiplicity -> Multiplicity -> Ordering
$c< :: Multiplicity -> Multiplicity -> Bool
< :: Multiplicity -> Multiplicity -> Bool
$c<= :: Multiplicity -> Multiplicity -> Bool
<= :: Multiplicity -> Multiplicity -> Bool
$c> :: Multiplicity -> Multiplicity -> Bool
> :: Multiplicity -> Multiplicity -> Bool
$c>= :: Multiplicity -> Multiplicity -> Bool
>= :: Multiplicity -> Multiplicity -> Bool
$cmax :: Multiplicity -> Multiplicity -> Multiplicity
max :: Multiplicity -> Multiplicity -> Multiplicity
$cmin :: Multiplicity -> Multiplicity -> Multiplicity
min :: Multiplicity -> Multiplicity -> Multiplicity
Ord,(forall x. Multiplicity -> Rep Multiplicity x)
-> (forall x. Rep Multiplicity x -> Multiplicity)
-> Generic Multiplicity
forall x. Rep Multiplicity x -> Multiplicity
forall x. Multiplicity -> Rep Multiplicity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Multiplicity -> Rep Multiplicity x
from :: forall x. Multiplicity -> Rep Multiplicity x
$cto :: forall x. Rep Multiplicity x -> Multiplicity
to :: forall x. Rep Multiplicity x -> Multiplicity
Generic)

instance Out Multiplicity where
  doc :: Multiplicity -> Doc
doc = String -> Doc
text (String -> Doc) -> (Multiplicity -> String) -> Multiplicity -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Multiplicity -> String
forall a. Show a => a -> String
show

instance NFData Multiplicity where
  rnf :: Multiplicity -> ()
rnf Multiplicity
_ = ()

-- | An abstract region identifier.  This is used inside type signatures and elsewhere.
data Region = GlobR Var Multiplicity -- ^ A global region with lifetime equal to the
                                     --   whole program.
            | DynR Var Multiplicity  -- ^ A dynamic region that may be created or
                                     --   destroyed, tagged by an identifier.
            | VarR Var               -- ^ A region metavariable that can range over
                                     --   either global or dynamic regions.
            | MMapR Var              -- ^ A region that doesn't result in an (explicit)
                                     --   memory allocation. It merely ensures that there
                                     --   are no free locations in the program.
  deriving (ReadPrec [Region]
ReadPrec Region
Int -> ReadS Region
ReadS [Region]
(Int -> ReadS Region)
-> ReadS [Region]
-> ReadPrec Region
-> ReadPrec [Region]
-> Read Region
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Region
readsPrec :: Int -> ReadS Region
$creadList :: ReadS [Region]
readList :: ReadS [Region]
$creadPrec :: ReadPrec Region
readPrec :: ReadPrec Region
$creadListPrec :: ReadPrec [Region]
readListPrec :: ReadPrec [Region]
Read,Int -> Region -> ShowS
[Region] -> ShowS
Region -> String
(Int -> Region -> ShowS)
-> (Region -> String) -> ([Region] -> ShowS) -> Show Region
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Region -> ShowS
showsPrec :: Int -> Region -> ShowS
$cshow :: Region -> String
show :: Region -> String
$cshowList :: [Region] -> ShowS
showList :: [Region] -> ShowS
Show,Region -> Region -> Bool
(Region -> Region -> Bool)
-> (Region -> Region -> Bool) -> Eq Region
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Region -> Region -> Bool
== :: Region -> Region -> Bool
$c/= :: Region -> Region -> Bool
/= :: Region -> Region -> Bool
Eq,Eq Region
Eq Region
-> (Region -> Region -> Ordering)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Bool)
-> (Region -> Region -> Region)
-> (Region -> Region -> Region)
-> Ord Region
Region -> Region -> Bool
Region -> Region -> Ordering
Region -> Region -> Region
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 :: Region -> Region -> Ordering
compare :: Region -> Region -> Ordering
$c< :: Region -> Region -> Bool
< :: Region -> Region -> Bool
$c<= :: Region -> Region -> Bool
<= :: Region -> Region -> Bool
$c> :: Region -> Region -> Bool
> :: Region -> Region -> Bool
$c>= :: Region -> Region -> Bool
>= :: Region -> Region -> Bool
$cmax :: Region -> Region -> Region
max :: Region -> Region -> Region
$cmin :: Region -> Region -> Region
min :: Region -> Region -> Region
Ord, (forall x. Region -> Rep Region x)
-> (forall x. Rep Region x -> Region) -> Generic Region
forall x. Rep Region x -> Region
forall x. Region -> Rep Region x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Region -> Rep Region x
from :: forall x. Region -> Rep Region x
$cto :: forall x. Rep Region x -> Region
to :: forall x. Rep Region x -> Region
Generic)

instance Out Region

instance NFData Region where
  rnf :: Region -> ()
rnf (GlobR Var
v Multiplicity
_) = Var -> ()
forall a. NFData a => a -> ()
rnf Var
v
  rnf (DynR Var
v Multiplicity
_)  = Var -> ()
forall a. NFData a => a -> ()
rnf Var
v
  rnf (VarR Var
v)    = Var -> ()
forall a. NFData a => a -> ()
rnf Var
v
  rnf (MMapR Var
v)   = Var -> ()
forall a. NFData a => a -> ()
rnf Var
v


-- | The modality of locations and cursors: input/output, for reading
-- and writing, respectively.
data Modality = Input | Output
  deriving (ReadPrec [Modality]
ReadPrec Modality
Int -> ReadS Modality
ReadS [Modality]
(Int -> ReadS Modality)
-> ReadS [Modality]
-> ReadPrec Modality
-> ReadPrec [Modality]
-> Read Modality
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Modality
readsPrec :: Int -> ReadS Modality
$creadList :: ReadS [Modality]
readList :: ReadS [Modality]
$creadPrec :: ReadPrec Modality
readPrec :: ReadPrec Modality
$creadListPrec :: ReadPrec [Modality]
readListPrec :: ReadPrec [Modality]
Read,Int -> Modality -> ShowS
[Modality] -> ShowS
Modality -> String
(Int -> Modality -> ShowS)
-> (Modality -> String) -> ([Modality] -> ShowS) -> Show Modality
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Modality -> ShowS
showsPrec :: Int -> Modality -> ShowS
$cshow :: Modality -> String
show :: Modality -> String
$cshowList :: [Modality] -> ShowS
showList :: [Modality] -> ShowS
Show,Modality -> Modality -> Bool
(Modality -> Modality -> Bool)
-> (Modality -> Modality -> Bool) -> Eq Modality
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Modality -> Modality -> Bool
== :: Modality -> Modality -> Bool
$c/= :: Modality -> Modality -> Bool
/= :: Modality -> Modality -> Bool
Eq,Eq Modality
Eq Modality
-> (Modality -> Modality -> Ordering)
-> (Modality -> Modality -> Bool)
-> (Modality -> Modality -> Bool)
-> (Modality -> Modality -> Bool)
-> (Modality -> Modality -> Bool)
-> (Modality -> Modality -> Modality)
-> (Modality -> Modality -> Modality)
-> Ord Modality
Modality -> Modality -> Bool
Modality -> Modality -> Ordering
Modality -> Modality -> Modality
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 :: Modality -> Modality -> Ordering
compare :: Modality -> Modality -> Ordering
$c< :: Modality -> Modality -> Bool
< :: Modality -> Modality -> Bool
$c<= :: Modality -> Modality -> Bool
<= :: Modality -> Modality -> Bool
$c> :: Modality -> Modality -> Bool
> :: Modality -> Modality -> Bool
$c>= :: Modality -> Modality -> Bool
>= :: Modality -> Modality -> Bool
$cmax :: Modality -> Modality -> Modality
max :: Modality -> Modality -> Modality
$cmin :: Modality -> Modality -> Modality
min :: Modality -> Modality -> Modality
Ord, (forall x. Modality -> Rep Modality x)
-> (forall x. Rep Modality x -> Modality) -> Generic Modality
forall x. Rep Modality x -> Modality
forall x. Modality -> Rep Modality x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Modality -> Rep Modality x
from :: forall x. Modality -> Rep Modality x
$cto :: forall x. Rep Modality x -> Modality
to :: forall x. Rep Modality x -> Modality
Generic)
instance Out Modality
instance NFData Modality where
  rnf :: Modality -> ()
rnf Modality
Input  = ()
  rnf Modality
Output = ()

-- | A location and region, together with modality.
data LRM = LRM { LRM -> Var
lrmLoc :: LocVar
               , LRM -> Region
lrmReg :: Region
               , LRM -> Modality
lrmMode :: Modality }
  deriving (ReadPrec [LRM]
ReadPrec LRM
Int -> ReadS LRM
ReadS [LRM]
(Int -> ReadS LRM)
-> ReadS [LRM] -> ReadPrec LRM -> ReadPrec [LRM] -> Read LRM
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LRM
readsPrec :: Int -> ReadS LRM
$creadList :: ReadS [LRM]
readList :: ReadS [LRM]
$creadPrec :: ReadPrec LRM
readPrec :: ReadPrec LRM
$creadListPrec :: ReadPrec [LRM]
readListPrec :: ReadPrec [LRM]
Read,Int -> LRM -> ShowS
[LRM] -> ShowS
LRM -> String
(Int -> LRM -> ShowS)
-> (LRM -> String) -> ([LRM] -> ShowS) -> Show LRM
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LRM -> ShowS
showsPrec :: Int -> LRM -> ShowS
$cshow :: LRM -> String
show :: LRM -> String
$cshowList :: [LRM] -> ShowS
showList :: [LRM] -> ShowS
Show,LRM -> LRM -> Bool
(LRM -> LRM -> Bool) -> (LRM -> LRM -> Bool) -> Eq LRM
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LRM -> LRM -> Bool
== :: LRM -> LRM -> Bool
$c/= :: LRM -> LRM -> Bool
/= :: LRM -> LRM -> Bool
Eq,Eq LRM
Eq LRM
-> (LRM -> LRM -> Ordering)
-> (LRM -> LRM -> Bool)
-> (LRM -> LRM -> Bool)
-> (LRM -> LRM -> Bool)
-> (LRM -> LRM -> Bool)
-> (LRM -> LRM -> LRM)
-> (LRM -> LRM -> LRM)
-> Ord LRM
LRM -> LRM -> Bool
LRM -> LRM -> Ordering
LRM -> LRM -> LRM
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 :: LRM -> LRM -> Ordering
compare :: LRM -> LRM -> Ordering
$c< :: LRM -> LRM -> Bool
< :: LRM -> LRM -> Bool
$c<= :: LRM -> LRM -> Bool
<= :: LRM -> LRM -> Bool
$c> :: LRM -> LRM -> Bool
> :: LRM -> LRM -> Bool
$c>= :: LRM -> LRM -> Bool
>= :: LRM -> LRM -> Bool
$cmax :: LRM -> LRM -> LRM
max :: LRM -> LRM -> LRM
$cmin :: LRM -> LRM -> LRM
min :: LRM -> LRM -> LRM
Ord, (forall x. LRM -> Rep LRM x)
-> (forall x. Rep LRM x -> LRM) -> Generic LRM
forall x. Rep LRM x -> LRM
forall x. LRM -> Rep LRM x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LRM -> Rep LRM x
from :: forall x. LRM -> Rep LRM x
$cto :: forall x. Rep LRM x -> LRM
to :: forall x. Rep LRM x -> LRM
Generic)

instance Out LRM

instance NFData LRM where
  rnf :: LRM -> ()
rnf (LRM Var
a Region
b Modality
c)  = Var -> ()
forall a. NFData a => a -> ()
rnf Var
a () -> () -> ()
forall a b. a -> b -> b
`seq` Region -> ()
forall a. NFData a => a -> ()
rnf Region
b () -> () -> ()
forall a b. a -> b -> b
`seq` Modality -> ()
forall a. NFData a => a -> ()
rnf Modality
c

-- | A designated doesn't-really-exist-anywhere location.
dummyLRM :: LRM
dummyLRM :: LRM
dummyLRM = Var -> Region -> Modality -> LRM
LRM Var
"l_dummy" (Var -> Region
VarR Var
"r_dummy") Modality
Input

regionToVar :: Region -> Var
regionToVar :: Region -> Var
regionToVar Region
r = case Region
r of
                  GlobR Var
v Multiplicity
_ -> Var
v
                  DynR  Var
v Multiplicity
_ -> Var
v
                  VarR  Var
v   -> Var
v
                  MMapR Var
v   -> Var
v


-- | The 'gRecoverType' instance defined in Language.Syntax is incorrect for L2.
-- For the AppE case, it'll just return the type with with the function was
-- defined. However, we want the recovered type to have the locations actually
-- used at the callsites! For example,
--
--     add1 :: Tree @ a -> Tree @ b
--     add1 = _
--
--     ... (add1 [loc1, loc2] tr1) ..
--
-- in this case, we want the type of (add1 tr1) to be (Tree @ loc2)
-- and NOT (Tree @ b). We have to do something similar for variables bound by
-- a pattern match.
instance Typeable (PreExp E2Ext LocVar (UrTy LocVar)) where
  gRecoverType :: DDefs (TyOf (PreExp E2Ext Var Ty2))
-> Env2 (TyOf (PreExp E2Ext Var Ty2))
-> PreExp E2Ext Var Ty2
-> TyOf (PreExp E2Ext Var Ty2)
gRecoverType DDefs (TyOf (PreExp E2Ext Var Ty2))
ddfs Env2 (TyOf (PreExp E2Ext Var Ty2))
env2 PreExp E2Ext Var Ty2
ex =
    case PreExp E2Ext Var Ty2
ex of
      VarE Var
v       -> Ty2 -> Var -> TyEnv Ty2 -> Ty2
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault (String -> Ty2
forall a. HasCallStack => String -> a
error (String -> Ty2) -> String -> Ty2
forall a b. (a -> b) -> a -> b
$ String
"Cannot find type of variable " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Var -> String
forall a. Show a => a -> String
show Var
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TyEnv Ty2 -> String
forall a. Show a => a -> String
show (Env2 Ty2 -> TyEnv Ty2
forall a. Env2 a -> TyEnv a
vEnv Env2 (TyOf (PreExp E2Ext Var Ty2))
Env2 Ty2
env2)) Var
v (Env2 Ty2 -> TyEnv Ty2
forall a. Env2 a -> TyEnv a
vEnv Env2 (TyOf (PreExp E2Ext Var Ty2))
Env2 Ty2
env2)
      LitE Int
_       -> TyOf (PreExp E2Ext Var Ty2)
Ty2
forall loc. UrTy loc
IntTy
      CharE{}      -> TyOf (PreExp E2Ext Var Ty2)
Ty2
forall loc. UrTy loc
CharTy
      FloatE{}     -> TyOf (PreExp E2Ext Var Ty2)
Ty2
forall loc. UrTy loc
FloatTy
      LitSymE Var
_    -> TyOf (PreExp E2Ext Var Ty2)
Ty2
forall loc. UrTy loc
SymTy
      AppE Var
v [Var]
locs [PreExp E2Ext Var Ty2]
_ -> let fnty :: ArrowTy2 Ty2
fnty  = Env2 Ty2 -> TyEnv (ArrowTy Ty2)
forall a. Env2 a -> TyEnv (ArrowTy a)
fEnv Env2 (TyOf (PreExp E2Ext Var Ty2))
Env2 Ty2
env2 Map Var (ArrowTy2 Ty2) -> Var -> ArrowTy2 Ty2
forall a b.
(Ord a, Out a, Out b, Show a, HasCallStack) =>
Map a b -> a -> b
# Var
v
                           outty :: Ty2
outty = ArrowTy2 Ty2 -> Ty2
forall ty2. ArrowTy2 ty2 -> ty2
arrOut ArrowTy2 Ty2
fnty
                           mp :: Map Var Var
mp = [(Var, Var)] -> Map Var Var
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Var, Var)] -> Map Var Var) -> [(Var, Var)] -> Map Var Var
forall a b. (a -> b) -> a -> b
$ [Var] -> [Var] -> [(Var, Var)]
forall a b. [a] -> [b] -> [(a, b)]
zip (ArrowTy2 Ty2 -> [Var]
forall ty2. ArrowTy2 ty2 -> [Var]
allLocVars ArrowTy2 Ty2
fnty) [Var]
locs
                       in Map Var Var -> Ty2 -> Ty2
substLoc Map Var Var
mp Ty2
outty

      PrimAppE (DictInsertP Ty2
ty) ((VarE Var
v):[PreExp E2Ext Var Ty2]
_) -> Maybe Var -> UrTy () -> Ty2
forall loc. Maybe Var -> UrTy () -> UrTy loc
SymDictTy (Var -> Maybe Var
forall a. a -> Maybe a
Just Var
v) (UrTy () -> Ty2) -> UrTy () -> Ty2
forall a b. (a -> b) -> a -> b
$ Ty2 -> UrTy ()
forall a. UrTy a -> UrTy ()
stripTyLocs Ty2
ty
      PrimAppE (DictEmptyP  Ty2
ty) ((VarE Var
v):[PreExp E2Ext Var Ty2]
_) -> Maybe Var -> UrTy () -> Ty2
forall loc. Maybe Var -> UrTy () -> UrTy loc
SymDictTy (Var -> Maybe Var
forall a. a -> Maybe a
Just Var
v) (UrTy () -> Ty2) -> UrTy () -> Ty2
forall a b. (a -> b) -> a -> b
$ Ty2 -> UrTy ()
forall a. UrTy a -> UrTy ()
stripTyLocs Ty2
ty
      PrimAppE Prim Ty2
p [PreExp E2Ext Var Ty2]
_ -> Prim Ty2 -> Ty2
forall a. Prim (UrTy a) -> UrTy a
primRetTy Prim Ty2
p

      LetE (Var
v,[Var]
_,Ty2
t,PreExp E2Ext Var Ty2
_) PreExp E2Ext Var Ty2
e -> DDefs (TyOf (PreExp E2Ext Var Ty2))
-> Env2 (TyOf (PreExp E2Ext Var Ty2))
-> PreExp E2Ext Var Ty2
-> TyOf (PreExp E2Ext Var Ty2)
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf (PreExp E2Ext Var Ty2))
ddfs (Var -> Ty2 -> Env2 Ty2 -> Env2 Ty2
forall a. Var -> a -> Env2 a -> Env2 a
extendVEnv Var
v Ty2
t Env2 (TyOf (PreExp E2Ext Var Ty2))
Env2 Ty2
env2) PreExp E2Ext Var Ty2
e
      IfE PreExp E2Ext Var Ty2
_ PreExp E2Ext Var Ty2
e PreExp E2Ext Var Ty2
_        -> DDefs (TyOf (PreExp E2Ext Var Ty2))
-> Env2 (TyOf (PreExp E2Ext Var Ty2))
-> PreExp E2Ext Var Ty2
-> TyOf (PreExp E2Ext Var Ty2)
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf (PreExp E2Ext Var Ty2))
ddfs Env2 (TyOf (PreExp E2Ext Var Ty2))
env2 PreExp E2Ext Var Ty2
e
      MkProdE [PreExp E2Ext Var Ty2]
es       -> [Ty2] -> Ty2
forall loc. [UrTy loc] -> UrTy loc
ProdTy ([Ty2] -> Ty2) -> [Ty2] -> Ty2
forall a b. (a -> b) -> a -> b
$ (PreExp E2Ext Var Ty2 -> Ty2) -> [PreExp E2Ext Var Ty2] -> [Ty2]
forall a b. (a -> b) -> [a] -> [b]
L.map (DDefs (TyOf (PreExp E2Ext Var Ty2))
-> Env2 (TyOf (PreExp E2Ext Var Ty2))
-> PreExp E2Ext Var Ty2
-> TyOf (PreExp E2Ext Var Ty2)
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf (PreExp E2Ext Var Ty2))
ddfs Env2 (TyOf (PreExp E2Ext Var Ty2))
env2) [PreExp E2Ext Var Ty2]
es
      DataConE Var
loc String
c [PreExp E2Ext Var Ty2]
_ -> String -> Var -> Ty2
forall loc. String -> loc -> UrTy loc
PackedTy (DDefs Ty2 -> ShowS
forall a. Out a => DDefs a -> ShowS
getTyOfDataCon DDefs (TyOf (PreExp E2Ext Var Ty2))
DDefs Ty2
ddfs String
c) Var
loc
      TimeIt PreExp E2Ext Var Ty2
e Ty2
_ Bool
_     -> DDefs (TyOf (PreExp E2Ext Var Ty2))
-> Env2 (TyOf (PreExp E2Ext Var Ty2))
-> PreExp E2Ext Var Ty2
-> TyOf (PreExp E2Ext Var Ty2)
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf (PreExp E2Ext Var Ty2))
ddfs Env2 (TyOf (PreExp E2Ext Var Ty2))
env2 PreExp E2Ext Var Ty2
e
      MapE (Var, Ty2, PreExp E2Ext Var Ty2)
_ PreExp E2Ext Var Ty2
e         -> DDefs (TyOf (PreExp E2Ext Var Ty2))
-> Env2 (TyOf (PreExp E2Ext Var Ty2))
-> PreExp E2Ext Var Ty2
-> TyOf (PreExp E2Ext Var Ty2)
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf (PreExp E2Ext Var Ty2))
ddfs Env2 (TyOf (PreExp E2Ext Var Ty2))
env2 PreExp E2Ext Var Ty2
e
      FoldE (Var, Ty2, PreExp E2Ext Var Ty2)
_ (Var, Ty2, PreExp E2Ext Var Ty2)
_ PreExp E2Ext Var Ty2
e      -> DDefs (TyOf (PreExp E2Ext Var Ty2))
-> Env2 (TyOf (PreExp E2Ext Var Ty2))
-> PreExp E2Ext Var Ty2
-> TyOf (PreExp E2Ext Var Ty2)
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf (PreExp E2Ext Var Ty2))
ddfs Env2 (TyOf (PreExp E2Ext Var Ty2))
env2 PreExp E2Ext Var Ty2
e
      Ext E2Ext Var Ty2
ext          -> DDefs (TyOf (E2Ext Var Ty2))
-> Env2 (TyOf (E2Ext Var Ty2))
-> E2Ext Var Ty2
-> TyOf (E2Ext Var Ty2)
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf (PreExp E2Ext Var Ty2))
DDefs (TyOf (E2Ext Var Ty2))
ddfs Env2 (TyOf (PreExp E2Ext Var Ty2))
Env2 (TyOf (E2Ext Var Ty2))
env2 E2Ext Var Ty2
ext
      ProjE Int
i PreExp E2Ext Var Ty2
e ->
        case DDefs (TyOf (PreExp E2Ext Var Ty2))
-> Env2 (TyOf (PreExp E2Ext Var Ty2))
-> PreExp E2Ext Var Ty2
-> TyOf (PreExp E2Ext Var Ty2)
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf (PreExp E2Ext Var Ty2))
ddfs Env2 (TyOf (PreExp E2Ext Var Ty2))
env2 PreExp E2Ext Var Ty2
e of
          (ProdTy [Ty2]
tys) -> [Ty2]
tys [Ty2] -> Int -> Ty2
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
          TyOf (PreExp E2Ext Var Ty2)
oth -> String -> TyOf (PreExp E2Ext Var Ty2)
forall a. HasCallStack => String -> a
error(String -> TyOf (PreExp E2Ext Var Ty2))
-> String -> TyOf (PreExp E2Ext Var Ty2)
forall a b. (a -> b) -> a -> b
$ String
"typeExp: Cannot project fields from this type: "String -> ShowS
forall a. [a] -> [a] -> [a]
++Ty2 -> String
forall a. Show a => a -> String
show TyOf (PreExp E2Ext Var Ty2)
Ty2
oth
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\nExpression:\n  "String -> ShowS
forall a. [a] -> [a] -> [a]
++ PreExp E2Ext Var Ty2 -> String
forall a. Out a => a -> String
sdoc PreExp E2Ext Var Ty2
ex
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"\nEnvironment:\n  "String -> ShowS
forall a. [a] -> [a] -> [a]
++TyEnv Ty2 -> String
forall a. Out a => a -> String
sdoc (Env2 Ty2 -> TyEnv Ty2
forall a. Env2 a -> TyEnv a
vEnv Env2 (TyOf (PreExp E2Ext Var Ty2))
Env2 Ty2
env2)
      SpawnE Var
v [Var]
locs [PreExp E2Ext Var Ty2]
_ -> let fnty :: ArrowTy2 Ty2
fnty  = Env2 Ty2 -> TyEnv (ArrowTy Ty2)
forall a. Env2 a -> TyEnv (ArrowTy a)
fEnv Env2 (TyOf (PreExp E2Ext Var Ty2))
Env2 Ty2
env2 Map Var (ArrowTy2 Ty2) -> Var -> ArrowTy2 Ty2
forall a b.
(Ord a, Out a, Out b, Show a, HasCallStack) =>
Map a b -> a -> b
# Var
v
                             outty :: Ty2
outty = ArrowTy2 Ty2 -> Ty2
forall ty2. ArrowTy2 ty2 -> ty2
arrOut ArrowTy2 Ty2
fnty
                             mp :: Map Var Var
mp = [(Var, Var)] -> Map Var Var
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Var, Var)] -> Map Var Var) -> [(Var, Var)] -> Map Var Var
forall a b. (a -> b) -> a -> b
$ [Var] -> [Var] -> [(Var, Var)]
forall a b. [a] -> [b] -> [(a, b)]
zip (ArrowTy2 Ty2 -> [Var]
forall ty2. ArrowTy2 ty2 -> [Var]
allLocVars ArrowTy2 Ty2
fnty) [Var]
locs
                         in Map Var Var -> Ty2 -> Ty2
substLoc Map Var Var
mp Ty2
outty
      PreExp E2Ext Var Ty2
SyncE -> TyOf (PreExp E2Ext Var Ty2)
Ty2
forall loc. UrTy loc
voidTy
      WithArenaE Var
_v PreExp E2Ext Var Ty2
e -> DDefs (TyOf (PreExp E2Ext Var Ty2))
-> Env2 (TyOf (PreExp E2Ext Var Ty2))
-> PreExp E2Ext Var Ty2
-> TyOf (PreExp E2Ext Var Ty2)
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf (PreExp E2Ext Var Ty2))
ddfs Env2 (TyOf (PreExp E2Ext Var Ty2))
env2 PreExp E2Ext Var Ty2
e
      CaseE PreExp E2Ext Var Ty2
_ [(String, [(Var, Var)], PreExp E2Ext Var Ty2)]
mp ->
        let (String
c,[(Var, Var)]
vlocs,PreExp E2Ext Var Ty2
e) = [(String, [(Var, Var)], PreExp E2Ext Var Ty2)]
-> (String, [(Var, Var)], PreExp E2Ext Var Ty2)
forall a. HasCallStack => [a] -> a
head [(String, [(Var, Var)], PreExp E2Ext Var Ty2)]
mp
            ([Var]
vars,[Var]
locs) = [(Var, Var)] -> ([Var], [Var])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Var, Var)]
vlocs
            env2' :: Env2 Ty2
env2' = HasCallStack =>
String -> DDefs Ty2 -> [Var] -> [Var] -> Env2 Ty2 -> Env2 Ty2
String -> DDefs Ty2 -> [Var] -> [Var] -> Env2 Ty2 -> Env2 Ty2
extendPatternMatchEnv String
c DDefs (TyOf (PreExp E2Ext Var Ty2))
DDefs Ty2
ddfs [Var]
vars [Var]
locs Env2 (TyOf (PreExp E2Ext Var Ty2))
Env2 Ty2
env2
        in DDefs (TyOf (PreExp E2Ext Var Ty2))
-> Env2 (TyOf (PreExp E2Ext Var Ty2))
-> PreExp E2Ext Var Ty2
-> TyOf (PreExp E2Ext Var Ty2)
forall e.
Typeable e =>
DDefs (TyOf e) -> Env2 (TyOf e) -> e -> TyOf e
gRecoverType DDefs (TyOf (PreExp E2Ext Var Ty2))
ddfs Env2 (TyOf (PreExp E2Ext Var Ty2))
Env2 Ty2
env2' PreExp E2Ext Var Ty2
e

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

instance Out (ArrowTy2 Ty2)

instance Out Effect
instance Out a => Out (S.Set a) where
  docPrec :: Int -> Set a -> Doc
docPrec Int
n Set a
x = Int -> [a] -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
n (Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
x)
  doc :: Set a -> Doc
doc Set a
x = [a] -> Doc
forall a. Out a => a -> Doc
doc (Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
x)
instance (Out l, Out d) => Out (E2Ext l d)
instance Out l => Out (PreLocExp l)
instance Out LocRet

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

-- | Retrieve all LocVars from a fn type (Arrow)
allLocVars :: ArrowTy2 ty2 -> [LocVar]
allLocVars :: forall ty2. ArrowTy2 ty2 -> [Var]
allLocVars ArrowTy2 ty2
ty = (LRM -> Var) -> [LRM] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(LRM Var
l Region
_ Modality
_) -> Var
l) (ArrowTy2 ty2 -> [LRM]
forall ty2. ArrowTy2 ty2 -> [LRM]
locVars ArrowTy2 ty2
ty)

inLocVars :: ArrowTy2 ty2 -> [LocVar]
inLocVars :: forall ty2. ArrowTy2 ty2 -> [Var]
inLocVars ArrowTy2 ty2
ty = (LRM -> Var) -> [LRM] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(LRM Var
l Region
_ Modality
_) -> Var
l) ([LRM] -> [Var]) -> [LRM] -> [Var]
forall a b. (a -> b) -> a -> b
$
               (LRM -> Bool) -> [LRM] -> [LRM]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\(LRM Var
_ Region
_ Modality
m) -> Modality
m Modality -> Modality -> Bool
forall a. Eq a => a -> a -> Bool
== Modality
Input) (ArrowTy2 ty2 -> [LRM]
forall ty2. ArrowTy2 ty2 -> [LRM]
locVars ArrowTy2 ty2
ty)

outLocVars :: ArrowTy2 ty2 -> [LocVar]
outLocVars :: forall ty2. ArrowTy2 ty2 -> [Var]
outLocVars ArrowTy2 ty2
ty = (LRM -> Var) -> [LRM] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(LRM Var
l Region
_ Modality
_) -> Var
l) ([LRM] -> [Var]) -> [LRM] -> [Var]
forall a b. (a -> b) -> a -> b
$
                (LRM -> Bool) -> [LRM] -> [LRM]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\(LRM Var
_ Region
_ Modality
m) -> Modality
m Modality -> Modality -> Bool
forall a. Eq a => a -> a -> Bool
== Modality
Output) (ArrowTy2 ty2 -> [LRM]
forall ty2. ArrowTy2 ty2 -> [LRM]
locVars ArrowTy2 ty2
ty)

outRegVars :: ArrowTy2 ty2 -> [LocVar]
outRegVars :: forall ty2. ArrowTy2 ty2 -> [Var]
outRegVars ArrowTy2 ty2
ty = (LRM -> Var) -> [LRM] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(LRM Var
_ Region
r Modality
_) -> Region -> Var
regionToVar Region
r) ([LRM] -> [Var]) -> [LRM] -> [Var]
forall a b. (a -> b) -> a -> b
$
                (LRM -> Bool) -> [LRM] -> [LRM]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\(LRM Var
_ Region
_ Modality
m) -> Modality
m Modality -> Modality -> Bool
forall a. Eq a => a -> a -> Bool
== Modality
Output) (ArrowTy2 ty2 -> [LRM]
forall ty2. ArrowTy2 ty2 -> [LRM]
locVars ArrowTy2 ty2
ty)

inRegVars :: ArrowTy2 ty2 -> [LocVar]
inRegVars :: forall ty2. ArrowTy2 ty2 -> [Var]
inRegVars ArrowTy2 ty2
ty = [Var] -> [Var]
forall a. Eq a => [a] -> [a]
L.nub ([Var] -> [Var]) -> [Var] -> [Var]
forall a b. (a -> b) -> a -> b
$ (LRM -> Var) -> [LRM] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(LRM Var
_ Region
r Modality
_) -> Region -> Var
regionToVar Region
r) ([LRM] -> [Var]) -> [LRM] -> [Var]
forall a b. (a -> b) -> a -> b
$
               (LRM -> Bool) -> [LRM] -> [LRM]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\(LRM Var
_ Region
_ Modality
m) -> Modality
m Modality -> Modality -> Bool
forall a. Eq a => a -> a -> Bool
== Modality
Input) (ArrowTy2 ty2 -> [LRM]
forall ty2. ArrowTy2 ty2 -> [LRM]
locVars ArrowTy2 ty2
ty)

allRegVars :: ArrowTy2 ty2 -> [LocVar]
allRegVars :: forall ty2. ArrowTy2 ty2 -> [Var]
allRegVars ArrowTy2 ty2
ty = [Var] -> [Var]
forall a. Eq a => [a] -> [a]
L.nub ([Var] -> [Var]) -> [Var] -> [Var]
forall a b. (a -> b) -> a -> b
$ (LRM -> Var) -> [LRM] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(LRM Var
_ Region
r Modality
_) -> Region -> Var
regionToVar Region
r) (ArrowTy2 ty2 -> [LRM]
forall ty2. ArrowTy2 ty2 -> [LRM]
locVars ArrowTy2 ty2
ty)

-- | Apply a location substitution to a type.
substLoc :: M.Map LocVar LocVar -> Ty2 -> Ty2
substLoc :: Map Var Var -> Ty2 -> Ty2
substLoc Map Var Var
mp Ty2
ty =
  case Ty2
ty of
   SymDictTy Maybe Var
v UrTy ()
te -> Maybe Var -> UrTy () -> Ty2
forall loc. Maybe Var -> UrTy () -> UrTy loc
SymDictTy Maybe Var
v UrTy ()
te -- (go te)
   ProdTy    [Ty2]
ts -> [Ty2] -> Ty2
forall loc. [UrTy loc] -> UrTy loc
ProdTy ((Ty2 -> Ty2) -> [Ty2] -> [Ty2]
forall a b. (a -> b) -> [a] -> [b]
L.map Ty2 -> Ty2
go [Ty2]
ts)
   PackedTy String
k Var
l ->
       case Var -> Map Var Var -> Maybe Var
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
l Map Var Var
mp of
             Just Var
v  -> String -> Var -> Ty2
forall loc. String -> loc -> UrTy loc
PackedTy String
k Var
v
             Maybe Var
Nothing -> String -> Var -> Ty2
forall loc. String -> loc -> UrTy loc
PackedTy String
k Var
l
   Ty2
_ -> Ty2
ty
  where go :: Ty2 -> Ty2
go = Map Var Var -> Ty2 -> Ty2
substLoc Map Var Var
mp

-- | List version of 'substLoc'.
substLocs :: M.Map LocVar LocVar -> [Ty2] -> [Ty2]
substLocs :: Map Var Var -> [Ty2] -> [Ty2]
substLocs Map Var Var
mp [Ty2]
tys = (Ty2 -> Ty2) -> [Ty2] -> [Ty2]
forall a b. (a -> b) -> [a] -> [b]
L.map (Map Var Var -> Ty2 -> Ty2
substLoc Map Var Var
mp) [Ty2]
tys

-- | Extend an environment for a pattern match. E.g.
--
--     data Foo = MkFoo Int Foo | ...
--
--     case foo1 of
--        MkFoo (i:loc1) (f:loc2) ->
--          new_env2 = extendPatternMatchEnv [loc1,loc2] old_env2
extendPatternMatchEnv :: HasCallStack => DataCon -> DDefs Ty2 -> [Var] -> [LocVar]
                      -> Env2 Ty2 -> Env2 Ty2
extendPatternMatchEnv :: HasCallStack =>
String -> DDefs Ty2 -> [Var] -> [Var] -> Env2 Ty2 -> Env2 Ty2
extendPatternMatchEnv String
dcon DDefs Ty2
ddefs [Var]
vars [Var]
locs Env2 Ty2
env2 =
  let tys :: [Ty2]
tys  = DDefs Ty2 -> String -> [Ty2]
forall a. Out a => DDefs a -> String -> [a]
lookupDataCon DDefs Ty2
ddefs String
dcon
      tys' :: [Ty2]
tys' = ((Var, Ty2) -> [Ty2] -> [Ty2]) -> [Ty2] -> [(Var, Ty2)] -> [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
loc,Ty2
ty) [Ty2]
acc ->
                  case Ty2 -> [Var]
locsInTy Ty2
ty of
                    []     -> Ty2
tyTy2 -> [Ty2] -> [Ty2]
forall a. a -> [a] -> [a]
:[Ty2]
acc
                    [Var
loc2] -> (Map Var Var -> Ty2 -> Ty2
substLoc (Var -> Var -> Map Var Var
forall k a. k -> a -> Map k a
M.singleton Var
loc2 Var
loc) Ty2
ty) Ty2 -> [Ty2] -> [Ty2]
forall a. a -> [a] -> [a]
: [Ty2]
acc
                    [Var]
_  -> String -> [Ty2]
forall a. HasCallStack => String -> a
error (String -> [Ty2]) -> String -> [Ty2]
forall a b. (a -> b) -> a -> b
$ String
"extendPatternMatchEnv': Found more than 1 location in type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ty2 -> String
forall a. Out a => a -> String
sdoc Ty2
ty)
               []
               ([Var] -> [Ty2] -> [(Var, Ty2)]
forall a b.
(Show a, Show b, HasCallStack) =>
[a] -> [b] -> [(a, b)]
fragileZip [Var]
locs [Ty2]
tys)
  in TyEnv Ty2 -> Env2 Ty2 -> Env2 Ty2
forall a. Map Var a -> Env2 a -> Env2 a
extendsVEnv ([(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)]
forall a b.
(Show a, Show b, HasCallStack) =>
[a] -> [b] -> [(a, b)]
fragileZip [Var]
vars [Ty2]
tys') Env2 Ty2
env2

-- | Apply a substitution to an effect.
substEff :: M.Map LocVar LocVar -> Effect -> Effect
substEff :: Map Var Var -> Effect -> Effect
substEff Map Var Var
mp (Traverse Var
v) =
    case Var -> Map Var Var -> Maybe Var
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v Map Var Var
mp of
      Just Var
v2 -> Var -> Effect
Traverse Var
v2
      Maybe Var
Nothing -> Var -> Effect
Traverse Var
v

-- | Apply a substitution to an effect set.
substEffs :: M.Map LocVar LocVar -> S.Set Effect -> S.Set Effect
substEffs :: Map Var Var -> Set Effect -> Set Effect
substEffs Map Var Var
mp Set Effect
effs =
    (Effect -> Effect) -> Set Effect -> Set Effect
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map (\Effect
ef -> Map Var Var -> Effect -> Effect
substEff Map Var Var
mp Effect
ef) Set Effect
effs

dummyTyLocs :: Applicative f => UrTy () -> f (UrTy LocVar)
dummyTyLocs :: forall (f :: * -> *). Applicative f => UrTy () -> f Ty2
dummyTyLocs UrTy ()
ty = (() -> f Var) -> UrTy () -> f Ty2
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UrTy a -> f (UrTy b)
traverse (f Var -> () -> f Var
forall a b. a -> b -> a
const (Var -> f Var
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Var
toVar String
"dummy"))) UrTy ()
ty

-- | Collect all the locations mentioned in a type.
locsInTy :: Ty2 -> [LocVar]
locsInTy :: Ty2 -> [Var]
locsInTy Ty2
ty =
    case Ty2
ty of
      PackedTy String
_ Var
lv -> [Var
lv]
      ProdTy [Ty2]
tys -> (Ty2 -> [Var]) -> [Ty2] -> [Var]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ty2 -> [Var]
locsInTy [Ty2]
tys
      Ty2
_ -> []

-- Because L2 just adds a bit of metadata and enriched types, it is
-- possible to strip it back down to L1.
revertToL1 :: Prog2 -> Prog1
revertToL1 :: Prog2 -> Prog1
revertToL1 Prog{DDefs (TyOf (PreExp E2Ext Var Ty2))
ddefs :: DDefs (TyOf (PreExp E2Ext Var Ty2))
ddefs :: forall ex. Prog ex -> DDefs (TyOf ex)
ddefs,FunDefs (PreExp E2Ext Var Ty2)
fundefs :: FunDefs (PreExp E2Ext Var Ty2)
fundefs :: forall ex. Prog ex -> FunDefs ex
fundefs,Maybe (PreExp E2Ext Var Ty2, TyOf (PreExp E2Ext Var Ty2))
mainExp :: Maybe (PreExp E2Ext Var Ty2, TyOf (PreExp E2Ext Var Ty2))
mainExp :: forall ex. Prog ex -> Maybe (ex, TyOf ex)
mainExp} =
  DDefs (TyOf Exp1)
-> FunDefs Exp1 -> Maybe (Exp1, TyOf Exp1) -> Prog1
forall ex.
DDefs (TyOf ex) -> FunDefs ex -> Maybe (ex, TyOf ex) -> Prog ex
Prog DDefs (TyOf Exp1)
Map Var (DDef (UrTy ()))
ddefs' FunDefs Exp1
funefs' Maybe (Exp1, TyOf Exp1)
Maybe (Exp1, UrTy ())
mainExp'
  where
    ddefs' :: Map Var (DDef (UrTy ()))
ddefs'   = (DDef Ty2 -> DDef (UrTy ()))
-> DDefs Ty2 -> Map Var (DDef (UrTy ()))
forall a b k. (a -> b) -> Map k a -> Map k b
M.map DDef Ty2 -> DDef (UrTy ())
revertDDef DDefs (TyOf (PreExp E2Ext Var Ty2))
DDefs Ty2
ddefs
    funefs' :: FunDefs Exp1
funefs'  = (FunDef2 -> FunDef1)
-> FunDefs (PreExp E2Ext Var Ty2) -> FunDefs Exp1
forall a b k. (a -> b) -> Map k a -> Map k b
M.map FunDef2 -> FunDef1
revertFunDef FunDefs (PreExp E2Ext Var Ty2)
fundefs
    mainExp' :: Maybe (Exp1, UrTy ())
mainExp' = case Maybe (PreExp E2Ext Var Ty2, TyOf (PreExp E2Ext Var Ty2))
mainExp of
                Maybe (PreExp E2Ext Var Ty2, TyOf (PreExp E2Ext Var Ty2))
Nothing -> Maybe (Exp1, UrTy ())
forall a. Maybe a
Nothing
                Just (PreExp E2Ext Var Ty2
e,TyOf (PreExp E2Ext Var Ty2)
ty) -> (Exp1, UrTy ()) -> Maybe (Exp1, UrTy ())
forall a. a -> Maybe a
Just (PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
e, Ty2 -> UrTy ()
forall a. UrTy a -> UrTy ()
stripTyLocs TyOf (PreExp E2Ext Var Ty2)
Ty2
ty)

revertDDef :: DDef Ty2 -> DDef Ty1
revertDDef :: DDef Ty2 -> DDef (UrTy ())
revertDDef (DDef Var
tyargs [TyVar]
a [(String, [(Bool, Ty2)])]
b) =
  Var -> [TyVar] -> [(String, [(Bool, UrTy ())])] -> DDef (UrTy ())
forall a. Var -> [TyVar] -> [(String, [(Bool, a)])] -> DDef a
DDef Var
tyargs [TyVar]
a
    (((String, [(Bool, UrTy ())]) -> Bool)
-> [(String, [(Bool, UrTy ())])] -> [(String, [(Bool, UrTy ())])]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\(String
dcon,[(Bool, UrTy ())]
_) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
isIndirectionTag String
dcon) ([(String, [(Bool, UrTy ())])] -> [(String, [(Bool, UrTy ())])])
-> [(String, [(Bool, UrTy ())])] -> [(String, [(Bool, UrTy ())])]
forall a b. (a -> b) -> a -> b
$
         ((String, [(Bool, Ty2)]) -> (String, [(Bool, UrTy ())]))
-> [(String, [(Bool, Ty2)])] -> [(String, [(Bool, UrTy ())])]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(String
dcon,[(Bool, Ty2)]
tys) -> (String
dcon, ((Bool, Ty2) -> (Bool, UrTy ()))
-> [(Bool, Ty2)] -> [(Bool, UrTy ())]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(Bool
x,Ty2
y) -> (Bool
x, Ty2 -> UrTy ()
forall a. UrTy a -> UrTy ()
stripTyLocs Ty2
y)) [(Bool, Ty2)]
tys)) [(String, [(Bool, Ty2)])]
b)

revertFunDef :: FunDef2 -> FunDef1
revertFunDef :: FunDef2 -> FunDef1
revertFunDef FunDef{Var
funName :: Var
funName :: forall ex. FunDef ex -> Var
funName,[Var]
funArgs :: [Var]
funArgs :: forall ex. FunDef ex -> [Var]
funArgs,ArrowTy (TyOf (PreExp E2Ext Var Ty2))
funTy :: ArrowTy (TyOf (PreExp E2Ext Var Ty2))
funTy :: forall ex. FunDef ex -> ArrowTy (TyOf ex)
funTy,PreExp E2Ext Var Ty2
funBody :: PreExp E2Ext Var Ty2
funBody :: forall ex. FunDef ex -> ex
funBody,FunMeta
funMeta :: FunMeta
funMeta :: forall ex. FunDef ex -> FunMeta
funMeta} =
  FunDef { funName :: Var
funName = Var
funName
         , funArgs :: [Var]
funArgs = [Var]
funArgs
         , funTy :: ArrowTy (TyOf Exp1)
funTy   = ((Ty2 -> UrTy ()) -> [Ty2] -> [UrTy ()]
forall a b. (a -> b) -> [a] -> [b]
L.map Ty2 -> UrTy ()
forall a. UrTy a -> UrTy ()
stripTyLocs (ArrowTy2 Ty2 -> [Ty2]
forall ty2. ArrowTy2 ty2 -> [ty2]
arrIns ArrowTy (TyOf (PreExp E2Ext Var Ty2))
ArrowTy2 Ty2
funTy), Ty2 -> UrTy ()
forall a. UrTy a -> UrTy ()
stripTyLocs (ArrowTy2 Ty2 -> Ty2
forall ty2. ArrowTy2 ty2 -> ty2
arrOut ArrowTy (TyOf (PreExp E2Ext Var Ty2))
ArrowTy2 Ty2
funTy))
         , funBody :: Exp1
funBody = PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
funBody
         , funMeta :: FunMeta
funMeta = FunMeta
funMeta
         }

revertExp :: Exp2 -> Exp1
revertExp :: PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
ex =
  case PreExp E2Ext Var Ty2
ex of
    VarE Var
v    -> Var -> Exp1
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v
    LitE Int
n    -> Int -> Exp1
forall (ext :: * -> * -> *) loc dec. Int -> PreExp ext loc dec
LitE Int
n
    CharE Char
c   -> Char -> Exp1
forall (ext :: * -> * -> *) loc dec. Char -> PreExp ext loc dec
CharE Char
c
    FloatE Double
n  -> Double -> Exp1
forall (ext :: * -> * -> *) loc dec. Double -> PreExp ext loc dec
FloatE Double
n
    LitSymE Var
v -> Var -> Exp1
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
LitSymE Var
v
    AppE Var
v [Var]
_ [PreExp E2Ext Var Ty2]
args   -> Var -> [()] -> [Exp1] -> Exp1
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
v [] ((PreExp E2Ext Var Ty2 -> Exp1) -> [PreExp E2Ext Var Ty2] -> [Exp1]
forall a b. (a -> b) -> [a] -> [b]
L.map PreExp E2Ext Var Ty2 -> Exp1
revertExp [PreExp E2Ext Var Ty2]
args)
    PrimAppE Prim Ty2
p [PreExp E2Ext Var Ty2]
args -> Prim (UrTy ()) -> [Exp1] -> Exp1
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE (Prim Ty2 -> Prim (UrTy ())
revertPrim Prim Ty2
p) ([Exp1] -> Exp1) -> [Exp1] -> Exp1
forall a b. (a -> b) -> a -> b
$ (PreExp E2Ext Var Ty2 -> Exp1) -> [PreExp E2Ext Var Ty2] -> [Exp1]
forall a b. (a -> b) -> [a] -> [b]
L.map PreExp E2Ext Var Ty2 -> Exp1
revertExp [PreExp E2Ext Var Ty2]
args
    LetE (Var
v,[Var]
_,Ty2
ty, (Ext (IndirectionE String
_ String
_ (Var, Var)
_ (Var, Var)
_ PreExp E2Ext Var Ty2
arg))) PreExp E2Ext Var Ty2
bod ->
      let PackedTy String
tycon Var
_ =  Ty2
ty in
          (Var, [()], UrTy (), Exp1) -> Exp1 -> Exp1
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
v,[],(Ty2 -> UrTy ()
forall a. UrTy a -> UrTy ()
stripTyLocs Ty2
ty), Var -> [()] -> [Exp1] -> Exp1
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE (String -> Var
mkCopyFunName String
tycon) [] [PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
arg]) (PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
bod)
    LetE (Var
v,[Var]
_,Ty2
ty,PreExp E2Ext Var Ty2
rhs) PreExp E2Ext Var Ty2
bod ->
      (Var, [()], UrTy (), Exp1) -> Exp1 -> Exp1
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
v,[], Ty2 -> UrTy ()
forall a. UrTy a -> UrTy ()
stripTyLocs Ty2
ty, PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
rhs) (PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
bod)
    IfE PreExp E2Ext Var Ty2
a PreExp E2Ext Var Ty2
b PreExp E2Ext Var Ty2
c  -> Exp1 -> Exp1 -> Exp1 -> Exp1
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec
IfE (PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
a) (PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
b) (PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
c)
    MkProdE [PreExp E2Ext Var Ty2]
ls -> [Exp1] -> Exp1
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE ([Exp1] -> Exp1) -> [Exp1] -> Exp1
forall a b. (a -> b) -> a -> b
$ (PreExp E2Ext Var Ty2 -> Exp1) -> [PreExp E2Ext Var Ty2] -> [Exp1]
forall a b. (a -> b) -> [a] -> [b]
L.map PreExp E2Ext Var Ty2 -> Exp1
revertExp [PreExp E2Ext Var Ty2]
ls
    ProjE Int
i PreExp E2Ext Var Ty2
e  -> Int -> Exp1 -> Exp1
forall (ext :: * -> * -> *) loc dec.
Int -> PreExp ext loc dec -> PreExp ext loc dec
ProjE Int
i (PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
e)
    CaseE PreExp E2Ext Var Ty2
scrt [(String, [(Var, Var)], PreExp E2Ext Var Ty2)]
brs     -> Exp1 -> [(String, [(Var, ())], Exp1)] -> Exp1
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> [(String, [(Var, loc)], PreExp ext loc dec)]
-> PreExp ext loc dec
CaseE (PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
scrt) (((String, [(Var, Var)], PreExp E2Ext Var Ty2)
 -> (String, [(Var, ())], Exp1))
-> [(String, [(Var, Var)], PreExp E2Ext Var Ty2)]
-> [(String, [(Var, ())], Exp1)]
forall a b. (a -> b) -> [a] -> [b]
L.map (String, [(Var, Var)], PreExp E2Ext Var Ty2)
-> (String, [(Var, ())], Exp1)
docase [(String, [(Var, Var)], PreExp E2Ext Var Ty2)]
brs)
    DataConE Var
_ String
dcon [PreExp E2Ext Var Ty2]
ls -> () -> String -> [Exp1] -> Exp1
forall (ext :: * -> * -> *) loc dec.
loc -> String -> [PreExp ext loc dec] -> PreExp ext loc dec
DataConE () String
dcon ([Exp1] -> Exp1) -> [Exp1] -> Exp1
forall a b. (a -> b) -> a -> b
$ (PreExp E2Ext Var Ty2 -> Exp1) -> [PreExp E2Ext Var Ty2] -> [Exp1]
forall a b. (a -> b) -> [a] -> [b]
L.map PreExp E2Ext Var Ty2 -> Exp1
revertExp [PreExp E2Ext Var Ty2]
ls
    TimeIt PreExp E2Ext Var Ty2
e Ty2
ty Bool
b -> Exp1 -> UrTy () -> Bool -> Exp1
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> dec -> Bool -> PreExp ext loc dec
TimeIt (PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
e) (Ty2 -> UrTy ()
forall a. UrTy a -> UrTy ()
stripTyLocs Ty2
ty) Bool
b
    SpawnE Var
v [Var]
_ [PreExp E2Ext Var Ty2]
args -> Var -> [()] -> [Exp1] -> Exp1
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
SpawnE Var
v [] ((PreExp E2Ext Var Ty2 -> Exp1) -> [PreExp E2Ext Var Ty2] -> [Exp1]
forall a b. (a -> b) -> [a] -> [b]
L.map PreExp E2Ext Var Ty2 -> Exp1
revertExp [PreExp E2Ext Var Ty2]
args)
    PreExp E2Ext Var Ty2
SyncE -> Exp1
forall (ext :: * -> * -> *) loc dec. PreExp ext loc dec
SyncE
    WithArenaE Var
v PreExp E2Ext Var Ty2
e -> Var -> Exp1 -> Exp1
forall (ext :: * -> * -> *) loc dec.
Var -> PreExp ext loc dec -> PreExp ext loc dec
WithArenaE Var
v (PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
e)
    Ext E2Ext Var Ty2
ext ->
      case E2Ext Var Ty2
ext of
        LetRegionE Region
_ RegionSize
_ Maybe RegionType
_ PreExp E2Ext Var Ty2
bod -> PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
bod
        LetParRegionE Region
_ RegionSize
_ Maybe RegionType
_ PreExp E2Ext Var Ty2
bod -> PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
bod
        LetLocE Var
_ LocExp
_ PreExp E2Ext Var Ty2
bod  -> PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
bod
        StartOfPkdCursor Var
cur -> E1Ext () (UrTy ()) -> Exp1
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Var -> E1Ext () (UrTy ())
forall loc dec. Var -> E1Ext loc dec
L1.StartOfPkdCursor Var
cur)
        TagCursor Var
a Var
_b -> E1Ext () (UrTy ()) -> Exp1
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Var -> E1Ext () (UrTy ())
forall loc dec. Var -> E1Ext loc dec
L1.StartOfPkdCursor Var
a)
        RetE [Var]
_ Var
v -> Var -> Exp1
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v
        AddFixed{} -> String -> Exp1
forall a. HasCallStack => String -> a
error String
"revertExp: TODO AddFixed."
        FromEndE{} -> String -> Exp1
forall a. HasCallStack => String -> a
error String
"revertExp: TODO FromEndLE"
        BoundsCheck{}   -> String -> Exp1
forall a. HasCallStack => String -> a
error String
"revertExp: TODO BoundsCheck"
        IndirectionE{}  -> String -> Exp1
forall a. HasCallStack => String -> a
error String
"revertExp: TODO IndirectionE"
        E2Ext Var Ty2
GetCilkWorkerNum-> Int -> Exp1
forall (ext :: * -> * -> *) loc dec. Int -> PreExp ext loc dec
LitE Int
0
        LetAvail [Var]
_ PreExp E2Ext Var Ty2
bod  -> PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
bod
        AllocateTagHere{} -> String -> Exp1
forall a. HasCallStack => String -> a
error String
"revertExp: TODO AddFixed."
        AllocateScalarsHere{} -> String -> Exp1
forall a. HasCallStack => String -> a
error String
"revertExp: TODO AddFixed."
        SSPush{} -> String -> Exp1
forall a. HasCallStack => String -> a
error String
"revertExp: TODO SSPush."
        SSPop{} -> String -> Exp1
forall a. HasCallStack => String -> a
error String
"revertExp: TODO SSPop."
    MapE{}  -> String -> Exp1
forall a. HasCallStack => String -> a
error (String -> Exp1) -> String -> Exp1
forall a b. (a -> b) -> a -> b
$ String
"revertExp: TODO MapE"
    FoldE{} -> String -> Exp1
forall a. HasCallStack => String -> a
error (String -> Exp1) -> String -> Exp1
forall a b. (a -> b) -> a -> b
$ String
"revertExp: TODO FoldE"
  where
    -- Ugh .. this is bad. Can we remove the identity cases here ?
    -- TODO: Get rid of this (and L3.toL3Prim) soon.
    revertPrim :: Prim Ty2 -> Prim Ty1
    revertPrim :: Prim Ty2 -> Prim (UrTy ())
revertPrim Prim Ty2
pr = (Ty2 -> UrTy ()) -> Prim Ty2 -> Prim (UrTy ())
forall a b. (a -> b) -> Prim a -> Prim b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ty2 -> UrTy ()
forall a. UrTy a -> UrTy ()
stripTyLocs Prim Ty2
pr

    docase :: (DataCon, [(Var,LocVar)], Exp2) -> (DataCon, [(Var,())], Exp1)
    docase :: (String, [(Var, Var)], PreExp E2Ext Var Ty2)
-> (String, [(Var, ())], Exp1)
docase (String
dcon,[(Var, Var)]
vlocs,PreExp E2Ext Var Ty2
rhs) =
      let ([Var]
vars,[Var]
_) = [(Var, Var)] -> ([Var], [Var])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Var, Var)]
vlocs
      in (String
dcon, [Var] -> [()] -> [(Var, ())]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
vars (() -> [()]
forall a. a -> [a]
repeat ()), PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
rhs)

docase :: (DataCon, [(Var, LocVar)], Exp2) -> (DataCon, [(Var, ())], Exp1)
docase :: (String, [(Var, Var)], PreExp E2Ext Var Ty2)
-> (String, [(Var, ())], Exp1)
docase (String
dcon, [(Var, Var)]
vlocs, PreExp E2Ext Var Ty2
rhs) =
  let ([Var]
vars, [Var]
_) = [(Var, Var)] -> ([Var], [Var])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Var, Var)]
vlocs
   in (String
dcon, [Var] -> [()] -> [(Var, ())]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
vars (() -> [()]
forall a. a -> [a]
repeat ()), PreExp E2Ext Var Ty2 -> Exp1
revertExp PreExp E2Ext Var Ty2
rhs)

-- | Does a variable occur in an expression ?
--
-- N.B. it only looks for actual variables, not LocVar's or RegionVar's.
occurs :: S.Set Var -> Exp2 -> Bool
occurs :: Set Var -> PreExp E2Ext Var Ty2 -> Bool
occurs Set Var
w PreExp E2Ext Var Ty2
ex =
  case PreExp E2Ext Var Ty2
ex of
    VarE Var
v -> Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Var
w
    LitE{}    -> Bool
False
    CharE{}   -> Bool
False
    FloatE{}  -> Bool
False
    LitSymE{} -> Bool
False
    AppE Var
_ [Var]
_ [PreExp E2Ext Var Ty2]
ls   -> (PreExp E2Ext Var Ty2 -> Bool) -> [PreExp E2Ext Var Ty2] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any PreExp E2Ext Var Ty2 -> Bool
go [PreExp E2Ext Var Ty2]
ls
    PrimAppE Prim Ty2
_ [PreExp E2Ext Var Ty2]
ls -> (PreExp E2Ext Var Ty2 -> Bool) -> [PreExp E2Ext Var Ty2] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any PreExp E2Ext Var Ty2 -> Bool
go [PreExp E2Ext Var Ty2]
ls
    LetE (Var
_,[Var]
_,Ty2
_,PreExp E2Ext Var Ty2
rhs) PreExp E2Ext Var Ty2
bod -> PreExp E2Ext Var Ty2 -> Bool
go PreExp E2Ext Var Ty2
rhs Bool -> Bool -> Bool
|| PreExp E2Ext Var Ty2 -> Bool
go PreExp E2Ext Var Ty2
bod
    IfE PreExp E2Ext Var Ty2
a PreExp E2Ext Var Ty2
b PreExp E2Ext Var Ty2
c   -> PreExp E2Ext Var Ty2 -> Bool
go PreExp E2Ext Var Ty2
a Bool -> Bool -> Bool
|| PreExp E2Ext Var Ty2 -> Bool
go PreExp E2Ext Var Ty2
b Bool -> Bool -> Bool
|| PreExp E2Ext Var Ty2 -> Bool
go PreExp E2Ext Var Ty2
c
    MkProdE [PreExp E2Ext Var Ty2]
ls  -> (PreExp E2Ext Var Ty2 -> Bool) -> [PreExp E2Ext Var Ty2] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any PreExp E2Ext Var Ty2 -> Bool
go [PreExp E2Ext Var Ty2]
ls
    ProjE Int
_ PreExp E2Ext Var Ty2
e   -> PreExp E2Ext Var Ty2 -> Bool
go PreExp E2Ext Var Ty2
e
    CaseE PreExp E2Ext Var Ty2
e [(String, [(Var, Var)], PreExp E2Ext Var Ty2)]
brs -> PreExp E2Ext Var Ty2 -> Bool
go PreExp E2Ext Var Ty2
e Bool -> Bool -> Bool
|| ((String, [(Var, Var)], PreExp E2Ext Var Ty2) -> Bool)
-> [(String, [(Var, Var)], PreExp E2Ext Var Ty2)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(String
_,[(Var, Var)]
_,PreExp E2Ext Var Ty2
bod) -> PreExp E2Ext Var Ty2 -> Bool
go PreExp E2Ext Var Ty2
bod) [(String, [(Var, Var)], PreExp E2Ext Var Ty2)]
brs
    DataConE Var
_ String
_ [PreExp E2Ext Var Ty2]
ls  -> (PreExp E2Ext Var Ty2 -> Bool) -> [PreExp E2Ext Var Ty2] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any PreExp E2Ext Var Ty2 -> Bool
go [PreExp E2Ext Var Ty2]
ls
    TimeIt PreExp E2Ext Var Ty2
e Ty2
_ Bool
_     -> PreExp E2Ext Var Ty2 -> Bool
go PreExp E2Ext Var Ty2
e
    SpawnE Var
_ [Var]
_ [PreExp E2Ext Var Ty2]
ls    -> (PreExp E2Ext Var Ty2 -> Bool) -> [PreExp E2Ext Var Ty2] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any PreExp E2Ext Var Ty2 -> Bool
go [PreExp E2Ext Var Ty2]
ls
    PreExp E2Ext Var Ty2
SyncE            -> Bool
False
    WithArenaE Var
v PreExp E2Ext Var Ty2
rhs -> Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Var
w Bool -> Bool -> Bool
|| PreExp E2Ext Var Ty2 -> Bool
go PreExp E2Ext Var Ty2
rhs
    Ext E2Ext Var Ty2
ext ->
      case E2Ext Var Ty2
ext of
        LetRegionE Region
_ RegionSize
_ Maybe RegionType
_ PreExp E2Ext Var Ty2
bod  -> PreExp E2Ext Var Ty2 -> Bool
go PreExp E2Ext Var Ty2
bod
        LetParRegionE Region
_ RegionSize
_ Maybe RegionType
_ PreExp E2Ext Var Ty2
bod  -> PreExp E2Ext Var Ty2 -> Bool
go PreExp E2Ext Var Ty2
bod
        LetLocE Var
_ LocExp
le PreExp E2Ext Var Ty2
bod  ->
          let oc_bod :: Bool
oc_bod = PreExp E2Ext Var Ty2 -> Bool
go PreExp E2Ext Var Ty2
bod in
          case LocExp
le of
            AfterVariableLE Var
v Var
_  Bool
_ -> Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Var
w Bool -> Bool -> Bool
|| Bool
oc_bod
            StartOfRegionLE{}         -> Bool
oc_bod
            AfterConstantLE{}   -> Bool
oc_bod
            InRegionLE{}        -> Bool
oc_bod
            FreeLE{}            -> Bool
oc_bod
            FromEndLE{}         -> Bool
oc_bod
        StartOfPkdCursor Var
v -> Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Var
w
        TagCursor Var
a Var
b -> Var
a Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Var
w Bool -> Bool -> Bool
|| Var
b Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Var
w
        RetE [Var]
_ Var
v      -> Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Var
w
        FromEndE{}    -> Bool
False
        BoundsCheck{} -> Bool
False
        AddFixed Var
v Int
_  -> Var
v Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Var
w
        IndirectionE String
_ String
_ (Var
_,Var
v1) (Var
_,Var
v2) PreExp E2Ext Var Ty2
ib ->
          Var
v1 Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Var
w  Bool -> Bool -> Bool
|| Var
v2 Var -> Set Var -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Var
w Bool -> Bool -> Bool
|| PreExp E2Ext Var Ty2 -> Bool
go PreExp E2Ext Var Ty2
ib
        E2Ext Var Ty2
GetCilkWorkerNum -> Bool
False
        LetAvail [Var]
_ PreExp E2Ext Var Ty2
bod -> PreExp E2Ext Var Ty2 -> Bool
go PreExp E2Ext Var Ty2
bod
        AllocateTagHere{} -> Bool
False
        AllocateScalarsHere{} -> Bool
False
        SSPush{} -> Bool
False
        SSPop{} -> Bool
False
    MapE{}  -> String -> Bool
forall a. HasCallStack => String -> a
error String
"occurs: TODO MapE"
    FoldE{} -> String -> Bool
forall a. HasCallStack => String -> a
error String
"occurs: TODO FoldE"
  where
    go :: PreExp E2Ext Var Ty2 -> Bool
go = Set Var -> PreExp E2Ext Var Ty2 -> Bool
occurs Set Var
w


mapPacked :: (Var -> l -> UrTy l) -> UrTy l -> UrTy l
mapPacked :: forall l. (Var -> l -> UrTy l) -> UrTy l -> UrTy l
mapPacked Var -> l -> UrTy l
fn UrTy l
t =
  case UrTy l
t of
    UrTy l
IntTy  -> UrTy l
forall loc. UrTy loc
IntTy
    UrTy l
CharTy -> UrTy l
forall loc. UrTy loc
CharTy
    UrTy l
FloatTy-> UrTy l
forall loc. UrTy loc
FloatTy
    UrTy l
BoolTy -> UrTy l
forall loc. UrTy loc
BoolTy
    UrTy l
SymTy  -> UrTy l
forall loc. UrTy loc
SymTy
    (ProdTy [UrTy l]
x)    -> [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
$ (UrTy l -> UrTy l) -> [UrTy l] -> [UrTy l]
forall a b. (a -> b) -> [a] -> [b]
L.map ((Var -> l -> UrTy l) -> UrTy l -> UrTy l
forall l. (Var -> l -> UrTy l) -> UrTy l -> UrTy l
mapPacked Var -> l -> UrTy l
fn) [UrTy l]
x
    (SymDictTy Maybe Var
v UrTy ()
x) -> Maybe Var -> UrTy () -> UrTy l
forall loc. Maybe Var -> UrTy () -> UrTy loc
SymDictTy Maybe Var
v UrTy ()
x
    PDictTy UrTy l
k UrTy l
v -> UrTy l -> UrTy l -> UrTy l
forall loc. UrTy loc -> UrTy loc -> UrTy loc
PDictTy UrTy l
k UrTy l
v
    PackedTy String
k l
l  -> Var -> l -> UrTy l
fn (String -> Var
toVar String
k) l
l
    UrTy l
PtrTy    -> UrTy l
forall loc. UrTy loc
PtrTy
    UrTy l
CursorTy -> UrTy l
forall loc. UrTy loc
CursorTy
    UrTy l
ArenaTy  -> UrTy l
forall loc. UrTy loc
ArenaTy
    VectorTy UrTy l
elty -> UrTy l -> UrTy l
forall loc. UrTy loc -> UrTy loc
VectorTy UrTy l
elty
    ListTy UrTy l
elty   -> UrTy l -> UrTy l
forall loc. UrTy loc -> UrTy loc
ListTy UrTy l
elty
    UrTy l
SymSetTy -> UrTy l
forall loc. UrTy loc
SymSetTy
    UrTy l
SymHashTy-> UrTy l
forall loc. UrTy loc
SymHashTy
    UrTy l
IntHashTy-> UrTy l
forall loc. UrTy loc
IntHashTy

constPacked :: UrTy a1 -> UrTy a2 -> UrTy a1
constPacked :: forall a1 a2. UrTy a1 -> UrTy a2 -> UrTy a1
constPacked UrTy a1
c UrTy a2
t =
  case UrTy a2
t of
    UrTy a2
IntTy  -> UrTy a1
forall loc. UrTy loc
IntTy
    UrTy a2
CharTy -> UrTy a1
forall loc. UrTy loc
CharTy
    UrTy a2
FloatTy-> UrTy a1
forall loc. UrTy loc
FloatTy
    UrTy a2
BoolTy -> UrTy a1
forall loc. UrTy loc
BoolTy
    UrTy a2
SymTy  -> UrTy a1
forall loc. UrTy loc
SymTy
    (ProdTy [UrTy a2]
x)    -> [UrTy a1] -> UrTy a1
forall loc. [UrTy loc] -> UrTy loc
ProdTy ([UrTy a1] -> UrTy a1) -> [UrTy a1] -> UrTy a1
forall a b. (a -> b) -> a -> b
$ (UrTy a2 -> UrTy a1) -> [UrTy a2] -> [UrTy a1]
forall a b. (a -> b) -> [a] -> [b]
L.map (UrTy a1 -> UrTy a2 -> UrTy a1
forall a1 a2. UrTy a1 -> UrTy a2 -> UrTy a1
constPacked UrTy a1
c) [UrTy a2]
x
    (SymDictTy Maybe Var
v UrTy ()
_x) -> Maybe Var -> UrTy () -> UrTy a1
forall loc. Maybe Var -> UrTy () -> UrTy loc
SymDictTy Maybe Var
v (UrTy () -> UrTy a1) -> UrTy () -> UrTy a1
forall a b. (a -> b) -> a -> b
$ UrTy a1 -> UrTy ()
forall a. UrTy a -> UrTy ()
stripTyLocs UrTy a1
c
    PDictTy UrTy a2
k UrTy a2
v -> UrTy a1 -> UrTy a1 -> UrTy a1
forall loc. UrTy loc -> UrTy loc -> UrTy loc
PDictTy (UrTy a1 -> UrTy a2 -> UrTy a1
forall a1 a2. UrTy a1 -> UrTy a2 -> UrTy a1
constPacked UrTy a1
c UrTy a2
k) (UrTy a1 -> UrTy a2 -> UrTy a1
forall a1 a2. UrTy a1 -> UrTy a2 -> UrTy a1
constPacked UrTy a1
c UrTy a2
v)
    PackedTy String
_k a2
_l  -> UrTy a1
c
    UrTy a2
PtrTy    -> UrTy a1
forall loc. UrTy loc
PtrTy
    UrTy a2
CursorTy -> UrTy a1
forall loc. UrTy loc
CursorTy
    UrTy a2
ArenaTy  -> UrTy a1
forall loc. UrTy loc
ArenaTy
    VectorTy UrTy a2
el_ty -> UrTy a1 -> UrTy a1
forall loc. UrTy loc -> UrTy loc
VectorTy (UrTy a1 -> UrTy a2 -> UrTy a1
forall a1 a2. UrTy a1 -> UrTy a2 -> UrTy a1
constPacked UrTy a1
c UrTy a2
el_ty)
    ListTy UrTy a2
el_ty -> UrTy a1 -> UrTy a1
forall loc. UrTy loc -> UrTy loc
ListTy (UrTy a1 -> UrTy a2 -> UrTy a1
forall a1 a2. UrTy a1 -> UrTy a2 -> UrTy a1
constPacked UrTy a1
c UrTy a2
el_ty)
    UrTy a2
SymSetTy -> UrTy a1
forall loc. UrTy loc
SymSetTy
    UrTy a2
SymHashTy-> UrTy a1
forall loc. UrTy loc
SymHashTy
    UrTy a2
IntHashTy-> UrTy a1
forall loc. UrTy loc
IntHashTy

-- | Build a dependency list which can be later converted to a graph
depList :: Exp2 -> [(Var, Var, [Var])]
-- The helper function, go, works with a map rather than list so that all
-- dependencies are properly grouped, without any duplicate keys. But we
-- convert it back to a list so that we can hand it off to 'graphFromEdges'.
-- Reversing the list makes it easy to peek at the return value of this AST later.
depList :: PreExp E2Ext Var Ty2 -> [(Var, Var, [Var])]
depList = ((Var, [Var]) -> (Var, Var, [Var]))
-> [(Var, [Var])] -> [(Var, Var, [Var])]
forall a b. (a -> b) -> [a] -> [b]
L.map (\(Var
a,[Var]
b) -> (Var
a,Var
a,[Var]
b)) ([(Var, [Var])] -> [(Var, Var, [Var])])
-> (PreExp E2Ext Var Ty2 -> [(Var, [Var])])
-> PreExp E2Ext Var Ty2
-> [(Var, Var, [Var])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Var [Var] -> [(Var, [Var])]
forall k a. Map k a -> [(k, a)]
M.toList (Map Var [Var] -> [(Var, [Var])])
-> (PreExp E2Ext Var Ty2 -> Map Var [Var])
-> PreExp E2Ext Var Ty2
-> [(Var, [Var])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
forall k a. Map k a
M.empty
    where
      go :: M.Map Var [Var] -> Exp2 -> M.Map Var [Var]
      go :: Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
acc PreExp E2Ext Var Ty2
ex =
        case PreExp E2Ext Var Ty2
ex of
          VarE Var
v    -> ([Var] -> [Var] -> [Var])
-> Var -> [Var] -> Map Var [Var] -> Map Var [Var]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
(++) Var
v [Var
v] Map Var [Var]
acc
          LitE{}    -> Map Var [Var]
acc
          CharE{}   -> Map Var [Var]
acc
          FloatE{}  -> Map Var [Var]
acc
          LitSymE{} -> Map Var [Var]
acc
          AppE Var
_ [Var]
_ [PreExp E2Ext Var Ty2]
args   -> (Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var])
-> Map Var [Var] -> [PreExp E2Ext Var Ty2] -> Map Var [Var]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
acc [PreExp E2Ext Var Ty2]
args
          PrimAppE Prim Ty2
_ [PreExp E2Ext Var Ty2]
args -> (Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var])
-> Map Var [Var] -> [PreExp E2Ext Var Ty2] -> Map Var [Var]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
acc [PreExp E2Ext Var Ty2]
args
          LetE (Var
v,[Var]
_,Ty2
_,PreExp E2Ext Var Ty2
rhs) PreExp E2Ext Var Ty2
bod ->
            let acc_rhs :: Map Var [Var]
acc_rhs = Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
acc PreExp E2Ext Var Ty2
rhs
            in Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go (([Var] -> [Var] -> [Var])
-> Var -> [Var] -> Map Var [Var] -> Map Var [Var]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
(++) Var
v (Set Var -> [Var]
forall a. Set a -> [a]
S.toList (Set Var -> [Var]) -> Set Var -> [Var]
forall a b. (a -> b) -> a -> b
$ PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
rhs) Map Var [Var]
acc_rhs) PreExp E2Ext Var Ty2
bod
          IfE PreExp E2Ext Var Ty2
_ PreExp E2Ext Var Ty2
b PreExp E2Ext Var Ty2
c  -> Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go (Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
acc PreExp E2Ext Var Ty2
b) PreExp E2Ext Var Ty2
c
          MkProdE [PreExp E2Ext Var Ty2]
ls -> (Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var])
-> Map Var [Var] -> [PreExp E2Ext Var Ty2] -> Map Var [Var]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
acc [PreExp E2Ext Var Ty2]
ls
          ProjE Int
_ PreExp E2Ext Var Ty2
e  -> Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
acc PreExp E2Ext Var Ty2
e
          CaseE (VarE Var
v) [(String, [(Var, Var)], PreExp E2Ext Var Ty2)]
mp ->
            ((String, [(Var, Var)], PreExp E2Ext Var Ty2)
 -> Map Var [Var] -> Map Var [Var])
-> Map Var [Var]
-> [(String, [(Var, Var)], PreExp E2Ext Var Ty2)]
-> Map Var [Var]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr (\(String
_,[(Var, Var)]
vlocs,PreExp E2Ext Var Ty2
e) Map Var [Var]
acc' ->
                       let ([Var]
vars,[Var]
locs) = [(Var, Var)] -> ([Var], [Var])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Var, Var)]
vlocs
                           acc'' :: Map Var [Var]
acc'' = (Var -> Map Var [Var] -> Map Var [Var])
-> Map Var [Var] -> [Var] -> Map Var [Var]
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
w Map Var [Var]
acc''' -> ([Var] -> [Var] -> [Var])
-> Var -> [Var] -> Map Var [Var] -> Map Var [Var]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
(++) Var
v [Var
w] Map Var [Var]
acc''')
                                           Map Var [Var]
acc'
                                           ([Var]
vars [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ [Var]
locs)
                       in Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
acc'' PreExp E2Ext Var Ty2
e)
                    Map Var [Var]
acc
                    [(String, [(Var, Var)], PreExp E2Ext Var Ty2)]
mp
          CaseE PreExp E2Ext Var Ty2
_scrt [(String, [(Var, Var)], PreExp E2Ext Var Ty2)]
mp -> ((String, [(Var, Var)], PreExp E2Ext Var Ty2)
 -> Map Var [Var] -> Map Var [Var])
-> Map Var [Var]
-> [(String, [(Var, Var)], PreExp E2Ext Var Ty2)]
-> Map Var [Var]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr (\(String
_,[(Var, Var)]
_,PreExp E2Ext Var Ty2
e) Map Var [Var]
acc' -> Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
acc' PreExp E2Ext Var Ty2
e) Map Var [Var]
acc [(String, [(Var, Var)], PreExp E2Ext Var Ty2)]
mp
          DataConE Var
_ String
_ [PreExp E2Ext Var Ty2]
args -> (Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var])
-> Map Var [Var] -> [PreExp E2Ext Var Ty2] -> Map Var [Var]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
acc [PreExp E2Ext Var Ty2]
args
          TimeIt PreExp E2Ext Var Ty2
e Ty2
_ Bool
_ -> Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
acc PreExp E2Ext Var Ty2
e
          WithArenaE Var
_ PreExp E2Ext Var Ty2
e -> Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
acc PreExp E2Ext Var Ty2
e
          SpawnE Var
_ [Var]
_ [PreExp E2Ext Var Ty2]
ls  -> (Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var])
-> Map Var [Var] -> [PreExp E2Ext Var Ty2] -> Map Var [Var]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
acc [PreExp E2Ext Var Ty2]
ls
          PreExp E2Ext Var Ty2
SyncE          -> Map Var [Var]
acc
          MapE{}  -> Map Var [Var]
acc
          FoldE{} -> Map Var [Var]
acc
          Ext E2Ext Var Ty2
ext ->
            case E2Ext Var Ty2
ext of
              LetRegionE Region
r RegionSize
_ Maybe RegionType
_ PreExp E2Ext Var Ty2
rhs ->
                Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go (([Var] -> [Var] -> [Var])
-> Var -> [Var] -> Map Var [Var] -> Map Var [Var]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
(++) (Region -> Var
regionToVar Region
r) (Set Var -> [Var]
forall a. Set a -> [a]
S.toList (Set Var -> [Var]) -> Set Var -> [Var]
forall a b. (a -> b) -> a -> b
$ PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
rhs) Map Var [Var]
acc) PreExp E2Ext Var Ty2
rhs
              LetParRegionE Region
r RegionSize
_ Maybe RegionType
_ PreExp E2Ext Var Ty2
rhs ->
                Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go (([Var] -> [Var] -> [Var])
-> Var -> [Var] -> Map Var [Var] -> Map Var [Var]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
(++) (Region -> Var
regionToVar Region
r) (Set Var -> [Var]
forall a. Set a -> [a]
S.toList (Set Var -> [Var]) -> Set Var -> [Var]
forall a b. (a -> b) -> a -> b
$ PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
rhs) Map Var [Var]
acc) PreExp E2Ext Var Ty2
rhs
              LetLocE Var
loc LocExp
phs PreExp E2Ext Var Ty2
rhs  ->
                Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go (([Var] -> [Var] -> [Var])
-> Var -> [Var] -> Map Var [Var] -> Map Var [Var]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
(++) Var
loc (LocExp -> [Var]
dep LocExp
phs [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
++ (Set Var -> [Var]
forall a. Set a -> [a]
S.toList (Set Var -> [Var]) -> Set Var -> [Var]
forall a b. (a -> b) -> a -> b
$ PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
rhs)) Map Var [Var]
acc) PreExp E2Ext Var Ty2
rhs
              RetE{}         -> Map Var [Var]
acc
              FromEndE{}     -> Map Var [Var]
acc
              BoundsCheck{}  -> Map Var [Var]
acc
              IndirectionE{} -> Map Var [Var]
acc
              AddFixed Var
v Int
_   -> ([Var] -> [Var] -> [Var])
-> Var -> [Var] -> Map Var [Var] -> Map Var [Var]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith [Var] -> [Var] -> [Var]
forall a. [a] -> [a] -> [a]
(++) Var
v [Var
v] Map Var [Var]
acc
              E2Ext Var Ty2
GetCilkWorkerNum -> Map Var [Var]
acc
              LetAvail [Var]
_ PreExp E2Ext Var Ty2
bod -> Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
acc PreExp E2Ext Var Ty2
bod
              AllocateTagHere{} -> Map Var [Var]
acc
              AllocateScalarsHere{} -> Map Var [Var]
acc
              SSPush{} -> Map Var [Var]
acc
              SSPop{} -> Map Var [Var]
acc
              StartOfPkdCursor Var
w -> Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
acc (Var -> PreExp E2Ext Var Ty2
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
w)
              TagCursor Var
a Var
b -> Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go (Map Var [Var] -> PreExp E2Ext Var Ty2 -> Map Var [Var]
go Map Var [Var]
acc (Var -> PreExp E2Ext Var Ty2
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
a)) (Var -> PreExp E2Ext Var Ty2
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
b)

      dep :: PreLocExp LocVar -> [Var]
      dep :: LocExp -> [Var]
dep LocExp
ex =
        case LocExp
ex of
          StartOfRegionLE Region
r -> [Region -> Var
regionToVar Region
r]
          AfterConstantLE Int
_ Var
loc   -> [Var
loc]
          AfterVariableLE Var
v Var
loc Bool
_ -> [Var
v,Var
loc]
          InRegionLE Region
r  -> [Region -> Var
regionToVar Region
r]
          FromEndLE Var
loc -> [Var
loc]
          LocExp
FreeLE -> []

-- gFreeVars ++ locations ++ region variables
allFreeVars :: Exp2 -> S.Set Var
allFreeVars :: PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
ex =
  case PreExp E2Ext Var Ty2
ex of
    AppE Var
_ [Var]
locs [PreExp E2Ext Var Ty2]
args -> [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var]
locs Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.union` ([Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ((PreExp E2Ext Var Ty2 -> Set Var)
-> [PreExp E2Ext Var Ty2] -> [Set Var]
forall a b. (a -> b) -> [a] -> [b]
map PreExp E2Ext Var Ty2 -> Set Var
allFreeVars [PreExp E2Ext Var Ty2]
args))
    PrimAppE Prim Ty2
_ [PreExp E2Ext Var Ty2]
args -> ([Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ((PreExp E2Ext Var Ty2 -> Set Var)
-> [PreExp E2Ext Var Ty2] -> [Set Var]
forall a b. (a -> b) -> [a] -> [b]
map PreExp E2Ext Var Ty2 -> Set Var
allFreeVars [PreExp E2Ext Var Ty2]
args))
    LetE (Var
v,[Var]
locs,Ty2
_,PreExp E2Ext Var Ty2
rhs) PreExp E2Ext Var Ty2
bod -> ([Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var]
locs Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.union` (PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
rhs) Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.union` (PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
bod))
                               Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
    IfE PreExp E2Ext Var Ty2
a PreExp E2Ext Var Ty2
b PreExp E2Ext Var Ty2
c -> PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
a Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.union` PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
b Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.union` PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
c
    MkProdE [PreExp E2Ext Var Ty2]
args -> ([Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ((PreExp E2Ext Var Ty2 -> Set Var)
-> [PreExp E2Ext Var Ty2] -> [Set Var]
forall a b. (a -> b) -> [a] -> [b]
map PreExp E2Ext Var Ty2 -> Set Var
allFreeVars [PreExp E2Ext Var Ty2]
args))
    ProjE Int
_ PreExp E2Ext Var Ty2
bod -> PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
bod
    CaseE PreExp E2Ext Var Ty2
scrt [(String, [(Var, Var)], PreExp E2Ext Var Ty2)]
brs -> (PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
scrt) Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.union` ([Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (((String, [(Var, Var)], PreExp E2Ext Var Ty2) -> Set Var)
-> [(String, [(Var, Var)], PreExp E2Ext Var Ty2)] -> [Set Var]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
_,[(Var, Var)]
vlocs,PreExp E2Ext Var Ty2
c) -> PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
c Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.difference`
                                                                                   [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList (((Var, Var) -> Var) -> [(Var, Var)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var, Var) -> Var
forall a b. (a, b) -> a
fst [(Var, Var)]
vlocs) Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.difference`
                                                                                   [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList (((Var, Var) -> Var) -> [(Var, Var)] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map (Var, Var) -> Var
forall a b. (a, b) -> b
snd [(Var, Var)]
vlocs))
                                                                  [(String, [(Var, Var)], PreExp E2Ext Var Ty2)]
brs))
    DataConE Var
loc String
_ [PreExp E2Ext Var Ty2]
args -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
loc Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.union` ([Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ((PreExp E2Ext Var Ty2 -> Set Var)
-> [PreExp E2Ext Var Ty2] -> [Set Var]
forall a b. (a -> b) -> [a] -> [b]
map PreExp E2Ext Var Ty2 -> Set Var
allFreeVars [PreExp E2Ext Var Ty2]
args))
    TimeIt PreExp E2Ext Var Ty2
e Ty2
_ Bool
_ -> PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
e
    WithArenaE Var
_ PreExp E2Ext Var Ty2
e -> PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
e
    SpawnE Var
_ [Var]
locs [PreExp E2Ext Var Ty2]
args -> [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var]
locs Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.union` ([Set Var] -> Set Var
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ((PreExp E2Ext Var Ty2 -> Set Var)
-> [PreExp E2Ext Var Ty2] -> [Set Var]
forall a b. (a -> b) -> [a] -> [b]
map PreExp E2Ext Var Ty2 -> Set Var
allFreeVars [PreExp E2Ext Var Ty2]
args))
    Ext E2Ext Var Ty2
ext ->
      case E2Ext Var Ty2
ext of
        LetRegionE Region
r RegionSize
_ Maybe RegionType
_ PreExp E2Ext Var Ty2
bod -> Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
S.delete (Region -> Var
regionToVar Region
r) (PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
bod)
        LetParRegionE Region
r RegionSize
_ Maybe RegionType
_ PreExp E2Ext Var Ty2
bod -> Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
S.delete (Region -> Var
regionToVar Region
r) (PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
bod)
        LetLocE Var
loc LocExp
locexp PreExp E2Ext Var Ty2
bod -> Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
S.delete Var
loc (PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
bod Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.union` LocExp -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars LocExp
locexp)
        StartOfPkdCursor Var
cur -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
cur
        TagCursor Var
a Var
b-> [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var
a,Var
b]
        RetE [Var]
locs Var
v     -> Var -> Set Var -> Set Var
forall a. Ord a => a -> Set a -> Set a
S.insert Var
v ([Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var]
locs)
        FromEndE Var
loc    -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
loc
        BoundsCheck Int
_ Var
reg Var
cur -> [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var
reg,Var
cur]
        IndirectionE String
_ String
_ (Var
a,Var
b) (Var
c,Var
d) PreExp E2Ext Var Ty2
_ -> [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList ([Var] -> Set Var) -> [Var] -> Set Var
forall a b. (a -> b) -> a -> b
$ [Var
a,Var
b,Var
c,Var
d]
        AddFixed Var
v Int
_    -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
v
        E2Ext Var Ty2
GetCilkWorkerNum-> Set Var
forall a. Set a
S.empty
        LetAvail [Var]
vs PreExp E2Ext Var Ty2
bod -> [Var] -> Set Var
forall a. Ord a => [a] -> Set a
S.fromList [Var]
vs Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.union` PreExp E2Ext Var Ty2 -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E2Ext Var Ty2
bod
        AllocateTagHere Var
loc String
_ -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
loc
        AllocateScalarsHere Var
loc -> Var -> Set Var
forall a. a -> Set a
S.singleton Var
loc
        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]
    PreExp E2Ext Var Ty2
_ -> PreExp E2Ext Var Ty2 -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E2Ext Var Ty2
ex

freeLocVars :: Exp2 -> [Var]
freeLocVars :: PreExp E2Ext Var Ty2 -> [Var]
freeLocVars PreExp E2Ext Var Ty2
ex = Set Var -> [Var]
forall a. Set a -> [a]
S.toList (Set Var -> [Var]) -> Set Var -> [Var]
forall a b. (a -> b) -> a -> b
$ (PreExp E2Ext Var Ty2 -> Set Var
allFreeVars PreExp E2Ext Var Ty2
ex) Set Var -> Set Var -> Set Var
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` (PreExp E2Ext Var Ty2 -> Set Var
forall a. FreeVars a => a -> Set Var
gFreeVars PreExp E2Ext Var Ty2
ex)

changeAppToSpawn :: (Eq loc, Eq dec) => Var -> [PreExp E2Ext loc dec] -> PreExp E2Ext loc dec -> PreExp E2Ext loc dec
changeAppToSpawn :: forall loc dec.
(Eq loc, Eq dec) =>
Var
-> [PreExp E2Ext loc dec]
-> PreExp E2Ext loc dec
-> PreExp E2Ext loc dec
changeAppToSpawn Var
v [PreExp E2Ext loc dec]
args2 PreExp E2Ext loc dec
ex1 =
  case PreExp E2Ext loc dec
ex1 of
    VarE{}    -> PreExp E2Ext loc dec
ex1
    LitE{}    -> PreExp E2Ext loc dec
ex1
    CharE{}   -> PreExp E2Ext loc dec
ex1
    FloatE{}  -> PreExp E2Ext loc dec
ex1
    LitSymE{} -> PreExp E2Ext loc dec
ex1
    AppE Var
f [loc]
locs [PreExp E2Ext loc dec]
args | Var
v Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
f Bool -> Bool -> Bool
&& [PreExp E2Ext loc dec]
args [PreExp E2Ext loc dec] -> [PreExp E2Ext loc dec] -> Bool
forall a. Eq a => a -> a -> Bool
== [PreExp E2Ext loc dec]
args2 -> Var -> [loc] -> [PreExp E2Ext loc dec] -> PreExp E2Ext loc dec
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
SpawnE Var
f [loc]
locs ([PreExp E2Ext loc dec] -> PreExp E2Ext loc dec)
-> [PreExp E2Ext loc dec] -> PreExp E2Ext loc dec
forall a b. (a -> b) -> a -> b
$ (PreExp E2Ext loc dec -> PreExp E2Ext loc dec)
-> [PreExp E2Ext loc dec] -> [PreExp E2Ext loc dec]
forall a b. (a -> b) -> [a] -> [b]
map PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go [PreExp E2Ext loc dec]
args
    AppE Var
f [loc]
locs [PreExp E2Ext loc dec]
args -> Var -> [loc] -> [PreExp E2Ext loc dec] -> PreExp E2Ext loc dec
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE Var
f [loc]
locs ([PreExp E2Ext loc dec] -> PreExp E2Ext loc dec)
-> [PreExp E2Ext loc dec] -> PreExp E2Ext loc dec
forall a b. (a -> b) -> a -> b
$ (PreExp E2Ext loc dec -> PreExp E2Ext loc dec)
-> [PreExp E2Ext loc dec] -> [PreExp E2Ext loc dec]
forall a b. (a -> b) -> [a] -> [b]
map PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go [PreExp E2Ext loc dec]
args
    PrimAppE Prim dec
f [PreExp E2Ext loc dec]
args  -> Prim dec -> [PreExp E2Ext loc dec] -> PreExp E2Ext loc dec
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE Prim dec
f ([PreExp E2Ext loc dec] -> PreExp E2Ext loc dec)
-> [PreExp E2Ext loc dec] -> PreExp E2Ext loc dec
forall a b. (a -> b) -> a -> b
$ (PreExp E2Ext loc dec -> PreExp E2Ext loc dec)
-> [PreExp E2Ext loc dec] -> [PreExp E2Ext loc dec]
forall a b. (a -> b) -> [a] -> [b]
map PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go [PreExp E2Ext loc dec]
args
    LetE (Var
v,[loc]
loc,dec
ty,PreExp E2Ext loc dec
rhs) PreExp E2Ext loc dec
bod -> (Var, [loc], dec, PreExp E2Ext loc dec)
-> PreExp E2Ext loc dec -> PreExp E2Ext loc dec
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
v,[loc]
loc,dec
ty, PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go PreExp E2Ext loc dec
rhs) (PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go PreExp E2Ext loc dec
bod)
    IfE PreExp E2Ext loc dec
a PreExp E2Ext loc dec
b PreExp E2Ext loc dec
c  -> PreExp E2Ext loc dec
-> PreExp E2Ext loc dec
-> PreExp E2Ext loc dec
-> PreExp E2Ext loc dec
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec
IfE (PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go PreExp E2Ext loc dec
a) (PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go PreExp E2Ext loc dec
b) (PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go PreExp E2Ext loc dec
c)
    MkProdE [PreExp E2Ext loc dec]
xs -> [PreExp E2Ext loc dec] -> PreExp E2Ext loc dec
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE ([PreExp E2Ext loc dec] -> PreExp E2Ext loc dec)
-> [PreExp E2Ext loc dec] -> PreExp E2Ext loc dec
forall a b. (a -> b) -> a -> b
$ (PreExp E2Ext loc dec -> PreExp E2Ext loc dec)
-> [PreExp E2Ext loc dec] -> [PreExp E2Ext loc dec]
forall a b. (a -> b) -> [a] -> [b]
map PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go [PreExp E2Ext loc dec]
xs
    ProjE Int
i PreExp E2Ext loc dec
e  -> Int -> PreExp E2Ext loc dec -> PreExp E2Ext loc dec
forall (ext :: * -> * -> *) loc dec.
Int -> PreExp ext loc dec -> PreExp ext loc dec
ProjE Int
i (PreExp E2Ext loc dec -> PreExp E2Ext loc dec)
-> PreExp E2Ext loc dec -> PreExp E2Ext loc dec
forall a b. (a -> b) -> a -> b
$ PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go PreExp E2Ext loc dec
e
    DataConE loc
loc String
dcon [PreExp E2Ext loc dec]
args -> loc -> String -> [PreExp E2Ext loc dec] -> PreExp E2Ext loc dec
forall (ext :: * -> * -> *) loc dec.
loc -> String -> [PreExp ext loc dec] -> PreExp ext loc dec
DataConE loc
loc String
dcon ([PreExp E2Ext loc dec] -> PreExp E2Ext loc dec)
-> [PreExp E2Ext loc dec] -> PreExp E2Ext loc dec
forall a b. (a -> b) -> a -> b
$ (PreExp E2Ext loc dec -> PreExp E2Ext loc dec)
-> [PreExp E2Ext loc dec] -> [PreExp E2Ext loc dec]
forall a b. (a -> b) -> [a] -> [b]
map PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go [PreExp E2Ext loc dec]
args
    CaseE PreExp E2Ext loc dec
scrt [(String, [(Var, loc)], PreExp E2Ext loc dec)]
mp ->
      PreExp E2Ext loc dec
-> [(String, [(Var, loc)], PreExp E2Ext loc dec)]
-> PreExp E2Ext loc dec
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> [(String, [(Var, loc)], PreExp ext loc dec)]
-> PreExp ext loc dec
CaseE (PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go PreExp E2Ext loc dec
scrt) ([(String, [(Var, loc)], PreExp E2Ext loc dec)]
 -> PreExp E2Ext loc dec)
-> [(String, [(Var, loc)], PreExp E2Ext loc dec)]
-> PreExp E2Ext loc dec
forall a b. (a -> b) -> a -> b
$ ((String, [(Var, loc)], PreExp E2Ext loc dec)
 -> (String, [(Var, loc)], PreExp E2Ext loc dec))
-> [(String, [(Var, loc)], PreExp E2Ext loc dec)]
-> [(String, [(Var, loc)], PreExp E2Ext loc dec)]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
a,[(Var, loc)]
b,PreExp E2Ext loc dec
c) -> (String
a,[(Var, loc)]
b, PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go PreExp E2Ext loc dec
c)) [(String, [(Var, loc)], PreExp E2Ext loc dec)]
mp
    TimeIt PreExp E2Ext loc dec
e dec
ty Bool
b  -> PreExp E2Ext loc dec -> dec -> Bool -> PreExp E2Ext loc dec
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> dec -> Bool -> PreExp ext loc dec
TimeIt (PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go PreExp E2Ext loc dec
e) dec
ty Bool
b
    WithArenaE Var
v PreExp E2Ext loc dec
e -> Var -> PreExp E2Ext loc dec -> PreExp E2Ext loc dec
forall (ext :: * -> * -> *) loc dec.
Var -> PreExp ext loc dec -> PreExp ext loc dec
WithArenaE Var
v (PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go PreExp E2Ext loc dec
e)
    SpawnE{} -> PreExp E2Ext loc dec
ex1
    SyncE{}  -> PreExp E2Ext loc dec
ex1
    Ext E2Ext loc dec
ext ->
      case E2Ext loc dec
ext of
        LetRegionE Region
r RegionSize
sz Maybe RegionType
ty PreExp E2Ext loc dec
rhs  -> E2Ext loc dec -> PreExp E2Ext loc dec
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E2Ext loc dec -> PreExp E2Ext loc dec)
-> E2Ext loc dec -> PreExp E2Ext loc dec
forall a b. (a -> b) -> a -> b
$ Region
-> RegionSize
-> Maybe RegionType
-> PreExp E2Ext loc dec
-> E2Ext loc dec
forall loc dec.
Region
-> RegionSize -> Maybe RegionType -> E2 loc dec -> E2Ext loc dec
LetRegionE Region
r RegionSize
sz Maybe RegionType
ty (PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go PreExp E2Ext loc dec
rhs)
        LetParRegionE Region
r RegionSize
sz Maybe RegionType
ty PreExp E2Ext loc dec
rhs  -> E2Ext loc dec -> PreExp E2Ext loc dec
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E2Ext loc dec -> PreExp E2Ext loc dec)
-> E2Ext loc dec -> PreExp E2Ext loc dec
forall a b. (a -> b) -> a -> b
$ Region
-> RegionSize
-> Maybe RegionType
-> PreExp E2Ext loc dec
-> E2Ext loc dec
forall loc dec.
Region
-> RegionSize -> Maybe RegionType -> E2 loc dec -> E2Ext loc dec
LetParRegionE Region
r RegionSize
sz Maybe RegionType
ty (PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go PreExp E2Ext loc dec
rhs)
        LetLocE Var
l PreLocExp loc
lhs PreExp E2Ext loc dec
rhs -> E2Ext loc dec -> PreExp E2Ext loc dec
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E2Ext loc dec -> PreExp E2Ext loc dec)
-> E2Ext loc dec -> PreExp E2Ext loc dec
forall a b. (a -> b) -> a -> b
$ Var -> PreLocExp loc -> PreExp E2Ext loc dec -> E2Ext loc dec
forall loc dec. Var -> PreLocExp loc -> E2 loc dec -> E2Ext loc dec
LetLocE Var
l PreLocExp loc
lhs (PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go PreExp E2Ext loc dec
rhs)
        StartOfPkdCursor{} -> PreExp E2Ext loc dec
ex1
        TagCursor{}    -> PreExp E2Ext loc dec
ex1
        RetE{}            -> PreExp E2Ext loc dec
ex1
        FromEndE{}        -> PreExp E2Ext loc dec
ex1
        BoundsCheck{}     -> PreExp E2Ext loc dec
ex1
        IndirectionE{}    -> PreExp E2Ext loc dec
ex1
        AddFixed{}        -> PreExp E2Ext loc dec
ex1
        E2Ext loc dec
GetCilkWorkerNum  -> PreExp E2Ext loc dec
ex1
        LetAvail [Var]
vs PreExp E2Ext loc dec
bod   -> E2Ext loc dec -> PreExp E2Ext loc dec
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E2Ext loc dec -> PreExp E2Ext loc dec)
-> E2Ext loc dec -> PreExp E2Ext loc dec
forall a b. (a -> b) -> a -> b
$ [Var] -> PreExp E2Ext loc dec -> E2Ext loc dec
forall loc dec. [Var] -> E2 loc dec -> E2Ext loc dec
LetAvail [Var]
vs (PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go PreExp E2Ext loc dec
bod)
        AllocateTagHere{} -> PreExp E2Ext loc dec
ex1
        AllocateScalarsHere{} -> PreExp E2Ext loc dec
ex1
        SSPush{} -> PreExp E2Ext loc dec
ex1
        SSPop{} -> PreExp E2Ext loc dec
ex1
    MapE{}  -> String -> PreExp E2Ext loc dec
forall a. HasCallStack => String -> a
error String
"addRANExp: TODO MapE"
    FoldE{}  -> String -> PreExp E2Ext loc dec
forall a. HasCallStack => String -> a
error String
"addRANExp: TODO FoldE"

  where go :: PreExp E2Ext loc dec -> PreExp E2Ext loc dec
go = Var
-> [PreExp E2Ext loc dec]
-> PreExp E2Ext loc dec
-> PreExp E2Ext loc dec
forall loc dec.
(Eq loc, Eq dec) =>
Var
-> [PreExp E2Ext loc dec]
-> PreExp E2Ext loc dec
-> PreExp E2Ext loc dec
changeAppToSpawn Var
v [PreExp E2Ext loc dec]
args2