From 08277fe043ae29296ce4a32bab569f524f88b859 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Tue, 23 Apr 2019 13:31:08 +0100 Subject: Add Report type --- src/VeriFuzz/Report.hs | 169 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 169 insertions(+) create mode 100644 src/VeriFuzz/Report.hs (limited to 'src/VeriFuzz/Report.hs') diff --git a/src/VeriFuzz/Report.hs b/src/VeriFuzz/Report.hs new file mode 100644 index 0000000..aab318c --- /dev/null +++ b/src/VeriFuzz/Report.hs @@ -0,0 +1,169 @@ +{-| +Module : VeriFuzz.Report +Description : Generate a report from a fuzz run. +Copyright : (c) 2019, Yann Herklotz Grave +License : GPL-3 +Maintainer : ymherklotz [at] gmail [dot] com +Stability : experimental +Portability : POSIX + +Generate a report from a fuzz run. +-} + +{-# LANGUAGE TemplateHaskell #-} + +module VeriFuzz.Report + ( SynthTool(..) + , SynthStatus(..) + , SimTool(..) + , FuzzReport(..) + , synthResults + , simResults + , synthStatus + , defaultIcarusSim + , defaultVivadoSynth + , defaultYosysSynth + , defaultXSTSynth + , defaultQuartusSynth + , descriptionToSim + , descriptionToSynth + ) +where + +import Control.Lens +import Control.Monad.IO.Class +import Control.Monad.Trans.Control (MonadBaseControl) +import Data.ByteString (ByteString) +import Prelude hiding (FilePath) +import Shelly.Lifted (MonadSh) +import VeriFuzz.Config +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 + +-- | Common type alias for synthesis results +type UResult = Result Failed () + +-- | Commont type alias for simulation results +type BResult = Result Failed ByteString + +data SynthTool = XSTSynth {-# UNPACK #-} !XST + | VivadoSynth {-# UNPACK #-} !Vivado + | YosysSynth {-# UNPACK #-} !Yosys + | QuartusSynth !Quartus + deriving (Eq) + +instance Show SynthTool where + show (XSTSynth xst) = show xst + show (VivadoSynth vivado) = show vivado + show (YosysSynth yosys) = show yosys + show (QuartusSynth quartus) = show quartus + +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 + + synthOutput (XSTSynth xst) = synthOutput xst + synthOutput (VivadoSynth vivado) = synthOutput vivado + synthOutput (YosysSynth yosys) = synthOutput yosys + synthOutput (QuartusSynth quartus) = synthOutput quartus + + setSynthOutput (YosysSynth yosys) = YosysSynth . setSynthOutput yosys + setSynthOutput (XSTSynth xst) = XSTSynth . setSynthOutput xst + setSynthOutput (VivadoSynth vivado) = VivadoSynth . setSynthOutput vivado + setSynthOutput (QuartusSynth quartus) = QuartusSynth . setSynthOutput quartus + +defaultYosysSynth :: SynthTool +defaultYosysSynth = YosysSynth defaultYosys + +defaultQuartusSynth :: SynthTool +defaultQuartusSynth = QuartusSynth defaultQuartus + +defaultVivadoSynth :: SynthTool +defaultVivadoSynth = VivadoSynth defaultVivado + +defaultXSTSynth :: SynthTool +defaultXSTSynth = XSTSynth defaultXST + +newtype SimTool = IcarusSim Icarus + deriving (Eq) + +instance Tool SimTool where + toText (IcarusSim icarus) = toText icarus + +instance Simulator SimTool where + runSim (IcarusSim icarus) = runSim icarus + runSimWithFile (IcarusSim icarus) = runSimWithFile icarus + +instance Show SimTool where + show (IcarusSim icarus) = show icarus + +defaultIcarusSim :: SimTool +defaultIcarusSim = IcarusSim defaultIcarus + +-- | The results from running a tool through a simulator. It can either fail or +-- return a result, which is most likely a 'ByteString'. +data SimResult = SimResult !SynthTool !SimTool !(BResult) + deriving (Eq) + +instance Show SimResult where + show (SimResult synth sim r) = show synth <> ", " <> show sim <> ": " <> show r + +-- | The results of comparing the synthesised outputs of two files using a +-- formal equivalence checker. This will either return a failure or an output +-- which is most likely '()'. +data SynthResult = SynthResult !SynthTool !SynthTool !(UResult) + deriving (Eq) + +instance Show SynthResult where + show (SynthResult synth synth2 r) = show synth <> ", " <> show synth2 <> ": " <> show r + +-- | The status of the synthesis using a simulator. This will be checked before +-- attempting to run the equivalence checks on the simulator, as that would be +-- unnecessary otherwise. +data SynthStatus = SynthStatus !SynthTool !(UResult) + deriving (Eq) + +instance Show SynthStatus where + show (SynthStatus synth r) = "synthesis " <> show synth <> ": " <> show r + +-- | The complete state that will be used during fuzzing, which contains the +-- results from all the operations. +data FuzzReport = FuzzReport { _synthResults :: ![SynthResult] + , _simResults :: ![SimResult] + , _synthStatus :: ![SynthStatus] + } + deriving (Eq, Show) + +$(makeLenses ''FuzzReport) + +instance Semigroup FuzzReport where + FuzzReport a1 b1 c1 <> FuzzReport a2 b2 c2 = FuzzReport (a1 <> a2) (b1 <> b2) (c1 <> c2) + +instance Monoid FuzzReport where + mempty = FuzzReport [] [] [] + +descriptionToSim :: SimDescription -> SimTool +descriptionToSim (SimDescription "icarus") = defaultIcarusSim +descriptionToSim s = + error $ "Could not find implementation for simulator '" <> show s <> "'" + +descriptionToSynth :: SynthDescription -> SynthTool +descriptionToSynth (SynthDescription "yosys" ) = defaultYosysSynth +descriptionToSynth (SynthDescription "vivado" ) = defaultVivadoSynth +descriptionToSynth (SynthDescription "xst" ) = defaultXSTSynth +descriptionToSynth (SynthDescription "quartus") = defaultQuartusSynth +descriptionToSynth s = + error $ "Could not find implementation for synthesiser '" <> show s <> "'" -- cgit