module Copilot.Compile.C99.Compile
( compile
) where
import Text.PrettyPrint (render)
import Data.List (nub)
import Data.Maybe (catMaybes)
import Language.C99.Pretty (pretty)
import qualified Language.C99.Simple as C
import Copilot.Core
import Copilot.Compile.C99.Util
import Copilot.Compile.C99.External
import Copilot.Compile.C99.Translate
import Copilot.Compile.C99.CodeGen
compile :: String -> Spec -> IO ()
compile :: String -> Spec -> IO ()
compile String
prefix Spec
spec = do
let cfile :: String
cfile = Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ TransUnit -> Doc
forall a. Pretty a => a -> Doc
pretty (TransUnit -> Doc) -> TransUnit -> Doc
forall a b. (a -> b) -> a -> b
$ TransUnit -> TransUnit
C.translate (TransUnit -> TransUnit) -> TransUnit -> TransUnit
forall a b. (a -> b) -> a -> b
$ Spec -> TransUnit
compilec Spec
spec
hfile :: String
hfile = Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ TransUnit -> Doc
forall a. Pretty a => a -> Doc
pretty (TransUnit -> Doc) -> TransUnit -> Doc
forall a b. (a -> b) -> a -> b
$ TransUnit -> TransUnit
C.translate (TransUnit -> TransUnit) -> TransUnit -> TransUnit
forall a b. (a -> b) -> a -> b
$ Spec -> TransUnit
compileh Spec
spec
cmacros :: String
cmacros = [String] -> String
unlines [ String
"#include <stdint.h>"
, String
"#include <stdbool.h>"
, String
"#include <string.h>"
, String
"#include <stdlib.h>"
, String
"#include <math.h>"
, String
""
, String
"#include \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".h\""
, String
""
]
String -> String -> IO ()
writeFile (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".c") (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
cmacros String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cfile
String -> String -> IO ()
writeFile (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".h") String
hfile
compilec :: Spec -> C.TransUnit
compilec :: Spec -> TransUnit
compilec Spec
spec = [Decln] -> [FunDef] -> TransUnit
C.TransUnit [Decln]
declns [FunDef]
funs where
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
exprs :: [UExpr]
exprs = [Stream] -> [Trigger] -> [UExpr]
gatherexprs [Stream]
streams [Trigger]
triggers
declns :: [Decln]
declns = [UExpr] -> [Decln]
mkstructdeclns [UExpr]
exprs [Decln] -> [Decln] -> [Decln]
forall a. [a] -> [a] -> [a]
++ [External] -> [Decln]
mkexts [External]
exts [Decln] -> [Decln] -> [Decln]
forall a. [a] -> [a] -> [a]
++ [Stream] -> [Decln]
mkglobals [Stream]
streams
funs :: [FunDef]
funs = [Stream] -> [Trigger] -> [FunDef]
genfuns [Stream]
streams [Trigger]
triggers [FunDef] -> [FunDef] -> [FunDef]
forall a. [a] -> [a] -> [a]
++ [[Stream] -> [Trigger] -> [External] -> FunDef
mkstep [Stream]
streams [Trigger]
triggers [External]
exts]
mkstructdeclns :: [UExpr] -> [C.Decln]
mkstructdeclns :: [UExpr] -> [Decln]
mkstructdeclns [UExpr]
es = [Maybe Decln] -> [Decln]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Decln] -> [Decln]) -> [Maybe Decln] -> [Decln]
forall a b. (a -> b) -> a -> b
$ (UType -> Maybe Decln) -> [UType] -> [Maybe Decln]
forall a b. (a -> b) -> [a] -> [b]
map UType -> Maybe Decln
mkdecln [UType]
utypes where
mkdecln :: UType -> Maybe Decln
mkdecln (UType Type a
ty) = case Type a
ty of
Struct a
x -> Decln -> Maybe Decln
forall a. a -> Maybe a
Just (Decln -> Maybe Decln) -> Decln -> Maybe Decln
forall a b. (a -> b) -> a -> b
$ Type a -> Decln
forall a. Struct a => Type a -> Decln
mkstructdecln Type a
ty
Type a
_ -> Maybe Decln
forall a. Maybe a
Nothing
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
mkexts :: [External] -> [C.Decln]
mkexts :: [External] -> [Decln]
mkexts [External]
exts = (External -> Decln) -> [External] -> [Decln]
forall a b. (a -> b) -> [a] -> [b]
map External -> Decln
mkextcpydecln [External]
exts
mkglobals :: [Stream] -> [C.Decln]
mkglobals :: [Stream] -> [Decln]
mkglobals [Stream]
streams = (Stream -> Decln) -> [Stream] -> [Decln]
forall a b. (a -> b) -> [a] -> [b]
map Stream -> Decln
buffdecln [Stream]
streams [Decln] -> [Decln] -> [Decln]
forall a. [a] -> [a] -> [a]
++ (Stream -> Decln) -> [Stream] -> [Decln]
forall a b. (a -> b) -> [a] -> [b]
map Stream -> Decln
indexdecln [Stream]
streams where
buffdecln :: Stream -> Decln
buffdecln (Stream Id
sid [a]
buff Expr a
_ Type a
ty) = Id -> Type a -> [a] -> Decln
forall a. Id -> Type a -> [a] -> Decln
mkbuffdecln Id
sid Type a
ty [a]
buff
indexdecln :: Stream -> Decln
indexdecln (Stream Id
sid [a]
_ Expr a
_ Type a
_ ) = Id -> Decln
mkindexdecln Id
sid
genfuns :: [Stream] -> [Trigger] -> [C.FunDef]
genfuns :: [Stream] -> [Trigger] -> [FunDef]
genfuns [Stream]
streams [Trigger]
triggers = (Stream -> FunDef) -> [Stream] -> [FunDef]
forall a b. (a -> b) -> [a] -> [b]
map Stream -> FunDef
streamgen [Stream]
streams
[FunDef] -> [FunDef] -> [FunDef]
forall a. [a] -> [a] -> [a]
++ (Trigger -> [FunDef]) -> [Trigger] -> [FunDef]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Trigger -> [FunDef]
triggergen [Trigger]
triggers where
streamgen :: Stream -> C.FunDef
streamgen :: Stream -> FunDef
streamgen (Stream Id
sid [a]
_ Expr a
expr Type a
ty) = String -> Expr a -> Type a -> FunDef
forall a. String -> Expr a -> Type a -> FunDef
genfun (Id -> String
generatorname Id
sid) Expr a
expr Type a
ty
triggergen :: Trigger -> [C.FunDef]
triggergen :: Trigger -> [FunDef]
triggergen (Trigger String
name Expr Bool
guard [UExpr]
args) = FunDef
guarddef FunDef -> [FunDef] -> [FunDef]
forall a. a -> [a] -> [a]
: [FunDef]
argdefs where
guarddef :: FunDef
guarddef = String -> Expr Bool -> Type Bool -> FunDef
forall a. String -> Expr a -> Type a -> FunDef
genfun (String -> String
guardname String
name) Expr Bool
guard Type Bool
Bool
argdefs :: [FunDef]
argdefs = ((String, UExpr) -> FunDef) -> [(String, UExpr)] -> [FunDef]
forall a b. (a -> b) -> [a] -> [b]
map (String, UExpr) -> FunDef
arggen ([String] -> [UExpr] -> [(String, UExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String -> [String]
argnames String
name) [UExpr]
args)
arggen :: (String, UExpr) -> C.FunDef
arggen :: (String, UExpr) -> FunDef
arggen (String
argname, UExpr Type a
ty Expr a
expr) = String -> Expr a -> Type a -> FunDef
forall a. String -> Expr a -> Type a -> FunDef
genfun String
argname Expr a
expr Type a
ty
compileh :: Spec -> C.TransUnit
compileh :: Spec -> TransUnit
compileh Spec
spec = [Decln] -> [FunDef] -> TransUnit
C.TransUnit [Decln]
declns [] where
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
exprs :: [UExpr]
exprs = [Stream] -> [Trigger] -> [UExpr]
gatherexprs [Stream]
streams [Trigger]
triggers
declns :: [Decln]
declns = [UExpr] -> [Decln]
mkstructforwdeclns [UExpr]
exprs
[Decln] -> [Decln] -> [Decln]
forall a. [a] -> [a] -> [a]
++ [External] -> [Decln]
mkexts [External]
exts
[Decln] -> [Decln] -> [Decln]
forall a. [a] -> [a] -> [a]
++ [Trigger] -> [Decln]
extfundeclns [Trigger]
triggers
[Decln] -> [Decln] -> [Decln]
forall a. [a] -> [a] -> [a]
++ [Decln
stepdecln]
mkstructforwdeclns :: [UExpr] -> [C.Decln]
mkstructforwdeclns :: [UExpr] -> [Decln]
mkstructforwdeclns [UExpr]
es = [Maybe Decln] -> [Decln]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Decln] -> [Decln]) -> [Maybe Decln] -> [Decln]
forall a b. (a -> b) -> a -> b
$ (UType -> Maybe Decln) -> [UType] -> [Maybe Decln]
forall a b. (a -> b) -> [a] -> [b]
map UType -> Maybe Decln
mkdecln [UType]
utypes where
mkdecln :: UType -> Maybe Decln
mkdecln (UType Type a
ty) = case Type a
ty of
Struct a
x -> Decln -> Maybe Decln
forall a. a -> Maybe a
Just (Decln -> Maybe Decln) -> Decln -> Maybe Decln
forall a b. (a -> b) -> a -> b
$ Type a -> Decln
forall a. Struct a => Type a -> Decln
mkstructforwdecln Type a
ty
Type a
_ -> Maybe Decln
forall a. Maybe a
Nothing
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
mkexts :: [External] -> [C.Decln]
mkexts :: [External] -> [Decln]
mkexts = (External -> Decln) -> [External] -> [Decln]
forall a b. (a -> b) -> [a] -> [b]
map External -> Decln
mkextdecln
extfundeclns :: [Trigger] -> [C.Decln]
extfundeclns :: [Trigger] -> [Decln]
extfundeclns [Trigger]
triggers = (Trigger -> Decln) -> [Trigger] -> [Decln]
forall a b. (a -> b) -> [a] -> [b]
map Trigger -> Decln
extfundecln [Trigger]
triggers where
extfundecln :: Trigger -> C.Decln
extfundecln :: Trigger -> Decln
extfundecln (Trigger String
name Expr Bool
_ [UExpr]
args) = Maybe StorageSpec -> Type -> String -> [Param] -> Decln
C.FunDecln Maybe StorageSpec
forall a. Maybe a
Nothing Type
cty String
name [Param]
params where
cty :: Type
cty = TypeSpec -> Type
C.TypeSpec TypeSpec
C.Void
params :: [Param]
params = ((String, UExpr) -> Param) -> [(String, UExpr)] -> [Param]
forall a b. (a -> b) -> [a] -> [b]
map (String, UExpr) -> Param
mkparam ([(String, UExpr)] -> [Param]) -> [(String, UExpr)] -> [Param]
forall a b. (a -> b) -> a -> b
$ [String] -> [UExpr] -> [(String, UExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String -> [String]
argnames String
name) [UExpr]
args
mkparam :: (String, UExpr) -> Param
mkparam (String
name, UExpr Type a
ty Expr a
_) = Type -> String -> Param
C.Param (Type a -> Type
forall a. Type a -> Type
transtype Type a
ty) String
name
stepdecln :: C.Decln
stepdecln :: Decln
stepdecln = Maybe StorageSpec -> Type -> String -> [Param] -> Decln
C.FunDecln Maybe StorageSpec
forall a. Maybe a
Nothing (TypeSpec -> Type
C.TypeSpec TypeSpec
C.Void) String
"step" []