{-# LANGUAGE Strict #-}

-- | ImpCode is an imperative intermediate language used as a stepping
-- stone in code generation.  The functional core IR
-- ("Futhark.IR.Syntax") gets translated into ImpCode by
-- "Futhark.CodeGen.ImpGen".  Later we then translate ImpCode to, for
-- example, C.
--
-- == Basic design
--
-- ImpCode distinguishes between /statements/ ('Code'), which may have
-- side effects, and /expressions/ ('Exp') which do not.  Expressions
-- involve only scalars and have a type.  The actual expression
-- definition is in "Futhark.Analysis.PrimExp", specifically
-- 'Futhark.Analysis.PrimExp.PrimExp' and its phantom-typed variant
-- 'Futhark.Analysis.PrimExp.TPrimExp'.
--
-- 'Code' is a generic representation parametrised on an extensible
-- arbitrary operation, represented by the 'Op' constructor.  Specific
-- instantiations of ImpCode, such as
-- "Futhark.CodeGen.ImpCode.Multicore", will pass in a specific kind
-- of operation to express backend-specific functionality (in the case
-- of multicore, this is
-- 'Futhark.CodeGen.ImpCode.Multicore.Multicore').
--
-- == Arrays and memory
--
-- ImpCode does not have arrays. 'DeclareArray' is for declaring
-- constant array literals, not arrays in general.  Instead, ImpCode
-- deals only with memory.  Array operations present in core IR
-- programs are turned into 'Write', v'Read', and 'Copy' operations
-- that use flat indexes and offsets based on the index function of
-- the original array.
--
-- == Scoping
--
-- ImpCode is much simpler than the functional core IR; partly because
-- we hope to do less work on it.  We don't have real optimisation
-- passes on ImpCode.  One result of this simplicity is that ImpCode
-- has a fairly naive view of scoping.  The /only/ things that can
-- bring new names into scope are 'DeclareMem', 'DeclareScalar',
-- 'DeclareArray', 'For', and function parameters.  In particular,
-- 'Op's /cannot/ bind parameters.  The standard workaround is to
-- define 'Op's that retrieve the value of an implicit parameter and
-- assign it to a variable declared with the normal
-- mechanisms. 'Futhark.CodeGen.ImpCode.Multicore.GetLoopBounds' is an
-- example of this pattern.
--
-- == Inspiration
--
-- ImpCode was originally inspired by the paper "Defunctionalizing
-- Push Arrays" (FHPC '14).
module Futhark.CodeGen.ImpCode
  ( Definitions (..),
    Functions (..),
    Function,
    FunctionT (..),
    EntryPoint (..),
    Constants (..),
    ValueDesc (..),
    ExternalValue (..),
    Param (..),
    paramName,
    MemSize,
    DimSize,
    Code (..),
    PrimValue (..),
    Exp,
    TExp,
    Volatility (..),
    Arg (..),
    var,
    ArrayContents (..),
    declaredIn,
    lexicalMemoryUsage,
    calledFuncs,
    callGraph,
    ParamMap,

    -- * Typed enumerations
    Bytes,
    Elements,
    elements,
    bytes,
    withElemType,

    -- * Re-exports from other modules.
    prettyText,
    prettyString,
    module Futhark.IR.Syntax.Core,
    module Language.Futhark.Core,
    module Language.Futhark.Primitive,
    module Futhark.Analysis.PrimExp,
    module Futhark.Analysis.PrimExp.Convert,
    module Futhark.IR.GPU.Sizes,
    module Futhark.IR.Prop.Names,
  )
where

import Data.Bifunctor (second)
import Data.List (intersperse)
import Data.Map qualified as M
import Data.Ord (comparing)
import Data.Set qualified as S
import Data.Text qualified as T
import Data.Traversable
import Futhark.Analysis.PrimExp
import Futhark.Analysis.PrimExp.Convert
import Futhark.IR.GPU.Sizes (Count (..), SizeClass (..))
import Futhark.IR.Pretty ()
import Futhark.IR.Prop.Names
import Futhark.IR.Syntax.Core
  ( EntryPointType (..),
    ErrorMsg (..),
    ErrorMsgPart (..),
    OpaqueType (..),
    OpaqueTypes (..),
    Rank (..),
    Signedness (..),
    Space (..),
    SpaceId,
    SubExp (..),
    ValueType (..),
    errorMsgArgTypes,
  )
import Futhark.Util (nubByOrd)
import Futhark.Util.Pretty hiding (space)
import Language.Futhark.Core
import Language.Futhark.Primitive

-- | The size of a memory block.
type MemSize = SubExp

-- | The size of an array.
type DimSize = SubExp

-- | An ImpCode function parameter.
data Param
  = MemParam VName Space
  | ScalarParam VName PrimType
  deriving (Param -> Param -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Param -> Param -> Bool
$c/= :: Param -> Param -> Bool
== :: Param -> Param -> Bool
$c== :: Param -> Param -> Bool
Eq, Int -> Param -> ShowS
[Param] -> ShowS
Param -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Param] -> ShowS
$cshowList :: [Param] -> ShowS
show :: Param -> String
$cshow :: Param -> String
showsPrec :: Int -> Param -> ShowS
$cshowsPrec :: Int -> Param -> ShowS
Show)

-- | The name of a parameter.
paramName :: Param -> VName
paramName :: Param -> VName
paramName (MemParam VName
name Space
_) = VName
name
paramName (ScalarParam VName
name PrimType
_) = VName
name

-- | A collection of imperative functions and constants.
data Definitions a = Definitions
  { forall a. Definitions a -> OpaqueTypes
defTypes :: OpaqueTypes,
    forall a. Definitions a -> Constants a
defConsts :: Constants a,
    forall a. Definitions a -> Functions a
defFuns :: Functions a
  }
  deriving (Int -> Definitions a -> ShowS
forall a. Show a => Int -> Definitions a -> ShowS
forall a. Show a => [Definitions a] -> ShowS
forall a. Show a => Definitions a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Definitions a] -> ShowS
$cshowList :: forall a. Show a => [Definitions a] -> ShowS
show :: Definitions a -> String
$cshow :: forall a. Show a => Definitions a -> String
showsPrec :: Int -> Definitions a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Definitions a -> ShowS
Show)

instance Functor Definitions where
  fmap :: forall a b. (a -> b) -> Definitions a -> Definitions b
fmap a -> b
f (Definitions OpaqueTypes
types Constants a
consts Functions a
funs) =
    forall a.
OpaqueTypes -> Constants a -> Functions a -> Definitions a
Definitions OpaqueTypes
types (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Constants a
consts) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Functions a
funs)

-- | A collection of imperative functions.
newtype Functions a = Functions {forall a. Functions a -> [(Name, Function a)]
unFunctions :: [(Name, Function a)]}
  deriving (Int -> Functions a -> ShowS
forall a. Show a => Int -> Functions a -> ShowS
forall a. Show a => [Functions a] -> ShowS
forall a. Show a => Functions a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Functions a] -> ShowS
$cshowList :: forall a. Show a => [Functions a] -> ShowS
show :: Functions a -> String
$cshow :: forall a. Show a => Functions a -> String
showsPrec :: Int -> Functions a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Functions a -> ShowS
Show)

instance Semigroup (Functions a) where
  Functions [(Name, Function a)]
