{-# LANGUAGE GADTs #-}
module Copilot.Compile.C99.CodeGen
(
mkExtCpyDecln
, mkExtDecln
, mkStructDecln
, mkStructForwDecln
, mkBuffDecln
, mkIndexDecln
, mkAccessDecln
, mkGenFun
, mkGenFunArray
, mkStep
)
where
import Control.Monad.State ( runState )
import Data.List ( unzip4 )
import qualified Data.List.NonEmpty as NonEmpty
import qualified Language.C99.Simple as C
import Copilot.Core ( Expr (..), Id, Stream (..), Struct (..), Trigger (..),
Type (..), UExpr (..), Value (..), fieldName, typeSize )
import Copilot.Compile.C99.Error ( impossible )
import Copilot.Compile.C99.Expr ( constArray, transExpr )
import Copilot.Compile.C99.External ( External (..) )
import Copilot.Compile.C99.Name ( argNames, argTempNames, generatorName,
guardName, indexName, streamAccessorName,
streamName )
import Copilot.Compile.C99.Settings ( CSettings, cSettingsStepFunctionName )
import Copilot.Compile.C99.Type ( transType )
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
mkExtCpyDecln :: External -> C.Decln
mkExtCpyDecln :: External -> Decln
mkExtCpyDecln (External String
_name String
cpyName 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.Static) Type
cTy String
cpyName forall a. Maybe a
Nothing
cTy :: Type
cTy = forall a. Type a -> Type
transType Type a
ty
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)
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)
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
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
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] -> [Decln] -> [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
mkGenFun :: String -> Expr a -> Type a -> C.FunDef
mkGenFun :: forall a. String -> Expr a -> Type a -> FunDef
mkGenFun String
name Expr a
expr Type a
ty = Type -> String -> [Param] -> [Decln] -> [Stmt] -> FunDef
C.FunDef Type
cTy String
name [] [Decln]
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, [Decln]
cVars) = forall s a. State s a -> s -> (a, s)
runState (forall a. Expr a -> State [Decln] Expr
transExpr Expr a
expr) forall a. Monoid a => a
mempty
mkGenFunArray :: String -> String -> Expr a -> Type a -> C.FunDef
mkGenFunArray :: forall a. String -> String -> Expr a -> Type a -> FunDef
mkGenFunArray String
name String
nameArg Expr a
expr ty :: Type a
ty@(Array Type t
_) =
Type -> String -> [Param] -> [Decln] -> [Stmt] -> FunDef
C.FunDef Type
funType String
name [ Param
outputParam ] [Decln]
varDecls [Stmt]
stmts
where
funType :: Type
funType = TypeSpec -> Type
C.TypeSpec TypeSpec
C.Void
outputParam :: Param
outputParam = Type -> String -> Param
C.Param Type
cArrayType String
nameArg
cArrayType :: Type
cArrayType = forall a. Type a -> Type
transType Type a
ty
(Expr
cExpr, [Decln]
varDecls) = forall s a. State s a -> s -> (a, s)
runState (forall a. Expr a -> State [Decln] Expr
transExpr Expr a
expr) forall a. Monoid a => a
mempty
stmts :: [Stmt]
stmts = [ Expr -> Stmt
C.Expr forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr -> Expr
memcpy (String -> Expr
C.Ident String
nameArg) Expr
cExpr Expr
size ]
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
typeSize Type a
ty)
Expr -> Expr -> Expr
C..* TypeName -> Expr
C.SizeOfType (Type -> TypeName
C.TypeName forall a b. (a -> b) -> a -> b
$ forall a. Type a -> Type
tyElemName Type a
ty)
mkGenFunArray String
_name String
_nameArg Expr a
_expr Type a
_ty =
forall a. String -> String -> a
impossible String
"mkGenFunArray" String
"copilot-c99"
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] -> [Decln] -> [Stmt] -> FunDef
C.FunDef Type
void (CSettings -> String
cSettingsStepFunctionName CSettings
cSettings) [] [Decln]
declns [Stmt]
stmts
where
void :: Type
void = TypeSpec -> Type
C.TypeSpec TypeSpec
C.Void
declns :: [Decln]
declns = [Decln]
streamDeclns
forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Decln]]
triggerDeclns
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
([Decln]
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
([[Decln]]
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 -> ([Decln], Stmt)
mkTriggerCheck [Trigger]
triggers
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
tmpVar 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
C.Funcall (String -> Expr
C.Ident forall a b. (a -> b) -> a -> b
$ Id -> String
generatorName Id
sId)
[ String -> Expr
C.Ident String
tmpVar ]
Type a
_ -> Expr -> Stmt
C.Expr forall a b. (a -> b) -> a -> b
$ String -> Expr
C.Ident String
tmpVar 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
tmpVar) Expr
size
where
dest :: Expr
dest = Expr -> Expr -> Expr
C.Index Expr
buffVar Expr
indexVar
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
typeSize 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
buffVar Expr
indexVar Expr -> Expr -> Expr
C..= String -> Expr
C.Ident String
tmpVar
indexUpdate :: Stmt
indexUpdate = Expr -> Stmt
C.Expr forall a b. (a -> b) -> a -> b
$ Expr
indexVar 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
indexVar Expr -> Expr -> Expr
C..+ Integer -> Expr
C.LitInt Integer
1
tmpVar :: String
tmpVar = Id -> String
streamName Id
sId forall a. [a] -> [a] -> [a]
++ String
"_tmp"
buffVar :: Expr
buffVar = String -> Expr
C.Ident forall a b. (a -> b) -> a -> b
$ Id -> String
streamName Id
sId
indexVar :: Expr
indexVar = 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
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
typeSize 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
mkTriggerCheck :: Trigger -> ([C.Decln], C.Stmt)
mkTriggerCheck :: Trigger -> ([Decln], Stmt)
mkTriggerCheck (Trigger String
name Expr Bool
_guard [UExpr]
args) =
([Decln]
aTmpDeclns, Stmt
triggerCheckStmt)
where
aTmpDeclns :: [C.Decln]
aTmpDeclns :: [Decln]
aTmpDeclns = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith UExpr -> String -> Decln
declare [UExpr]
args [String]
aTempNames
where
declare :: UExpr -> C.Ident -> C.Decln
declare :: UExpr -> String -> Decln
declare UExpr
arg String
tmpVar =
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
tempType :: UExpr -> C.Type
tempType :: UExpr -> Type
tempType (UExpr { uExprType :: ()
uExprType = Type a
ty }) =
case Type a
ty of
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
triggerCheckStmt :: C.Stmt
triggerCheckStmt :: Stmt
triggerCheckStmt = Expr -> [Stmt] -> Stmt
C.If Expr
guard' [Stmt]
fireTrigger
where
guard' :: Expr
guard' = Expr -> [Expr] -> Expr
C.Funcall (String -> Expr
C.Ident forall a b. (a -> b) -> a -> b
$ String -> String
guardName String
name) []
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
argAssigns :: [C.Expr]
argAssigns :: [Expr]
argAssigns = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> Expr -> Expr
assign [String]
aTempNames [Expr]
args'
assign :: C.Ident -> C.Expr -> C.Expr
assign :: String -> Expr -> Expr
assign String
aTempName = AssignOp -> Expr -> Expr -> Expr
C.AssignOp AssignOp
C.Assign (String -> Expr
C.Ident String
aTempName)
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') []
passArg :: String -> UExpr -> C.Expr
passArg :: String -> UExpr -> Expr
passArg String
aTempName (UExpr { uExprType :: ()
uExprType = Type a
ty }) =
case Type a
ty of
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
aTempNames :: [String]
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)
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]
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