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
|
{-|
Module : VeriFuzz.Fuzz
Description : Environment to run the simulator and synthesisers in a matrix.
Copyright : (c) 2019, Yann Herklotz
License : GPL-3
Maintainer : ymherklotz [at] gmail [dot] com
Stability : experimental
Portability : POSIX
Environment to run the simulator and synthesisers in a matrix.
-}
module VeriFuzz.Fuzz
( SynthTool(..)
, SimTool(..)
, FuzzResult(..)
, Fuzz
, fuzz
, runFuzz
)
where
import Control.Monad.IO.Class
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader hiding (local)
import Control.Monad.Trans.State.Strict
import Data.List (nubBy)
import Hedgehog (Gen)
import Prelude hiding (FilePath)
import VeriFuzz.Result
import VeriFuzz.Sim.Icarus
import VeriFuzz.Sim.Internal
import VeriFuzz.Sim.Quartus
import VeriFuzz.Sim.Vivado
import VeriFuzz.Sim.XST
import VeriFuzz.Sim.Yosys
import VeriFuzz.Verilog.AST
data SynthTool = XSTSynth {-# UNPACK #-} !XST
| VivadoSynth {-# UNPACK #-} !Vivado
| YosysSynth {-# UNPACK #-} !Yosys
| QuartusSynth !Quartus
deriving (Eq, Show)
instance Tool SynthTool where
toText (XSTSynth xst) = toText xst
toText (VivadoSynth vivado) = toText vivado
toText (YosysSynth yosys) = toText yosys
toText (QuartusSynth quartus) = toText quartus
instance Synthesiser SynthTool where
runSynth (XSTSynth xst) = runSynth xst
runSynth (VivadoSynth vivado) = runSynth vivado
runSynth (YosysSynth yosys) = runSynth yosys
runSynth (QuartusSynth quartus) = runSynth quartus
newtype SimTool = IcarusSim Icarus
deriving (Eq, Show)
instance Tool SimTool where
toText (IcarusSim icarus) = toText icarus
instance Simulator SimTool where
runSim (IcarusSim icarus) = runSim icarus
runSimWithFile (IcarusSim icarus) = runSimWithFile icarus
data FuzzEnv = FuzzEnv { getSynthesisers :: ![SynthTool]
, getSimulators :: ![SimTool]
}
deriving (Eq, Show)
data SimResult a = SimResult !SynthTool !SimTool !(Result Failed a)
deriving (Eq, Show)
data SynthResult a = SynthResult !SynthTool !SynthTool !(Result Failed a)
deriving (Eq, Show)
data FuzzResult a = FuzzResult { getSynthResults :: ![SynthResult a]
, getSimResults :: ![SimResult a]
}
deriving (Eq, Show)
instance Semigroup (FuzzResult a) where
FuzzResult a1 b1 <> FuzzResult a2 b2 = FuzzResult (a1 <> a2) (b1 <> b2)
instance Monoid (FuzzResult a) where
mempty = FuzzResult [] []
type Fuzz a m = StateT (FuzzResult a) (ReaderT FuzzEnv m)
runFuzz :: (Monad m) => [SynthTool] -> [SimTool] -> Fuzz a m b -> m b
runFuzz synth sim m =
runReaderT (evalStateT m (FuzzResult [] [])) (FuzzEnv synth sim)
synthesisers :: (Monad m) => Fuzz () m [SynthTool]
synthesisers = lift $ asks getSynthesisers
simulators :: (Monad m) => Fuzz () m [SimTool]
simulators = lift $ asks getSimulators
combinations :: [a] -> [b] -> [(a, b)]
combinations l1 l2 = [ (x, y) | x <- l1, y <- l2 ]
fuzz :: (MonadIO m) => Gen SourceInfo -> Fuzz () m (FuzzResult ())
fuzz _ = do
synth <- synthesisers
sim <- simulators
let synthComb =
nubBy tupEq . filter (uncurry (/=)) $ combinations synth synth
let simComb = combinations synth sim
return mempty
where tupEq (a, b) (a', b') = (a == a' && b == b') || (a == b' && b == a')
|