x <> :: Functions a -> Functions a -> Functions a
<> Functions [(Name, Function a)]
y = forall a. [(Name, Function a)] -> Functions a
Functions forall a b. (a -> b) -> a -> b
$ [(Name, Function a)]
x forall a. [a] -> [a] -> [a]
++ [(Name, Function a)]
y

instance Monoid (Functions a) where
  mempty :: Functions a
mempty = forall a. [(Name, Function a)] -> Functions a
Functions []

-- | A collection of imperative constants.
data Constants a = Constants
  { -- | The constants that are made available to the functions.
    forall a. Constants a -> [Param]
constsDecl :: [Param],
    -- | Setting the value of the constants.  Note that this must not
    -- contain declarations of the names defined in 'constsDecl'.
    forall a. Constants a -> Code a
constsInit :: Code a
  }
  deriving (Int -> Constants a -> ShowS
forall a. Show a => Int -> Constants a -> ShowS
forall a. Show a => [Constants a] -> ShowS
forall a. Show a => Constants a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constants a] -> ShowS
$cshowList :: forall a. Show a => [Constants a] -> ShowS
show :: Constants a -> String
$cshow :: forall a. Show a => Constants a -> String
showsPrec :: Int -> Constants a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Constants a -> ShowS
Show)

instance Functor Constants where
  fmap :: forall a b. (a -> b) -> Constants a -> Constants b
fmap a -> b
f (Constants [Param]
params Code a
code) = forall a. [Param] -> Code a -> Constants a
Constants [Param]
params (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Code a
code)

instance Monoid (Constants a) where
  mempty :: Constants a
mempty = forall a. [Param] -> Code a -> Constants a
Constants forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

instance Semigroup (Constants a) where
  Constants [Param]
ps1 Code a
c1 <> :: Constants a -> Constants a -> Constants a
<> Constants [Param]
ps2 Code a
c2 =
    forall a. [Param] -> Code a -> Constants a
Constants (forall a. (a -> a -> Ordering) -> [a] -> [a]
nubByOrd (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (forall a. Pretty a => a -> String
prettyString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Param -> VName
paramName)) forall a b. (a -> b) -> a -> b
$ [Param]
ps1 forall a. Semigroup a => a -> a -> a
<> [Param]
ps2) (Code a
c1 forall a. Semigroup a => a -> a -> a
<> Code a
c2)

-- | A description of an externally meaningful value.
data ValueDesc
  = -- | An array with memory block memory space, element type,
    -- signedness of element type (if applicable), and shape.
    ArrayValue VName Space PrimType Signedness [DimSize]
  | -- | A scalar value with signedness if applicable.
    ScalarValue PrimType Signedness VName
  deriving (ValueDesc -> ValueDesc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValueDesc -> ValueDesc -> Bool
$c/= :: ValueDesc -> ValueDesc -> Bool
== :: ValueDesc -> ValueDesc -> Bool
$c== :: ValueDesc -> ValueDesc -> Bool
Eq, Int -> ValueDesc -> ShowS
[ValueDesc] -> ShowS
ValueDesc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValueDesc] -> ShowS
$cshowList :: [ValueDesc] -> ShowS
show :: ValueDesc -> String
$cshow :: ValueDesc -> String
showsPrec :: Int -> ValueDesc -> ShowS
$cshowsPrec :: Int -> ValueDesc -> ShowS
Show)

-- | ^ An externally visible value.  This can be an opaque value
-- (covering several physical internal values), or a single value that
-- can be used externally.  We record the uniqueness because it is
-- important to the external interface as well.
data ExternalValue
  = -- | The string is a human-readable description with no other
    -- semantics.
    OpaqueValue Name [ValueDesc]
  | TransparentValue ValueDesc
  deriving (Int -> ExternalValue -> ShowS
[ExternalValue] -> ShowS
ExternalValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternalValue] -> ShowS
$cshowList :: [ExternalValue] -> ShowS
show :: ExternalValue -> String
$cshow :: ExternalValue -> String
showsPrec :: Int -> ExternalValue -> ShowS
$cshowsPrec :: Int -> ExternalValue -> ShowS
Show)

-- | Information about how this function can be called from the outside world.
data EntryPoint = EntryPoint
  { EntryPoint -> Name
entryPointName :: Name,
    EntryPoint -> [(Uniqueness, ExternalValue)]
entryPointResults :: [(Uniqueness, ExternalValue)],
    EntryPoint -> [((Name, Uniqueness), ExternalValue)]
entryPointArgs :: [((Name, Uniqueness), ExternalValue)]
  }
  deriving (Int -> EntryPoint -> ShowS
[EntryPoint] -> ShowS
EntryPoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntryPoint] -> ShowS
$cshowList :: [EntryPoint] -> ShowS
show :: EntryPoint -> String
$cshow :: EntryPoint -> String
showsPrec :: Int -> EntryPoint -> ShowS
$cshowsPrec :: Int -> EntryPoint -> ShowS
Show)

-- | A imperative function, containing the body as well as its
-- low-level inputs and outputs, as well as its high-level arguments
-- and results.  The latter are only present if the function is an entry
-- point.
data FunctionT a = Function
  { forall a. FunctionT a -> Maybe EntryPoint
functionEntry :: Maybe EntryPoint,
    forall a. FunctionT a -> [Param]
functionOutput :: [Param],
    forall a. FunctionT a -> [Param]
functionInput :: [Param],
    forall a. FunctionT a -> Code a
functionBody :: Code a
  }
  deriving (Int -> FunctionT a -> ShowS
forall a. Show a => Int -> FunctionT a -> ShowS
forall a. Show a => [FunctionT a] -> ShowS
forall a. Show a => FunctionT a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionT a] -> ShowS
$cshowList :: forall a. Show a => [FunctionT a] -> ShowS
show :: FunctionT a -> String
$cshow :: forall a. Show a => FunctionT a -> String
showsPrec :: Int -> FunctionT a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> FunctionT a -> ShowS
Show)

-- | Type alias for namespace control.
type Function = FunctionT

-- | The contents of a statically declared constant array.  Such
-- arrays are always unidimensional, and reshaped if necessary in the
-- code that uses them.
data ArrayContents
  = -- | Precisely these values.
    ArrayValues [PrimValue]
  | -- | This many zeroes.
    ArrayZeros Int
  deriving (Int -> ArrayContents -> ShowS
[ArrayContents] -> ShowS
ArrayContents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArrayContents] -> ShowS
$cshowList :: [ArrayContents] -> ShowS
show :: ArrayContents -> String
$cshow :: ArrayContents -> String
showsPrec :: Int -> ArrayContents -> ShowS
$cshowsPrec :: Int -> ArrayContents -> ShowS
Show)

