{-# LANGUAGE RecordWildCards, OverloadedStrings, ViewPatterns #-} {-# LANGUAGE TemplateHaskell, CPP #-} module Clash.Clashilator (generateFiles) where import Clash.Driver.Manifest import Control.Monad (forM_) import Data.List (partition) import System.FilePath import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Development.Shake (writeFileChanged) import Text.Mustache import qualified Text.Mustache.Compile.TH as TH import Data.Aeson hiding (Options) #if MIN_VERSION_aeson(2, 0, 0) import qualified Data.Aeson.KeyMap as Aeson #else import qualified Data.HashMap.Strict as Aeson #endif data Port = Port Text Int deriving Int -> Port -> ShowS [Port] -> ShowS Port -> FilePath (Int -> Port -> ShowS) -> (Port -> FilePath) -> ([Port] -> ShowS) -> Show Port forall a. (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> Port -> ShowS showsPrec :: Int -> Port -> ShowS $cshow :: Port -> FilePath show :: Port -> FilePath $cshowList :: [Port] -> ShowS showList :: [Port] -> ShowS Show data FFIType = FFIBit | FFIU8 | FFIU16 | FFIU32 | FFIU64 ffiType :: Int -> FFIType ffiType :: Int -> FFIType ffiType Int 1 = FFIType FFIBit ffiType Int n | Int n Int -> Int -> Bool forall a. Ord a => a -> a -> Bool <= Int 8 = FFIType FFIU8 | Int n Int -> Int -> Bool forall a. Ord a => a -> a -> Bool <= Int 16 = FFIType FFIU16 | Int n Int -> Int -> Bool forall a. Ord a => a -> a -> Bool <= Int 32 = FFIType FFIU32 | Int n Int -> Int -> Bool forall a. Ord a => a -> a -> Bool <= Int 64 = FFIType FFIU64 | Bool otherwise = FilePath -> FFIType forall a. HasCallStack => FilePath -> a error (FilePath -> FFIType) -> FilePath -> FFIType forall a b. (a -> b) -> a -> b $ [FilePath] -> FilePath unwords [FilePath "ffiType:", Int -> FilePath forall a. Show a => a -> FilePath show Int n] cType :: FFIType -> Text cType :: FFIType -> Text cType FFIType FFIBit = Text "bit" cType FFIType FFIU8 = Text "uint8_t" cType FFIType FFIU16 = Text "uint16_t" cType FFIType FFIU32 = Text "uint32_t" cType FFIType FFIU64 = Text "uint64_t" hsType :: FFIType -> Text hsType :: FFIType -> Text hsType FFIType FFIBit = Text "Bit" hsType FFIType FFIU8 = Text "Word8" hsType FFIType FFIU16 = Text "Word16" hsType FFIType FFIU32 = Text "Word32" hsType FFIType FFIU64 = Text "Word64" cName :: Text -> Text cName :: Text -> Text cName = Text -> Text forall a. a -> a id hsName :: Text -> Text -> Text hsName :: Text -> Text -> Text hsName Text tag Text s = Text tag Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text s getClockAndInPorts :: Maybe Text -> [ManifestPort] -> (Maybe Text, [Port]) getClockAndInPorts :: Maybe Text -> [ManifestPort] -> (Maybe Text, [Port]) getClockAndInPorts Maybe Text clkName [ManifestPort] inPorts = (Maybe Text clk, [ Text -> Int -> Port Port Text mpName Int mpWidth | ManifestPort{Bool Int Maybe Text Text PortDirection mpName :: Text mpWidth :: Int mpTypeName :: Text mpDirection :: PortDirection mpIsClock :: Bool mpDomain :: Maybe Text mpName :: ManifestPort -> Text mpTypeName :: ManifestPort -> Text mpDirection :: ManifestPort -> PortDirection mpWidth :: ManifestPort -> Int mpIsClock :: ManifestPort -> Bool mpDomain :: ManifestPort -> Maybe Text ..} <- [ManifestPort] inPorts' ]) where ((ManifestPort -> Text) -> [ManifestPort] -> [Text] forall a b. (a -> b) -> [a] -> [b] map ManifestPort -> Text mpName -> [Text] clks, [ManifestPort] inPorts') = (ManifestPort -> Bool) -> [ManifestPort] -> ([ManifestPort], [ManifestPort]) forall a. (a -> Bool) -> [a] -> ([a], [a]) partition ManifestPort -> Bool mpIsClock [ManifestPort] inPorts clk :: Maybe Text clk = case (Maybe Text clkName, [Text] clks) of (Just Text clkName, [Text] clks) | Text clkName Text -> [Text] -> Bool forall a. Eq a => a -> [a] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` [Text] clks -> Text -> Maybe Text forall a. a -> Maybe a Just Text clkName (Maybe Text Nothing, [Text clk]) -> Text -> Maybe Text forall a. a -> Maybe a Just Text clk (Maybe Text, [Text]) _ -> Maybe Text forall a. Maybe a Nothing portInfo :: Text -> Port -> Value portInfo :: Text -> Port -> Value portInfo Text tag (Port Text name Int width) = [Pair] -> Value object [ Key "cName" Key -> Text -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Text -> Text cName Text name , Key "cType" Key -> Text -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= FFIType -> Text cType FFIType ty , Key "hsName" Key -> Text -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Text -> Text -> Text hsName Text tag Text name , Key "hsType" Key -> Text -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= FFIType -> Text hsType FFIType ty ] where ty :: FFIType ty = Int -> FFIType ffiType Int width manifestInfo :: Maybe String -> FilePath -> FilePath -> Maybe Text -> Manifest -> Value manifestInfo :: Maybe FilePath -> FilePath -> FilePath -> Maybe Text -> Manifest -> Value manifestInfo Maybe FilePath cflags FilePath srcDir FilePath outputDir Maybe Text clkName Manifest{[(FilePath, ByteString)] [Text] [ManifestPort] (Int, Int) ByteString HashMap Text VDomainConfiguration Text manifestHash :: ByteString successFlags :: (Int, Int) ports :: [ManifestPort] componentNames :: [Text] topComponent :: Text fileNames :: [(FilePath, ByteString)] domains :: HashMap Text VDomainConfiguration transitiveDependencies :: [Text] manifestHash :: Manifest -> ByteString successFlags :: Manifest -> (Int, Int) ports :: Manifest -> [ManifestPort] componentNames :: Manifest -> [Text] topComponent :: Manifest -> Text fileNames :: Manifest -> [(FilePath, ByteString)] domains :: Manifest -> HashMap Text VDomainConfiguration transitiveDependencies :: Manifest -> [Text] ..} = [Pair] -> Value object [ Key "inPorts" Key -> [Value] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= ([Value] -> [Value] markEnds ([Value] -> [Value]) -> [Value] -> [Value] forall a b. (a -> b) -> a -> b $ (Port -> Value) -> [Port] -> [Value] forall a b. (a -> b) -> [a] -> [b] map (Text -> Port -> Value portInfo Text "i") [Port] ins) , Key "outPorts" Key -> [Value] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= ([Value] -> [Value] markEnds ([Value] -> [Value]) -> [Value] -> [Value] forall a b. (a -> b) -> a -> b $ (Port -> Value) -> [Port] -> [Value] forall a b. (a -> b) -> [a] -> [b] map (Text -> Port -> Value portInfo Text "o") [Port] outs) , Key "clock" Key -> Maybe Value -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= (Text -> Value) -> Maybe Text -> Maybe Value forall a b. (a -> b) -> Maybe a -> Maybe b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (\Text clock -> [Pair] -> Value object [Key "cName" Key -> Text -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Text -> Text cName Text clock]) Maybe Text clock , Key "hdlDir" Key -> FilePath -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= FilePath srcDir , Key "srcs" Key -> [Value] -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= [ [Pair] -> Value object [Key "verilogPath" Key -> Text -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= FilePath -> Text TL.pack (FilePath srcDir FilePath -> ShowS </> Text -> FilePath T.unpack Text component FilePath -> ShowS <.> FilePath "v")] | Text component <- [Text] componentNames ] , Key "verilator" Key -> Maybe Value -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= (FilePath -> Value) -> Maybe FilePath -> Maybe Value forall a b. (a -> b) -> Maybe a -> Maybe b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (\FilePath cflags -> [Pair] -> Value object [ Key "cflags" Key -> Text -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Text -> Text TL.strip (FilePath -> Text TL.pack FilePath cflags) ]) Maybe FilePath cflags , Key "outputDir" Key -> FilePath -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= FilePath outputDir ] where #if MIN_VERSION_clash_lib(1, 6, 0) inPorts :: [ManifestPort] inPorts = [ ManifestPort port | port :: ManifestPort port@ManifestPort{Bool Int Maybe Text Text PortDirection mpName :: ManifestPort -> Text mpTypeName :: ManifestPort -> Text mpDirection :: ManifestPort -> PortDirection mpWidth :: ManifestPort -> Int mpIsClock :: ManifestPort -> Bool mpDomain :: ManifestPort -> Maybe Text mpName :: Text mpTypeName :: Text mpDirection :: PortDirection mpWidth :: Int mpIsClock :: Bool mpDomain :: Maybe Text ..} <- [ManifestPort] ports, PortDirection mpDirection PortDirection -> [PortDirection] -> Bool forall a. Eq a => a -> [a] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` [PortDirection In, PortDirection InOut] ] outPorts :: [ManifestPort] outPorts = [ ManifestPort port | port :: ManifestPort port@ManifestPort{Bool Int Maybe Text Text PortDirection mpName :: ManifestPort -> Text mpTypeName :: ManifestPort -> Text mpDirection :: ManifestPort -> PortDirection mpWidth :: ManifestPort -> Int mpIsClock :: ManifestPort -> Bool mpDomain :: ManifestPort -> Maybe Text mpName :: Text mpTypeName :: Text mpDirection :: PortDirection mpWidth :: Int mpIsClock :: Bool mpDomain :: Maybe Text ..} <- [ManifestPort] ports, PortDirection mpDirection PortDirection -> [PortDirection] -> Bool forall a. Eq a => a -> [a] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` [PortDirection InOut, PortDirection Out] ] #endif (Maybe Text clock, [Port] ins) = Maybe Text -> [ManifestPort] -> (Maybe Text, [Port]) getClockAndInPorts Maybe Text clkName [ManifestPort] inPorts outs :: [Port] outs = [ Text -> Int -> Port Port Text mpName Int mpWidth | ManifestPort{Bool Int Maybe Text Text PortDirection mpName :: ManifestPort -> Text mpTypeName :: ManifestPort -> Text mpDirection :: ManifestPort -> PortDirection mpWidth :: ManifestPort -> Int mpIsClock :: ManifestPort -> Bool mpDomain :: ManifestPort -> Maybe Text mpName :: Text mpWidth :: Int mpTypeName :: Text mpDirection :: PortDirection mpIsClock :: Bool mpDomain :: Maybe Text ..} <- [ManifestPort] outPorts ] markEnds :: [Value] -> [Value] markEnds :: [Value] -> [Value] markEnds [] = [] markEnds (Value v:[Value] vs) = Value -> Value markStart Value v Value -> [Value] -> [Value] forall a. a -> [a] -> [a] : [Value] vs where markStart :: Value -> Value markStart (Object Object o) = Object -> Value Object (Object -> Value) -> Object -> Value forall a b. (a -> b) -> a -> b $ Object o Object -> Object -> Object forall a. Semigroup a => a -> a -> a <> [Pair] -> Object forall v. [(Key, v)] -> KeyMap v Aeson.fromList [ Key "first" Key -> Bool -> Pair forall v. ToJSON v => Key -> v -> Pair forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv .= Bool True ] templates :: [(FilePath, Template)] templates = [ (FilePath "src/Interface.h", $(TH.compileMustacheFile "template/Interface.h.mustache")) , (FilePath "src/Impl.cpp", $(TH.compileMustacheFile "template/Impl.cpp.mustache")) , (FilePath "src/Impl.h", $(TH.compileMustacheFile "template/Impl.h.mustache")) , (FilePath "Makefile", $(TH.compileMustacheFile "template/Makefile.mustache")) , (FilePath "src/Clash/Clashilator/FFI.hsc", $(TH.compileMustacheFile "template/FFI.hsc.mustache")) ] generateFiles :: Maybe String -> FilePath -> FilePath -> Maybe Text -> Manifest -> IO () generateFiles :: Maybe FilePath -> FilePath -> FilePath -> Maybe Text -> Manifest -> IO () generateFiles Maybe FilePath cflags FilePath inputDir FilePath outputDir Maybe Text clkName Manifest manifest = do let vals :: Value vals = Maybe FilePath -> FilePath -> FilePath -> Maybe Text -> Manifest -> Value manifestInfo Maybe FilePath cflags FilePath inputDir FilePath outputDir Maybe Text clkName Manifest manifest [(FilePath, Template)] -> ((FilePath, Template) -> IO ()) -> IO () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ [(FilePath, Template)] templates (((FilePath, Template) -> IO ()) -> IO ()) -> ((FilePath, Template) -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \(FilePath fname, Template template) -> do FilePath -> FilePath -> IO () forall (m :: * -> *). (MonadIO m, HasCallStack) => FilePath -> FilePath -> m () writeFileChanged (FilePath outputDir FilePath -> ShowS </> FilePath fname) (FilePath -> IO ()) -> FilePath -> IO () forall a b. (a -> b) -> a -> b $ Text -> FilePath TL.unpack (Text -> FilePath) -> Text -> FilePath forall a b. (a -> b) -> a -> b $ Template -> Value -> Text renderMustache Template template Value vals