From 7124a4f00e536b4d5323a7488c1f65469dddb102 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Tue, 12 May 2020 12:21:36 +0100 Subject: Format with ormolu --- src/Verismith/Tool/Internal.hs | 293 +++++++++++++++++++++-------------------- 1 file changed, 153 insertions(+), 140 deletions(-) (limited to 'src/Verismith/Tool/Internal.hs') diff --git a/src/Verismith/Tool/Internal.hs b/src/Verismith/Tool/Internal.hs index f462c74..ab2892e 100644 --- a/src/Verismith/Tool/Internal.hs +++ b/src/Verismith/Tool/Internal.hs @@ -1,63 +1,61 @@ -{-| -Module : Verismith.Tool.Internal -Description : Class of the simulator. -Copyright : (c) 2018-2019, Yann Herklotz -License : GPL-3 -Maintainer : yann [at] yannherklotz [dot] com -Stability : experimental -Portability : POSIX - -Class of the simulator and the synthesize tool. --} - {-# LANGUAGE DeriveFunctor #-} +-- | +-- Module : Verismith.Tool.Internal +-- Description : Class of the simulator. +-- Copyright : (c) 2018-2019, Yann Herklotz +-- License : GPL-3 +-- Maintainer : yann [at] yannherklotz [dot] com +-- Stability : experimental +-- Portability : POSIX +-- +-- Class of the simulator and the synthesize tool. module Verismith.Tool.Internal - ( ResultSh - , resultSh - , Tool(..) - , Simulator(..) - , Synthesiser(..) - , Failed(..) - , renameSource - , checkPresent - , checkPresentModules - , replace - , replaceMods - , rootPath - , timeout - , timeout_ - , bsToI - , noPrint - , logger - , logCommand - , logCommand_ - , execute - , execute_ - , () - , annotate - ) + ( ResultSh, + resultSh, + Tool (..), + Simulator (..), + Synthesiser (..), + Failed (..), + renameSource, + checkPresent, + checkPresentModules, + replace, + replaceMods, + rootPath, + timeout, + timeout_, + bsToI, + noPrint, + logger, + logCommand, + logCommand_, + execute, + execute_, + (), + annotate, + ) where -import Control.Lens -import Control.Monad (forM, void) -import Control.Monad.Catch (throwM) -import Data.Bits (shiftL) -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Maybe (catMaybes) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Time.Format (defaultTimeLocale, formatTime) -import Data.Time.LocalTime (getZonedTime) -import Prelude hiding (FilePath) -import Shelly -import Shelly.Lifted (MonadSh, liftSh) -import System.FilePath.Posix (takeBaseName) -import Verismith.CounterEg (CounterEg) -import Verismith.Internal -import Verismith.Result -import Verismith.Verilog.AST +import Control.Lens +import Control.Monad (forM, void) +import Control.Monad.Catch (throwM) +import Data.Bits (shiftL) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Maybe (catMaybes) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Format (defaultTimeLocale, formatTime) +import Data.Time.LocalTime (getZonedTime) +import Shelly +import Shelly.Lifted (MonadSh, liftSh) +import System.FilePath.Posix (takeBaseName) +import Verismith.CounterEg (CounterEg) +import Verismith.Internal +import Verismith.Result +import Verismith.Verilog.AST +import Prelude hiding (FilePath) -- | Tool class. class Tool a where @@ -65,51 +63,62 @@ class Tool a where -- | Simulation type class. class Tool a => Simulator a where - runSim :: Show ann - => a -- ^ Simulator instance - -> SourceInfo ann -- ^ Run information - -> [ByteString] -- ^ Inputs to simulate - -> ResultSh ByteString -- ^ Returns the value of the hash at the output of the testbench. - runSimWithFile :: a - -> FilePath - -> [ByteString] - -> ResultSh ByteString - -data Failed = EmptyFail - | EquivFail (Maybe CounterEg) - | EquivError - | SimFail ByteString - | SynthFail - | TimeoutError - deriving (Eq) + runSim :: + Show ann => + -- | Simulator instance + a -> + -- | Run information + SourceInfo ann -> + -- | Inputs to simulate + [ByteString] -> + -- | Returns the value of the hash at the output of the testbench. + ResultSh ByteString + runSimWithFile :: + a -> + FilePath -> + [ByteString] -> + ResultSh ByteString + +data Failed + = EmptyFail + | EquivFail (Maybe CounterEg) + | EquivError + | SimFail ByteString + | SynthFail + | TimeoutError + deriving (Eq) instance Show Failed where - show EmptyFail = "EmptyFail" - show (EquivFail _) = "EquivFail" - show EquivError = "EquivError" - show (SimFail bs) = "SimFail " <> T.unpack (T.take 10 $ showBS bs) - show SynthFail = "SynthFail" - show TimeoutError = "TimeoutError" + show EmptyFail = "EmptyFail" + show (EquivFail _) = "EquivFail" + show EquivError = "EquivError" + show (SimFail bs) = "SimFail " <> T.unpack (T.take 10 $ showBS bs) + show SynthFail = "SynthFail" + show TimeoutError = "TimeoutError" instance Semigroup Failed where - EmptyFail <> a = a - b <> _ = b + EmptyFail <> a = a + b <> _ = b instance Monoid Failed where - mempty = EmptyFail + mempty = EmptyFail -- | Synthesiser type class. class Tool a => Synthesiser a where - runSynth :: Show ann - => a -- ^ Synthesiser tool instance - -> SourceInfo ann -- ^ Run information - -> ResultSh () -- ^ does not return any values - synthOutput :: a -> FilePath - setSynthOutput :: a -> FilePath -> a + runSynth :: + Show ann => + -- | Synthesiser tool instance + a -> + -- | Run information + SourceInfo ann -> + -- | does not return any values + ResultSh () + synthOutput :: a -> FilePath + setSynthOutput :: a -> FilePath -> a renameSource :: (Synthesiser a) => a -> SourceInfo ann -> SourceInfo ann renameSource a src = - src & infoSrc . _Wrapped . traverse . modId . _Wrapped %~ (<> toText a) + src & infoSrc . _Wrapped . traverse . modId . _Wrapped %~ (<> toText a) -- | Type synonym for a 'ResultT' that will be used throughout 'Verismith'. This -- has instances for 'MonadSh' and 'MonadIO' if the 'Monad' it is parametrised @@ -118,31 +127,33 @@ type ResultSh = ResultT Failed Sh resultSh :: ResultSh a -> Sh a resultSh s = do - result <- runResultT s - case result of - Fail e -> throwM . RunFailed "" [] 1 $ showT e - Pass s' -> return s' + result <- runResultT s + case result of + Fail e -> throwM . RunFailed "" [] 1 $ showT e + Pass s' -> return s' checkPresent :: FilePath -> Text -> Sh (Maybe Text) checkPresent fp t = do - errExit False $ run_ "grep" [t, toTextIgnore fp] - i <- lastExitCode - if i == 0 then return $ Just t else return Nothing + errExit False $ run_ "grep" [t, toTextIgnore fp] + i <- lastExitCode + if i == 0 then return $ Just t else return Nothing -- | Checks what modules are present in the synthesised output, as some modules -- may have been inlined. This could be improved if the parser worked properly. checkPresentModules :: FilePath -> SourceInfo ann -> Sh [Text] checkPresentModules fp (SourceInfo _ src) = do - vals <- forM (src ^.. _Wrapped . traverse . modId . _Wrapped) - $ checkPresent fp - return $ catMaybes vals + vals <- + forM (src ^.. _Wrapped . traverse . modId . _Wrapped) $ + checkPresent fp + return $ catMaybes vals -- | Uses sed to replace a string in a text file. replace :: FilePath -> Text -> Text -> Sh () replace fp t1 t2 = do - errExit False . noPrint $ run_ - "sed" - ["-i", "s/" <> t1 <> "/" <> t2 <> "/g", toTextIgnore fp] + errExit False . noPrint $ + run_ + "sed" + ["-i", "s/" <> t1 <> "/" <> t2 <> "/g", toTextIgnore fp] -- | This is used because rename only renames the definitions of modules of -- course, so instead this just searches and replaces all the module names. This @@ -150,14 +161,14 @@ replace fp t1 t2 = do -- much simpler if the parser works. replaceMods :: FilePath -> Text -> SourceInfo ann -> Sh () replaceMods fp t (SourceInfo _ src) = - void - . forM (src ^.. _Wrapped . traverse . modId . _Wrapped) - $ (\a -> replace fp a (a <> t)) + void + . forM (src ^.. _Wrapped . traverse . modId . _Wrapped) + $ (\a -> replace fp a (a <> t)) rootPath :: Sh FilePath rootPath = do - current <- pwd - maybe current fromText <$> get_env "VERISMITH_ROOT" + current <- pwd + maybe current fromText <$> get_env "VERISMITH_ROOT" timeout :: FilePath -> [Text] -> Sh Text timeout = command1 "timeout" ["300"] . toTextIgnore @@ -178,18 +189,20 @@ noPrint = print_stdout False . print_stderr False logger :: Text -> Sh () logger t = do - fn <- pwd - currentTime <- liftIO getZonedTime - echo - $ "Verismith " - <> T.pack (formatTime defaultTimeLocale "%H:%M:%S " currentTime) - <> bname fn - <> " - " - <> t - where bname = T.pack . takeBaseName . T.unpack . toTextIgnore + fn <- pwd + currentTime <- liftIO getZonedTime + echo $ + "Verismith " + <> T.pack (formatTime defaultTimeLocale "%H:%M:%S " currentTime) + <> bname fn + <> " - " + <> t + where + bname = T.pack . takeBaseName . T.unpack . toTextIgnore logCommand :: FilePath -> Text -> Sh a -> Sh a -logCommand fp name = log_stderr_with (l "_stderr.log") +logCommand fp name = + log_stderr_with (l "_stderr.log") . log_stdout_with (l ".log") where l s t = appendFile (file s) (T.unpack t) >> appendFile (file s) "\n" @@ -198,29 +211,29 @@ logCommand fp name = log_stderr_with (l "_stderr.log") logCommand_ :: FilePath -> Text -> Sh a -> Sh () logCommand_ fp name = void . logCommand fp name -execute - :: (MonadSh m, Monad m) - => Failed - -> FilePath - -> Text - -> FilePath - -> [Text] - -> ResultT Failed m Text +execute :: + (MonadSh m, Monad m) => + Failed -> + FilePath -> + Text -> + FilePath -> + [Text] -> + ResultT Failed m Text execute f dir name e cs = do - (res, exitCode) <- liftSh $ do - res <- errExit False . logCommand dir name $ timeout e cs - (,) res <$> lastExitCode - case exitCode of - 0 -> ResultT . return $ Pass res - 124 -> ResultT . return $ Fail TimeoutError - _ -> ResultT . return $ Fail f - -execute_ - :: (MonadSh m, Monad m) - => Failed - -> FilePath - -> Text - -> FilePath - -> [Text] - -> ResultT Failed m () + (res, exitCode) <- liftSh $ do + res <- errExit False . logCommand dir name $ timeout e cs + (,) res <$> lastExitCode + case exitCode of + 0 -> ResultT . return $ Pass res + 124 -> ResultT . return $ Fail TimeoutError + _ -> ResultT . return $ Fail f + +execute_ :: + (MonadSh m, Monad m) => + Failed -> + FilePath -> + Text -> + FilePath -> + [Text] -> + ResultT Failed m () execute_ a b c d = void . execute a b c d -- cgit