-- | A block of imperative code.  Parameterised by an 'Op', which
-- allows extensibility.  Concrete uses of this type will instantiate
-- the type parameter with e.g. a construct for launching GPU kernels.
data Code a
  = -- | No-op.  Crucial for the 'Monoid' instance.
    Skip
  | -- | Statement composition.  Crucial for the 'Semigroup' instance.
    Code a :>>: Code a
  | -- | A for-loop iterating the given number of times.
    -- The loop parameter starts counting from zero and will
    -- have the same (integer) type as the bound.  The bound
    -- is evaluated just once, before the loop is entered.
    For VName Exp (Code a)
  | -- | While loop.  The conditional is (of course)
    -- re-evaluated before every iteration of the loop.
    While (TExp Bool) (Code a)
  | -- | Declare a memory block variable that will point to
    -- memory in the given memory space.  Note that this is
    -- distinct from allocation.  The memory block must be the
    -- target of either an 'Allocate' or a 'SetMem' before it
    -- can be used for reading or writing.
    DeclareMem VName Space
  | -- | Declare a scalar variable with an initially undefined value.
    DeclareScalar VName Volatility PrimType
  | -- | Create a DefaultSpace array containing the given values.  The
    -- lifetime of the array will be the entire application.  This is
    -- mostly used for constant arrays.
    DeclareArray VName PrimType ArrayContents
  | -- | Memory space must match the corresponding
    -- 'DeclareMem'.
    Allocate VName (Count Bytes (TExp Int64)) Space
  | -- | Indicate that some memory block will never again be
    -- referenced via the indicated variable.  However, it
    -- may still be accessed through aliases.  It is only
    -- safe to actually deallocate the memory block if this
    -- is the last reference.  There is no guarantee that
    -- all memory blocks will be freed with this statement.
    -- Backends are free to ignore it entirely.
    Free VName Space
  | -- | Element type being copied, destination, offset in
    -- destination, destination space, source, offset in source,
    -- offset space, number of bytes.
    Copy
      PrimType
      VName
      (Count Bytes (TExp Int64))
      Space
      VName
      (Count Bytes (TExp Int64))
      Space
      (Count Bytes (TExp Int64))
  | -- | @Write mem i t space vol v@ writes the value @v@ to
    -- @mem@ offset by @i@ elements of type @t@.  The
    -- 'Space' argument is the memory space of @mem@
    -- (technically redundant, but convenient).
    Write VName (Count Elements (TExp Int64)) PrimType Space Volatility Exp
  | -- | Set a scalar variable.
    SetScalar VName Exp
  | -- | Read a scalar from memory from memory.  The first 'VName' is
    -- the target scalar variable, and the remaining arguments have
    -- the same meaning as with 'Write'.
    Read VName VName (Count Elements (TExp Int64)) PrimType Space Volatility
  | -- | Must be in same space.
    SetMem VName VName Space
  | -- | Function call.  The results are written to the
    -- provided 'VName' variables.
    Call [VName] Name [Arg]
  | -- | Conditional execution.
    If (TExp Bool) (Code a) (Code a)
  | -- | Assert that something must be true.  Should it turn
    -- out not to be true, then report a failure along with
    -- the given error message.
    Assert Exp (ErrorMsg Exp) (SrcLoc, [SrcLoc])
  | -- | Has the same semantics as the contained code, but
    -- the comment should show up in generated code for ease
    -- of inspection.
    Comment T.Text (Code a)
  | -- | Print the given value to the screen, somehow
    -- annotated with the given string as a description.  If
    -- no type/value pair, just print the string.  This has
    -- no semantic meaning, but is used entirely for
    -- debugging.  Code generators are free to ignore this
    -- statement.
    DebugPrint String (Maybe Exp)
  | -- | Log the given message, *without* a trailing linebreak (unless
    -- part of the mssage).
    TracePrint (ErrorMsg Exp)
  | -- | Perform an extensible operation.
    Op a
  deriving (Int -> Code a -> ShowS
forall a. Show a => Int -> Code a -> ShowS
forall a. Show a => [Code a] -> ShowS
forall a. Show a => Code a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Code a] -> ShowS
$cshowList :: forall a. Show a => [Code a] -> ShowS
show :: Code a -> String
$cshow :: forall a. Show a => Code a -> String
showsPrec :: Int -> Code a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Code a -> ShowS
Show)

-- | The volatility of a memory access or variable.  Feel free to
-- ignore this for backends where it makes no sense (anything but C
-- and similar low-level things)
data Volatility = Volatile | Nonvolatile
  deriving (Volatility -> Volatility -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Volatility -> Volatility -> Bool
$c/= :: Volatility -> Volatility -> Bool
== :: Volatility -> Volatility -> Bool
$c== :: Volatility -> Volatility -> Bool
Eq, Eq Volatility
Volatility -> Volatility -> Bool
Volatility -> Volatility -> Ordering
Volatility -> Volatility -> Volatility
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
min :: Volatility -> Volatility -> Volatility
$cmin :: Volatility -> Volatility -> Volatility
max :: Volatility -> Volatility -> Volatility
$cmax :: Volatility -> Volatility -> Volatility
>= :: Volatility -> Volatility -> Bool
$c>= :: Volatility -> Volatility -> Bool
> :: Volatility -> Volatility -> Bool
$c> :: Volatility -> Volatility -> Bool
<= :: Volatility -> Volatility -> Bool
$c<= :: Volatility -> Volatility -> Bool
< :: Volatility -> Volatility -> Bool
$c< :: Volatility -> Volatility -> Bool
compare :: Volatility -> Volatility -> Ordering
$ccompare :: Volatility -> Volatility -> Ordering
Ord, Int -> Volatility -> ShowS
[Volatility] -> ShowS
Volatility -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Volatility] -> ShowS
$cshowList :: [Volatility] -> ShowS
show :: Volatility -> String
$cshow :: Volatility -> String
showsPrec :: Int -> Volatility -> ShowS
$cshowsPrec :: Int -> Volatility -> ShowS
Show)

instance Semigroup (Code a) where
  Code a
Skip <> :: Code a -> Code a -> Code a
<> Code a
y = Code a
y
  Code a
x <> Code a
Skip = Code a
x
  Code a
x <> Code a
y = Code a
x forall a. Code a -> Code a -> Code a
:>>: Code a
y

instance Monoid (Code a) where
  mempty :: Code a
mempty = forall a. Code a
Skip

-- | Find those memory blocks that are used only lexically.  That is,
-- are not used as the source or target of a 'SetMem', or are the
-- result of the function, nor passed as arguments to other functions.
-- This is interesting because such memory blocks do not need
-- reference counting, but can be managed in a purely stack-like
-- fashion.
--
-- We do not look inside any 'Op's.  We assume that no 'Op' is going
-- to 'SetMem' a memory block declared outside it.
lexicalMemoryUsage :: Function a -> M.Map VName Space
lexicalMemoryUsage :: forall a. Function a -> Map VName Space
lexicalMemoryUsage Function a
func =
  forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VName -> Names -> Bool
`notNameIn` Names
nonlexical)) forall a b. (a -> b) -> a -> b
$
    forall {a}. Code a -> Map VName Space
declared forall a b. (a -> b) -> a -> b
$
      forall a. FunctionT a -> Code a
functionBody Function a
func
  where
    nonlexical :: Names
nonlexical =
      forall {a}. Code a -> Names
set (forall a. FunctionT a -> Code a
functionBody Function a
func)
        forall a. Semigroup a => a -> a -> a
<> [VName] -> Names
namesFromList (forall a b. (a -> b) -> [a] -> [b]
map Param -> VName
paramName (forall a. FunctionT a -> [Param]
functionOutput Function a
func))

    go :: (Code a -> a) -> Code a -> a
go Code a -> a
f (Code a
x :>>: Code a
y) = Code a -> a
f Code a
x forall a. Semigroup a => a -> a -> a
<> Code a -> a
f Code a
y
    go Code a -> a
f (If TExp Bool
_ Code a
x Code a
y) = Code a -> a
f Code a
x forall a. Semigroup a => a -> a -> a
<> Code a -> a
f Code a
y
    go Code a -> a
