From 4ba440d842e9a0502b429fbc04e2be41c8037a4c Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Sat, 19 Jan 2019 19:20:33 +0000 Subject: Add brittany formatting instead of stylish-haskell --- src/VeriFuzz/Simulator/General.hs | 10 +++++----- src/VeriFuzz/Simulator/Icarus.hs | 35 +++++++++++++++++++---------------- src/VeriFuzz/Simulator/Xst.hs | 10 ++++++---- src/VeriFuzz/Simulator/Yosys.hs | 18 +++++++++++------- 4 files changed, 41 insertions(+), 32 deletions(-) (limited to 'src/VeriFuzz/Simulator') diff --git a/src/VeriFuzz/Simulator/General.hs b/src/VeriFuzz/Simulator/General.hs index 3615d3a..9001bf9 100644 --- a/src/VeriFuzz/Simulator/General.hs +++ b/src/VeriFuzz/Simulator/General.hs @@ -12,11 +12,11 @@ Class of the simulator and the synthesize tool. module VeriFuzz.Simulator.General where -import Data.Bits (shiftL) -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Text (Text) -import Prelude hiding (FilePath) +import Data.Bits ( shiftL ) +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as B +import Data.Text ( Text ) +import Prelude hiding ( FilePath ) import Shelly import VeriFuzz.Verilog.AST diff --git a/src/VeriFuzz/Simulator/Icarus.hs b/src/VeriFuzz/Simulator/Icarus.hs index 1f5ad38..443f096 100644 --- a/src/VeriFuzz/Simulator/Icarus.hs +++ b/src/VeriFuzz/Simulator/Icarus.hs @@ -13,12 +13,12 @@ Icarus verilog module. module VeriFuzz.Simulator.Icarus where import Control.Lens -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Foldable (fold) +import Data.ByteString ( ByteString ) +import qualified Data.ByteString as B +import Data.Foldable ( fold ) import Data.Hashable -import Data.List (transpose) -import Prelude hiding (FilePath) +import Data.List ( transpose ) +import Prelude hiding ( FilePath ) import Shelly import VeriFuzz.Simulator.General import VeriFuzz.Verilog @@ -37,26 +37,29 @@ defaultIcarus :: Icarus defaultIcarus = Icarus "iverilog" "vvp" addDisplay :: [Stmnt] -> [Stmnt] -addDisplay s = - concat $ transpose [s, replicate l $ TimeCtrl 1 Nothing - , replicate l . SysTaskEnable $ Task "display" ["%h", Id "y"]] - where - l = length s +addDisplay s = concat $ transpose + [ s + , replicate l $ TimeCtrl 1 Nothing + , replicate l . SysTaskEnable $ Task "display" ["%h", Id "y"] + ] + where l = length s assignFunc :: [Port] -> ByteString -> Stmnt assignFunc inp bs = NonBlockAssign . Assign conc Nothing . Number (B.length bs * 4) $ bsToI bs - where - conc = RegConcat (portToExpr <$> inp) + where conc = RegConcat (portToExpr <$> inp) runSimIcarus :: Icarus -> ModDecl -> [ByteString] -> Sh Int runSimIcarus sim m bss = do - let tb = ModDecl "main" [] [] - [ Initial $ - fold (addDisplay $ assignFunc (m ^. modInPorts) <$> bss) + let tb = ModDecl + "main" + [] + [] + [ Initial + $ fold (addDisplay $ assignFunc (m ^. modInPorts) <$> bss) <> (SysTaskEnable $ Task "finish" []) ] - let newtb = instantiateMod m tb + let newtb = instantiateMod m tb let modWithTb = VerilogSrc $ Description <$> [newtb, m] writefile "main.v" $ genSource modWithTb run_ (icarusPath sim) ["-o", "main", "main.v"] diff --git a/src/VeriFuzz/Simulator/Xst.hs b/src/VeriFuzz/Simulator/Xst.hs index 16e9b97..3209caf 100644 --- a/src/VeriFuzz/Simulator/Xst.hs +++ b/src/VeriFuzz/Simulator/Xst.hs @@ -14,10 +14,10 @@ Xst (ise) simulator implementation. module VeriFuzz.Simulator.Xst where -import Control.Lens hiding ((<.>)) -import Prelude hiding (FilePath) +import Control.Lens hiding ( (<.>) ) +import Prelude hiding ( FilePath ) import Shelly -import Text.Shakespeare.Text (st) +import Text.Shakespeare.Text ( st ) import VeriFuzz.Simulator.General import VeriFuzz.Verilog.AST import VeriFuzz.Verilog.CodeGen @@ -33,8 +33,10 @@ instance Synthesize Xst where runSynth = runSynthXst defaultXst :: Xst -defaultXst = Xst "/opt/Xilinx/14.7/ISE_DS/ISE/bin/lin64/xst" "/opt/Xilinx/14.7/ISE_DS/ISE/bin/lin64/netgen" +defaultXst = Xst "/opt/Xilinx/14.7/ISE_DS/ISE/bin/lin64/xst" + "/opt/Xilinx/14.7/ISE_DS/ISE/bin/lin64/netgen" +-- brittany-disable-next-binding runSynthXst :: Xst -> ModDecl -> FilePath -> Sh () runSynthXst sim m outf = do writefile xstFile [st|run diff --git a/src/VeriFuzz/Simulator/Yosys.hs b/src/VeriFuzz/Simulator/Yosys.hs index af950f2..028fbb2 100644 --- a/src/VeriFuzz/Simulator/Yosys.hs +++ b/src/VeriFuzz/Simulator/Yosys.hs @@ -15,10 +15,10 @@ Yosys simulator implementation. module VeriFuzz.Simulator.Yosys where import Control.Lens -import Data.Text (Text) -import Prelude hiding (FilePath) +import Data.Text ( Text ) +import Prelude hiding ( FilePath ) import Shelly -import Text.Shakespeare.Text (st) +import Text.Shakespeare.Text ( st ) import VeriFuzz.Simulator.General import VeriFuzz.Verilog @@ -33,6 +33,7 @@ instance Synthesize Yosys where defaultYosys :: Yosys defaultYosys = Yosys "/usr/bin/yosys" +-- brittany-disable-next-binding writeSimFile :: Yosys -- ^ Simulator instance -> ModDecl -- ^ Current module -> FilePath -- ^ Output sim file @@ -47,11 +48,12 @@ runSynthYosys :: Yosys -> ModDecl -> FilePath -> Sh () runSynthYosys sim m outf = do writefile inpf $ genSource m run_ (yosysPath sim) ["-q", "-b", "verilog -noattr", "-o", out, "-S", inp] - where - inpf = "rtl.v" - inp = toTextIgnore inpf - out = toTextIgnore outf + where + inpf = "rtl.v" + inp = toTextIgnore inpf + out = toTextIgnore outf +-- brittany-disable-next-binding writeSatFile :: (Synthesize a, Synthesize b) => Text -> a -> Maybe b -> ModDecl -> Sh () writeSatFile checkFile sim1 sim2 m = writefile (fromText checkFile) [st|read_verilog syn_#{toText sim1}.v @@ -69,10 +71,12 @@ sat -timeout 20 -verify-no-timeout -ignore_div_by_zero -prove y_1 y_2 #{modName} modName = m ^. moduleId . getIdentifier -- ids = T.intercalate "," $ allVars m ^.. traverse . getIdentifier +-- brittany-disable-next-binding runOtherSynth :: (Synthesize a) => Maybe a -> ModDecl -> Sh () runOtherSynth (Just sim) m = runSynth sim m $ fromText [st|syn_#{toText sim}.v|] runOtherSynth Nothing m = writefile "syn_rtl.v" $ genSource m +-- brittany-disable-next-binding runEquiv :: (Synthesize a, Synthesize b) => Yosys -> a -> Maybe b -> ModDecl -> Sh () runEquiv yosys sim1 sim2 m = do writefile "top.v" . genSource . initMod $ makeTop 2 m -- cgit