{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | High-level translation of Copilot Core into C99.
module Copilot.Compile.C99.CodeGen where

import           Control.Monad.State (runState)
import           Data.List           (union, unzip4)
import qualified Data.List.NonEmpty  as NonEmpty
import           Data.Typeable       (Typeable)

import qualified Language.C99.Simple as C

import Copilot.Core
import Copilot.Compile.C99.Util
import Copilot.Compile.C99.External
import Copilot.Compile.C99.Settings
import Copilot.Compile.C99.Translate

-- | Write a declaration for a generator function.
gendecln :: String -> Type a -> C.Decln
gendecln :: forall a. String -> Type a -> Decln
gendecln String
name Type a
ty = Maybe StorageSpec -> Type -> String -> [Param] -> Decln
C.FunDecln forall a. Maybe a
Nothing Type
cty String
name []
  where
    cty :: Type
cty = Type -> Type
C.decay forall a b. (a -> b) -> a -> b
$ forall a. Type a -> Type
transtype Type a
ty

-- | Write a generator function for a stream.
genfun :: String -> Expr a -> Type a -> C.FunDef
genfun :: forall a. String -> Expr a -> Type a -> FunDef
genfun String
name Expr a
expr Type a
ty = Type -> String -> [Param] -> FunEnv -> [Stmt] -> FunDef
C.FunDef Type
cty String
name [] FunEnv
cvars [Maybe Expr -> Stmt
C.Return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Expr
cexpr]
  where
    cty :: Type
cty = Type -> Type
C.decay forall a b. (a -> b) -> a -> b
$ forall a. Type a -> Type
transtype Type a
ty
    (Expr
cexpr, FunEnv
cvars) = forall s a. State s a -> s -> (a, s)
runState (forall a. Expr a -> State FunEnv Expr
transexpr Expr a
expr) forall a. Monoid a => a
mempty

-- | Make a extern declaration of a variable.
mkextdecln :: External -> C.Decln
mkextdecln :: External -> Decln
mkextdecln (External String
name String
_ Type a
ty) = Decln
decln
  where
    decln :: Decln
decln = Maybe StorageSpec -> Type -> String -> Maybe Init -> Decln
C.VarDecln (forall a. a -> Maybe a
Just StorageSpec
C.Extern) Type
cty String
name forall a. Maybe a
Nothing
    cty :: Type
cty   = forall a. Type a -> Type
transtype Type a
ty

-- | Make a declaration for a copy of an external variable.
mkextcpydecln :: External -> C.Decln
mkextcpydecln :: External -> Decln
mkextcpydecln (External String
name String
cpyname Type a
ty) = Decln
decln
  where
    cty :: Type
cty   = forall a. Type a -> Type
transtype Type a
ty
    decln :: Decln
decln = Maybe StorageSpec -> Type -> String -> Maybe Init -> Decln
C.VarDecln (forall a. a -> Maybe a
Just StorageSpec
C.Static) Type
cty String
cpyname forall a. Maybe a
Nothing

-- | Make a C buffer variable and initialise it with the stream buffer.
mkbuffdecln :: Id -> Type a -> [a] -> C.Decln
mkbuffdecln :: forall a. Id -> Type a -> [a] -> Decln
mkbuffdecln Id
sid Type a
ty [a]
xs = Maybe StorageSpec -> Type -> String -> Maybe Init -> Decln
C.VarDecln (forall a. a -> Maybe a
Just StorageSpec
C.Static) Type
cty String
name Maybe Init
initvals
  where
    name :: String
name     = Id -> String
streamname Id
sid
    cty :: Type
cty      = Type -> Maybe Expr -> Type
C.Array (forall a. Type a -> Type
transtype Type a
ty) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Integer -> Expr
C.LitInt forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Id
buffsize)
    buffsize :: Id
buffsize = forall (t :: * -> *) a. Foldable t => t a -> Id
length [a]
xs
    initvals :: Maybe Init
initvals = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ NonEmpty InitItem -> Init
C.InitList forall a b. (a -> b) -> a -> b
$ forall a. Type a -> [a] -> NonEmpty InitItem
constarray Type a
ty [a]
xs