f (For VName
_ Exp
_ Code a
x) = Code a -> a
f Code a
x
    go Code a -> a
f (While TExp Bool
_ Code a
x) = Code a -> a
f Code a
x
    go Code a -> a
f (Comment Text
_ Code a
x) = Code a -> a
f Code a
x
    go Code a -> a
_ Code a
_ = forall a. Monoid a => a
mempty

    declared :: Code a -> Map VName Space
declared (DeclareMem VName
mem Space
space) =
      forall k a. k -> a -> Map k a
M.singleton VName
mem Space
space
    declared Code a
x = forall {a} {a}. Monoid a => (Code a -> a) -> Code a -> a
go Code a -> Map VName Space
declared Code a
x

    set :: Code a -> Names
set (SetMem VName
x VName
y Space
_) = [VName] -> Names
namesFromList [VName
x, VName
y]
    set (Call [VName]
dests Name
_ [Arg]
args) =
      -- Some of the dests might not be memory, but it does not matter.
      [VName] -> Names
namesFromList [VName]
dests forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Arg -> Names
onArg [Arg]
args
      where
        onArg :: Arg -> Names
onArg ExpArg {} = forall a. Monoid a => a
mempty
        onArg (MemArg VName
x) = VName -> Names
oneName VName
x
    set Code a
x = forall {a} {a}. Monoid a => (Code a -> a) -> Code a -> a
go Code a -> Names
set Code a
x

-- | The set of functions that are called by this code.  Accepts a
-- function for determing function calls in 'Op's.
calledFuncs :: (a -> S.Set Name) -> Code a -> S.Set Name
calledFuncs :: forall a. (a -> Set Name) -> Code a -> Set Name
calledFuncs a -> Set Name
_ (Call [VName]
_ Name
v [Arg]
_) = forall a. a -> Set a
S.singleton Name
v
calledFuncs a -> Set Name
f (Op a
x) = a -> Set Name
f a
x
calledFuncs a -> Set Name
f (Code a
x :>>: Code a
y) = forall a. (a -> Set Name) -> Code a -> Set Name
calledFuncs a -> Set Name
f Code a
x forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Set Name) -> Code a -> Set Name
calledFuncs a -> Set Name
f Code a
y
calledFuncs a -> Set Name
f (If TExp Bool
_ Code a
x Code a
y) = forall a. (a -> Set Name) -> Code a -> Set Name
calledFuncs a -> Set Name
f Code a
x forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Set Name) -> Code a -> Set Name
calledFuncs a -> Set Name
f Code a
y
calledFuncs a -> Set Name
f (For VName
_ Exp
_ Code a
x) = forall a. (a -> Set Name) -> Code a -> Set Name
calledFuncs a -> Set Name
f Code a
x
calledFuncs a -> Set Name
f (While TExp Bool
_ Code a
x) = forall a. (a -> Set Name) -> Code a -> Set Name
calledFuncs a -> Set Name
f Code a
x
calledFuncs a -> Set Name
f (Comment Text
_ Code a
x) = forall a. (a -> Set Name) -> Code a -> Set Name
calledFuncs a -> Set Name
f Code a
x
calledFuncs a -> Set Name
_ Code a
_ = forall a. Monoid a => a
mempty

-- | Compute call graph, as per 'calledFuncs', but also include
-- transitive calls.
callGraph :: (a -> S.Set Name) -> Functions a -> M.Map Name (S.Set Name)
callGraph :: forall a. (a -> Set Name) -> Functions a -> Map Name (Set Name)
callGraph a -> Set Name
f (Functions [(Name, Function a)]
funs) =
  forall {k}. Ord k => Map k (Set k) -> Map k (Set k)
loop forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall a b. (a -> b) -> a -> b
$ forall a. (a -> Set Name) -> Code a -> Set Name
calledFuncs a -> Set Name
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FunctionT a -> Code a
functionBody) [(Name, Function a)]
funs
  where
    loop :: Map k (Set k) -> Map k (Set k)
loop Map k (Set k)
cur =
      let grow :: k -> Set k
grow k
v = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> Set a
S.singleton k
v) (forall a. Ord a => a -> Set a -> Set a
S.insert k
v) (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
v Map k (Set k)
cur)
          next :: Map k (Set k)
next = forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap k -> Set k
grow) Map k (Set k)
cur
       in if Map k (Set k)
next forall a. Eq a => a -> a -> Bool
== Map k (Set k)
cur then Map k (Set k)
cur else Map k (Set k) -> Map k (Set k)
loop Map k (Set k)
next

-- | A mapping from names of tuning parameters to their class, as well
-- as which functions make use of them (including transitively).
type ParamMap = M.Map Name (SizeClass, S.Set Name)

-- | A side-effect free expression whose execution will produce a
-- single primitive value.
type Exp = PrimExp VName

-- | Like 'Exp', but with a required/known type.
type TExp t = TPrimExp t VName

-- | A function call argument.
data Arg
  = ExpArg Exp
  | MemArg VName
  deriving (Int -> Arg -> ShowS
[Arg] -> ShowS
Arg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arg] -> ShowS
$cshowList :: [Arg] -> ShowS
show :: Arg -> String
$cshow :: Arg -> String
showsPrec :: Int -> Arg -> ShowS
$cshowsPrec :: Int -> Arg -> ShowS
Show)

-- | Phantom type for a count of elements.
data Elements

-- | Phantom type for a count of bytes.
data Bytes

-- | This expression counts elements.
elements :: a -> Count Elements a
elements :: forall a. a -> Count Elements a
elements = forall {k} (u :: k) e. e -> Count u e
Count

-- | This expression counts bytes.
bytes :: a -> Count Bytes a
bytes :: forall a. a -> Count Bytes a
bytes = forall {k} (u :: k) e. e -> Count u e
Count

-- | Convert a count of elements into a count of bytes, given the
-- per-element size.
withElemType :: Count Elements (TExp Int64) -> PrimType -> Count Bytes (TExp Int64)
withElemType :: Count Elements (TExp Int64) -> PrimType -> Count Bytes (TExp Int64)
withElemType (Count TExp Int64
e) PrimType
t = forall a. a -> Count Bytes a
bytes forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k) v. IntExp t => TPrimExp t v -> TPrimExp Int64 v
sExt64 TExp Int64
e forall a. Num a => a -> a -> a
* forall a. Num a => PrimType -> a
primByteSize PrimType
t

-- | Turn a 'VName' into a 'Exp'.
var :: VName -> PrimType -> Exp
var :: VName -> PrimType -> Exp
var = forall v. v -> PrimType -> PrimExp v
LeafExp

-- Prettyprinting definitions.

instance Pretty op => Pretty (Definitions op) where
  pretty :: forall ann. Definitions op -> Doc ann
pretty (Definitions OpaqueTypes
types Constants op
consts Functions op
funs) =
    forall a ann. Pretty a => a -> Doc ann
pretty OpaqueTypes
types forall a. Doc a -> Doc a -> Doc a
</> forall a ann. Pretty a => a -> Doc ann
pretty Constants op
consts forall a. Doc a -> Doc a -> Doc a
</> forall a ann. Pretty a => a -> Doc ann
pretty Functions op
funs

instance Pretty op => Pretty (Functions op) where
  pretty :: forall ann. Functions op -> Doc ann
