aboutsummaryrefslogtreecommitdiffstats
path: root/src/VeriFuzz/Sim/Internal.hs
blob: 8327ad81c980af5bbfafbb56dab332e83e72f058 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
{-|
Module      : VeriFuzz.Sim.Internal
Description : Class of the simulator.
Copyright   : (c) 2018-2019, Yann Herklotz
License     : BSD-3
Maintainer  : ymherklotz [at] gmail [dot] com
Stability   : experimental
Portability : POSIX

Class of the simulator and the synthesize tool.
-}

{-# LANGUAGE DeriveFunctor #-}

module VeriFuzz.Sim.Internal
    ( ResultSh
    , Tool(..)
    , Simulator(..)
    , Synthesiser(..)
    , Failed(..)
    , rootPath
    , timeout
    , timeout_
    , bsToI
    , noPrint
    , echoP
    , logger
    , logger_
    , execute
    , execute_
    , (<?>)
    , annotate
    )
where

import           Control.Monad         (void)
import           Data.Bits             (shiftL)
import           Data.ByteString       (ByteString)
import qualified Data.ByteString       as B
import           Data.Text             (Text)
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.
class Tool a where
  toText :: a -> Text

-- | Simulation type class.
class Tool a => Simulator a where
  runSim :: a             -- ^ Simulator instance
         -> SourceInfo       -- ^ 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
            | 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
  runSynth :: a        -- ^ Synthesiser tool instance
           -> SourceInfo  -- ^ Run information
           -> FilePath -- ^ Output verilog file for the module
           -> 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
    current <- pwd
    maybe current fromText <$> get_env "VERIFUZZ_ROOT"

timeout :: FilePath -> [Text] -> Sh Text
timeout = command1 "timeout" ["300"] . toTextIgnore
{-# INLINE timeout #-}

timeout_ :: FilePath -> [Text] -> Sh ()
timeout_ = command1_ "timeout" ["300"] . toTextIgnore
{-# INLINE timeout_ #-}

-- | Helper function to convert bytestrings to integers
bsToI :: ByteString -> Integer
bsToI = B.foldl' (\i b -> (i `shiftL` 8) + fromIntegral b) 0
{-# INLINE bsToI #-}

noPrint :: Sh a -> Sh a
noPrint = liftSh . print_stdout False . print_stderr False
{-# INLINE noPrint #-}

echoP :: Text -> Sh ()
echoP t = do
    fn          <- pwd
    currentTime <- liftIO getZonedTime
    echo $ bname fn <> " [" <> showT currentTime <> "] - " <> t
    where bname = T.pack . takeBaseName . T.unpack . toTextIgnore

logger :: FilePath -> Text -> Sh a -> Sh a
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 . 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