-- | Make a C index variable and initialise it to 0.
mkindexdecln :: Id -> C.Decln
mkindexdecln :: Id -> Decln
mkindexdecln Id
sid = Maybe StorageSpec -> Type -> String -> Maybe Init -> Decln
C.VarDecln (forall a. a -> Maybe a
Just StorageSpec
C.Static) Type
cty String
name Maybe Init
initval
  where
    name :: String
name    = Id -> String
indexname Id
sid
    cty :: Type
cty     = TypeSpec -> Type
C.TypeSpec forall a b. (a -> b) -> a -> b
$ String -> TypeSpec
C.TypedefName String
"size_t"
    initval :: Maybe Init
initval = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Expr -> Init
C.InitExpr forall a b. (a -> b) -> a -> b
$ Integer -> Expr
C.LitInt Integer
0

-- | Define an accessor functions for the ring buffer associated with a stream
mkaccessdecln :: Id -> Type a -> [a] -> C.FunDef
mkaccessdecln :: forall a. Id -> Type a -> [a] -> FunDef
mkaccessdecln Id
sid Type a
ty [a]
xs = Type -> String -> [Param] -> FunEnv -> [Stmt] -> FunDef
C.FunDef Type
cty String
name [Param]
params [] [Maybe Expr -> Stmt
C.Return (forall a. a -> Maybe a
Just Expr
expr)]
  where
    cty :: Type
cty        = Type -> Type
C.decay forall a b. (a -> b) -> a -> b
$ forall a. Type a -> Type
transtype Type a
ty
    name :: String
name       = Id -> String
streamaccessorname Id
sid
    bufflength :: Expr
bufflength = Integer -> Expr
C.LitInt forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Id
length [a]
xs
    params :: [Param]
params     = [Type -> String -> Param
C.Param (TypeSpec -> Type
C.TypeSpec forall a b. (a -> b) -> a -> b
$ String -> TypeSpec
C.TypedefName String
"size_t") String
"x"]
    index :: Expr
index      = (String -> Expr
C.Ident (Id -> String
indexname Id
sid) Expr -> Expr -> Expr
C..+ String -> Expr
C.Ident String
"x") Expr -> Expr -> Expr
C..% Expr
bufflength
    expr :: Expr
expr       = Expr -> Expr -> Expr
C.Index (String -> Expr
C.Ident (Id -> String
streamname Id
sid)) Expr
index

-- | Writes the step function, that updates all streams.
mkstep :: CSettings -> [Stream] -> [Trigger] -> [External] -> C.FunDef
mkstep :: CSettings -> [Stream] -> [Trigger] -> [External] -> FunDef
mkstep CSettings
cSettings [Stream]
streams [Trigger]
triggers [External]
exts =
    Type -> String -> [Param] -> FunEnv -> [Stmt] -> FunDef
C.FunDef Type
void (CSettings -> String
cSettingsStepFunctionName CSettings
cSettings) [] FunEnv
declns [Stmt]
stmts
  where

    void :: Type
void = TypeSpec -> Type
C.TypeSpec TypeSpec
C.Void
    stmts :: [Stmt]
stmts  =  forall a b. (a -> b) -> [a] -> [b]
map External -> Stmt
mkexcopy [External]
exts
           forall a. [a] -> [a] -> [a]
++ [Stmt]
triggerStmts
           forall a. [a] -> [a] -> [a]
++ [Stmt]
tmpassigns
           forall a. [a] -> [a] -> [a]
++ [Stmt]
bufferupdates
           forall a. [a] -> [a] -> [a]
++ [Stmt]
indexupdates
    declns :: FunEnv
declns =  FunEnv
streamDeclns
           forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [FunEnv]
triggerDeclns
    (FunEnv
streamDeclns, [Stmt]
tmpassigns, [Stmt]
bufferupdates, [Stmt]
indexupdates) =
      forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Stream -> (Decln, Stmt, Stmt, Stmt)
mkupdateglobals [Stream]
streams
    ([FunEnv]
triggerDeclns, [Stmt]
triggerStmts) =
      forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Trigger -> (FunEnv, Stmt)