pretty (Functions [(Name, Function op)]
funs) = forall a. [Doc a] -> Doc a
stack forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {ann}. (Pretty a, Pretty a) => (a, a) -> Doc ann
ppFun [(Name, Function op)]
funs
    where
      ppFun :: (a, a) -> Doc ann
ppFun (a
name, a
fun) =
        Doc ann
"Function " forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty a
name forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
colon forall a. Doc a -> Doc a -> Doc a
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a ann. Pretty a => a -> Doc ann
pretty a
fun)

instance Pretty op => Pretty (Constants op) where
  pretty :: forall ann. Constants op -> Doc ann
pretty (Constants [Param]
decls Code op
code) =
    Doc ann
"Constants:"
      forall a. Doc a -> Doc a -> Doc a
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a. [Doc a] -> Doc a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [Param]
decls)
      forall a. Doc a -> Doc a -> Doc a
</> forall a. Monoid a => a
mempty
      forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"Initialisation:"
      forall a. Doc a -> Doc a -> Doc a
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a ann. Pretty a => a -> Doc ann
pretty Code op
code)

instance Pretty EntryPoint where
  pretty :: forall ann. EntryPoint -> Doc ann
pretty (EntryPoint Name
name [(Uniqueness, ExternalValue)]
results [((Name, Uniqueness), ExternalValue)]
args) =
    Doc ann
"Name:"
      forall a. Doc a -> Doc a -> Doc a
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall ann. Doc ann -> Doc ann
dquotes (forall a ann. Pretty a => a -> Doc ann
pretty Name
name))
      forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"Arguments:"
      forall a. Doc a -> Doc a -> Doc a
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a. [Doc a] -> Doc a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {a} {ann}.
(Pretty a, Pretty a, Pretty a) =>
((a, a), a) -> Doc ann
ppArg [((Name, Uniqueness), ExternalValue)]
args)
      forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"Results:"
      forall a. Doc a -> Doc a -> Doc a
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a. [Doc a] -> Doc a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {ann}. (Pretty a, Pretty a) => (a, a) -> Doc ann
ppRes [(Uniqueness, ExternalValue)]
results)
    where
      ppArg :: ((a, a), a) -> Doc ann
ppArg ((a
p, a
u), a
t) = forall a ann. Pretty a => a -> Doc ann
pretty a
p forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
":" forall a. Doc a -> Doc a -> Doc a
<+> forall {a} {a} {ann}. (Pretty a, Pretty a) => (a, a) -> Doc ann
ppRes (a
u, a
t)
      ppRes :: (a, a) -> Doc ann
ppRes (a
u, a
t) = forall a ann. Pretty a => a -> Doc ann
pretty a
u forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty a
t

instance Pretty op => Pretty (FunctionT op) where
  pretty :: forall ann. FunctionT op -> Doc ann
pretty (Function Maybe EntryPoint
entry [Param]
outs [Param]
ins Code op
body) =
    Doc ann
"Inputs:"
      forall a. Doc a -> Doc a -> Doc a
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a. [Doc a] -> Doc a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [Param]
ins)
      forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"Outputs:"
      forall a. Doc a -> Doc a -> Doc a
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a. [Doc a] -> Doc a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [Param]
outs)
      forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"Entry:"
      forall a. Doc a -> Doc a -> Doc a
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a ann. Pretty a => a -> Doc ann
pretty Maybe EntryPoint
entry)
      forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"Body:"
      forall a. Doc a -> Doc a -> Doc a
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a ann. Pretty a => a -> Doc ann
pretty Code op
body)

instance Pretty Param where
  pretty :: forall ann. Param -> Doc ann
pretty (ScalarParam VName
name PrimType
ptype) = forall a ann. Pretty a => a -> Doc ann
pretty PrimType
ptype forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty VName
name
  pretty (MemParam VName
name Space
space) = Doc ann
"mem" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Space
space forall a. Semigroup a => a -> a -> a
<> Doc ann
" " forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty VName
name

instance Pretty ValueDesc where
  pretty :: forall ann. ValueDesc -> Doc ann
pretty (ScalarValue PrimType
t Signedness
ept VName
name) =
    forall a ann. Pretty a => a -> Doc ann
pretty PrimType
t forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty VName
name forall a. Semigroup a => a -> a -> a
<> Doc ann
ept'
    where
      ept' :: Doc ann
ept' = case Signedness
ept of
        Signedness
Unsigned -> Doc ann
" (unsigned)"
        Signedness
Signed -> forall a. Monoid a => a
mempty
  pretty (ArrayValue VName
mem Space
space PrimType
et Signedness
ept [DimSize]
shape) =
    forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {ann}. Pretty a => a -> Doc ann -> Doc ann
f (forall a ann. Pretty a => a -> Doc ann
pretty PrimType
et) [DimSize]
shape forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"at" forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty VName
mem forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Space
space forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
ept'
    where
      f :: a -> Doc ann -> Doc ann
f a
e Doc ann
s = forall ann. Doc ann -> Doc ann
brackets forall a b. (a -> b) -> a -> b
$ Doc ann
s forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
comma forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty a
e
      ept' :: Doc ann
ept' = case Signedness
ept of
        Signedness
Unsigned -> Doc ann
" (unsigned)"
        Signedness
Signed -> forall a. Monoid a => a
mempty

instance Pretty ExternalValue where
  pretty :: forall ann. ExternalValue -> Doc ann
pretty (TransparentValue ValueDesc
v) = forall a ann. Pretty a => a -> Doc ann
pretty ValueDesc
v
  pretty (OpaqueValue Name
desc [ValueDesc]
vs) =
    Doc ann
"opaque"
      forall a. Doc a -> Doc a -> Doc a
<+> forall ann. Doc ann -> Doc ann
dquotes (forall a ann. Pretty a => a -> Doc ann
pretty Name
desc)
      forall a. Doc a -> Doc a -> Doc a
<+> forall a. Doc a -> Doc a -> Doc a -> Doc a
nestedBlock Doc ann
"{" Doc ann
"}" (forall a. [Doc a] -> Doc a
stack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [ValueDesc]
vs)

instance Pretty ArrayContents where
  pretty :: forall ann. ArrayContents -> Doc ann
pretty (ArrayValues [PrimValue]
vs) = forall ann. Doc ann -> Doc ann
braces (forall a. [Doc a] -> Doc a
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [PrimValue]
vs)
  pretty (ArrayZeros Int
n) = forall ann. Doc ann -> Doc ann
braces Doc ann
"0" forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"*" forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty Int
n

instance Pretty op => Pretty (Code op) where
  pretty :: forall ann. Code op -> Doc ann
pretty (Op op
op) = forall a ann. Pretty a => a -> Doc ann
pretty op
op
  pretty Code op
Skip = Doc ann
"skip"
  pretty (Code op
c1 :>>: Code op
c2) = forall a ann. Pretty a => a -> Doc ann
pretty Code op
c1 forall a. Doc a -> Doc a -> Doc a
</> forall a ann. Pretty a => a -> Doc ann
pretty Code op
c2
  pretty (For VName
i Exp
limit Code op
body) =
    Doc ann
"for"
      forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty VName
i
      forall a. Doc a -> Doc a -> Doc a
<+> forall ann. Doc ann
langle
      forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty Exp
