{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
module Copilot.Compile.Bluespec.Compile
( compile
, compileWith
) where
import Data.List (nub, union)
import Data.Maybe (catMaybes, maybeToList)
import Data.String (IsString (..))
import Data.Typeable (Typeable)
import qualified Language.Bluespec.Classic.AST as BS
import qualified Language.Bluespec.Classic.AST.Builtin.Ids as BS
import qualified Language.Bluespec.Classic.AST.Builtin.Types as BS
import Text.PrettyPrint.HughesPJClass (Pretty (..), render)
import System.Directory (createDirectoryIfMissing)
import System.Exit (exitFailure)
import System.FilePath ((</>))
import System.IO (hPutStrLn, stderr)
import Copilot.Core
import Copilot.Compile.Bluespec.CodeGen
import Copilot.Compile.Bluespec.External
import Copilot.Compile.Bluespec.Name
import Copilot.Compile.Bluespec.Settings
compileWith :: BluespecSettings -> String -> Spec -> IO ()
compileWith :: BluespecSettings -> [Char] -> Spec -> IO ()
compileWith BluespecSettings
bsSettings [Char]
prefix Spec
spec
| [Trigger] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Spec -> [Trigger]
specTriggers Spec
spec)
= do Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char]
"Copilot error: attempt at compiling empty specification.\n"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"You must define at least one trigger to generate Bluespec monitors."
IO ()
forall a. IO a
exitFailure
| Bool
otherwise
= do let typesBsFile :: [Char]
typesBsFile = Doc -> [Char]
render (Doc -> [Char]) -> Doc -> [Char]
forall a b. (a -> b) -> a -> b
$ CPackage -> Doc
forall a. Pretty a => a -> Doc
pPrint (CPackage -> Doc) -> CPackage -> Doc
forall a b. (a -> b) -> a -> b
$ BluespecSettings -> [Char] -> Spec -> CPackage
compileTypesBS BluespecSettings
bsSettings [Char]
prefix Spec
spec
ifcBsFile :: [Char]
ifcBsFile = Doc -> [Char]
render (Doc -> [Char]) -> Doc -> [Char]
forall a b. (a -> b) -> a -> b
$ CPackage -> Doc
forall a. Pretty a => a -> Doc
pPrint (CPackage -> Doc) -> CPackage -> Doc
forall a b. (a -> b) -> a -> b
$ BluespecSettings -> [Char] -> Spec -> CPackage
compileIfcBS BluespecSettings
bsSettings [Char]
prefix Spec
spec
bsFile :: [Char]
bsFile = Doc -> [Char]
render (Doc -> [Char]) -> Doc -> [Char]
forall a b. (a -> b) -> a -> b
$ CPackage -> Doc
forall a. Pretty a => a -> Doc
pPrint (CPackage -> Doc) -> CPackage -> Doc
forall a b. (a -> b) -> a -> b
$ BluespecSettings -> [Char] -> Spec -> CPackage
compileBS BluespecSettings
bsSettings [Char]
prefix Spec
spec
let dir :: [Char]
dir = BluespecSettings -> [Char]
bluespecSettingsOutputDirectory BluespecSettings
bsSettings
Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
dir
[Char] -> [Char] -> IO ()
writeFile ([Char]
dir [Char] -> [Char] -> [Char]
</> [Char] -> [Char]
specTypesPkgName [Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".bs") [Char]
typesBsFile
[Char] -> [Char] -> IO ()
writeFile ([Char]
dir [Char] -> [Char] -> [Char]
</> [Char] -> [Char]
specIfcPkgName [Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".bs") [Char]
ifcBsFile
[Char] -> [Char] -> IO ()
writeFile ([Char]
dir [Char] -> [Char] -> [Char]
</> [Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".bs") [Char]
bsFile
compile :: String -> Spec -> IO ()
compile :: [Char] -> Spec -> IO ()
compile = BluespecSettings -> [Char] -> Spec -> IO ()
compileWith BluespecSettings
mkDefaultBluespecSettings
compileBS :: BluespecSettings -> String -> Spec -> BS.CPackage
compileBS :: BluespecSettings -> [Char] -> Spec -> CPackage
compileBS BluespecSettings
_bsSettings [Char]
prefix Spec
spec =
Id
-> Either [CExport] [CExport]
-> [CImport]
-> [CFixity]
-> [CDefn]
-> [CInclude]
-> CPackage
BS.CPackage
(Position -> FString -> Id
BS.mkId Position
BS.NoPos ([Char] -> FString
forall a. IsString a => [Char] -> a
fromString [Char]
prefix))
([CExport] -> Either [CExport] [CExport]
forall a b. b -> Either a b
Right [])
([CImport]
stdLibImports [CImport] -> [CImport] -> [CImport]
forall a. [a] -> [a] -> [a]
++ [CImport]
genImports)
[]
[CDefn
moduleDef]
[]
where
genImports :: [BS.CImport]
genImports :: [CImport]
genImports =
[ Bool -> Id -> CImport
BS.CImpId Bool
False (Id -> CImport) -> Id -> CImport
forall a b. (a -> b) -> a -> b
$ Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ [Char] -> FString
forall a. IsString a => [Char] -> a
fromString
([Char] -> FString) -> [Char] -> FString
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
specTypesPkgName [Char]
prefix
, Bool -> Id -> CImport
BS.CImpId Bool
False (Id -> CImport) -> Id -> CImport
forall a b. (a -> b) -> a -> b
$ Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ [Char] -> FString
forall a. IsString a => [Char] -> a
fromString
([Char] -> FString) -> [Char] -> FString
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
specIfcPkgName [Char]
prefix
]
moduleDef :: BS.CDefn
moduleDef :: CDefn
moduleDef = CDef -> CDefn
BS.CValueSign (CDef -> CDefn) -> CDef -> CDefn
forall a b. (a -> b) -> a -> b
$
Id -> CQType -> [CClause] -> CDef
BS.CDef
(Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ [Char] -> FString
forall a. IsString a => [Char] -> a
fromString ([Char] -> FString) -> [Char] -> FString
forall a b. (a -> b) -> a -> b
$ [Char]
"mk" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
prefix)
([CPred] -> CType -> CQType
BS.CQType
[]
(CType
BS.tArrow
CType -> CType -> CType
`BS.TAp` (CType
BS.tModule CType -> CType -> CType
`BS.TAp` CType
ifcTy)
CType -> CType -> CType
`BS.TAp` (CType
BS.tModule CType -> CType -> CType
`BS.TAp` CType
emptyTy)))
[ [CPat] -> [CQual] -> CExpr -> CClause
BS.CClause [Id -> CPat
BS.CPVar Id
ifcModId] [] (CExpr -> CClause) -> CExpr -> CClause
forall a b. (a -> b) -> a -> b
$
Position -> [CMStmt] -> CExpr
BS.Cmodule Position
BS.NoPos ([CMStmt] -> CExpr) -> [CMStmt] -> CExpr
forall a b. (a -> b) -> a -> b
$
CStmt -> CMStmt
BS.CMStmt
(CPat -> Maybe CExpr -> [(Position, PProp)] -> CExpr -> CStmt
BS.CSBind (Id -> CPat
BS.CPVar Id
ifcArgId) Maybe CExpr
forall a. Maybe a
Nothing [] (Id -> CExpr
BS.CVar Id
ifcModId))
CMStmt -> [CMStmt] -> [CMStmt]
forall a. a -> [a] -> [a]
: (CStmt -> CMStmt) -> [CStmt] -> [CMStmt]
forall a b. (a -> b) -> [a] -> [b]
map CStmt -> CMStmt
BS.CMStmt [CStmt]
mkGlobals [CMStmt] -> [CMStmt] -> [CMStmt]
forall a. [a] -> [a] -> [a]
++
[ CStmt -> CMStmt
BS.CMStmt (CStmt -> CMStmt) -> CStmt -> CMStmt
forall a b. (a -> b) -> a -> b
$ [CDefl] -> CStmt
BS.CSletrec [CDefl]
genFuns
, CExpr -> CMStmt
BS.CMrules (CExpr -> CMStmt) -> CExpr -> CMStmt
forall a b. (a -> b) -> a -> b
$ [CSchedulePragma] -> [CRule] -> CExpr
BS.Crules [] [CRule]
rules
]
]
ifcArgId :: Id
ifcArgId = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ [Char] -> FString
forall a. IsString a => [Char] -> a
fromString [Char]
ifcArgName
ifcModId :: Id
ifcModId = Position -> FString -> Id
BS.mkId Position
BS.NoPos FString
"ifcMod"
rules :: [BS.CRule]
rules :: [CRule]
rules = (Trigger -> CRule) -> [Trigger] -> [CRule]
forall a b. (a -> b) -> [a] -> [b]
map Trigger -> CRule
mkTriggerRule [Trigger]
triggers [CRule] -> [CRule] -> [CRule]
forall a. [a] -> [a] -> [a]
++ Maybe CRule -> [CRule]
forall a. Maybe a -> [a]
maybeToList ([Stream] -> Maybe CRule
mkStepRule [Stream]
streams)
streams :: [Stream]
streams = Spec -> [Stream]
specStreams Spec
spec
triggers :: [Trigger]
triggers = Spec -> [Trigger]
specTriggers Spec
spec
exts :: [External]
exts = [Stream] -> [Trigger] -> [External]
gatherExts [Stream]
streams [Trigger]
triggers
ifcId :: Id
ifcId = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ [Char] -> FString
forall a. IsString a => [Char] -> a
fromString ([Char] -> FString) -> [Char] -> FString
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
specIfcName [Char]
prefix
ifcFields :: [CField]
ifcFields = [Trigger] -> [External] -> [CField]
mkSpecIfcFields [Trigger]
triggers [External]
exts
ifcTy :: CType
ifcTy = TyCon -> CType
BS.TCon (BS.TyCon
{ tcon_name :: Id
BS.tcon_name = Id
ifcId
, tcon_kind :: Maybe Kind
BS.tcon_kind = Kind -> Maybe Kind
forall a. a -> Maybe a
Just Kind
BS.KStar
, tcon_sort :: TISort
BS.tcon_sort = StructSubType -> [Id] -> TISort
BS.TIstruct
([IfcPragma] -> StructSubType
BS.SInterface [])
((CField -> Id) -> [CField] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map CField -> Id
BS.cf_name [CField]
ifcFields)
})
emptyTy :: CType
emptyTy = TyCon -> CType
BS.TCon (BS.TyCon
{ tcon_name :: Id
BS.tcon_name = Id
BS.idEmpty
, tcon_kind :: Maybe Kind
BS.tcon_kind = Kind -> Maybe Kind
forall a. a -> Maybe a
Just Kind
BS.KStar
, tcon_sort :: TISort
BS.tcon_sort = StructSubType -> [Id] -> TISort
BS.TIstruct ([IfcPragma] -> StructSubType
BS.SInterface []) []
})
mkGlobals :: [BS.CStmt]
mkGlobals :: [CStmt]
mkGlobals = (Stream -> [CStmt]) -> [Stream] -> [CStmt]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stream -> [CStmt]
buffDecln [Stream]
streams [CStmt] -> [CStmt] -> [CStmt]
forall a. [a] -> [a] -> [a]
++ (Stream -> CStmt) -> [Stream] -> [CStmt]
forall a b. (a -> b) -> [a] -> [b]
map Stream -> CStmt
indexDecln [Stream]
streams
where
buffDecln :: Stream -> [CStmt]
buffDecln (Stream Id
sId [a]
buff Expr a
_ Type a
ty) = Id -> Type a -> [a] -> [CStmt]
forall a. Id -> Type a -> [a] -> [CStmt]
mkBuffDecln Id
sId Type a
ty [a]
buff
indexDecln :: Stream -> CStmt
indexDecln (Stream Id
sId [a]
_ Expr a
_ Type a
_ ) = Id -> CStmt
mkIndexDecln Id
sId
genFuns :: [BS.CDefl]
genFuns :: [CDefl]
genFuns = (Stream -> CDefl) -> [Stream] -> [CDefl]
forall a b. (a -> b) -> [a] -> [b]
map Stream -> CDefl
accessDecln [Stream]
streams
[CDefl] -> [CDefl] -> [CDefl]
forall a. [a] -> [a] -> [a]
++ (Stream -> CDefl) -> [Stream] -> [CDefl]
forall a b. (a -> b) -> [a] -> [b]
map Stream -> CDefl
streamGen [Stream]
streams
[CDefl] -> [CDefl] -> [CDefl]
forall a. [a] -> [a] -> [a]
++ (Trigger -> [CDefl]) -> [Trigger] -> [CDefl]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Trigger -> [CDefl]
triggerGen [Trigger]
triggers
where
accessDecln :: Stream -> BS.CDefl
accessDecln :: Stream -> CDefl
accessDecln (Stream Id
sId [a]
buff Expr a
_ Type a
ty) = Id -> Type a -> [a] -> CDefl
forall a. Id -> Type a -> [a] -> CDefl
mkAccessDecln Id
sId Type a
ty [a]
buff
streamGen :: Stream -> BS.CDefl
streamGen :: Stream -> CDefl
streamGen (Stream Id
sId [a]
_ Expr a
expr Type a
ty) = [Char] -> Expr a -> Type a -> CDefl
forall a. [Char] -> Expr a -> Type a -> CDefl
mkGenFun (Id -> [Char]
generatorName Id
sId) Expr a
expr Type a
ty
triggerGen :: Trigger -> [BS.CDefl]
triggerGen :: Trigger -> [CDefl]
triggerGen (Trigger [Char]
name Expr Bool
guard [UExpr]
args) = CDefl
guardDef CDefl -> [CDefl] -> [CDefl]
forall a. a -> [a] -> [a]
: [CDefl]
argDefs
where
guardDef :: CDefl
guardDef = [Char] -> Expr Bool -> Type Bool -> CDefl
forall a. [Char] -> Expr a -> Type a -> CDefl
mkGenFun ([Char] -> [Char]
guardName [Char]
name) Expr Bool
guard Type Bool
Bool
argDefs :: [CDefl]
argDefs = (([Char], UExpr) -> CDefl) -> [([Char], UExpr)] -> [CDefl]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], UExpr) -> CDefl
argGen ([[Char]] -> [UExpr] -> [([Char], UExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Char] -> [[Char]]
argNames [Char]
name) [UExpr]
args)
argGen :: (String, UExpr) -> BS.CDefl
argGen :: ([Char], UExpr) -> CDefl
argGen ([Char]
argName, UExpr Type a
ty Expr a
expr) = [Char] -> Expr a -> Type a -> CDefl
forall a. [Char] -> Expr a -> Type a -> CDefl
mkGenFun [Char]
argName Expr a
expr Type a
ty
compileIfcBS :: BluespecSettings -> String -> Spec -> BS.CPackage
compileIfcBS :: BluespecSettings -> [Char] -> Spec -> CPackage
compileIfcBS BluespecSettings
_bsSettings [Char]
prefix Spec
spec =
Id
-> Either [CExport] [CExport]
-> [CImport]
-> [CFixity]
-> [CDefn]
-> [CInclude]
-> CPackage
BS.CPackage
Id
ifcPkgId
([CExport] -> Either [CExport] [CExport]
forall a b. b -> Either a b
Right [])
([CImport]
stdLibImports [CImport] -> [CImport] -> [CImport]
forall a. [a] -> [a] -> [a]
++ [CImport]
genImports)
[]
[CDefn
ifcDef]
[]
where
genImports :: [BS.CImport]
genImports :: [CImport]
genImports =
[ Bool -> Id -> CImport
BS.CImpId Bool
False (Id -> CImport) -> Id -> CImport
forall a b. (a -> b) -> a -> b
$ Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ [Char] -> FString
forall a. IsString a => [Char] -> a
fromString
([Char] -> FString) -> [Char] -> FString
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
specTypesPkgName [Char]
prefix
]
ifcId :: Id
ifcId = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ [Char] -> FString
forall a. IsString a => [Char] -> a
fromString ([Char] -> FString) -> [Char] -> FString
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
specIfcName [Char]
prefix
ifcPkgId :: Id
ifcPkgId = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ [Char] -> FString
forall a. IsString a => [Char] -> a
fromString ([Char] -> FString) -> [Char] -> FString
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
specIfcPkgName [Char]
prefix
ifcFields :: [CField]
ifcFields = [Trigger] -> [External] -> [CField]
mkSpecIfcFields [Trigger]
triggers [External]
exts
streams :: [Stream]
streams = Spec -> [Stream]
specStreams Spec
spec
triggers :: [Trigger]
triggers = Spec -> [Trigger]
specTriggers Spec
spec
exts :: [External]
exts = [Stream] -> [Trigger] -> [External]
gatherExts [Stream]
streams [Trigger]
triggers
ifcDef :: BS.CDefn
ifcDef :: CDefn
ifcDef = Bool
-> StructSubType
-> IdK
-> [Id]
-> [CField]
-> [CTypeclass]
-> CDefn
BS.Cstruct
Bool
True
([IfcPragma] -> StructSubType
BS.SInterface [])
(Id -> IdK
BS.IdK Id
ifcId)
[]
[CField]
ifcFields
[]
compileTypesBS :: BluespecSettings -> String -> Spec -> BS.CPackage
compileTypesBS :: BluespecSettings -> [Char] -> Spec -> CPackage
compileTypesBS BluespecSettings
_bsSettings [Char]
prefix Spec
spec =
Id
-> Either [CExport] [CExport]
-> [CImport]
-> [CFixity]
-> [CDefn]
-> [CInclude]
-> CPackage
BS.CPackage
Id
typesId
([CExport] -> Either [CExport] [CExport]
forall a b. b -> Either a b
Right [])
[CImport]
stdLibImports
[]
[CDefn]
structDefs
[]
where
typesId :: Id
typesId = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ [Char] -> FString
forall a. IsString a => [Char] -> a
fromString ([Char] -> FString) -> [Char] -> FString
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
specTypesPkgName [Char]
prefix
structDefs :: [CDefn]
structDefs = [UExpr] -> [CDefn]
mkTypeDeclns [UExpr]
exprs
exprs :: [UExpr]
exprs = [Stream] -> [Trigger] -> [UExpr]
gatherExprs [Stream]
streams [Trigger]
triggers
streams :: [Stream]
streams = Spec -> [Stream]
specStreams Spec
spec
triggers :: [Trigger]
triggers = Spec -> [Trigger]
specTriggers Spec
spec
mkTypeDeclns :: [UExpr] -> [BS.CDefn]
mkTypeDeclns :: [UExpr] -> [CDefn]
mkTypeDeclns [UExpr]
es = [Maybe CDefn] -> [CDefn]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe CDefn] -> [CDefn]) -> [Maybe CDefn] -> [CDefn]
forall a b. (a -> b) -> a -> b
$ (UType -> Maybe CDefn) -> [UType] -> [Maybe CDefn]
forall a b. (a -> b) -> [a] -> [b]
map UType -> Maybe CDefn
mkTypeDecln [UType]
uTypes
where
uTypes :: [UType]
uTypes = [UType] -> [UType]
forall a. Eq a => [a] -> [a]
nub ([UType] -> [UType]) -> [UType] -> [UType]
forall a b. (a -> b) -> a -> b
$ (UExpr -> [UType]) -> [UExpr] -> [UType]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(UExpr Type a
_ Expr a
e) -> Expr a -> [UType]
forall a. Typeable a => Expr a -> [UType]
exprTypes Expr a
e) [UExpr]
es
mkTypeDecln :: UType -> Maybe CDefn
mkTypeDecln (UType Type a
ty) = case Type a
ty of
Struct a
x -> CDefn -> Maybe CDefn
forall a. a -> Maybe a
Just (CDefn -> Maybe CDefn) -> CDefn -> Maybe CDefn
forall a b. (a -> b) -> a -> b
$ a -> CDefn
forall a. Struct a => a -> CDefn
mkStructDecln a
x
Type a
_ -> Maybe CDefn
forall a. Maybe a
Nothing
stdLibImports :: [BS.CImport]
stdLibImports :: [CImport]
stdLibImports =
[ Bool -> Id -> CImport
BS.CImpId Bool
False (Id -> CImport) -> Id -> CImport
forall a b. (a -> b) -> a -> b
$ Position -> FString -> Id
BS.mkId Position
BS.NoPos FString
"FloatingPoint"
, Bool -> Id -> CImport
BS.CImpId Bool
False (Id -> CImport) -> Id -> CImport
forall a b. (a -> b) -> a -> b
$ Position -> FString -> Id
BS.mkId Position
BS.NoPos FString
"Vector"
]
exprTypes :: Typeable a => Expr a -> [UType]
exprTypes :: forall a. Typeable a => Expr a -> [UType]
exprTypes Expr a
e = case Expr a
e of
Const Type a
ty a
_ -> Type a -> [UType]
forall a. Typeable a => Type a -> [UType]
typeTypes Type a
ty
Local Type a1
ty1 Type a
ty2 [Char]
_ Expr a1
e1 Expr a
e2 -> Type a1 -> [UType]
forall a. Typeable a => Type a -> [UType]
typeTypes Type a1
ty1 [UType] -> [UType] -> [UType]
forall a. Eq a => [a] -> [a] -> [a]
`union` Type a -> [UType]
forall a. Typeable a => Type a -> [UType]
typeTypes Type a
ty2
[UType] -> [UType] -> [UType]
forall a. Eq a => [a] -> [a] -> [a]
`union` Expr a1 -> [UType]
forall a. Typeable a => Expr a -> [UType]
exprTypes Expr a1
e1 [UType] -> [UType] -> [UType]
forall a. Eq a => [a] -> [a] -> [a]
`union` Expr a -> [UType]
forall a. Typeable a => Expr a -> [UType]
exprTypes Expr a
e2
Var Type a
ty [Char]
_ -> Type a -> [UType]
forall a. Typeable a => Type a -> [UType]
typeTypes Type a
ty
Drop Type a
ty DropIdx
_ Id
_ -> Type a -> [UType]
forall a. Typeable a => Type a -> [UType]
typeTypes Type a
ty
ExternVar Type a
ty [Char]
_ Maybe [a]
_ -> Type a -> [UType]
forall a. Typeable a => Type a -> [UType]
typeTypes Type a
ty
Op1 Op1 a1 a
_ Expr a1
e1 -> Expr a1 -> [UType]
forall a. Typeable a => Expr a -> [UType]
exprTypes Expr a1
e1
Op2 Op2 a1 b a
_ Expr a1
e1 Expr b
e2 -> Expr a1 -> [UType]
forall a. Typeable a => Expr a -> [UType]
exprTypes Expr a1
e1 [UType] -> [UType] -> [UType]
forall a. Eq a => [a] -> [a] -> [a]
`union` Expr b -> [UType]
forall a. Typeable a => Expr a -> [UType]
exprTypes Expr b
e2
Op3 Op3 a1 b c a
_ Expr a1
e1 Expr b
e2 Expr c
e3 -> Expr a1 -> [UType]
forall a. Typeable a => Expr a -> [UType]
exprTypes Expr a1
e1 [UType] -> [UType] -> [UType]
forall a. Eq a => [a] -> [a] -> [a]
`union` Expr b -> [UType]
forall a. Typeable a => Expr a -> [UType]
exprTypes Expr b
e2
[UType] -> [UType] -> [UType]
forall a. Eq a => [a] -> [a] -> [a]
`union` Expr c -> [UType]
forall a. Typeable a => Expr a -> [UType]
exprTypes Expr c
e3
Label Type a
ty [Char]
_ Expr a
_ -> Type a -> [UType]
forall a. Typeable a => Type a -> [UType]
typeTypes Type a
ty
typeTypes :: Typeable a => Type a -> [UType]
typeTypes :: forall a. Typeable a => Type a -> [UType]
typeTypes Type a
ty = case Type a
ty of
Array Type t
ty' -> Type t -> [UType]
forall a. Typeable a => Type a -> [UType]
typeTypes Type t
ty' [UType] -> [UType] -> [UType]
forall a. Eq a => [a] -> [a] -> [a]
`union` [Type a -> UType
forall a. Typeable a => Type a -> UType
UType Type a
ty]
Struct a
x -> (Value a -> [UType]) -> [Value a] -> [UType]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Value Type t
ty' Field s t
_) -> Type t -> [UType]
forall a. Typeable a => Type a -> [UType]
typeTypes Type t
ty') (a -> [Value a]
forall a. Struct a => a -> [Value a]
toValues a
x)
[UType] -> [UType] -> [UType]
forall a. Eq a => [a] -> [a] -> [a]
`union` [Type a -> UType
forall a. Typeable a => Type a -> UType
UType Type a
ty]
Type a
_ -> [Type a -> UType
forall a. Typeable a => Type a -> UType
UType Type a
ty]
gatherExprs :: [Stream] -> [Trigger] -> [UExpr]
gatherExprs :: [Stream] -> [Trigger] -> [UExpr]
gatherExprs [Stream]
streams [Trigger]
triggers = (Stream -> UExpr) -> [Stream] -> [UExpr]
forall a b. (a -> b) -> [a] -> [b]
map Stream -> UExpr
streamUExpr [Stream]
streams
[UExpr] -> [UExpr] -> [UExpr]
forall a. [a] -> [a] -> [a]
++ (Trigger -> [UExpr]) -> [Trigger] -> [UExpr]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Trigger -> [UExpr]
triggerUExpr [Trigger]
triggers
where
streamUExpr :: Stream -> UExpr
streamUExpr (Stream Id
_ [a]
_ Expr a
expr Type a
ty) = Type a -> Expr a -> UExpr
forall a. Typeable a => Type a -> Expr a -> UExpr
UExpr Type a
ty Expr a
expr
triggerUExpr :: Trigger -> [UExpr]
triggerUExpr (Trigger [Char]
_ Expr Bool
guard [UExpr]
args) = Type Bool -> Expr Bool -> UExpr
forall a. Typeable a => Type a -> Expr a -> UExpr
UExpr Type Bool
Bool Expr Bool
guard UExpr -> [UExpr] -> [UExpr]
forall a. a -> [a] -> [a]
: [UExpr]
args