mktriggercheck [Trigger]
triggers

    -- Write code to update global stream buffers and index.
    mkupdateglobals :: Stream -> (C.Decln, C.Stmt, C.Stmt, C.Stmt)
    mkupdateglobals :: Stream -> (Decln, Stmt, Stmt, Stmt)
mkupdateglobals (Stream Id
sid [a]
buff Expr a
expr Type a
ty) =
      (Decln
tmpdecln, Stmt
tmpassign, Stmt
bufferupdate, Stmt
indexupdate)
        where
          tmpdecln :: Decln
tmpdecln = Maybe StorageSpec -> Type -> String -> Maybe Init -> Decln
C.VarDecln forall a. Maybe a
Nothing Type
cty String
tmp_var forall a. Maybe a
Nothing

          tmpassign :: Stmt
tmpassign = case Type a
ty of
            Array Type t
_ -> Expr -> Stmt
C.Expr forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr -> Expr
memcpy (String -> Expr
C.Ident String
tmp_var) Expr
val Expr
size
              where
                size :: Expr
size = Integer -> Expr
C.LitInt (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) t. KnownNat n => Type (Array n t) -> Id
tysize Type a
ty)
                        Expr -> Expr -> Expr
C..* TypeName -> Expr
C.SizeOfType (Type -> TypeName
C.TypeName (forall a. Type a -> Type
tyElemName Type a
ty))
            Type a
_       -> Expr -> Stmt
C.Expr forall a b. (a -> b) -> a -> b
$ String -> Expr
C.Ident String
tmp_var Expr -> Expr -> Expr
C..= Expr
val

          bufferupdate :: Stmt
bufferupdate = case Type a
ty of
            Array Type t
_ -> Expr -> Stmt
C.Expr forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr -> Expr
memcpy Expr
dest (String -> Expr
C.Ident String
tmp_var) Expr
size
              where
                dest :: Expr
dest = Expr -> Expr -> Expr
C.Index Expr
buff_var Expr
index_var
                size :: Expr
size = Integer -> Expr
C.LitInt (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) t. KnownNat n => Type (Array n t) -> Id
tysize Type a
ty)
                         Expr -> Expr -> Expr
C..* TypeName -> Expr
C.SizeOfType (Type -> TypeName
C.TypeName (forall a. Type a -> Type
tyElemName Type a
ty))
            Type a
_       -> Expr -> Stmt
C.Expr forall a b. (a -> b) -> a -> b
$
                           Expr -> Expr -> Expr
C.Index Expr
buff_var Expr
index_var Expr -> Expr -> Expr
C..= (String -> Expr
C.Ident String
tmp_var)

          indexupdate :: Stmt
indexupdate = Expr -> Stmt
C.Expr forall a b. (a -> b) -> a -> b
$ Expr
index_var Expr -> Expr -> Expr
C..= (Expr
incindex Expr -> Expr -> Expr
C..% Expr
bufflength)
            where
              bufflength :: Expr
bufflength = Integer -> Expr
C.LitInt forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Id
length [a]
buff
              incindex :: Expr
incindex   = Expr
index_var Expr -> Expr -> Expr
C..+ Integer -> Expr
C.LitInt Integer
1

          tmp_var :: String
tmp_var   = Id -> String
streamname Id
sid forall a. [a] -> [a] -> [a]
++ String
"_tmp"
          buff_var :: Expr
buff_var  = String -> Expr
C.Ident forall a b. (a -> b) -> a -> b
$ Id -> String
streamname Id
sid
          index_var :: Expr
index_var = String -> Expr
C.Ident forall a b. (a -> b) -> a -> b
$ Id -> String
indexname Id
sid
          val :: Expr
val       = Expr -> [Expr] -> Expr
C.Funcall (String -> Expr
C.Ident forall a b. (a -> b) -> a -> b
$ Id -> String
generatorname Id
sid) []
          cty :: Type
cty       = forall a. Type a -> Type
transtype Type a
ty

    -- Make code that copies an external variable to its local one.
    mkexcopy :: External -> C.Stmt
    mkexcopy :: External -> Stmt
mkexcopy (External String
name String
cpyname Type a
ty) = Expr -> Stmt
C.Expr forall a b. (a -> b) -> a -> b
$ case Type a
ty of
      Array Type t