limit
      forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"{"
      forall a. Doc a -> Doc a -> Doc a
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a ann. Pretty a => a -> Doc ann
pretty Code op
body)
      forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"}"
  pretty (While TExp Bool
cond Code op
body) =
    Doc ann
"while"
      forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty TExp Bool
cond
      forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"{"
      forall a. Doc a -> Doc a -> Doc a
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a ann. Pretty a => a -> Doc ann
pretty Code op
body)
      forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"}"
  pretty (DeclareMem VName
name Space
space) =
    Doc ann
"var" forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty VName
name forall a. Semigroup a => a -> a -> a
<> Doc ann
": mem" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Space
space
  pretty (DeclareScalar VName
name Volatility
vol PrimType
t) =
    Doc ann
"var" forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty VName
name forall a. Semigroup a => a -> a -> a
<> Doc ann
":" forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
vol' forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty PrimType
t
    where
      vol' :: Doc ann
vol' = case Volatility
vol of
        Volatility
Volatile -> Doc ann
"volatile "
        Volatility
Nonvolatile -> forall a. Monoid a => a
mempty
  pretty (DeclareArray VName
name PrimType
t ArrayContents
vs) =
    Doc ann
"array"
      forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty VName
name
      forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
":"
      forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty PrimType
t
      forall a. Doc a -> Doc a -> Doc a
<+> forall ann. Doc ann
equals
      forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty ArrayContents
vs
  pretty (Allocate VName
name Count Bytes (TExp Int64)
e Space
space) =
    forall a ann. Pretty a => a -> Doc ann
pretty VName
name forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"<-" forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"malloc" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty Count Bytes (TExp Int64)
e) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Space
space
  pretty (Free VName
name Space
space) =
    Doc ann
"free" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty VName
name) forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Space
space
  pretty (Write VName
name Count Elements (TExp Int64)
i PrimType
bt Space
space Volatility
vol Exp
val) =
    forall a ann. Pretty a => a -> Doc ann
pretty VName
name forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
langle forall a. Semigroup a => a -> a -> a
<> Doc ann
vol' forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty PrimType
bt forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Space
space forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
rangle forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
brackets (forall a ann. Pretty a => a -> Doc ann
pretty Count Elements (TExp Int64)
i)
      forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"<-"
      forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty Exp
val
    where
      vol' :: Doc ann
vol' = case Volatility
vol of
        Volatility
Volatile -> Doc ann
"volatile "
        Volatility
Nonvolatile -> forall a. Monoid a => a
mempty
  pretty (Read VName
name VName
v Count Elements (TExp Int64)
is PrimType
bt Space
space Volatility
vol) =
    forall a ann. Pretty a => a -> Doc ann
pretty VName
name
      forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"<-"
      forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty VName
v forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
langle forall a. Semigroup a => a -> a -> a
<> Doc ann
vol' forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty PrimType
bt forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Space
space forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
rangle forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
brackets (forall a ann. Pretty a => a -> Doc ann
pretty Count Elements (TExp Int64)
is)
    where
      vol' :: Doc ann
vol' = case Volatility
vol of
        Volatility
Volatile -> Doc ann
"volatile "
        Volatility
Nonvolatile -> forall a. Monoid a => a
mempty
  pretty (SetScalar VName
name Exp
val) =
    forall a ann. Pretty a => a -> Doc ann
pretty VName
name forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"<-" forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty Exp
val
  pretty (SetMem VName
dest VName
from Space
DefaultSpace) =
    forall a ann. Pretty a => a -> Doc ann
pretty VName
dest forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"<-" forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty VName
from
  pretty (SetMem VName
dest VName
from Space
space) =
    forall a ann. Pretty a => a -> Doc ann
pretty VName
dest forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"<-" forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty VName
from forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"@" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Space
space
  pretty (Assert Exp
e ErrorMsg Exp
msg (SrcLoc, [SrcLoc])
_) =
    Doc ann
"assert" forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
parens (forall a. [Doc a] -> Doc a
commasep [forall a ann. Pretty a => a -> Doc ann
pretty ErrorMsg Exp
msg, forall a ann. Pretty a => a -> Doc ann
pretty Exp
e])
  pretty (Copy PrimType
t VName
dest Count Bytes (TExp Int64)
destoffset Space
destspace VName
src Count Bytes (TExp Int64)
srcoffset Space
srcspace Count Bytes (TExp Int64)
size) =
    Doc ann
"copy"
      forall a. Semigroup a => a -> a -> a
<> (forall ann. Doc ann -> Doc ann
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> Doc ann
align)
        ( forall a ann. Pretty a => a -> Doc ann
pretty PrimType
t forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
comma
            forall a. Doc a -> Doc a -> Doc a
</> forall {a} {a} {ann}. (Pretty a, Pretty a) => a -> a -> Doc ann
ppMemLoc VName
dest Count Bytes (TExp Int64)
destoffset forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Space
destspace forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
comma
            forall a. Doc a -> Doc a -> Doc a
</> forall {a} {a} {ann}. (Pretty a, Pretty a) => a -> a -> Doc ann
ppMemLoc VName
src Count Bytes (TExp Int64)
srcoffset forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Space
srcspace forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
comma
            forall a. Doc a -> Doc a -> Doc a
</> forall a ann. Pretty a => a -> Doc ann
pretty Count Bytes (TExp Int64)
size
        )
    where
      ppMemLoc :: a -> a -> Doc ann
ppMemLoc a
base a
offset =
        forall a ann. Pretty a => a -> Doc ann
pretty a
base forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"+" forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty a
offset
  pretty (If TExp Bool
cond Code op
tbranch Code op
fbranch) =
    Doc ann
"if"
      forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty TExp Bool
cond
      forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"then {"
      forall a. Doc a -> Doc a -> Doc a
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a ann. Pretty a => a -> Doc ann
pretty Code op
tbranch)
      forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"} else"
      forall a. Doc a -> Doc a -> Doc a
<+> case Code op
fbranch of
        If {} -> forall a ann. Pretty a => a -> Doc ann
pretty Code op
fbranch
        Code op
_ ->
          Doc ann
"{" forall a. Doc a -> Doc a -> Doc a
</> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall a ann. Pretty a => a -> Doc ann
pretty Code op
fbranch) forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"}"
  pretty (Call [VName]
dests Name
fname [Arg]
args) =
    forall a. [Doc a] -> Doc a
commasep (forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [VName]
dests)
      forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"<-"
      forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty Name
fname forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
parens (forall a. [Doc a] -> Doc a
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [Arg]
args)
  pretty (Comment Text
s Code op
code) =
    Doc ann
"--" forall a. Doc a -> Doc a -> Doc a
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
s forall a. Doc a -> Doc a -> Doc a
</> forall a ann. Pretty a => a -> Doc ann
pretty Code op
code
  pretty (DebugPrint String
desc (Just Exp
e)) =
    Doc ann
"debug" forall a. Doc a -> Doc a -> Doc a
<+> forall ann. Doc ann -> Doc ann
parens (forall a. [Doc a] -> Doc a
commasep [forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show String
desc), forall a ann. Pretty a => a -> Doc ann
pretty Exp
e])
  pretty (DebugPrint String
desc Maybe Exp
Nothing) =
    Doc ann
"debug" forall a. Doc a -> Doc a -> Doc a
<+> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show String
desc))
  pretty (TracePrint ErrorMsg Exp
msg) =
    Doc ann
