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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
|
{-|
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(..)
, 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 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 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
-> ResultSh () -- ^ does not return any values
synthOutput :: a -> FilePath
setSynthOutput :: a -> FilePath -> a
-- | 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
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
-- | 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 -> Sh [Text]
checkPresentModules fp (SourceInfo _ src) = do
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]
-- | 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
-- should find all the instantiations and definitions. This could again be made
-- much simpler if the parser works.
replaceMods :: FilePath -> Text -> SourceInfo -> Sh ()
replaceMods fp t (SourceInfo _ src) =
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 "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 = print_stdout False . print_stderr False
{-# INLINE noPrint #-}
logger :: Text -> Sh ()
logger t = do
fn <- pwd
currentTime <- liftIO getZonedTime
echo
$ "VeriFuzz "
<> 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")
. 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
logCommand_ :: FilePath -> Text -> Sh a -> Sh ()
logCommand_ fp name = void . logCommand 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 . logCommand 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
|