_ -> Expr -> Expr -> Expr -> Expr
memcpy Expr
exvar Expr
locvar Expr
size
        where
          exvar :: Expr
exvar  = String -> Expr
C.Ident String
cpyname
          locvar :: Expr
locvar = String -> Expr
C.Ident String
name
          size :: Expr
size   = Integer -> Expr
C.LitInt (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) t. KnownNat n => Type (Array n t) -> Id
tysize Type a
ty)
                     Expr -> Expr -> Expr
C..* TypeName -> Expr
C.SizeOfType (Type -> TypeName
C.TypeName (forall a. Type a -> Type
tyElemName Type a
ty))

      Type a
_       -> String -> Expr
C.Ident String
cpyname Expr -> Expr -> Expr
C..= String -> Expr
C.Ident String
name

    -- Make if-statement to check the guard, call the handler if necessary.
    -- This returns two things:
    --
    -- * A list of Declns for temporary variables, one for each argument that
    --   the handler function accepts. For example, if a handler function takes
    --   three arguments, the list of Declns might look something like this:
    --
    --   @
    --   int8_t   handler_arg_temp0;
    --   int16_t  handler_arg_temp1;
    --   struct s handler_arg_temp2;
    --   @
    --
    -- * A Stmt representing the if-statement. Continuing the example above,
    --   the if-statement would look something like this:
    --
    --   @
    --   if (handler_guard()) {
    --     handler_arg_temp0 = handler_arg0();
    --     handler_arg_temp1 = handler_arg1();
    --     handler_arg_temp2 = handler_arg2();
    --     handler(handler_arg_temp0, handler_arg_temp1, &handler_arg_temp2);
    --   }
    --   @
    --
    -- We create temporary variables because:
    --
    -- 1. We want to pass structs by reference intead of by value. To this end,
    --    we use C's & operator to obtain a reference to a temporary variable
    --    of a struct type and pass that to the handler function.
    --
    -- 2. Assigning a struct to a temporary variable defensively ensures that
    --    any modifications that the handler called makes to the struct argument
    --    will not affect the internals of the monitoring code.
    mktriggercheck :: Trigger -> ([C.Decln], C.Stmt)
    mktriggercheck :: Trigger -> (FunEnv, Stmt)
mktriggercheck (Trigger String
name Expr Bool
guard [UExpr]
args) =
        (FunEnv
aTmpDeclns, Stmt
ifStmt)
      where
        aTmpDeclns :: FunEnv
aTmpDeclns = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\String
tmpVar UExpr
arg ->
                               Maybe StorageSpec -> Type -> String -> Maybe Init -> Decln
C.VarDecln forall a. Maybe a
Nothing (UExpr -> Type
tempType UExpr
arg) String
tmpVar forall a. Maybe a
Nothing)
                             [String]
aTempNames
                             [UExpr]
args
          where
            tempType :: UExpr -> Type
tempType (UExpr { uExprType :: ()
uExprType = Type a
ty }) =
              case Type a
ty of
                -- If a temporary variable is being used to store an array,
                -- declare the type of the temporary variable as a pointer, not
                -- an array. The problem with declaring it as an array is that
                -- the `arg` function will return a pointer, not an array, and
                -- C doesn't make it easy to cast directly from an array to a
                -- pointer.
                Array Type t
ty' -> Type -> Type
C.Ptr forall a b. (a -> b) -> a -> b
$ forall a. Type a -> Type
transtype Type t
ty'
                Type a
_         -> forall a. Type a -> Type
transtype Type a
ty

        aTempNames :: [String]
aTempNames = forall a. Id -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Id
length [UExpr]
args) (String -> [String]
argTempNames String
name)

        ifStmt :: Stmt
ifStmt = Expr -> [Stmt] -> Stmt
C.If Expr
guard' [Stmt]
firetrigger

        guard' :: Expr
guard' = Expr -> [Expr] -> Expr
C.Funcall (String -> Expr
C.Ident forall a b. (a -> b) -> a -> b
$ String -> String
guardname String
name) []

        -- The body of the if-statement. This consists of statements that assign
        -- the values of the temporary variables, following by a final statement
        -- that passes the temporary variables to the handler function.
        firetrigger :: [Stmt]