"trace" forall a. Doc a -> Doc a -> Doc a
<+> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty ErrorMsg Exp
msg)

instance Pretty Arg where
  pretty :: forall ann. Arg -> Doc ann
pretty (MemArg VName
m) = forall a ann. Pretty a => a -> Doc ann
pretty VName
m
  pretty (ExpArg Exp
e) = forall a ann. Pretty a => a -> Doc ann
pretty Exp
e

instance Functor Functions where
  fmap :: forall a b. (a -> b) -> Functions a -> Functions b
fmap = forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault

instance Foldable Functions where
  foldMap :: forall m a. Monoid m => (a -> m) -> Functions a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Traversable Functions where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Functions a -> f (Functions b)
traverse a -> f b
f (Functions [(Name, Function a)]
funs) =
    forall a. [(Name, Function a)] -> Functions a
Functions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {t :: * -> *} {t}. Traversable t => (t, t a) -> f (t, t b)
f' [(Name, Function a)]
funs
    where
      f' :: (t, t a) -> f (t, t b)
f' (t
name, t a
fun) = (t
name,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f t a
fun

instance Functor FunctionT where
  fmap :: forall a b. (a -> b) -> FunctionT a -> FunctionT b
fmap = forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault

instance Foldable FunctionT where
  foldMap :: forall m a. Monoid m => (a -> m) -> FunctionT a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Traversable FunctionT where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FunctionT a -> f (FunctionT b)
traverse a -> f b
f (Function Maybe EntryPoint
entry [Param]
outs [Param]
ins Code a
body) =
    forall a.
Maybe EntryPoint -> [Param] -> [Param] -> Code a -> FunctionT a
Function Maybe EntryPoint
entry [Param]
outs [Param]
ins forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Code a
body

instance Functor Code where
  fmap :: forall a b. (a -> b) -> Code a -> Code b
fmap = forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault

instance Foldable Code where
  foldMap :: forall m a. Monoid m => (a -> m) -> Code a -> m
foldMap = forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Traversable Code where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Code a -> f (Code b)
traverse a -> f b
f (Code a
x :>>: Code a
y) =
    forall a. Code a -> Code a -> Code a
(:>>:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Code a
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Code a
y
  traverse a -> f b
f (For VName
i Exp
bound Code a
code) =
    forall a. VName -> Exp -> Code a -> Code a
For VName
i Exp
bound forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Code a
code
  traverse a -> f b
f (While TExp Bool
cond Code a
code) =
    forall a. TExp Bool -> Code a -> Code a
While TExp Bool
cond forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Code a
code
  traverse a -> f b
f (If TExp Bool
cond Code a
x Code a
y) =
    forall a. TExp Bool -> Code a -> Code a -> Code a
If TExp Bool
cond forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Code a
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Code a
y
  traverse a -> f b
f (Op a
kernel) =
    forall a. a -> Code a
Op forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
kernel
  traverse a -> f b
_ Code a
Skip =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Code a
Skip
  traverse a -> f b
_ (DeclareMem VName
name Space
space) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. VName -> Space -> Code a
DeclareMem VName
name Space
space
  traverse a -> f b
_ (DeclareScalar VName
name Volatility
vol PrimType
bt) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. VName -> Volatility -> PrimType -> Code a
DeclareScalar VName
name Volatility
vol PrimType
bt
  traverse a -> f b
_ (DeclareArray VName
name PrimType
t ArrayContents
vs) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. VName -> PrimType -> ArrayContents -> Code a
DeclareArray VName
name PrimType
t ArrayContents
vs
  traverse a -> f b
_ (Allocate VName
name Count Bytes (TExp Int64)
size Space
s) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. VName -> Count Bytes (TExp Int64) -> Space -> Code a
Allocate VName
name Count Bytes (TExp Int64)
size Space
s
  traverse a -> f b
_ (Free VName
name Space
space) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. VName -> Space -> Code a
Free VName
name Space
space
  traverse a -> f b
_ (Copy PrimType
dest VName
pt Count Bytes (TExp Int64)
destoffset Space
destspace VName
src Count Bytes (TExp Int64)
srcoffset Space
srcspace Count Bytes (TExp Int64)
size) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
PrimType
-> VName
-> Count Bytes (TExp Int64)
-> Space
-> VName
-> Count Bytes (TExp Int64)
-> Space
-> Count Bytes (TExp Int64)
-> Code a
Copy PrimType
dest VName
pt Count Bytes (TExp Int64)
destoffset Space
destspace VName
src Count Bytes (TExp Int64)
srcoffset Space
srcspace Count Bytes (TExp Int64)
size
  traverse a -> f b
_ (Write VName
name Count Elements (TExp Int64)
i PrimType
bt Space
val Volatility
space Exp
vol) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
VName
-> Count Elements (TExp Int64)
-> PrimType
-> Space
-> Volatility
-> Exp
-> Code a
Write VName
name Count Elements (TExp Int64)
i PrimType
bt Space
val Volatility
space Exp
vol
  traverse a -> f b
_ (Read VName
x VName
name Count Elements (TExp Int64)
i PrimType
bt Space
space Volatility
vol) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
VName
-> VName
-> Count Elements (TExp Int64)
-> PrimType
-> Space
-> Volatility
-> Code a
Read VName
x VName
name Count Elements (TExp Int64)
i PrimType
bt Space
space Volatility
vol
  traverse a -> f b
_ (SetScalar VName
name Exp
val) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. VName -> Exp -> Code a
SetScalar VName
name Exp
val
  traverse a -> f b
_ (SetMem VName
dest VName
from Space
space) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. VName -> VName -> Space -> Code a
SetMem VName
dest VName
from Space
space
  traverse a -> f b
_ (Assert Exp
e ErrorMsg Exp
msg (SrcLoc, [SrcLoc])
loc) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Exp -> ErrorMsg Exp -> (SrcLoc, [SrcLoc]) -> Code a
Assert Exp
e ErrorMsg Exp
msg (SrcLoc, [SrcLoc])
loc
  traverse a -> f b
_ (Call [VName]
dests Name
fname [Arg]
args) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [VName] -> Name -> [Arg] -> Code a
Call [VName]
dests Name
fname [Arg]
args
  traverse a -> f b
f (Comment Text
s Code a
code) =
    forall a. Text -> Code a -> Code a
Comment Text
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Code a
code
  traverse a -> f b
_ (DebugPrint String
s Maybe Exp
v) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. String -> Maybe Exp -> Code a
DebugPrint String
s Maybe Exp
v
  traverse a -> f b
_ (TracePrint ErrorMsg Exp
msg) =
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. ErrorMsg Exp -> Code a
TracePrint ErrorMsg Exp
msg

-- | The names declared with 'DeclareMem', 'DeclareScalar', and
-- 'DeclareArray' in the given code.
declaredIn :: Code a -> Names
declaredIn :: forall {a}. Code a -> Names
declaredIn (DeclareMem VName
name Space
_) = VName -> Names
oneName VName
name
declaredIn (DeclareScalar VName
name Volatility
_ PrimType
_) = VName -> Names
oneName VName
name
declaredIn (DeclareArray VName
name PrimType
_ ArrayContents
_) = VName -> Names
oneName VName
name
declaredIn (If TExp Bool
_ Code a
t Code a
f) = forall {a}. Code a -> Names
declaredIn Code a
t forall a. Semigroup a => a -> a -> a
<> forall {a}. Code a -> Names
declaredIn Code a
f
declaredIn (Code a
x :>>: Code a
y) = forall {a}. Code a -> Names
declaredIn Code a
x forall a. Semigroup a => a -> a -> a
<> forall {a}. Code a -> Names
declaredIn Code a
y
declaredIn (For VName
i Exp
_ Code a
body) = VName -> Names
oneName VName
i forall a. Semigroup a => a -> a -> a
<> forall {a}. Code a -> Names
declaredIn Code a
body
declaredIn (While TExp Bool
_ Code a
body) = forall {a}. Code a -> Names
declaredIn Code a
body
declaredIn (Comment Text
_ Code a
body) = forall {a}. Code a -> Names
declaredIn Code a
body
declaredIn Code a
_ = forall a. Monoid a => a
mempty

instance FreeIn EntryPoint where
  freeIn' :: EntryPoint -> FV
freeIn' (EntryPoint Name
_ [(Uniqueness, ExternalValue)]
res [((Name, Uniqueness), ExternalValue)]
args) =
    forall a. FreeIn a => a -> FV
freeIn' (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Uniqueness, ExternalValue)]
res) forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [((Name, Uniqueness), ExternalValue)]
args)

