{-# LANGUAGE Strict #-}
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,
declsFirst,
calledFuncs,
callGraph,
ParamMap,
Bytes,
Elements,
elements,
bytes,
withElemType,
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, partition)
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
type MemSize = SubExp
type DimSize = SubExp
data Param
= MemParam VName Space
| ScalarParam VName PrimType
deriving (Param -> Param -> Bool
(Param -> Param -> Bool) -> (Param -> Param -> Bool) -> Eq Param
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Param -> Param -> Bool
== :: Param -> Param -> Bool
$c/= :: Param -> Param -> Bool
/= :: Param -> Param -> Bool
Eq, Int -> Param -> ShowS
[Param] -> ShowS
Param -> String
(Int -> Param -> ShowS)
-> (Param -> String) -> ([Param] -> ShowS) -> Show Param
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Param -> ShowS
showsPrec :: Int -> Param -> ShowS
$cshow :: Param -> String
show :: Param -> String
$cshowList :: [Param] -> ShowS
showList :: [Param] -> ShowS
Show)
paramName :: Param -> VName
paramName :: Param -> VName
paramName (MemParam VName
name Space
_) = VName
name
paramName (ScalarParam VName
name PrimType
_) = VName
name
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
[Definitions a] -> ShowS
Definitions a -> String
(Int -> Definitions a -> ShowS)
-> (Definitions a -> String)
-> ([Definitions a] -> ShowS)
-> Show (Definitions a)
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
$cshowsPrec :: forall a. Show a => Int -> Definitions a -> ShowS
showsPrec :: Int -> Definitions a -> ShowS
$cshow :: forall a. Show a => Definitions a -> String
show :: Definitions a -> String
$cshowList :: forall a. Show a => [Definitions a] -> ShowS
showList :: [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) =
OpaqueTypes -> Constants b -> Functions b -> Definitions b
forall a.
OpaqueTypes -> Constants a -> Functions a -> Definitions a
Definitions OpaqueTypes
types ((a -> b) -> Constants a -> Constants b
forall a b. (a -> b) -> Constants a -> Constants b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Constants a
consts) ((a -> b) -> Functions a -> Functions b
forall a b. (a -> b) -> Functions a -> Functions b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Functions a
funs)
newtype Functions a = Functions {forall a. Functions a -> [(Name, Function a)]
unFunctions :: [(Name, Function a)]}
deriving (Int -> Functions a -> ShowS
[Functions a] -> ShowS
Functions a -> String
(Int -> Functions a -> ShowS)
-> (Functions a -> String)
-> ([Functions a] -> ShowS)
-> Show (Functions a)
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
$cshowsPrec :: forall a. Show a => Int -> Functions a -> ShowS
showsPrec :: Int -> Functions a -> ShowS
$cshow :: forall a. Show a => Functions a -> String
show :: Functions a -> String
$cshowList :: forall a. Show a => [Functions a] -> ShowS
showList :: [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 = [(Name, Function a)] -> Functions a
forall a. [(Name, Function a)] -> Functions a
Functions ([(Name, Function a)] -> Functions a)
-> [(Name, Function a)] -> Functions a
forall a b. (a -> b) -> a -> b
$ [(Name, Function a)]
x [(Name, Function a)]
-> [(Name, Function a)] -> [(Name, Function a)]
forall a. [a] -> [a] -> [a]
++ [(Name, Function a)]
y
instance Monoid (Functions a) where
mempty :: Functions a
mempty = [(Name, Function a)] -> Functions a
forall a. [(Name, Function a)] -> Functions a
Functions []
data Constants a = Constants
{
forall a. Constants a -> [Param]
constsDecl :: [Param],
forall a. Constants a -> Code a
constsInit :: Code a
}
deriving (Int -> Constants a -> ShowS
[Constants a] -> ShowS
Constants a -> String
(Int -> Constants a -> ShowS)
-> (Constants a -> String)
-> ([Constants a] -> ShowS)
-> Show (Constants a)
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
$cshowsPrec :: forall a. Show a => Int -> Constants a -> ShowS
showsPrec :: Int -> Constants a -> ShowS
$cshow :: forall a. Show a => Constants a -> String
show :: Constants a -> String
$cshowList :: forall a. Show a => [Constants a] -> ShowS
showList :: [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) = [Param] -> Code b -> Constants b
forall a. [Param] -> Code a -> Constants a
Constants [Param]
params ((a -> b) -> Code a -> Code b
forall a b. (a -> b) -> Code a -> Code b
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 = [Param] -> Code a -> Constants a
forall a. [Param] -> Code a -> Constants a
Constants [Param]
forall a. Monoid a => a
mempty Code a
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 =
[Param] -> Code a -> Constants a
forall a. [Param] -> Code a -> Constants a
Constants ((Param -> Param -> Ordering) -> [Param] -> [Param]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubByOrd ((Param -> String) -> Param -> Param -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (VName -> String
forall a. Pretty a => a -> String
prettyString (VName -> String) -> (Param -> VName) -> Param -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Param -> VName
paramName)) ([Param] -> [Param]) -> [Param] -> [Param]
forall a b. (a -> b) -> a -> b
$ [Param]
ps1 [Param] -> [Param] -> [Param]
forall a. Semigroup a => a -> a -> a
<> [Param]
ps2) (Code a
c1 Code a -> Code a -> Code a
forall a. Semigroup a => a -> a -> a
<> Code a
c2)
data ValueDesc
=
ArrayValue VName Space PrimType Signedness [DimSize]
|
ScalarValue PrimType Signedness VName
deriving (ValueDesc -> ValueDesc -> Bool
(ValueDesc -> ValueDesc -> Bool)
-> (ValueDesc -> ValueDesc -> Bool) -> Eq ValueDesc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValueDesc -> ValueDesc -> Bool
== :: ValueDesc -> ValueDesc -> Bool
$c/= :: ValueDesc -> ValueDesc -> Bool
/= :: ValueDesc -> ValueDesc -> Bool
Eq, Int -> ValueDesc -> ShowS
[ValueDesc] -> ShowS
ValueDesc -> String
(Int -> ValueDesc -> ShowS)
-> (ValueDesc -> String)
-> ([ValueDesc] -> ShowS)
-> Show ValueDesc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValueDesc -> ShowS
showsPrec :: Int -> ValueDesc -> ShowS
$cshow :: ValueDesc -> String
show :: ValueDesc -> String
$cshowList :: [ValueDesc] -> ShowS
showList :: [ValueDesc] -> ShowS
Show)
data ExternalValue
=
OpaqueValue Name [ValueDesc]
| TransparentValue ValueDesc
deriving (Int -> ExternalValue -> ShowS
[ExternalValue] -> ShowS
ExternalValue -> String
(Int -> ExternalValue -> ShowS)
-> (ExternalValue -> String)
-> ([ExternalValue] -> ShowS)
-> Show ExternalValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExternalValue -> ShowS
showsPrec :: Int -> ExternalValue -> ShowS
$cshow :: ExternalValue -> String
show :: ExternalValue -> String
$cshowList :: [ExternalValue] -> ShowS
showList :: [ExternalValue] -> ShowS
Show)
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
(Int -> EntryPoint -> ShowS)
-> (EntryPoint -> String)
-> ([EntryPoint] -> ShowS)
-> Show EntryPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntryPoint -> ShowS
showsPrec :: Int -> EntryPoint -> ShowS
$cshow :: EntryPoint -> String
show :: EntryPoint -> String
$cshowList :: [EntryPoint] -> ShowS
showList :: [EntryPoint] -> ShowS
Show)
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
[FunctionT a] -> ShowS
FunctionT a -> String
(Int -> FunctionT a -> ShowS)
-> (FunctionT a -> String)
-> ([FunctionT a] -> ShowS)
-> Show (FunctionT a)
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
$cshowsPrec :: forall a. Show a => Int -> FunctionT a -> ShowS
showsPrec :: Int -> FunctionT a -> ShowS
$cshow :: forall a. Show a => FunctionT a -> String
show :: FunctionT a -> String
$cshowList :: forall a. Show a => [FunctionT a] -> ShowS
showList :: [FunctionT a] -> ShowS
Show)
type Function = FunctionT
data ArrayContents
=
ArrayValues [PrimValue]
|
ArrayZeros Int
deriving (Int -> ArrayContents -> ShowS
[ArrayContents] -> ShowS
ArrayContents -> String
(Int -> ArrayContents -> ShowS)
-> (ArrayContents -> String)
-> ([ArrayContents] -> ShowS)
-> Show ArrayContents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArrayContents -> ShowS
showsPrec :: Int -> ArrayContents -> ShowS
$cshow :: ArrayContents -> String
show :: ArrayContents -> String
$cshowList :: [ArrayContents] -> ShowS
showList :: [ArrayContents] -> ShowS
Show)
data Code a
=
Skip
|
Code a :>>: Code a
|
For VName Exp (Code a)
|
While (TExp Bool) (Code a)
|
DeclareMem VName Space
|
DeclareScalar VName Volatility PrimType
|
DeclareArray VName PrimType ArrayContents
|
Allocate VName (Count Bytes (TExp Int64)) Space
|
Free VName Space
|
Copy
PrimType
[Count Elements (TExp Int64)]
(VName, Space)
( Count Elements (TExp Int64),
[Count Elements (TExp Int64)]
)
(VName, Space)
( Count Elements (TExp Int64),
[Count Elements (TExp Int64)]
)
|
Write VName (Count Elements (TExp Int64)) PrimType Space Volatility Exp
|
SetScalar VName Exp
|
Read VName VName (Count Elements (TExp Int64)) PrimType Space Volatility
|
SetMem VName VName Space
|
Call [VName] Name [Arg]
|
If (TExp Bool) (Code a) (Code a)
|
Assert Exp (ErrorMsg Exp) (SrcLoc, [SrcLoc])
|
T.Text (Code a)
|
DebugPrint String (Maybe Exp)
|
TracePrint (ErrorMsg Exp)
|
Op a
deriving (Int -> Code a -> ShowS
[Code a] -> ShowS
Code a -> String
(Int -> Code a -> ShowS)
-> (Code a -> String) -> ([Code a] -> ShowS) -> Show (Code a)
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
$cshowsPrec :: forall a. Show a => Int -> Code a -> ShowS
showsPrec :: Int -> Code a -> ShowS
$cshow :: forall a. Show a => Code a -> String
show :: Code a -> String
$cshowList :: forall a. Show a => [Code a] -> ShowS
showList :: [Code a] -> ShowS
Show)
data Volatility = Volatile | Nonvolatile
deriving (Volatility -> Volatility -> Bool
(Volatility -> Volatility -> Bool)
-> (Volatility -> Volatility -> Bool) -> Eq Volatility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Volatility -> Volatility -> Bool
== :: Volatility -> Volatility -> Bool
$c/= :: Volatility -> Volatility -> Bool
/= :: Volatility -> Volatility -> Bool
Eq, Eq Volatility
Eq Volatility =>
(Volatility -> Volatility -> Ordering)
-> (Volatility -> Volatility -> Bool)
-> (Volatility -> Volatility -> Bool)
-> (Volatility -> Volatility -> Bool)
-> (Volatility -> Volatility -> Bool)
-> (Volatility -> Volatility -> Volatility)
-> (Volatility -> Volatility -> Volatility)
-> Ord 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
$ccompare :: Volatility -> Volatility -> Ordering
compare :: Volatility -> Volatility -> Ordering
$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
>= :: Volatility -> Volatility -> Bool
$cmax :: Volatility -> Volatility -> Volatility
max :: Volatility -> Volatility -> Volatility
$cmin :: Volatility -> Volatility -> Volatility
min :: Volatility -> Volatility -> Volatility
Ord, Int -> Volatility -> ShowS
[Volatility] -> ShowS
Volatility -> String
(Int -> Volatility -> ShowS)
-> (Volatility -> String)
-> ([Volatility] -> ShowS)
-> Show Volatility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Volatility -> ShowS
showsPrec :: Int -> Volatility -> ShowS
$cshow :: Volatility -> String
show :: Volatility -> String
$cshowList :: [Volatility] -> ShowS
showList :: [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 Code a -> Code a -> Code a
forall a. Code a -> Code a -> Code a
:>>: Code a
y
instance Monoid (Code a) where
mempty :: Code a
mempty = Code a
forall a. Code a
Skip
lexicalMemoryUsage :: Function a -> M.Map VName Space
lexicalMemoryUsage :: forall a. Function a -> Map VName Space
lexicalMemoryUsage Function a
func =
(VName -> Space -> Bool) -> Map VName Space -> Map VName Space
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (Bool -> Space -> Bool
forall a b. a -> b -> a
const (Bool -> Space -> Bool)
-> (VName -> Bool) -> VName -> Space -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VName -> Names -> Bool
`notNameIn` Names
nonlexical)) (Map VName Space -> Map VName Space)
-> Map VName Space -> Map VName Space
forall a b. (a -> b) -> a -> b
$
Code a -> Map VName Space
forall {a}. Code a -> Map VName Space
declared (Code a -> Map VName Space) -> Code a -> Map VName Space
forall a b. (a -> b) -> a -> b
$
Function a -> Code a
forall a. FunctionT a -> Code a
functionBody Function a
func
where
nonlexical :: Names
nonlexical =
Code a -> Names
forall {a}. Code a -> Names
set (Function a -> Code a
forall a. FunctionT a -> Code a
functionBody Function a
func)
Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> [VName] -> Names
namesFromList ((Param -> VName) -> [Param] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param -> VName
paramName (Function a -> [Param]
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 a -> a -> a
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 a -> a -> a
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
_ = a
forall a. Monoid a => a
mempty
declared :: Code a -> Map VName Space
declared (DeclareMem VName
mem Space
space) =
VName -> Space -> Map VName Space
forall k a. k -> a -> Map k a
M.singleton VName
mem Space
space
declared Code a
x = (Code a -> Map VName Space) -> Code a -> Map VName Space
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) =
[VName] -> Names
namesFromList [VName]
dests Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> (Arg -> Names) -> [Arg] -> Names
forall m a. Monoid m => (a -> m) -> [a] -> m
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 {} = Names
forall a. Monoid a => a
mempty
onArg (MemArg VName
x) = VName -> Names
oneName VName
x
set Code a
x = (Code a -> Names) -> Code a -> Names
forall {a} {a}. Monoid a => (Code a -> a) -> Code a -> a
go Code a -> Names
set Code a
x
declsFirst :: Code a -> Code a
declsFirst :: forall a. Code a -> Code a
declsFirst = [Code a] -> Code a
forall a. Monoid a => [a] -> a
mconcat ([Code a] -> Code a) -> (Code a -> [Code a]) -> Code a -> Code a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Code a] -> [Code a] -> [Code a])
-> ([Code a], [Code a]) -> [Code a]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Code a] -> [Code a] -> [Code a]
forall a. Semigroup a => a -> a -> a
(<>) (([Code a], [Code a]) -> [Code a])
-> (Code a -> ([Code a], [Code a])) -> Code a -> [Code a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Code a -> Bool) -> [Code a] -> ([Code a], [Code a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Code a -> Bool
forall {a}. Code a -> Bool
isDecl ([Code a] -> ([Code a], [Code a]))
-> (Code a -> [Code a]) -> Code a -> ([Code a], [Code a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code a -> [Code a]
forall {a}. Code a -> [Code a]
listify
where
listify :: Code a -> [Code a]
listify (Code a
c1 :>>: Code a
c2) = Code a -> [Code a]
listify Code a
c1 [Code a] -> [Code a] -> [Code a]
forall a. Semigroup a => a -> a -> a
<> Code a -> [Code a]
listify Code a
c2
listify (If TExp Bool
cond Code a
c1 Code a
c2) = [TExp Bool -> Code a -> Code a -> Code a
forall a. TExp Bool -> Code a -> Code a -> Code a
If TExp Bool
cond (Code a -> Code a
forall a. Code a -> Code a
declsFirst Code a
c1) (Code a -> Code a
forall a. Code a -> Code a
declsFirst Code a
c2)]
listify (For VName
i Exp
e Code a
c) = [VName -> Exp -> Code a -> Code a
forall a. VName -> Exp -> Code a -> Code a
For VName
i Exp
e (Code a -> Code a
forall a. Code a -> Code a
declsFirst Code a
c)]
listify (While TExp Bool
cond Code a
c) = [TExp Bool -> Code a -> Code a
forall a. TExp Bool -> Code a -> Code a
While TExp Bool
cond (Code a -> Code a
forall a. Code a -> Code a
declsFirst Code a
c)]
listify Code a
c = [Code a
c]
isDecl :: Code a -> Bool
isDecl (DeclareScalar {}) = Bool
True
isDecl (DeclareMem {}) = Bool
True
isDecl Code a
_ = Bool
False
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]
_) = Name -> Set Name
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) = (a -> Set Name) -> Code a -> Set Name
forall a. (a -> Set Name) -> Code a -> Set Name
calledFuncs a -> Set Name
f Code a
x Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
<> (a -> Set Name) -> Code a -> Set Name
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) = (a -> Set Name) -> Code a -> Set Name
forall a. (a -> Set Name) -> Code a -> Set Name
calledFuncs a -> Set Name
f Code a
x Set Name -> Set Name -> Set Name
forall a. Semigroup a => a -> a -> a
<> (a -> Set Name) -> Code a -> Set Name
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) = (a -> Set Name) -> Code a -> Set Name
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) = (a -> Set Name) -> Code a -> Set Name
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) = (a -> Set Name) -> Code a -> Set Name
forall a. (a -> Set Name) -> Code a -> Set Name
calledFuncs a -> Set Name
f Code a
x
calledFuncs a -> Set Name
_ Code a
_ = Set Name
forall a. Monoid a => a
mempty
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) =
Map Name (Set Name) -> Map Name (Set Name)
forall {k}. Ord k => Map k (Set k) -> Map k (Set k)
loop (Map Name (Set Name) -> Map Name (Set Name))
-> Map Name (Set Name) -> Map Name (Set Name)
forall a b. (a -> b) -> a -> b
$ [(Name, Set Name)] -> Map Name (Set Name)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Set Name)] -> Map Name (Set Name))
-> [(Name, Set Name)] -> Map Name (Set Name)
forall a b. (a -> b) -> a -> b
$ ((Name, Function a) -> (Name, Set Name))
-> [(Name, Function a)] -> [(Name, Set Name)]
forall a b. (a -> b) -> [a] -> [b]
map ((Function a -> Set Name) -> (Name, Function a) -> (Name, Set Name)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Function a -> Set Name)
-> (Name, Function a) -> (Name, Set Name))
-> (Function a -> Set Name)
-> (Name, Function a)
-> (Name, Set Name)
forall a b. (a -> b) -> a -> b
$ (a -> Set Name) -> Code a -> Set Name
forall a. (a -> Set Name) -> Code a -> Set Name
calledFuncs a -> Set Name
f (Code a -> Set Name)
-> (Function a -> Code a) -> Function a -> Set Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function a -> Code a
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 = Set k -> (Set k -> Set k) -> Maybe (Set k) -> Set k
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (k -> Set k
forall a. a -> Set a
S.singleton k
v) (k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
S.insert k
v) (k -> Map k (Set k) -> Maybe (Set k)
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 = (Set k -> Set k) -> Map k (Set k) -> Map k (Set k)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ((k -> Set k) -> Set k -> Set k
forall m a. Monoid m => (a -> m) -> Set a -> m
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 Map k (Set k) -> Map k (Set k) -> Bool
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
type ParamMap = M.Map Name (SizeClass, S.Set Name)
type Exp = PrimExp VName
type TExp t = TPrimExp t VName
data Arg
= ExpArg Exp
| MemArg VName
deriving (Int -> Arg -> ShowS
[Arg] -> ShowS
Arg -> String
(Int -> Arg -> ShowS)
-> (Arg -> String) -> ([Arg] -> ShowS) -> Show Arg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Arg -> ShowS
showsPrec :: Int -> Arg -> ShowS
$cshow :: Arg -> String
show :: Arg -> String
$cshowList :: [Arg] -> ShowS
showList :: [Arg] -> ShowS
Show)
data Elements
data Bytes
elements :: a -> Count Elements a
elements :: forall a. a -> Count Elements a
elements = a -> Count Elements a
forall {k} (u :: k) e. e -> Count u e
Count
bytes :: a -> Count Bytes a
bytes :: forall a. a -> Count Bytes a
bytes = a -> Count Bytes a
forall {k} (u :: k) e. e -> Count u e
Count
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 = TExp Int64 -> Count Bytes (TExp Int64)
forall a. a -> Count Bytes a
bytes (TExp Int64 -> Count Bytes (TExp Int64))
-> TExp Int64 -> Count Bytes (TExp Int64)
forall a b. (a -> b) -> a -> b
$ TExp Int64 -> TExp Int64
forall {k} (t :: k) v. IntExp t => TPrimExp t v -> TPrimExp Int64 v
sExt64 TExp Int64
e TExp Int64 -> TExp Int64 -> TExp Int64
forall a. Num a => a -> a -> a
* PrimType -> TExp Int64
forall a. Num a => PrimType -> a
primByteSize PrimType
t
var :: VName -> PrimType -> Exp
var :: VName -> PrimType -> Exp
var = VName -> PrimType -> Exp
forall v. v -> PrimType -> PrimExp v
LeafExp
instance (Pretty op) => Pretty (Definitions op) where
pretty :: forall ann. Definitions op -> Doc ann
pretty (Definitions OpaqueTypes
types Constants op
consts Functions op
funs) =
OpaqueTypes -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. OpaqueTypes -> Doc ann
pretty OpaqueTypes
types Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Constants op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Constants op -> Doc ann
pretty Constants op
consts Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Functions op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Functions op -> 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) = [Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
stack ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
intersperse Doc ann
forall a. Monoid a => a
mempty ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ ((Name, Function op) -> Doc ann)
-> [(Name, Function op)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Function op) -> Doc ann
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 " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (a -> Doc ann
forall ann. a -> Doc ann
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:"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
stack ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Param -> Doc ann) -> [Param] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Param -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Param -> Doc ann
pretty [Param]
decls)
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Doc ann
forall a. Monoid a => a
mempty
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"Initialisation:"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Code op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Code op -> 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:"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes (Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
name))
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"Arguments:"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
stack ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (((Name, Uniqueness), ExternalValue) -> Doc ann)
-> [((Name, Uniqueness), ExternalValue)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ((Name, Uniqueness), ExternalValue) -> Doc ann
forall {a} {a} {a} {ann}.
(Pretty a, Pretty a, Pretty a) =>
((a, a), a) -> Doc ann
ppArg [((Name, Uniqueness), ExternalValue)]
args)
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"Results:"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
stack ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ ((Uniqueness, ExternalValue) -> Doc ann)
-> [(Uniqueness, ExternalValue)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Uniqueness, ExternalValue) -> Doc ann
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) = a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
p Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> (a, a) -> Doc ann
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) = a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
u Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall ann. a -> Doc ann
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:"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
stack ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Param -> Doc ann) -> [Param] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Param -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Param -> Doc ann
pretty [Param]
ins)
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"Outputs:"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
stack ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Param -> Doc ann) -> [Param] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Param -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Param -> Doc ann
pretty [Param]
outs)
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"Entry:"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Maybe EntryPoint -> Doc ann
forall ann. Maybe EntryPoint -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe EntryPoint
entry)
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"Body:"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Code op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Code op -> Doc ann
pretty Code op
body)
instance Pretty Param where
pretty :: forall ann. Param -> Doc ann
pretty (ScalarParam VName
name PrimType
ptype) = PrimType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimType -> Doc ann
pretty PrimType
ptype Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
name
pretty (MemParam VName
name Space
space) = Doc ann
"mem" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Space -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Space -> Doc ann
pretty Space
space Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
name
instance Pretty ValueDesc where
pretty :: forall ann. ValueDesc -> Doc ann
pretty (ScalarValue PrimType
t Signedness
ept VName
name) =
PrimType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimType -> Doc ann
pretty PrimType
t Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
name Doc ann -> Doc ann -> Doc ann
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 -> Doc ann
forall a. Monoid a => a
mempty
pretty (ArrayValue VName
mem Space
space PrimType
et Signedness
ept [DimSize]
shape) =
(DimSize -> Doc ann) -> [DimSize] -> Doc ann
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Doc ann -> Doc ann) -> (DimSize -> Doc ann) -> DimSize -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DimSize -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. DimSize -> Doc ann
pretty) [DimSize]
shape
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (PrimType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimType -> Doc ann
pretty PrimType
et Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"at" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
mem Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Space -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Space -> Doc ann
pretty Space
space Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
ept')
where
ept' :: Doc ann
ept' = case Signedness
ept of
Signedness
Unsigned -> Doc ann
" (unsigned)"
Signedness
Signed -> Doc ann
forall a. Monoid a => a
mempty
instance Pretty ExternalValue where
pretty :: forall ann. ExternalValue -> Doc ann
pretty (TransparentValue ValueDesc
v) = ValueDesc -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ValueDesc -> Doc ann
pretty ValueDesc
v
pretty (OpaqueValue Name
desc [ValueDesc]
vs) =
Doc ann
"opaque"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes (Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
desc)
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann -> Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a -> Doc a
nestedBlock Doc ann
"{" Doc ann
"}" ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
stack ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (ValueDesc -> Doc ann) -> [ValueDesc] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map ValueDesc -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ValueDesc -> Doc ann
pretty [ValueDesc]
vs)
instance Pretty ArrayContents where
pretty :: forall ann. ArrayContents -> Doc ann
pretty (ArrayValues [PrimValue]
vs) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (PrimValue -> Doc ann) -> [PrimValue] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map PrimValue -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimValue -> Doc ann
pretty [PrimValue]
vs)
pretty (ArrayZeros Int
n) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces Doc ann
"0" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"*" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Int -> Doc ann
forall ann. Int -> Doc ann
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) = op -> Doc ann
forall ann. op -> Doc ann
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) = Code op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Code op -> Doc ann
pretty Code op
c1 Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Code op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Code op -> Doc ann
pretty Code op
c2
pretty (For VName
i Exp
limit Code op
body) =
Doc ann
"for"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
i
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
forall ann. Doc ann
langle
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
limit
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"{"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Code op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Code op -> Doc ann
pretty Code op
body)
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"}"
pretty (While TExp Bool
cond Code op
body) =
Doc ann
"while"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> TExp Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TExp Bool -> Doc ann
pretty TExp Bool
cond
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"{"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Code op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Code op -> Doc ann
pretty Code op
body)
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"}"
pretty (DeclareMem VName
name Space
space) =
Doc ann
"var" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
": mem" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Space -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Space -> Doc ann
pretty Space
space
pretty (DeclareScalar VName
name Volatility
vol PrimType
t) =
Doc ann
"var" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
name Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
vol' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> PrimType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimType -> Doc ann
pretty PrimType
t
where
vol' :: Doc ann
vol' = case Volatility
vol of
Volatility
Volatile -> Doc ann
"volatile "
Volatility
Nonvolatile -> Doc ann
forall a. Monoid a => a
mempty
pretty (DeclareArray VName
name PrimType
t ArrayContents
vs) =
Doc ann
"array"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
name
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
":"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> PrimType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimType -> Doc ann
pretty PrimType
t
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
forall ann. Doc ann
equals
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> ArrayContents -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ArrayContents -> Doc ann
pretty ArrayContents
vs
pretty (Allocate VName
name Count Bytes (TExp Int64)
e Space
space) =
VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
name Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"<-" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"malloc" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Count Bytes (TExp Int64) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count Bytes (TExp Int64) -> Doc ann
pretty Count Bytes (TExp Int64)
e) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Space -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Space -> Doc ann
pretty Space
space
pretty (Free VName
name Space
space) =
Doc ann
"free" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
name) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Space -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Space -> Doc ann
pretty Space
space
pretty (Write VName
name Count Elements (TExp Int64)
i PrimType
bt Space
space Volatility
vol Exp
val) =
VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
name
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
langle
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
vol'
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> PrimType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimType -> Doc ann
pretty PrimType
bt
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Space -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Space -> Doc ann
pretty Space
space
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
rangle
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Count Elements (TExp Int64) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count Elements (TExp Int64) -> Doc ann
pretty Count Elements (TExp Int64)
i)
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"<-"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
val
where
vol' :: Doc ann
vol' = case Volatility
vol of
Volatility
Volatile -> Doc ann
"volatile "
Volatility
Nonvolatile -> Doc ann
forall a. Monoid a => a
mempty
pretty (Read VName
name VName
v Count Elements (TExp Int64)
is PrimType
bt Space
space Volatility
vol) =
VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
name
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"<-"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
v
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
langle
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
vol'
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> PrimType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimType -> Doc ann
pretty PrimType
bt
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Space -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Space -> Doc ann
pretty Space
space
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
rangle
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Count Elements (TExp Int64) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count Elements (TExp Int64) -> Doc ann
pretty Count Elements (TExp Int64)
is)
where
vol' :: Doc ann
vol' = case Volatility
vol of
Volatility
Volatile -> Doc ann
"volatile "
Volatility
Nonvolatile -> Doc ann
forall a. Monoid a => a
mempty
pretty (SetScalar VName
name Exp
val) =
VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
name Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"<-" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
val
pretty (SetMem VName
dest VName
from Space
DefaultSpace) =
VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
dest Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"<-" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
from
pretty (SetMem VName
dest VName
from Space
space) =
VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
dest Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"<-" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
from Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"@" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Space -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Space -> Doc ann
pretty Space
space
pretty (Assert Exp
e ErrorMsg Exp
msg (SrcLoc, [SrcLoc])
_) =
Doc ann
"assert" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [ErrorMsg Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ErrorMsg Exp -> Doc ann
pretty ErrorMsg Exp
msg, Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
e])
pretty (Copy PrimType
t [Count Elements (TExp Int64)]
shape (VName
dst, Space
dstspace) (Count Elements (TExp Int64)
dstoffset, [Count Elements (TExp Int64)]
dststrides) (VName
src, Space
srcspace) (Count Elements (TExp Int64)
srcoffset, [Count Elements (TExp Int64)]
srcstrides)) =
(Doc ann
"lmadcopy_" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Count Elements (TExp Int64)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Count Elements (TExp Int64)]
shape) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"d_" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> PrimType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimType -> Doc ann
pretty PrimType
t)
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align)
( (Count Elements (TExp Int64) -> Doc ann)
-> [Count Elements (TExp Int64)] -> Doc ann
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Doc ann -> Doc ann)
-> (Count Elements (TExp Int64) -> Doc ann)
-> Count Elements (TExp Int64)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Count Elements (TExp Int64) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count Elements (TExp Int64) -> Doc ann
pretty) [Count Elements (TExp Int64)]
shape
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
","
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> VName
-> Space
-> Count Elements (TExp Int64)
-> [Count Elements (TExp Int64)]
-> Doc ann
forall {t :: * -> *} {a} {a} {a} {a} {ann}.
(Foldable t, Pretty a, Pretty a, Pretty a, Pretty a) =>
a -> a -> a -> t a -> Doc ann
p VName
dst Space
dstspace Count Elements (TExp Int64)
dstoffset [Count Elements (TExp Int64)]
dststrides
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
","
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> VName
-> Space
-> Count Elements (TExp Int64)
-> [Count Elements (TExp Int64)]
-> Doc ann
forall {t :: * -> *} {a} {a} {a} {a} {ann}.
(Foldable t, Pretty a, Pretty a, Pretty a, Pretty a) =>
a -> a -> a -> t a -> Doc ann
p VName
src Space
srcspace Count Elements (TExp Int64)
srcoffset [Count Elements (TExp Int64)]
srcstrides
)
where
p :: a -> a -> a -> t a -> Doc ann
p a
mem a
space a
offset t a
strides =
a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
mem
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
space
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"+"
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
offset
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> (a -> Doc ann) -> t a -> Doc ann
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Doc ann -> Doc ann) -> (a -> Doc ann) -> a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty) t a
strides
pretty (If TExp Bool
cond Code op
tbranch Code op
fbranch) =
Doc ann
"if"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> TExp Bool -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TExp Bool -> Doc ann
pretty TExp Bool
cond
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"then {"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Code op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Code op -> Doc ann
pretty Code op
tbranch)
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"} else"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> case Code op
fbranch of
If {} -> Code op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Code op -> Doc ann
pretty Code op
fbranch
Code op
_ ->
Doc ann
"{" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Code op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Code op -> Doc ann
pretty Code op
fbranch) Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Doc ann
"}"
pretty (Call [] Name
fname [Arg]
args) =
Doc ann
"call" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
fname Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Arg -> Doc ann) -> [Arg] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Arg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Arg -> Doc ann
pretty [Arg]
args)
pretty (Call [VName]
dests Name
fname [Arg]
args) =
Doc ann
"call"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> [Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep ((VName -> Doc ann) -> [VName] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty [VName]
dests)
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann
"<-"
Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Name -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Name -> Doc ann
pretty Name
fname
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Arg -> Doc ann) -> [Arg] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Arg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Arg -> Doc ann
pretty [Arg]
args)
pretty (Comment Text
s Code op
code) =
Doc ann
"--" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
s Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
</> Code op -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Code op -> Doc ann
pretty Code op
code
pretty (DebugPrint String
desc (Just Exp
e)) =
Doc ann
"debug" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep [String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ShowS
forall a. Show a => a -> String
show String
desc), Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
e])
pretty (DebugPrint String
desc Maybe Exp
Nothing) =
Doc ann
"debug" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ShowS
forall a. Show a => a -> String
show String
desc))
pretty (TracePrint ErrorMsg Exp
msg) =
Doc ann
"trace" Doc ann -> Doc ann -> Doc ann
forall a. Doc a -> Doc a -> Doc a
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (ErrorMsg Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ErrorMsg Exp -> Doc ann
pretty ErrorMsg Exp
msg)
instance Pretty Arg where
pretty :: forall ann. Arg -> Doc ann
pretty (MemArg VName
m) = VName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. VName -> Doc ann
pretty VName
m
pretty (ExpArg Exp
e) = Exp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Exp -> Doc ann
pretty Exp
e
instance Functor Functions where
fmap :: forall a b. (a -> b) -> Functions a -> Functions b
fmap = (a -> b) -> Functions a -> Functions b
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 = (a -> m) -> Functions a -> m
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) =
[(Name, Function b)] -> Functions b
forall a. [(Name, Function a)] -> Functions a
Functions ([(Name, Function b)] -> Functions b)
-> f [(Name, Function b)] -> f (Functions b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Name, Function a) -> f (Name, Function b))
-> [(Name, Function a)] -> f [(Name, Function b)]
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) -> [a] -> f [b]
traverse (Name, Function a) -> f (Name, Function b)
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,) (t b -> (t, t b)) -> f (t b) -> f (t, t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> t a -> f (t b)
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) -> 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 = (a -> b) -> FunctionT a -> FunctionT b
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 = (a -> m) -> FunctionT a -> m
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) =
Maybe EntryPoint -> [Param] -> [Param] -> Code b -> FunctionT b
forall a.
Maybe EntryPoint -> [Param] -> [Param] -> Code a -> FunctionT a
Function Maybe EntryPoint
entry [Param]
outs [Param]
ins (Code b -> FunctionT b) -> f (Code b) -> f (FunctionT b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Code a -> f (Code b)
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) -> Code a -> f (Code b)
traverse a -> f b
f Code a
body
instance Functor Code where
fmap :: forall a b. (a -> b) -> Code a -> Code b
fmap = (a -> b) -> Code a -> Code b
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 = (a -> m) -> Code a -> m
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) =
Code b -> Code b -> Code b
forall a. Code a -> Code a -> Code a
(:>>:) (Code b -> Code b -> Code b) -> f (Code b) -> f (Code b -> Code b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Code a -> f (Code b)
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) -> Code a -> f (Code b)
traverse a -> f b
f Code a
x f (Code b -> Code b) -> f (Code b) -> f (Code b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Code a -> f (Code b)
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) -> Code a -> f (Code b)
traverse a -> f b
f Code a
y
traverse a -> f b
f (For VName
i Exp
bound Code a
code) =
VName -> Exp -> Code b -> Code b
forall a. VName -> Exp -> Code a -> Code a
For VName
i Exp
bound (Code b -> Code b) -> f (Code b) -> f (Code b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Code a -> f (Code b)
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) -> Code a -> f (Code b)
traverse a -> f b
f Code a
code
traverse a -> f b
f (While TExp Bool
cond Code a
code) =
TExp Bool -> Code b -> Code b
forall a. TExp Bool -> Code a -> Code a
While TExp Bool
cond (Code b -> Code b) -> f (Code b) -> f (Code b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Code a -> f (Code b)
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) -> Code a -> f (Code b)
traverse a -> f b
f Code a
code
traverse a -> f b
f (If TExp Bool
cond Code a
x Code a
y) =
TExp Bool -> Code b -> Code b -> Code b
forall a. TExp Bool -> Code a -> Code a -> Code a
If TExp Bool
cond (Code b -> Code b -> Code b) -> f (Code b) -> f (Code b -> Code b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Code a -> f (Code b)
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) -> Code a -> f (Code b)
traverse a -> f b
f Code a
x f (Code b -> Code b) -> f (Code b) -> f (Code b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Code a -> f (Code b)
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) -> Code a -> f (Code b)
traverse a -> f b
f Code a
y
traverse a -> f b
f (Op a
kernel) =
b -> Code b
forall a. a -> Code a
Op (b -> Code b) -> f b -> f (Code b)
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 =
Code b -> f (Code b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Code b
forall a. Code a
Skip
traverse a -> f b
_ (DeclareMem VName
name Space
space) =
Code b -> f (Code b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Code b -> f (Code b)) -> Code b -> f (Code b)
forall a b. (a -> b) -> a -> b
$ VName -> Space -> Code b
forall a. VName -> Space -> Code a
DeclareMem VName
name Space
space
traverse a -> f b
_ (DeclareScalar VName
name Volatility
vol PrimType
bt) =
Code b -> f (Code b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Code b -> f (Code b)) -> Code b -> f (Code b)
forall a b. (a -> b) -> a -> b
$ VName -> Volatility -> PrimType -> Code 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) =
Code b -> f (Code b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Code b -> f (Code b)) -> Code b -> f (Code b)
forall a b. (a -> b) -> a -> b
$ VName -> PrimType -> ArrayContents -> Code 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) =
Code b -> f (Code b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Code b -> f (Code b)) -> Code b -> f (Code b)
forall a b. (a -> b) -> a -> b
$ VName -> Count Bytes (TExp Int64) -> Space -> Code 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) =
Code b -> f (Code b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Code b -> f (Code b)) -> Code b -> f (Code b)
forall a b. (a -> b) -> a -> b
$ VName -> Space -> Code b
forall a. VName -> Space -> Code a
Free VName
name Space
space
traverse a -> f b
_ (Copy PrimType
t [Count Elements (TExp Int64)]
shape (VName
dst, Space
dstspace) (Count Elements (TExp Int64)
dstoffset, [Count Elements (TExp Int64)]
dststrides) (VName
src, Space
srcspace) (Count Elements (TExp Int64)
srcoffset, [Count Elements (TExp Int64)]
srcstrides)) =
Code b -> f (Code b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Code b -> f (Code b)) -> Code b -> f (Code b)
forall a b. (a -> b) -> a -> b
$ PrimType
-> [Count Elements (TExp Int64)]
-> (VName, Space)
-> (Count Elements (TExp Int64), [Count Elements (TExp Int64)])
-> (VName, Space)
-> (Count Elements (TExp Int64), [Count Elements (TExp Int64)])
-> Code b
forall a.
PrimType
-> [Count Elements (TExp Int64)]
-> (VName, Space)
-> (Count Elements (TExp Int64), [Count Elements (TExp Int64)])
-> (VName, Space)
-> (Count Elements (TExp Int64), [Count Elements (TExp Int64)])
-> Code a
Copy PrimType
t [Count Elements (TExp Int64)]
shape (VName
dst, Space
dstspace) (Count Elements (TExp Int64)
dstoffset, [Count Elements (TExp Int64)]
dststrides) (VName
src, Space
srcspace) (Count Elements (TExp Int64)
srcoffset, [Count Elements (TExp Int64)]
srcstrides)
traverse a -> f b
_ (Write VName
name Count Elements (TExp Int64)
i PrimType
bt Space
val Volatility
space Exp
vol) =
Code b -> f (Code b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Code b -> f (Code b)) -> Code b -> f (Code b)
forall a b. (a -> b) -> a -> b
$ VName
-> Count Elements (TExp Int64)
-> PrimType
-> Space
-> Volatility
-> Exp
-> Code 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) =
Code b -> f (Code b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Code b -> f (Code b)) -> Code b -> f (Code b)
forall a b. (a -> b) -> a -> b
$ VName
-> VName
-> Count Elements (TExp Int64)
-> PrimType
-> Space
-> Volatility
-> Code 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) =
Code b -> f (Code b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Code b -> f (Code b)) -> Code b -> f (Code b)
forall a b. (a -> b) -> a -> b
$ VName -> Exp -> Code b
forall a. VName -> Exp -> Code a
SetScalar VName
name Exp
val
traverse a -> f b
_ (SetMem VName
dest VName
from Space
space) =
Code b -> f (Code b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Code b -> f (Code b)) -> Code b -> f (Code b)
forall a b. (a -> b) -> a -> b
$ VName -> VName -> Space -> Code 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) =
Code b -> f (Code b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Code b -> f (Code b)) -> Code b -> f (Code b)
forall a b. (a -> b) -> a -> b
$ Exp -> ErrorMsg Exp -> (SrcLoc, [SrcLoc]) -> Code 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) =
Code b -> f (Code b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Code b -> f (Code b)) -> Code b -> f (Code b)
forall a b. (a -> b) -> a -> b
$ [VName] -> Name -> [Arg] -> Code 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) =
Text -> Code b -> Code b
forall a. Text -> Code a -> Code a
Comment Text
s (Code b -> Code b) -> f (Code b) -> f (Code b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Code a -> f (Code b)
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) -> Code a -> f (Code b)
traverse a -> f b
f Code a
code
traverse a -> f b
_ (DebugPrint String
s Maybe Exp
v) =
Code b -> f (Code b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Code b -> f (Code b)) -> Code b -> f (Code b)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Exp -> Code b
forall a. String -> Maybe Exp -> Code a
DebugPrint String
s Maybe Exp
v
traverse a -> f b
_ (TracePrint ErrorMsg Exp
msg) =
Code b -> f (Code b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Code b -> f (Code b)) -> Code b -> f (Code b)
forall a b. (a -> b) -> a -> b
$ ErrorMsg Exp -> Code b
forall a. ErrorMsg Exp -> Code a
TracePrint ErrorMsg Exp
msg
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) = Code a -> Names
forall {a}. Code a -> Names
declaredIn Code a
t Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Code a -> Names
forall {a}. Code a -> Names
declaredIn Code a
f
declaredIn (Code a
x :>>: Code a
y) = Code a -> Names
forall {a}. Code a -> Names
declaredIn Code a
x Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Code a -> Names
forall {a}. Code a -> Names
declaredIn Code a
y
declaredIn (For VName
i Exp
_ Code a
body) = VName -> Names
oneName VName
i Names -> Names -> Names
forall a. Semigroup a => a -> a -> a
<> Code a -> Names
forall {a}. Code a -> Names
declaredIn Code a
body
declaredIn (While TExp Bool
_ Code a
body) = Code a -> Names
forall {a}. Code a -> Names
declaredIn Code a
body
declaredIn (Comment Text
_ Code a
body) = Code a -> Names
forall {a}. Code a -> Names
declaredIn Code a
body
declaredIn Code a
_ = Names
forall a. Monoid a => a
mempty
instance FreeIn EntryPoint where
freeIn' :: EntryPoint -> FV
freeIn' (EntryPoint Name
_ [(Uniqueness, ExternalValue)]
res [((Name, Uniqueness), ExternalValue)]
args) =
[ExternalValue] -> FV
forall a. FreeIn a => a -> FV
freeIn' (((Uniqueness, ExternalValue) -> ExternalValue)
-> [(Uniqueness, ExternalValue)] -> [ExternalValue]
forall a b. (a -> b) -> [a] -> [b]
map (Uniqueness, ExternalValue) -> ExternalValue
forall a b. (a, b) -> b
snd [(Uniqueness, ExternalValue)]
res) FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> [ExternalValue] -> FV
forall a. FreeIn a => a -> FV
freeIn' ((((Name, Uniqueness), ExternalValue) -> ExternalValue)
-> [((Name, Uniqueness), ExternalValue)] -> [ExternalValue]
forall a b. (a -> b) -> [a] -> [b]
map ((Name, Uniqueness), ExternalValue) -> ExternalValue
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) = ((Name, Function a) -> FV) -> [(Name, Function a)] -> FV
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Function a -> FV
forall {a}. FreeIn a => FunctionT a -> FV
onFun (Function a -> FV)
-> ((Name, Function a) -> Function a) -> (Name, Function a) -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Function a) -> Function a
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 (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ Code a -> FV
forall a. FreeIn a => a -> FV
freeIn' (FunctionT a -> Code a
forall a. FunctionT a -> Code a
functionBody FunctionT a
f) FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Maybe EntryPoint -> FV
forall a. FreeIn a => a -> FV
freeIn' (FunctionT a -> Maybe EntryPoint
forall a. FunctionT a -> Maybe EntryPoint
functionEntry FunctionT a
f)
where
pnames :: Names
pnames =
[VName] -> Names
namesFromList ([VName] -> Names) -> [VName] -> Names
forall a b. (a -> b) -> a -> b
$ (Param -> VName) -> [Param] -> [VName]
forall a b. (a -> b) -> [a] -> [b]
map Param -> VName
paramName ([Param] -> [VName]) -> [Param] -> [VName]
forall a b. (a -> b) -> a -> b
$ FunctionT a -> [Param]
forall a. FunctionT a -> [Param]
functionInput FunctionT a
f [Param] -> [Param] -> [Param]
forall a. Semigroup a => a -> a -> a
<> FunctionT a -> [Param]
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) = VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
mem FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> [DimSize] -> FV
forall a. FreeIn a => a -> FV
freeIn' [DimSize]
dims
freeIn' ScalarValue {} = FV
forall a. Monoid a => a
mempty
instance FreeIn ExternalValue where
freeIn' :: ExternalValue -> FV
freeIn' (TransparentValue ValueDesc
vd) = ValueDesc -> FV
forall a. FreeIn a => a -> FV
freeIn' ValueDesc
vd
freeIn' (OpaqueValue Name
_ [ValueDesc]
vds) = (ValueDesc -> FV) -> [ValueDesc] -> FV
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ValueDesc -> FV
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 (Code a -> Names
forall {a}. Code a -> Names
declaredIn Code a
x) (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ Code a -> FV
forall a. FreeIn a => a -> FV
freeIn' Code a
x FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Code a -> FV
forall a. FreeIn a => a -> FV
freeIn' Code a
y
freeIn' Code a
Skip =
FV
forall a. Monoid a => a
mempty
freeIn' (For VName
i Exp
bound Code a
body) =
Names -> FV -> FV
fvBind (VName -> Names
oneName VName
i) (FV -> FV) -> FV -> FV
forall a b. (a -> b) -> a -> b
$ Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
bound FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Code a -> FV
forall a. FreeIn a => a -> FV
freeIn' Code a
body
freeIn' (While TExp Bool
cond Code a
body) =
TExp Bool -> FV
forall a. FreeIn a => a -> FV
freeIn' TExp Bool
cond FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Code a -> FV
forall a. FreeIn a => a -> FV
freeIn' Code a
body
freeIn' (DeclareMem VName
_ Space
space) =
Space -> FV
forall a. FreeIn a => a -> FV
freeIn' Space
space
freeIn' DeclareScalar {} =
FV
forall a. Monoid a => a
mempty
freeIn' DeclareArray {} =
FV
forall a. Monoid a => a
mempty
freeIn' (Allocate VName
name Count Bytes (TExp Int64)
size Space
space) =
VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
name FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Count Bytes (TExp Int64) -> FV
forall a. FreeIn a => a -> FV
freeIn' Count Bytes (TExp Int64)
size FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Space -> FV
forall a. FreeIn a => a -> FV
freeIn' Space
space
freeIn' (Free VName
name Space
_) =
VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
name
freeIn' (Copy PrimType
_ [Count Elements (TExp Int64)]
shape (VName
dst, Space
_) (Count Elements (TExp Int64)
dstoffset, [Count Elements (TExp Int64)]
dststrides) (VName
src, Space
_) (Count Elements (TExp Int64)
srcoffset, [Count Elements (TExp Int64)]
srcstrides)) =
[Count Elements (TExp Int64)] -> FV
forall a. FreeIn a => a -> FV
freeIn' [Count Elements (TExp Int64)]
shape FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
dst FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Count Elements (TExp Int64) -> FV
forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
dstoffset FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> [Count Elements (TExp Int64)] -> FV
forall a. FreeIn a => a -> FV
freeIn' [Count Elements (TExp Int64)]
dststrides FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
src FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Count Elements (TExp Int64) -> FV
forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
srcoffset FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> [Count Elements (TExp Int64)] -> FV
forall a. FreeIn a => a -> FV
freeIn' [Count Elements (TExp Int64)]
srcstrides
freeIn' (SetMem VName
x VName
y Space
_) =
VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
x FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
y
freeIn' (Write VName
v Count Elements (TExp Int64)
i PrimType
_ Space
_ Volatility
_ Exp
e) =
VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
v FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Count Elements (TExp Int64) -> FV
forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
i FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
e
freeIn' (Read VName
x VName
v Count Elements (TExp Int64)
i PrimType
_ Space
_ Volatility
_) =
VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
x FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
v FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Count Elements (TExp Int64) -> FV
forall a. FreeIn a => a -> FV
freeIn' Count Elements (TExp Int64)
i
freeIn' (SetScalar VName
x Exp
y) =
VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
x FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
y
freeIn' (Call [VName]
dests Name
_ [Arg]
args) =
[VName] -> FV
forall a. FreeIn a => a -> FV
freeIn' [VName]
dests FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> [Arg] -> FV
forall a. FreeIn a => a -> FV
freeIn' [Arg]
args
freeIn' (If TExp Bool
cond Code a
t Code a
f) =
TExp Bool -> FV
forall a. FreeIn a => a -> FV
freeIn' TExp Bool
cond FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Code a -> FV
forall a. FreeIn a => a -> FV
freeIn' Code a
t FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> Code a -> FV
forall a. FreeIn a => a -> FV
freeIn' Code a
f
freeIn' (Assert Exp
e ErrorMsg Exp
msg (SrcLoc, [SrcLoc])
_) =
Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
e FV -> FV -> FV
forall a. Semigroup a => a -> a -> a
<> (Exp -> FV) -> ErrorMsg Exp -> FV
forall m a. Monoid m => (a -> m) -> ErrorMsg a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' ErrorMsg Exp
msg
freeIn' (Op a
op) =
a -> FV
forall a. FreeIn a => a -> FV
freeIn' a
op
freeIn' (Comment Text
_ Code a
code) =
Code a -> FV
forall a. FreeIn a => a -> FV
freeIn' Code a
code
freeIn' (DebugPrint String
_ Maybe Exp
v) =
FV -> (Exp -> FV) -> Maybe Exp -> FV
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FV
forall a. Monoid a => a
mempty Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Maybe Exp
v
freeIn' (TracePrint ErrorMsg Exp
msg) =
(Exp -> FV) -> ErrorMsg Exp -> FV
forall m a. Monoid m => (a -> m) -> ErrorMsg a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' ErrorMsg Exp
msg
instance FreeIn Arg where
freeIn' :: Arg -> FV
freeIn' (MemArg VName
m) = VName -> FV
forall a. FreeIn a => a -> FV
freeIn' VName
m
freeIn' (ExpArg Exp
e) = Exp -> FV
forall a. FreeIn a => a -> FV
freeIn' Exp
e