firetrigger = forall a b. (a -> b) -> [a] -> [b]
map Expr -> Stmt
C.Expr [Expr]
argAssigns forall a. [a] -> [a] -> [a]
++
                      [Expr -> Stmt
C.Expr forall a b. (a -> b) -> a -> b
$ Expr -> [Expr] -> Expr
C.Funcall (String -> Expr
C.Ident String
name)
                                          (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> UExpr -> Expr
passArg [String]
aTempNames [UExpr]
args)]
          where
            passArg :: String -> UExpr -> Expr
passArg String
aTempName (UExpr { uExprType :: ()
uExprType = Type a
ty }) =
              case Type a
ty of
                -- Special case for Struct to pass reference to temporary
                -- struct variable to handler. (See the comments for
                -- mktriggercheck for details.)
                Struct a
_ -> UnaryOp -> Expr -> Expr
C.UnaryOp UnaryOp
C.Ref forall a b. (a -> b) -> a -> b
$ String -> Expr
C.Ident String
aTempName
                Type a
_        -> String -> Expr
C.Ident String
aTempName

            argAssigns :: [Expr]
argAssigns = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\String
aTempName Expr
arg ->
                                   AssignOp -> Expr -> Expr -> Expr
C.AssignOp AssignOp
C.Assign (String -> Expr
C.Ident String
aTempName) Expr
arg)
                                 [String]
aTempNames
                                 [Expr]
args'
            args' :: [Expr]
args'        = forall a. Id -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Id
length [UExpr]
args) (forall a b. (a -> b) -> [a] -> [b]
map String -> Expr
argcall (String -> [String]
argnames String
name))
            argcall :: String -> Expr
argcall String
name = Expr -> [Expr] -> Expr
C.Funcall (String -> Expr
C.Ident String
name) []

    -- Write a call to the memcpy function.
    memcpy :: C.Expr -> C.Expr -> C.Expr -> C.Expr
    memcpy :: Expr -> Expr -> Expr -> Expr
memcpy Expr
dest Expr
src Expr
size = Expr -> [Expr] -> Expr
C.Funcall (String -> Expr
C.Ident String
"memcpy") [Expr
dest, Expr
src, Expr
size]

    -- Translate a Copilot type to a C99 type, handling arrays especially.
    --
    -- If the given type is an array (including multi-dimensional arrays), the
    -- type is that of the elements in the array. Otherwise, it is just the
    -- equivalent representation of the given type in C.
    tyElemName :: Type a -> C.Type
    tyElemName :: forall a. Type a -> Type
tyElemName Type a
ty = case Type a
ty of
      Array Type t
ty' -> forall a. Type a -> Type
tyElemName Type t
ty'
      Type a
_         -> forall a. Type a -> Type
transtype Type a
ty

-- | Write a struct declaration based on its definition.
mkstructdecln :: Struct a => Type a -> C.Decln
mkstructdecln :: forall a. Struct a => Type a -> Decln
mkstructdecln (Struct a
x) = Type -> Decln
C.TypeDecln Type
struct
  where
    struct :: Type
struct = TypeSpec -> Type
C.TypeSpec forall a b. (a -> b) -> a -> b
$ Maybe String -> NonEmpty FieldDecln -> TypeSpec
C.StructDecln (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Struct a => a -> String
typename a
x) NonEmpty FieldDecln
fields
    fields :: NonEmpty FieldDecln
fields = forall a. [a] -> NonEmpty a
NonEmpty.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Value a -> FieldDecln
mkfield (forall a. Struct a => a -> [Value a]
toValues a
x)

    mkfield :: Value a -> C.FieldDecln
    mkfield :: forall a. Value a -> FieldDecln
mkfield (Value Type t
ty Field s t
field) = Type -> String -> FieldDecln
C.FieldDecln (forall a. Type a -> Type
transtype Type t
ty) (forall (s :: Symbol) t. KnownSymbol s => Field s t -> String
fieldname Field s t
field)

-- | Write a forward struct declaration.
mkstructforwdecln :: Struct a => Type a -> C.Decln
mkstructforwdecln :: forall a. Struct a => Type a -> Decln
mkstructforwdecln (Struct a
x) = Type -> Decln
C.TypeDecln Type
struct
  where
    struct :: Type
