From 805f67c07cc15d784078b00a84f4055f84016cec Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Mon, 11 May 2020 18:29:06 +0100 Subject: Fix types with annotations --- src/Verismith.hs | 8 ++++---- src/Verismith/Config.hs | 2 +- src/Verismith/Fuzz.hs | 19 ++++++++++--------- src/Verismith/Tool/Icarus.hs | 9 +++++---- src/Verismith/Tool/Identity.hs | 2 +- src/Verismith/Tool/Internal.hs | 10 ++++++---- src/Verismith/Tool/Quartus.hs | 2 +- src/Verismith/Tool/QuartusLight.hs | 2 +- src/Verismith/Tool/Template.hs | 2 +- src/Verismith/Tool/Vivado.hs | 2 +- src/Verismith/Tool/XST.hs | 2 +- src/Verismith/Tool/Yosys.hs | 8 ++++---- src/Verismith/Verilog/CodeGen.hs | 27 +++++++++++++++------------ 13 files changed, 51 insertions(+), 44 deletions(-) diff --git a/src/Verismith.hs b/src/Verismith.hs index c9d3e78..e709ff4 100644 --- a/src/Verismith.hs +++ b/src/Verismith.hs @@ -147,7 +147,7 @@ handleOpts (Fuzz o configF f k n nosim noequiv noreduction file top cc checker) return () handleOpts (Generate f c) = do config <- getConfig c - source <- proceduralIO "top" config + source <- proceduralIO "top" config :: IO (Verilog ()) maybe (T.putStrLn $ genSource source) (flip T.writeFile $ genSource source) $ T.unpack . toTextIgnore @@ -188,7 +188,7 @@ handleOpts (Reduce f t _ ls' False) = do return () where dir = fromText "reduce" handleOpts (Reduce f t _ ls' True) = do - src <- parseSourceInfoFile t (toTextIgnore f) + src <- parseSourceInfoFile t (toTextIgnore f) :: IO (SourceInfo ()) datadir <- getDataDir case descriptionToSynth <$> ls' of a : b : _ -> do @@ -248,7 +248,7 @@ runSimulation = do -- let circ = -- head $ (nestUpTo 30 . generateAST $ Circuit gr) ^.. getVerilog . traverse . getDescription rand <- generateByteString Nothing 32 20 - rand2 <- Hog.sample (randomMod 10 100) + rand2 <- Hog.sample (randomMod 10 100) :: IO (ModDecl ()) val <- shelly . runResultT $ runSim defaultIcarus (makeSrcInfo rand2) rand case val of Pass a -> T.putStrLn $ showBS a @@ -271,7 +271,7 @@ onFailure t _ = do chdir ".." $ cp_r (fromText t) $ fromText (t <> "_failed") return $ Fail EmptyFail -checkEquivalence :: (SourceInfo ann) -> Text -> IO Bool +checkEquivalence :: Show ann => SourceInfo ann -> Text -> IO Bool checkEquivalence src dir = shellyFailDir $ do mkdir_p (fromText dir) curr <- toTextIgnore <$> pwd diff --git a/src/Verismith/Config.hs b/src/Verismith/Config.hs index f757ebb..df684b7 100644 --- a/src/Verismith/Config.hs +++ b/src/Verismith/Config.hs @@ -538,7 +538,7 @@ parseConfigFile = Toml.decodeFile configCodec parseConfig :: Text -> Config parseConfig t = case Toml.decode configCodec t of - Right c -> c + Right c-> c Left Toml.TrivialError -> error "Trivial error while parsing Toml config" Left (Toml.KeyNotFound k) -> error $ "Key " ++ show k ++ " not found" Left (Toml.TableNotFound k) -> error $ "Table " ++ show k ++ " not found" diff --git a/src/Verismith/Fuzz.hs b/src/Verismith/Fuzz.hs index 20dc13c..7771f6a 100644 --- a/src/Verismith/Fuzz.hs +++ b/src/Verismith/Fuzz.hs @@ -205,7 +205,7 @@ timeit a = do end <- liftIO getCurrentTime return (diffUTCTime end start, result) -synthesis :: (MonadBaseControl IO m, MonadSh m) => (SourceInfo ann) -> Fuzz m () +synthesis :: (MonadBaseControl IO m, MonadSh m, Show ann) => (SourceInfo ann) -> Fuzz m () synthesis src = do synth <- synthesisers resTimes <- liftSh $ mapM exec synth @@ -267,7 +267,7 @@ toolRun t m = do logT $ "Finished " <> t <> " " <> showT s return s -equivalence :: (MonadBaseControl IO m, MonadSh m) => (SourceInfo ann) -> Fuzz m () +equivalence :: (MonadBaseControl IO m, MonadSh m, Show ann) => (SourceInfo ann) -> Fuzz m () equivalence src = do doCrossCheck <- fmap _fuzzOptsCrossCheck askOpts datadir <- fmap _fuzzDataDir askOpts @@ -303,7 +303,7 @@ equivalence src = do runEquiv checker datadir a b src where dir = fromText $ "equiv_" <> toText a <> "_" <> toText b -simulation :: (MonadIO m, MonadSh m) => (SourceInfo ann) -> Fuzz m () +simulation :: (MonadIO m, MonadSh m, Show ann) => (SourceInfo ann) -> Fuzz m () simulation src = do datadir <- fmap _fuzzDataDir askOpts synth <- passedSynthesis @@ -365,8 +365,8 @@ passEquiv = filter withIdentity . _fuzzSynthResults <$> get withIdentity _ = False -- | Always reduces with respect to 'Identity'. -reduction :: (MonadSh m, Eq ann) => (SourceInfo ann) -> Fuzz m () -reduction src = do +reduction :: (MonadSh m) => SourceInfo ann -> Fuzz m () +reduction rsrc = do datadir <- fmap _fuzzDataDir askOpts checker <- fmap _fuzzOptsChecker askOpts fails <- failEquivWithIdentity @@ -386,6 +386,7 @@ reduction src = do redSim datadir (SimResult t _ bs _ _) = do r <- reduceSimIc datadir bs t src writefile (fromText $ "reduce_sim_" <> toText t <> ".v") $ genSource r + src = clearAnn rsrc titleRun :: (MonadIO m, MonadSh m) => Text -> Fuzz m a -> Fuzz m (NominalDiffTime, a) @@ -402,7 +403,7 @@ getTime :: (Num n) => Maybe (n, a) -> n getTime = maybe 0 fst generateSample - :: (MonadIO m, MonadSh m) + :: (MonadIO m, MonadSh m, Show ann) => Fuzz m (Seed, (SourceInfo ann)) -> Fuzz m (Seed, (SourceInfo ann)) generateSample f = do @@ -452,7 +453,7 @@ medianFreqs l = zip hat (return <$> l) hat = set_ <$> [1 .. length l] set_ n = if n == h then 1 else 0 -fuzz :: (MonadFuzz m, Ord ann) => Gen (SourceInfo ann) -> Fuzz m FuzzReport +fuzz :: (MonadFuzz m, Ord ann, Show ann) => Gen (SourceInfo ann) -> Fuzz m FuzzReport fuzz gen = do conf <- askConfig opts <- askOpts @@ -494,7 +495,7 @@ fuzz gen = do (getTime redResult) return report -fuzzInDir :: (MonadFuzz m, Ord ann) => Gen (SourceInfo ann) -> Fuzz m FuzzReport +fuzzInDir :: (MonadFuzz m, Ord ann, Show ann) => Gen (SourceInfo ann) -> Fuzz m FuzzReport fuzzInDir src = do fuzzOpts <- askOpts let fp = fromMaybe "fuzz" $ _fuzzOptsOutput fuzzOpts @@ -508,7 +509,7 @@ fuzzInDir src = do bname = T.pack . takeBaseName . T.unpack . toTextIgnore fuzzMultiple - :: (MonadFuzz m, Ord ann) + :: (MonadFuzz m, Ord ann, Show ann) => Gen (SourceInfo ann) -> Fuzz m [FuzzReport] fuzzMultiple src = do diff --git a/src/Verismith/Tool/Icarus.hs b/src/Verismith/Tool/Icarus.hs index 0fb2146..4b91652 100644 --- a/src/Verismith/Tool/Icarus.hs +++ b/src/Verismith/Tool/Icarus.hs @@ -103,7 +103,7 @@ mask = T.replace "x" "0" callback :: ByteString -> Text -> ByteString callback b t = b <> convert (mask t) -runSimIcarus :: Icarus -> (SourceInfo ann) -> [ByteString] -> ResultSh ByteString +runSimIcarus :: Show ann => Icarus -> (SourceInfo ann) -> [ByteString] -> ResultSh ByteString runSimIcarus sim rinfo bss = do let tb = ModDecl "main" @@ -159,7 +159,8 @@ counterTestBench (CounterEg _ states) m = tbModule filtered m where filtered = convert . fold . fmap snd . filter ((/= "clk") . fst) <$> states -runSimIc' :: (Synthesiser b) => ([ByteString] -> (ModDecl ann) -> (Verilog ann)) +runSimIc' :: (Synthesiser b, Show ann) + => ([ByteString] -> (ModDecl ann) -> (Verilog ann)) -> FilePath -> Icarus -> b @@ -194,7 +195,7 @@ runSimIc' fun datadir sim1 synth1 srcInfo bss bs = do tbname = fromText $ toText synth1 <> "_testbench.v" exename = toText synth1 <> "_main" -runSimIc :: (Synthesiser b) +runSimIc :: (Synthesiser b, Show ann) => FilePath -- ^ Data directory. -> Icarus -- ^ Icarus simulator. -> b -- ^ Synthesis tool to be tested. @@ -206,6 +207,6 @@ runSimIc :: (Synthesiser b) -> ResultSh ByteString runSimIc = runSimIc' tbModule -runSimIcEC :: (Synthesiser b) => FilePath -> Icarus -> b +runSimIcEC :: (Synthesiser b, Show ann) => FilePath -> Icarus -> b -> (SourceInfo ann) -> CounterEg -> Maybe ByteString -> ResultSh ByteString runSimIcEC a b c d e = runSimIc' (const $ counterTestBench e) a b c d [] diff --git a/src/Verismith/Tool/Identity.hs b/src/Verismith/Tool/Identity.hs index 8f6901f..804f096 100644 --- a/src/Verismith/Tool/Identity.hs +++ b/src/Verismith/Tool/Identity.hs @@ -44,7 +44,7 @@ instance Synthesiser Identity where instance NFData Identity where rnf = rwhnf -runSynthIdentity :: Identity -> (SourceInfo ann) -> ResultSh () +runSynthIdentity :: Show ann => Identity -> (SourceInfo ann) -> ResultSh () runSynthIdentity (Identity _ out) = writefile out . genSource defaultIdentity :: Identity diff --git a/src/Verismith/Tool/Internal.hs b/src/Verismith/Tool/Internal.hs index 77ec4c9..f462c74 100644 --- a/src/Verismith/Tool/Internal.hs +++ b/src/Verismith/Tool/Internal.hs @@ -65,9 +65,10 @@ class Tool a where -- | Simulation type class. class Tool a => Simulator a where - runSim :: a -- ^ Simulator instance - -> SourceInfo ann -- ^ Run information - -> [ByteString] -- ^ Inputs to simulate + runSim :: Show ann + => a -- ^ Simulator instance + -> SourceInfo ann -- ^ Run information + -> [ByteString] -- ^ Inputs to simulate -> ResultSh ByteString -- ^ Returns the value of the hash at the output of the testbench. runSimWithFile :: a -> FilePath @@ -99,7 +100,8 @@ instance Monoid Failed where -- | Synthesiser type class. class Tool a => Synthesiser a where - runSynth :: a -- ^ Synthesiser tool instance + runSynth :: Show ann + => a -- ^ Synthesiser tool instance -> SourceInfo ann -- ^ Run information -> ResultSh () -- ^ does not return any values synthOutput :: a -> FilePath diff --git a/src/Verismith/Tool/Quartus.hs b/src/Verismith/Tool/Quartus.hs index e6624eb..ff8a62b 100644 --- a/src/Verismith/Tool/Quartus.hs +++ b/src/Verismith/Tool/Quartus.hs @@ -49,7 +49,7 @@ instance NFData Quartus where defaultQuartus :: Quartus defaultQuartus = Quartus Nothing "quartus" "syn_quartus.v" -runSynthQuartus :: Quartus -> (SourceInfo ann) -> ResultSh () +runSynthQuartus :: Show ann => Quartus -> (SourceInfo ann) -> ResultSh () runSynthQuartus sim (SourceInfo top src) = do dir <- liftSh pwd let ex = execute_ SynthFail dir "quartus" diff --git a/src/Verismith/Tool/QuartusLight.hs b/src/Verismith/Tool/QuartusLight.hs index f703da0..cdf2636 100644 --- a/src/Verismith/Tool/QuartusLight.hs +++ b/src/Verismith/Tool/QuartusLight.hs @@ -49,7 +49,7 @@ instance NFData QuartusLight where defaultQuartusLight :: QuartusLight defaultQuartusLight = QuartusLight Nothing "quartus" "syn_quartus.v" -runSynthQuartusLight :: QuartusLight -> (SourceInfo ann) -> ResultSh () +runSynthQuartusLight :: Show ann => QuartusLight -> (SourceInfo ann) -> ResultSh () runSynthQuartusLight sim (SourceInfo top src) = do dir <- liftSh pwd let ex = execute_ SynthFail dir "quartus" diff --git a/src/Verismith/Tool/Template.hs b/src/Verismith/Tool/Template.hs index a2e0675..5a20ff5 100644 --- a/src/Verismith/Tool/Template.hs +++ b/src/Verismith/Tool/Template.hs @@ -172,7 +172,7 @@ sbyConfig mt datadir sim1 sim2 (SourceInfo top _) = T.unlines <$> deps readL = T.intercalate "\n" $ mappend "read -formal " <$> deps -icarusTestbench :: (Synthesiser a) => FilePath -> (Verilog ann) -> a -> Text +icarusTestbench :: (Synthesiser a, Show ann) => FilePath -> (Verilog ann) -> a -> Text icarusTestbench datadir t synth1 = T.unlines [ "`include \"" <> ddir <> "/data/cells_cmos.v\"" , "`include \"" <> ddir <> "/data/cells_cyclone_v.v\"" diff --git a/src/Verismith/Tool/Vivado.hs b/src/Verismith/Tool/Vivado.hs index 35cda2e..ef8b1b7 100644 --- a/src/Verismith/Tool/Vivado.hs +++ b/src/Verismith/Tool/Vivado.hs @@ -49,7 +49,7 @@ instance NFData Vivado where defaultVivado :: Vivado defaultVivado = Vivado Nothing "vivado" "syn_vivado.v" -runSynthVivado :: Vivado -> (SourceInfo ann) -> ResultSh () +runSynthVivado :: Show ann => Vivado -> (SourceInfo ann) -> ResultSh () runSynthVivado sim (SourceInfo top src) = do dir <- liftSh pwd liftSh $ do diff --git a/src/Verismith/Tool/XST.hs b/src/Verismith/Tool/XST.hs index 1e37149..213fae8 100644 --- a/src/Verismith/Tool/XST.hs +++ b/src/Verismith/Tool/XST.hs @@ -51,7 +51,7 @@ instance NFData XST where defaultXST :: XST defaultXST = XST Nothing "xst" "syn_xst.v" -runSynthXST :: XST -> (SourceInfo ann) -> ResultSh () +runSynthXST :: Show ann => XST -> (SourceInfo ann) -> ResultSh () runSynthXST sim (SourceInfo top src) = do dir <- liftSh pwd let exec n = execute_ diff --git a/src/Verismith/Tool/Yosys.hs b/src/Verismith/Tool/Yosys.hs index 24b83fd..f68f39f 100644 --- a/src/Verismith/Tool/Yosys.hs +++ b/src/Verismith/Tool/Yosys.hs @@ -63,7 +63,7 @@ defaultYosys = Yosys Nothing "yosys" "syn_yosys.v" yosysPath :: Yosys -> FilePath yosysPath sim = maybe (S.fromText "yosys") ( S.fromText "yosys") $ yosysBin sim -runSynthYosys :: Yosys -> (SourceInfo ann) -> ResultSh () +runSynthYosys :: Show ann => Yosys -> (SourceInfo ann) -> ResultSh () runSynthYosys sim (SourceInfo _ src) = do dir <- liftSh $ do dir' <- S.pwd @@ -83,7 +83,7 @@ runSynthYosys sim (SourceInfo _ src) = do out = S.toTextIgnore $ synthOutput sim runEquivYosys - :: (Synthesiser a, Synthesiser b) + :: (Synthesiser a, Synthesiser b, Show ann) => Yosys -> a -> b @@ -103,8 +103,8 @@ runEquivYosys yosys sim1 sim2 srcInfo = do liftSh $ S.run_ (yosysPath yosys) [S.toTextIgnore checkFile] where checkFile = S.fromText $ "test." <> toText sim1 <> "." <> toText sim2 <> ".ys" -runEquiv - :: (Synthesiser a, Synthesiser b) => Maybe Text -> FilePath -> a -> b -> (SourceInfo ann) -> ResultSh () +runEquiv :: (Synthesiser a, Synthesiser b, Show ann) + => Maybe Text -> FilePath -> a -> b -> (SourceInfo ann) -> ResultSh () runEquiv mt datadir sim1 sim2 srcInfo = do dir <- liftSh S.pwd liftSh $ do diff --git a/src/Verismith/Verilog/CodeGen.hs b/src/Verismith/Verilog/CodeGen.hs index f8fce80..39301e4 100644 --- a/src/Verismith/Verilog/CodeGen.hs +++ b/src/Verismith/Verilog/CodeGen.hs @@ -40,15 +40,15 @@ class Source a where -- | Map a 'Maybe (Statement ann)' to 'Text'. If it is 'Just statement', the generated -- statements are returned. If it is 'Nothing', then @;\n@ is returned. -defMap :: Maybe (Statement ann) -> Doc a +defMap :: Show ann => Maybe (Statement ann) -> Doc a defMap = maybe semi statement -- | Convert the 'Verilog ann' type to 'Text' so that it can be rendered. -verilogSrc :: (Verilog ann) -> Doc a +verilogSrc :: Show ann => (Verilog ann) -> Doc a verilogSrc (Verilog modules) = vsep . punctuate line $ moduleDecl <$> modules -- | Generate the 'ModDecl ann' for a module and convert it to 'Text'. -moduleDecl :: ModDecl ann -> Doc a +moduleDecl :: Show ann => ModDecl ann -> Doc a moduleDecl (ModDecl i outP inP items ps) = vsep [ sep ["module" <+> identifier i, params ps, ports <> semi] , indent 2 modI @@ -62,6 +62,7 @@ moduleDecl (ModDecl i outP inP items ps) = vsep outIn = outP ++ inP params [] = "" params (p : pps) = hcat ["#", paramList (p :| pps)] +moduleDecl (ModDeclAnn a m) = sep [hsep ["/*", pretty $ show a, "*/"], moduleDecl m] -- | Generates a parameter list. Can only be called with a 'NonEmpty' list. paramList :: NonEmpty Parameter -> Doc a @@ -111,8 +112,8 @@ portDir PortOut = "output" portDir PortInOut = "inout" -- | Generate a '(ModItem ann)'. -moduleItem :: (ModItem ann) -> Doc a -moduleItem (ModCA ca ) = contAssign ca +moduleItem :: Show ann => ModItem ann -> Doc a +moduleItem (ModCA ca) = contAssign ca moduleItem (ModInst i name conn) = (<> semi) $ hsep [ identifier i , identifier name @@ -126,6 +127,7 @@ moduleItem (Decl dir p ini) = (<> semi) . hsep . makeIni = ("=" <+>) . constExpr moduleItem (ParamDecl p) = hcat [paramList p, semi] moduleItem (LocalParamDecl p) = hcat [localParamList p, semi] +moduleItem (ModItemAnn a mi) = sep [hsep ["/*", pretty $ show a, "*/"], moduleItem mi] mConn :: ModConn -> Doc a mConn (ModConn c ) = expr c @@ -248,11 +250,11 @@ caseType CaseStandard = "case" caseType CaseX = "casex" caseType CaseZ = "casez" -casePair :: (CasePair ann) -> Doc a +casePair :: Show ann => (CasePair ann) -> Doc a casePair (CasePair e s) = vsep [hsep [expr e, colon], indent 2 $ statement s] -statement :: Statement ann -> Doc a +statement :: Show ann => Statement ann -> Doc a statement (TimeCtrl d stat) = hsep [delay d, defMap stat] statement (EventCtrl e stat) = hsep [event e, defMap stat] statement (SeqBlock s) = @@ -283,6 +285,7 @@ statement (ForLoop a e incr stmnt) = vsep ] , indent 2 $ statement stmnt ] +statement (StmntAnn a s) = sep [hsep ["/*", pretty $ show a, "*/"], statement s] task :: Task -> Doc a task (Task i e) @@ -302,7 +305,7 @@ instance Source Identifier where instance Source Task where genSource = showT . task -instance Source (Statement ann) where +instance Show ann => Source (Statement ann) where genSource = showT . statement instance Source PortType where @@ -329,7 +332,7 @@ instance Source Expr where instance Source ContAssign where genSource = showT . contAssign -instance Source (ModItem ann) where +instance Show ann => Source (ModItem ann) where genSource = showT . moduleItem instance Source PortDir where @@ -338,13 +341,13 @@ instance Source PortDir where instance Source Port where genSource = showT . port -instance Source (ModDecl ann) where +instance Show ann => Source (ModDecl ann) where genSource = showT . moduleDecl -instance Source (Verilog ann) where +instance Show ann => Source (Verilog ann) where genSource = showT . verilogSrc -instance Source (SourceInfo ann) where +instance Show ann => Source (SourceInfo ann) where genSource (SourceInfo _ src) = genSource src newtype GenVerilog a = GenVerilog { unGenVerilog :: a } -- cgit