Fix types with annotations

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 }