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 the specification to a .h and a .c file.
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

      -- TODO: find a nicer solution using annotated AST's
      -- Should figure out exactly which headers are needed, based on what
      -- is used.
      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

-- | Generate the .c file from a spec. It has the following structure:
-- |
-- | * Include .h file
-- | * Declarations of global buffers and indices.
-- | * Generator functions for streams, guards and trigger args.
-- | * Declaration of step() function.
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]

  -- Write struct datatypes
  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

  -- Make declarations for copies of external variables.
  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

  -- Make buffer and index declarations for streams.
  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

  -- Make generator functions, including trigger arguments.
  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

-- | Generate the .h file from a spec.
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

  -- Make declarations for external variables.
  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

  -- Declaration for the step function.
  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" []