diff options
author | Yann Herklotz <git@ymhg.org> | 2019-04-17 11:01:43 +0100 |
---|---|---|
committer | Yann Herklotz <git@ymhg.org> | 2019-04-17 11:01:43 +0100 |
commit | 1db2dbfd5ffa617e58e95d42fbc84c3cdae56b4a (patch) | |
tree | 87af85f8f0e2d1025c55cc30c9828812587d5068 /src/VeriFuzz/Sim/Internal.hs | |
parent | 449caedc72a6ccc76934149205202d43052a214c (diff) | |
download | verismith-1db2dbfd5ffa617e58e95d42fbc84c3cdae56b4a.tar.gz verismith-1db2dbfd5ffa617e58e95d42fbc84c3cdae56b4a.zip |
Update simulator with Result type
Diffstat (limited to 'src/VeriFuzz/Sim/Internal.hs')
-rw-r--r-- | src/VeriFuzz/Sim/Internal.hs | 72 |
1 files changed, 57 insertions, 15 deletions
diff --git a/src/VeriFuzz/Sim/Internal.hs b/src/VeriFuzz/Sim/Internal.hs index 3ff2924..8327ad8 100644 --- a/src/VeriFuzz/Sim/Internal.hs +++ b/src/VeriFuzz/Sim/Internal.hs @@ -10,10 +10,14 @@ Portability : POSIX Class of the simulator and the synthesize tool. -} +{-# LANGUAGE DeriveFunctor #-} + module VeriFuzz.Sim.Internal - ( Tool(..) + ( ResultSh + , Tool(..) , Simulator(..) , Synthesiser(..) + , Failed(..) , rootPath , timeout , timeout_ @@ -22,6 +26,10 @@ module VeriFuzz.Sim.Internal , echoP , logger , logger_ + , execute + , execute_ + , (<?>) + , annotate ) where @@ -34,8 +42,10 @@ import qualified Data.Text as T import Data.Time.LocalTime (getZonedTime) import Prelude hiding (FilePath) import Shelly +import Shelly.Lifted (MonadSh, liftSh) import System.FilePath.Posix (takeBaseName) import VeriFuzz.Internal +import VeriFuzz.Result import VeriFuzz.Verilog.AST -- | Tool class. @@ -43,22 +53,40 @@ class Tool a where toText :: a -> Text -- | Simulation type class. -class (Tool a) => Simulator a where +class Tool a => Simulator a where runSim :: a -- ^ Simulator instance -> SourceInfo -- ^ Run information -> [ByteString] -- ^ Inputs to simulate - -> Sh ByteString -- ^ Returns the value of the hash at the output of the testbench. + -> ResultSh ByteString -- ^ Returns the value of the hash at the output of the testbench. runSimWithFile :: a -> FilePath -> [ByteString] - -> Sh ByteString + -> ResultSh ByteString + +data Failed = EmptyFail + | EquivFail + | SimFail + | SynthFail + deriving (Eq, Show) + +instance Semigroup Failed where + EmptyFail <> a = a + b <> _ = b + +instance Monoid Failed where + mempty = EmptyFail -- | Synthesiser type class. -class (Tool a) => Synthesiser a where +class Tool a => Synthesiser a where runSynth :: a -- ^ Synthesiser tool instance -> SourceInfo -- ^ Run information -> FilePath -- ^ Output verilog file for the module - -> Sh () -- ^ does not return any values + -> ResultSh () -- ^ does not return any values + +-- | Type synonym for a 'ResultT' that will be used throughout 'VeriFuzz'. This +-- has instances for 'MonadSh' and 'MonadIO' if the 'Monad' it is parametrised +-- with also has those instances. +type ResultSh = ResultT Failed Sh rootPath :: Sh FilePath rootPath = do @@ -79,7 +107,7 @@ bsToI = B.foldl' (\i b -> (i `shiftL` 8) + fromIntegral b) 0 {-# INLINE bsToI #-} noPrint :: Sh a -> Sh a -noPrint = print_stdout False . print_stderr False +noPrint = liftSh . print_stdout False . print_stderr False {-# INLINE noPrint #-} echoP :: Text -> Sh () @@ -90,16 +118,30 @@ echoP t = do where bname = T.pack . takeBaseName . T.unpack . toTextIgnore logger :: FilePath -> Text -> Sh a -> Sh a -logger fp name = log_stderr_with (l "_log.stderr.txt") - . log_stdout_with (l "_log.txt") +logger 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" file s = T.unpack (toTextIgnore $ fp </> fromText name) <> s logger_ :: FilePath -> Text -> Sh a -> Sh () -logger_ fp name = - void . log_stderr_with (l "_log.stderr.txt") . log_stdout_with - (l "_log.txt") - where - l s t = appendFile (file s) (T.unpack t) >> appendFile (file s) "\n" - file s = T.unpack (toTextIgnore $ fp </> fromText name) <> s +logger_ fp name = void . logger fp name + +execute + :: (MonadSh m, Monad m, Monoid a) + => a + -> FilePath + -> Text + -> FilePath + -> [Text] + -> ResultT a m Text +execute f dir name e = annotate f . liftSh . logger dir name . timeout e + +execute_ + :: (MonadSh m, Monad m, Monoid a) + => a + -> FilePath + -> Text + -> FilePath + -> [Text] + -> ResultT a m () +execute_ a b c d = void . execute a b c d |