struct = TypeSpec -> Type
C.TypeSpec forall a b. (a -> b) -> a -> b
$ String -> TypeSpec
C.Struct (forall a. Struct a => a -> String
typename a
x)

-- | List all types of an expression, returns items uniquely.
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
_            -> forall a. Typeable a => Type a -> [UType]
typetypes Type a
ty
  Local Type a1
ty1 Type a
ty2 String
_ Expr a1
e1 Expr a
e2 -> forall a. Typeable a => Type a -> [UType]
typetypes Type a1
ty1 forall a. Eq a => [a] -> [a] -> [a]
`union` forall a. Typeable a => Type a -> [UType]
typetypes Type a
ty2
                           forall a. Eq a => [a] -> [a] -> [a]
`union` forall a. Typeable a => Expr a -> [UType]
exprtypes Expr a1
e1 forall a. Eq a => [a] -> [a] -> [a]
`union` forall a. Typeable a => Expr a -> [UType]
exprtypes Expr a
e2
  Var Type a
ty String
_              -> forall a. Typeable a => Type a -> [UType]
typetypes Type a
ty
  Drop Type a
ty DropIdx
_ Id
_           -> forall a. Typeable a => Type a -> [UType]
typetypes Type a
ty
  ExternVar Type a
ty String
_ Maybe [a]
_      -> forall a. Typeable a => Type a -> [UType]
typetypes Type a
ty
  Op1 Op1 a1 a
_ Expr a1
e1              -> forall a. Typeable a => Expr a -> [UType]
exprtypes Expr a1
e1
  Op2 Op2 a1 b a
_ Expr a1
e1 Expr b
e2           -> forall a. Typeable a => Expr a -> [UType]
exprtypes Expr a1
e1 forall a. Eq a => [a] -> [a] -> [a]
`union` 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        -> forall a. Typeable a => Expr a -> [UType]
exprtypes Expr a1
e1 forall a. Eq a => [a] -> [a] -> [a]
`union` forall a. Typeable a => Expr a -> [UType]
exprtypes Expr b
e2 forall a. Eq a => [a] -> [a] -> [a]
`union` forall a. Typeable a => Expr a -> [UType]
exprtypes Expr c
e3
  Label Type a
ty String
_ Expr a
_          -> forall a. Typeable a => Type a -> [UType]
typetypes Type a
ty

-- | List all types of a type, returns items uniquely.
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' -> forall a. Typeable a => Type a -> [UType]
typetypes Type t
ty' forall a. Eq a => [a] -> [a] -> [a]
`union` [forall a. Typeable a => Type a -> UType
UType Type a
ty]
  Struct a
x  -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Value Type t
ty' Field s t
_) -> forall a. Typeable a => Type a -> [UType]
typetypes Type t
ty') (forall a. Struct a => a -> [Value a]
toValues a
x) forall a. Eq a => [a] -> [a] -> [a]
`union` [forall a. Typeable a => Type a -> UType
UType Type a
ty]
  Type a
_         -> [forall a. Typeable a => Type a -> UType
UType Type a
ty]

-- | Collect all expression of a list of streams and triggers and wrap them
-- into an UEXpr.
gatherexprs :: [Stream] -> [Trigger] -> [UExpr]
gatherexprs :: [Stream] -> [Trigger] -> [UExpr]
gatherexprs [Stream]
streams [Trigger]
triggers =  forall a b. (a -> b) -> [a] -> [b]
map Stream -> UExpr
streamexpr [Stream]
streams
                             forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Trigger -> [UExpr]
triggerexpr [Trigger]
triggers
  where
    streamexpr :: Stream -> UExpr
streamexpr  (Stream Id
_ [a]
_ Expr a
expr Type a
ty)   = forall a. Typeable a => Type a -> Expr a -> UExpr
UExpr Type a
ty Expr a
expr
    triggerexpr :: Trigger -> [UExpr]
triggerexpr (Trigger String
_ Expr Bool
guard [UExpr]
args) = forall a. Typeable a => Type a -> Expr a -> UExpr
UExpr Type Bool
Bool Expr Bool
guard forall a. a -> [a] -> [a]
: [UExpr]
args