instance FreeIn a => FreeIn (Functions a) where
  freeIn' :: Functions a -> FV
freeIn' (Functions [(Name, Function a)]
fs) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall {a}. FreeIn a => FunctionT a -> FV
onFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Name, Function a)]
fs
    where
      onFun :: FunctionT a -> FV
onFun FunctionT a
f =
        Names -> FV -> FV
fvBind Names
pnames forall a b. (a -> b) -> a -> b
$ forall a. FreeIn a => a -> FV
freeIn' (forall a. FunctionT a -> Code a
functionBody FunctionT a
f) forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' (forall a. FunctionT a -> Maybe EntryPoint
functionEntry FunctionT a
f)
        where
          pnames :: Names
pnames =
            [VName] -> Names
namesFromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Param -> VName
paramName forall a b. (a -> b) -> a -> b
$ forall a. FunctionT a -> [Param]
functionInput FunctionT a
f forall a. Semigroup a => a -> a -> a
<> forall a. FunctionT a -> [Param]
functionOutput FunctionT a
f

instance FreeIn ValueDesc where
  freeIn' :: ValueDesc -> FV
freeIn' (ArrayValue VName
mem Space
_ PrimType
_ Signedness
_ [DimSize]
dims) = forall a. FreeIn a => a -> FV
freeIn' VName
mem forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' [DimSize]
dims
  freeIn' ScalarValue {} = forall a. Monoid a => a
mempty

instance FreeIn ExternalValue where
  freeIn' :: ExternalValue -> FV
freeIn' (TransparentValue ValueDesc
vd) = forall a. FreeIn a => a -> FV
freeIn' ValueDesc
vd
  freeIn' (OpaqueValue Name
_ [ValueDesc]
vds) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. FreeIn a => a -> FV
freeIn' [ValueDesc]
vds

instance FreeIn a => FreeIn (Code a) where
  freeIn' :: Code a -> FV
freeIn' (Code a
x :>>: Code a
y) =
    Names -> FV -> FV
fvBind (forall {a}. Code a -> Names
declaredIn Code a
x) forall a b. (a -> b) -> a -> b
$ forall a. FreeIn a => a -> FV
freeIn' Code a
x forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' Code a
y
  freeIn' Code a
Skip =
    forall a. Monoid a => a
mempty
  freeIn' (For VName
i Exp
bound Code a
body) =
    Names -> FV -> FV
fvBind (VName -> Names
oneName VName
i) forall a b. (a -> b) -> a -> b
$ forall a. FreeIn a => a -> FV
freeIn' Exp
bound forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' Code a
body
  freeIn' (While TExp Bool
cond Code a
body) =
    forall a. FreeIn a => a -> FV
freeIn' TExp Bool
cond forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' Code a
body
  freeIn' (DeclareMem VName
_ Space
space) =
    forall a. FreeIn a => a -> FV
freeIn' Space
space
  freeIn' DeclareScalar {} =
    forall a. Monoid a => a
mempty
  freeIn' DeclareArray {} =
    forall a. Monoid a => a
mempty
  freeIn' (Allocate VName
name Count Bytes (TExp Int64)
size Space
space) =
    forall a. FreeIn a => a -> FV
freeIn' VName
name forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' Count Bytes (TExp Int64)
size forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' Space
space
  freeIn' (Free VName
name Space
_) =
    forall a. FreeIn a => a -> FV
freeIn' VName
name
  freeIn' (Copy PrimType
_ VName
dest Count Bytes (TExp Int64)
x Space
_ VName
src Count Bytes (TExp Int64)
y Space
_ Count Bytes (TExp Int64)
n) =
    forall a. FreeIn a => a -> FV
freeIn' VName
dest forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' Count Bytes (TExp Int64)
x forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' VName
src forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' Count Bytes (TExp Int64)
y forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' Count Bytes (TExp Int64)
n
  freeIn' (SetMem VName
x VName
y Space
_) =
    forall a. FreeIn a => a -> FV
freeIn' VName
x forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' VName
y
  freeIn' (Write VName
v Count Elements (TExp Int64)
i PrimType
_ Space
_ Volatility
_ Exp
e) =
    forall a. FreeIn a => a -> FV
freeIn' VName
v forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
i forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' Exp
e
  freeIn' (Read VName
x VName
v Count Elements (TExp Int64)
i PrimType
_ Space
_ Volatility
_) =
    forall a. FreeIn a => a -> FV
freeIn' VName
x forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' VName
v forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
i
  freeIn' (SetScalar VName
x Exp
y) =
    forall a. FreeIn a => a -> FV
freeIn' VName
x forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' Exp
y
  freeIn' (Call [VName]
dests Name
_ [Arg]
args) =
    forall a. FreeIn a => a -> FV
freeIn' [VName]
dests forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' [Arg]
args
  freeIn' (If TExp Bool
cond Code a
t Code a
f) =
    forall a. FreeIn a => a -> FV
freeIn' TExp Bool
cond forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' Code a
t forall a. Semigroup a => a -> a -> a
<> forall a. FreeIn a => a -> FV
freeIn' Code a
f
  freeIn' (Assert Exp
e ErrorMsg Exp
msg (SrcLoc, [SrcLoc])
_) =
    forall a. FreeIn a => a -> FV
freeIn' Exp
e forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. FreeIn a => a -> FV
freeIn' ErrorMsg Exp
msg
  freeIn' (Op a
op) =
    forall a. FreeIn a => a -> FV
freeIn' a
op
  freeIn' (Comment Text
_ Code a
code) =
    forall a. FreeIn a => a -> FV
freeIn' Code a
code
  freeIn' (DebugPrint String
_ Maybe Exp
v) =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. FreeIn a => a -> FV
freeIn' Maybe Exp
v
  freeIn' (TracePrint ErrorMsg Exp
msg) =
    forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. FreeIn a => a -> FV
freeIn' ErrorMsg Exp
msg

instance FreeIn Arg where
  freeIn' :: Arg -> FV
freeIn' (MemArg VName
m) = forall a. FreeIn a => a -> FV
freeIn' VName
m
  freeIn' (ExpArg Exp
e) = forall a. FreeIn a => a -> FV
freeIn' Exp
e