From 796ea70c979cda97aef5849fd5cd5ecb969422b7 Mon Sep 17 00:00:00 2001 From: dopamane Date: Tue, 23 Jul 2024 02:52:32 -0700 Subject: [PATCH 1/3] Add `justSig` --- lib/Bayeux/Signal.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lib/Bayeux/Signal.hs b/lib/Bayeux/Signal.hs index 0d4db02..b3c13e1 100644 --- a/lib/Bayeux/Signal.hs +++ b/lib/Bayeux/Signal.hs @@ -7,6 +7,7 @@ module Bayeux.Signal , sig , slice , toMaybeSig + , justSig , fromMaybeSig , sliceValid , sliceValue @@ -46,6 +47,9 @@ slice end start s = Sig{ spec = SigSpecSlice (spec s) end (Just start) } toMaybeSig :: Sig Bool -> Sig a -> Sig (Maybe a) toMaybeSig validSig valueSig = Sig $ spec validSig <> spec valueSig +justSig :: Sig a -> Sig (Maybe a) +justSig = toMaybeSig $ sig True + fromMaybeSig :: Width a => Sig (Maybe a) -> (Sig Bool, Sig a) fromMaybeSig s = (slice (w - 1) (w - 1) s, slice (w - 2) 0 s) where From 8c1ce275065ea649b06a21e0436696b256038b37 Mon Sep 17 00:00:00 2001 From: dopamane Date: Wed, 24 Jul 2024 02:13:27 -0700 Subject: [PATCH 2/3] Add `memInitV2C` cell --- lib/Bayeux/Rtl.hs | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/lib/Bayeux/Rtl.hs b/lib/Bayeux/Rtl.hs index 7e76eae..3e88c69 100644 --- a/lib/Bayeux/Rtl.hs +++ b/lib/Bayeux/Rtl.hs @@ -90,6 +90,8 @@ module Bayeux.Rtl , modFloorC , -- *** Multiplexers muxC + , -- *** Memories + memInitV2C , -- ** Processes Process(..) , ProcStmt(..) @@ -547,6 +549,29 @@ muxC cellId w a b s y = Cell ] CellEndStmt +memInitV2C + :: CellId + -> Constant -- ^ MEMID + -> Constant -- ^ ABITS + -> Constant -- ^ WIDTH + -> Constant -- ^ WORDS + -> Constant -- ^ PRIORITY + -> SigSpec -- ^ ADDR + -> SigSpec -- ^ DATA + -> Cell +memInitV2C cellId memId aBits w wrds p a d= Cell + [] + (CellStmt "$meminit_v2" cellId) + [ CellParameter Nothing "\\MEMID" memId + , CellParameter Nothing "\\ABITS" aBits + , CellParameter Nothing "\\WIDTH" w + , CellParameter Nothing "\\WORDS" wrds + , CellParameter Nothing "\\PRIORITY" p + , CellConnect "\\ADDR" a + , CellConnect "\\DATA" d + ] + CellEndStmt + data Process = Process [AttrStmt] ProcStmt ProcessBody ProcEndStmt deriving (Eq, Read, Show) From 5aa5020cbcbfb5d9567dcab2711208b5d071aa37 Mon Sep 17 00:00:00 2001 From: David Cox Date: Thu, 25 Jul 2024 02:43:29 -0700 Subject: [PATCH 3/3] Jettison Yosys RTL (#38) --- bayeux.cabal | 2 + lib/Bayeux.hs | 1 + lib/Bayeux/Buffer.hs | 1 + lib/Bayeux/Cell.hs | 2 +- lib/Bayeux/Encode.hs | 28 +- lib/Bayeux/Flow.hs | 2 +- lib/Bayeux/Ice40/IO.hs | 2 +- lib/Bayeux/Ice40/Led.hs | 1 + lib/Bayeux/Ice40/Rgb.hs | 1 + lib/Bayeux/Ice40/Spi.hs | 1 + lib/Bayeux/Ice40/Spram.hs | 1 + lib/Bayeux/Rtl.hs | 653 +------------------------------- lib/Bayeux/Signal.hs | 1 + lib/Bayeux/Uart.hs | 1 + test/Test/Bayeux/Ice40/Led.hs | 1 + test/Test/Bayeux/Ice40/Rgb.hs | 1 + test/Test/Bayeux/Ice40/Spram.hs | 1 + test/Test/Bayeux/Rtl.hs | 1 + test/Test/Bayeux/Uart.hs | 1 + 19 files changed, 21 insertions(+), 681 deletions(-) diff --git a/bayeux.cabal b/bayeux.cabal index 22c8377..2e5da3d 100644 --- a/bayeux.cabal +++ b/bayeux.cabal @@ -47,6 +47,7 @@ library , serialport , shake , text + , yosys-rtl hs-source-dirs: lib default-language: Haskell2010 @@ -88,3 +89,4 @@ test-suite test , tasty-hedgehog , tasty-hunit , text + , yosys-rtl diff --git a/lib/Bayeux.hs b/lib/Bayeux.hs index 0ddc295..4efed2b 100644 --- a/lib/Bayeux.hs +++ b/lib/Bayeux.hs @@ -21,6 +21,7 @@ import System.FilePath import System.Hardware.Serialport import System.IO import Text.Megaparsec hiding (parse) +import Yosys.Rtl app :: Cli -> IO () app = \case diff --git a/lib/Bayeux/Buffer.hs b/lib/Bayeux/Buffer.hs index adde6b1..b594b08 100644 --- a/lib/Bayeux/Buffer.hs +++ b/lib/Bayeux/Buffer.hs @@ -19,6 +19,7 @@ import Data.Finite import Data.String import Data.Word import GHC.TypeNats +import Yosys.Rtl class MonadBuffer m where buffer diff --git a/lib/Bayeux/Cell.hs b/lib/Bayeux/Cell.hs index 38573af..6fab479 100644 --- a/lib/Bayeux/Cell.hs +++ b/lib/Bayeux/Cell.hs @@ -49,13 +49,13 @@ module Bayeux.Cell ) where import Bayeux.Encode -import Bayeux.Rtl hiding (at, binary, mux, shift, shr, sshr, shl, unary) import Bayeux.Signal import Bayeux.Width import Control.Monad import Data.List.NonEmpty (NonEmpty(..), nonEmpty) import Data.Maybe import Prelude hiding (and, div, mod, not, or) +import Yosys.Rtl -- | increment inc :: Encode a => Width a => MonadSignal m => Sig a -> m (Sig a) diff --git a/lib/Bayeux/Encode.hs b/lib/Bayeux/Encode.hs index 9801a8c..fc5c356 100644 --- a/lib/Bayeux/Encode.hs +++ b/lib/Bayeux/Encode.hs @@ -10,36 +10,10 @@ import Data.Array import Data.Bits import Data.Bool import Data.Finite -import Data.String import Data.Word import GHC.TypeLits -import Prettyprinter hiding (width) +import Yosys.Rtl -data BinaryDigit = B0 - | B1 - | X - | Z - | M - | D - deriving (Eq, Read, Show) - -instance Pretty BinaryDigit where - pretty = \case - B0 -> "0" - B1 -> "1" - X -> "x" - Z -> "z" - M -> "m" - D -> "-" - -instance IsString BinaryDigit where - fromString = \case - "0" -> B0 - "1" -> B1 - "x" -> X - "z" -> Z - "m" -> M - _ -> D class Encode a where encode :: a -> [BinaryDigit] diff --git a/lib/Bayeux/Flow.hs b/lib/Bayeux/Flow.hs index f942140..326a63f 100644 --- a/lib/Bayeux/Flow.hs +++ b/lib/Bayeux/Flow.hs @@ -2,13 +2,13 @@ module Bayeux.Flow ( flow ) where -import Bayeux.Rtl import Development.Shake import Development.Shake.FilePath import Data.Text (Text) import qualified Data.Text.IO as TIO import Prettyprinter import Prettyprinter.Render.Text +import Yosys.Rtl flow :: Bool -> Bool -> String -> File -> FilePath -> IO () flow prog clean name designFile pcfFile = shake shakeOptions{ shakeFiles = "_build" name } $ do diff --git a/lib/Bayeux/Ice40/IO.hs b/lib/Bayeux/Ice40/IO.hs index af2afe3..ad35cc5 100644 --- a/lib/Bayeux/Ice40/IO.hs +++ b/lib/Bayeux/Ice40/IO.hs @@ -4,7 +4,7 @@ module Bayeux.Ice40.IO ( sbIO ) where -import Bayeux.Rtl +import Yosys.Rtl sbIO :: CellId diff --git a/lib/Bayeux/Ice40/Led.hs b/lib/Bayeux/Ice40/Led.hs index 77c0928..fc3ad69 100644 --- a/lib/Bayeux/Ice40/Led.hs +++ b/lib/Bayeux/Ice40/Led.hs @@ -26,6 +26,7 @@ import Data.Array import Data.Char import Data.Finite import Data.Word +import Yosys.Rtl sbLeddaIp :: SigSpec -- ^ leddcs diff --git a/lib/Bayeux/Ice40/Rgb.hs b/lib/Bayeux/Ice40/Rgb.hs index 3062f63..d65033d 100644 --- a/lib/Bayeux/Ice40/Rgb.hs +++ b/lib/Bayeux/Ice40/Rgb.hs @@ -19,6 +19,7 @@ import Bayeux.Signal import Bayeux.Width import Control.Monad.Writer import Data.Word +import Yosys.Rtl sbRgbaDrv :: SigSpec -- ^ red pwm input diff --git a/lib/Bayeux/Ice40/Spi.hs b/lib/Bayeux/Ice40/Spi.hs index 8a3c722..71c69f0 100644 --- a/lib/Bayeux/Ice40/Spi.hs +++ b/lib/Bayeux/Ice40/Spi.hs @@ -21,6 +21,7 @@ import Data.Finite import Data.String import Data.Text (Text) import Data.Word +import Yosys.Rtl sbSpi :: CellId diff --git a/lib/Bayeux/Ice40/Spram.hs b/lib/Bayeux/Ice40/Spram.hs index 82a46bc..a33c9f8 100644 --- a/lib/Bayeux/Ice40/Spram.hs +++ b/lib/Bayeux/Ice40/Spram.hs @@ -24,6 +24,7 @@ import Data.Array import Data.Finite import Data.String import Data.Word +import Yosys.Rtl spramC :: CellId diff --git a/lib/Bayeux/Rtl.hs b/lib/Bayeux/Rtl.hs index 3e88c69..b532326 100644 --- a/lib/Bayeux/Rtl.hs +++ b/lib/Bayeux/Rtl.hs @@ -5,116 +5,14 @@ -- | Yosys [RTLIL](https://yosyshq.readthedocs.io/projects/yosys/en/latest/yosys_internals/formats/rtlil_text.html) module Bayeux.Rtl - ( -- * Lexical elements - Ident(..) - , Value(..) - , BinaryDigit(..) - , binaryDigits + ( binaryDigits , binaryValue - , -- * File - File(..) , top - , -- ** Autoindex statements - AutoIdxStmt(..) - , -- ** Modules - Module(..) - , ModuleStmt(..) - , ModuleBody(..) - , ParamStmt(..) - , Constant(..) - , ModuleEndStmt(..) , initial - , -- ** Attribute statements - AttrStmt(..) - , -- ** Signal specifications - SigSpec(..) - , -- ** Connections - ConnStmt(..) - , -- ** Wires - Wire(..) - , WireStmt(..) - , WireId(..) , freshWireId - , WireOption(..) - , -- ** Memories - Memory(..) - , MemoryStmt(..) - , MemoryOption(..) - , -- ** Cells - Cell(..) - , CellStmt(..) - , CellId(..) , freshCellId - , CellType(..) - , CellBodyStmt(..) - , CellEndStmt(..) - , -- *** Unary cells - unaryCell - , notC - , posC - , negC - , reduceAndC - , reduceOrC - , reduceXorC - , reduceXnorC - , reduceBoolC - , logicNotC - , -- *** Binary cells - binaryCell - , shiftCell - , andC - , orC - , xorC - , xnorC - , shlC - , shrC - , sshlC - , sshrC - , logicAndC - , logicOrC - , eqxC - , nexC - , powC - , ltC - , leC - , eqC - , neC - , geC - , gtC - , addC - , subC - , mulC - , divC - , modC - , divFloorC - , modFloorC - , -- *** Multiplexers - muxC - , -- *** Memories - memInitV2C - , -- ** Processes - Process(..) - , ProcStmt(..) , freshProcStmt - , ProcessBody(..) - , AssignStmt(..) - , DestSigSpec(..) - , SrcSigSpec(..) - , ProcEndStmt(..) , updateP - , -- ** Switches - Switch(..) - , SwitchStmt(..) - , Case(..) - , CaseStmt(..) - , Compare(..) - , CaseBody(..) - , SwitchEndStmt(..) - , -- ** Syncs - Sync(..) - , SyncStmt(..) - , SyncType(..) - , UpdateStmt(..) , -- * Monad MonadRtl(..) , shl, shr, sshl, sshr @@ -130,108 +28,14 @@ import Control.Monad.State import Control.Monad.Writer import Data.String import Data.Text (Text) -import Prettyprinter hiding (width) - -newtype Ident = Ident Text - deriving (Eq, IsString, Pretty, Read, Semigroup, Monoid, Show) - -data Value = Value Integer [BinaryDigit] - deriving (Eq, Read, Show) - -instance Pretty Value where - pretty (Value i bs) = pretty i <> "\'" <> foldMap pretty bs - -instance IsString Value where - fromString s = let (l, r) = break (== '\'') s - in if read l /= length r - 1 - then error $ "IsString " <> s - else Value (read l) $ map (fromString . pure) $ drop 1 r +import Yosys.Rtl binaryValue :: Encode b => Width b => b -> Value binaryValue b = Value (width b) $ encode b -data File = File (Maybe AutoIdxStmt) [Module] - deriving (Eq, Read, Show) - -instance Pretty File where - pretty (File iM ms) = let ms' = pretty <$> ms - in vl $ case iM of - Just i -> pretty i : ms' - Nothing -> ms' - top :: [ModuleBody] -> File top body = File (Just 0) [Module [] "\\top" body ModuleEndStmt] -newtype AutoIdxStmt = AutoIdxStmt Integer - deriving (Eq, Num, Read, Show) - -instance Pretty AutoIdxStmt where - pretty (AutoIdxStmt i) = "autoidx" <+> pretty i - -data Module = Module [AttrStmt] ModuleStmt [ModuleBody] ModuleEndStmt - deriving (Eq, Read, Show) - -instance Pretty Module where - pretty (Module as m bs e) = vl - [ vl $ pretty <$> as - , pretty m - , indent 2 $ vl $ pretty <$> bs - , pretty e - ] - -newtype ModuleStmt = ModuleStmt Ident - deriving (Eq, IsString, Read, Show) - -instance Pretty ModuleStmt where - pretty (ModuleStmt i) = "module" <+> pretty i - -data ModuleBody = ModuleBodyParamStmt ParamStmt - | ModuleBodyWire Wire - | ModuleBodyMemory Memory - | ModuleBodyCell Cell - | ModuleBodyProcess Process - | ModuleBodyConnStmt ConnStmt - deriving (Eq, Read, Show) - -instance Pretty ModuleBody where - pretty = \case - ModuleBodyParamStmt p -> pretty p - ModuleBodyWire w -> pretty w - ModuleBodyMemory m -> pretty m - ModuleBodyCell c -> pretty c - ModuleBodyProcess p -> pretty p - ModuleBodyConnStmt c -> pretty c - - -data ParamStmt = ParamStmt Ident (Maybe Constant) - deriving (Eq, Read, Show) - -instance Pretty ParamStmt where - pretty (ParamStmt i cM) = mconcat - [ "parameter" <+> pretty i - , maybe mempty (surround " " " " . pretty) cM - ] - -data Constant = ConstantValue Value - | ConstantInteger Integer - | ConstantString Text - deriving (Eq, Read, Show) - -instance Pretty Constant where - pretty = \case - ConstantValue v -> pretty v - ConstantInteger i -> pretty i - ConstantString t -> dquotes $ pretty t - -instance IsString Constant where - fromString = ConstantValue . fromString - -data ModuleEndStmt = ModuleEndStmt - deriving (Eq, Read, Show) - -instance Pretty ModuleEndStmt where - pretty _ = "end" <> hardline - initial :: Encode output => Width output @@ -249,378 +53,15 @@ initial outputIdent output = bs = encode output in ConstantValue $ Value size bs -data AttrStmt = AttrStmt Ident Constant - deriving (Eq, Read, Show) - -instance Pretty AttrStmt where - pretty (AttrStmt i c) = "attribute" <+> pretty i <+> pretty c - -data SigSpec = SigSpecConstant Constant - | SigSpecWireId WireId - | SigSpecSlice SigSpec Integer (Maybe Integer) - | SigSpecCat [SigSpec] - deriving (Eq, Read, Show) - -instance Pretty SigSpec where - pretty = \case - SigSpecConstant c -> pretty c - SigSpecWireId w -> pretty w - SigSpecSlice s x yM -> pretty s <+> brackets (pretty x <> maybe mempty ((":" <>) . pretty) yM) - SigSpecCat ss -> braces $ " " <> mconcat (punctuate " " $ pretty <$> ss) <> " " - -instance Semigroup SigSpec where - SigSpecCat a <> SigSpecCat b = SigSpecCat $ a <> b - SigSpecCat a <> b = SigSpecCat $ a <> [b] - a <> SigSpecCat b = SigSpecCat $ [a] <> b - a <> b = SigSpecCat [a, b] - -instance Monoid SigSpec where - mempty = SigSpecCat mempty - -instance IsString SigSpec where - fromString = SigSpecConstant . fromString - -data ConnStmt = ConnStmt SigSpec SigSpec - deriving (Eq, Read, Show) - -instance Pretty ConnStmt where - pretty (ConnStmt x y) = "connect" <+> pretty x <+> pretty y - -data Wire = Wire [AttrStmt] WireStmt - deriving (Eq, Read, Show) - -instance Pretty Wire where - pretty (Wire as s) = foldMap pretty as <> pretty s - -data WireStmt = WireStmt [WireOption] WireId - deriving (Eq, Read, Show) - -instance Pretty WireStmt where - pretty (WireStmt os i) = "wire" <+> hsep (pretty <$> os) <+> pretty i - -newtype WireId = WireId Ident - deriving (Eq, IsString, Monoid, Pretty, Read, Semigroup, Show) - freshWireId :: Functor m => MonadRtl m => m WireId freshWireId = ("\\wire" <>) . fromString . show <$> fresh -data WireOption = WireOptionWidth Integer - | WireOptionOffset Integer - | WireOptionInput Integer - | WireOptionOutput Integer - | WireOptionInout Integer - | WireOptionUpto - | WireOptionSigned - deriving (Eq, Read, Show) - -instance Pretty WireOption where - pretty = \case - WireOptionWidth i -> "width" <+> pretty i - WireOptionOffset i -> "offset" <+> pretty i - WireOptionInput i -> "input" <+> pretty i - WireOptionOutput i -> "output" <+> pretty i - WireOptionInout i -> "inout" <+> pretty i - WireOptionUpto -> "upto" - WireOptionSigned -> "signed" - -data Memory = Memory [AttrStmt] MemoryStmt - deriving (Eq, Read, Show) - -instance Pretty Memory where - pretty (Memory as s) = hsep $ pretty `fmap` as <> [pretty s] - -data MemoryStmt = MemoryStmt [MemoryOption] Ident - deriving (Eq, Read, Show) - -instance Pretty MemoryStmt where - pretty (MemoryStmt os i) = "memory" <> foldMap pretty os <> pretty i - -data MemoryOption = MemoryOptionWidth Integer - | MemoryOptionSize Integer - | MemoryOptionOffset Integer - deriving (Eq, Read, Show) - -instance Pretty MemoryOption where - pretty = \case - MemoryOptionWidth i -> "width" <+> pretty i - MemoryOptionSize i -> "size" <+> pretty i - MemoryOptionOffset i -> "offset" <+> pretty i - -data Cell = Cell [AttrStmt] CellStmt [CellBodyStmt] CellEndStmt - deriving (Eq, Read, Show) - -instance Pretty Cell where - pretty (Cell as s bs e) = vl - [ vl $ pretty <$> as - , pretty s - , indent 2 $ vl $ pretty <$> bs - , pretty e - ] - -vl :: [Doc ann] -> Doc ann -vl = concatWith $ \x y -> x <> hardline <> y - -data CellStmt = CellStmt CellType CellId - deriving (Eq, Read, Show) - -instance Pretty CellStmt where - pretty (CellStmt t i) = "cell" <+> pretty t <+> pretty i - -newtype CellId = CellId Ident - deriving (Eq, IsString, Monoid, Pretty, Read, Semigroup, Show) - freshCellId :: Functor m => MonadRtl m => m CellId freshCellId = ("$cell" <>) . fromString . show <$> fresh -newtype CellType = CellType Ident - deriving (Eq, IsString, Pretty, Read, Show) - -data ParamType = Signed | Real - deriving (Eq, Read, Show) - -instance Pretty ParamType where - pretty Signed = "signed" - pretty Real = "real" - -data CellBodyStmt = CellParameter (Maybe ParamType) Ident Constant - | CellConnect Ident SigSpec - deriving (Eq, Read, Show) - -instance Pretty CellBodyStmt where - pretty = \case - CellParameter Nothing i c -> "parameter" <+> pretty i <+> pretty c - CellParameter (Just p) i c -> "parameter" <+> pretty p <+> pretty i <+> pretty c - CellConnect i s -> "connect" <+> pretty i <+> pretty s - -data CellEndStmt = CellEndStmt - deriving (Eq, Read, Show) - -instance Pretty CellEndStmt where - pretty _ = "end" <> hardline - -unaryCell - :: CellStmt - -> Bool -- ^ \\A_SIGNED - -> Integer -- ^ \\A_WIDTH - -> Integer -- ^ \\Y_WIDTH - -> SigSpec -- ^ A - -> SigSpec -- ^ Y - -> Cell -unaryCell cellStmt aSigned aWidth yWidth a y = Cell - [] - cellStmt - [ CellParameter Nothing "\\A_SIGNED" $ ConstantInteger $ fromBool aSigned - , CellParameter Nothing "\\A_WIDTH" $ ConstantInteger aWidth - , CellParameter Nothing "\\Y_WIDTH" $ ConstantInteger yWidth - , CellConnect "\\A" a - , CellConnect "\\Y" y - ] - CellEndStmt - --- unary cells -notC, posC, negC, reduceAndC, reduceOrC, reduceXorC, reduceXnorC, reduceBoolC, logicNotC - :: CellId - -> Bool - -> Integer - -> Integer - -> SigSpec - -> SigSpec - -> Cell - -notC = unaryCell . CellStmt "$not" -posC = unaryCell . CellStmt "$pos" -negC = unaryCell . CellStmt "$neg" -reduceAndC = unaryCell . CellStmt "$reduce_and" -reduceOrC = unaryCell . CellStmt "$reduce_or" -reduceXorC = unaryCell . CellStmt "$reduce_xor" -reduceXnorC = unaryCell . CellStmt "$reduce_xnor" -reduceBoolC = unaryCell . CellStmt "$reduce_bool" -logicNotC = unaryCell . CellStmt "$logic_not" - -binaryCell - :: CellStmt - -> Bool -- ^ \\A_SIGNED - -> Integer -- ^ \\A_WIDTH - -> Bool -- ^ \\B_SIGNED - -> Integer -- ^ \\B_WIDTH - -> Integer -- ^ \\Y_WIDTH - -> SigSpec -- ^ A - -> SigSpec -- ^ B - -> SigSpec -- ^ Y - -> Cell -binaryCell cellStmt aSigned aWidth bSigned bWidth yWidth a b y = Cell - [] - cellStmt - [ CellParameter Nothing "\\A_SIGNED" $ ConstantInteger $ fromBool aSigned - , CellParameter Nothing "\\A_WIDTH" $ ConstantInteger aWidth - , CellParameter Nothing "\\B_SIGNED" $ ConstantInteger $ fromBool bSigned - , CellParameter Nothing "\\B_WIDTH" $ ConstantInteger bWidth - , CellParameter Nothing "\\Y_WIDTH" $ ConstantInteger yWidth - , CellConnect "\\A" a - , CellConnect "\\B" b - , CellConnect "\\Y" y - ] - CellEndStmt - -fromBool :: Bool -> Integer -fromBool True = 1 -fromBool False = 0 - -shiftCell - :: CellStmt - -> Bool - -> Integer - -> Integer - -> Integer - -> SigSpec - -> SigSpec - -> SigSpec - -> Cell -shiftCell cellStmt aSigned aWidth = binaryCell cellStmt aSigned aWidth False - --- binary cells -andC, orC, xorC, xnorC, logicAndC, logicOrC, eqxC, nexC, powC, ltC, leC, eqC, neC, geC, gtC, addC, subC, mulC, divC, modC, divFloorC, modFloorC - :: CellId - -> Bool - -> Integer - -> Bool - -> Integer - -> Integer - -> SigSpec - -> SigSpec - -> SigSpec - -> Cell - -shlC, shrC, sshlC, sshrC - :: CellId - -> Bool - -> Integer - -> Integer - -> Integer - -> SigSpec - -> SigSpec - -> SigSpec - -> Cell - -andC = binaryCell . CellStmt "$and" -orC = binaryCell . CellStmt "$or" -xorC = binaryCell . CellStmt "$xor" -xnorC = binaryCell . CellStmt "$xnor" -shlC = shiftCell . CellStmt "$shl" -shrC = shiftCell . CellStmt "$shr" -sshlC = shiftCell . CellStmt "$sshl" -sshrC = shiftCell . CellStmt "$sshr" -logicAndC = binaryCell . CellStmt "$logic_and" -logicOrC = binaryCell . CellStmt "$logic_or" -eqxC = binaryCell . CellStmt "$eqx" -nexC = binaryCell . CellStmt "$nex" -powC = binaryCell . CellStmt "$pow" -ltC = binaryCell . CellStmt "$lt" -leC = binaryCell . CellStmt "$le" -eqC = binaryCell . CellStmt "$eq" -neC = binaryCell . CellStmt "$ne" -geC = binaryCell . CellStmt "$ge" -gtC = binaryCell . CellStmt "$gt" -addC = binaryCell . CellStmt "$add" -subC = binaryCell . CellStmt "$sub" -mulC = binaryCell . CellStmt "$mul" -divC = binaryCell . CellStmt "$div" -modC = binaryCell . CellStmt "$mod" -divFloorC = binaryCell . CellStmt "$divfloor" -modFloorC = binaryCell . CellStmt "$modfloor" - --- | Y = S ? B : A -muxC - :: CellId - -> Integer -- ^ WIDTH - -> SigSpec -- ^ A - -> SigSpec -- ^ B - -> SigSpec -- ^ S - -> SigSpec -- ^ Y - -> Cell -muxC cellId w a b s y = Cell - [] - (CellStmt "$mux" cellId) - [ CellParameter Nothing "\\WIDTH" $ ConstantInteger w - , CellConnect "\\A" a - , CellConnect "\\B" b - , CellConnect "\\S" s - , CellConnect "\\Y" y - ] - CellEndStmt - -memInitV2C - :: CellId - -> Constant -- ^ MEMID - -> Constant -- ^ ABITS - -> Constant -- ^ WIDTH - -> Constant -- ^ WORDS - -> Constant -- ^ PRIORITY - -> SigSpec -- ^ ADDR - -> SigSpec -- ^ DATA - -> Cell -memInitV2C cellId memId aBits w wrds p a d= Cell - [] - (CellStmt "$meminit_v2" cellId) - [ CellParameter Nothing "\\MEMID" memId - , CellParameter Nothing "\\ABITS" aBits - , CellParameter Nothing "\\WIDTH" w - , CellParameter Nothing "\\WORDS" wrds - , CellParameter Nothing "\\PRIORITY" p - , CellConnect "\\ADDR" a - , CellConnect "\\DATA" d - ] - CellEndStmt - -data Process = Process [AttrStmt] ProcStmt ProcessBody ProcEndStmt - deriving (Eq, Read, Show) - -instance Pretty Process where - pretty (Process as s b e) = vl - [ vl $ pretty <$> as - , pretty s - , indent 2 $ pretty b - , pretty e - ] - -newtype ProcStmt = ProcStmt Ident - deriving (Eq, IsString, Monoid, Read, Semigroup, Show) - -instance Pretty ProcStmt where - pretty (ProcStmt i) = "process" <+> pretty i - freshProcStmt :: Functor m => MonadRtl m => m ProcStmt freshProcStmt = ("$proc" <>) . fromString . show <$> fresh -data ProcessBody = ProcessBody [AssignStmt] (Maybe Switch) [AssignStmt] [Sync] - deriving (Eq, Read, Show) - -instance Pretty ProcessBody where - pretty (ProcessBody as sM bs ss) = vl - [ vl $ pretty <$> as - , maybe mempty pretty sM - , vl $ pretty <$> bs - , vl $ pretty <$> ss - ] - -data AssignStmt = AssignStmt DestSigSpec SrcSigSpec - deriving (Eq, Read, Show) - -instance Pretty AssignStmt where - pretty (AssignStmt d s) = "assign" <+> pretty d <+> pretty s - -newtype DestSigSpec = DestSigSpec SigSpec - deriving (Eq, Pretty, Read, Show) - -newtype SrcSigSpec = SrcSigSpec SigSpec - deriving (Eq, Pretty, Read, Show) - -data ProcEndStmt = ProcEndStmt - deriving (Eq, Read, Show) - -instance Pretty ProcEndStmt where - pretty _ = "end" <> hardline - updateP :: ProcStmt -> DestSigSpec -> SrcSigSpec -> Process updateP procStmt destSig srcSig = Process [] @@ -636,96 +77,6 @@ updateP procStmt destSig srcSig = Process ) ProcEndStmt -data Switch = Switch SwitchStmt [Case] SwitchEndStmt - deriving (Eq, Read, Show) - -instance Pretty Switch where - pretty (Switch s cs e) = vl - [ pretty s - , indent 2 $ vl $ pretty <$> cs - , pretty e - ] - -data SwitchStmt = SwitchStmt [AttrStmt] SigSpec - deriving (Eq, Read, Show) - -instance Pretty SwitchStmt where - pretty (SwitchStmt as s) = foldMap pretty as <> "switch" <+> pretty s - -data Case = Case [AttrStmt] CaseStmt CaseBody - deriving (Eq, Read, Show) - -instance Pretty Case where - pretty (Case as s b) = foldMap pretty as <> pretty s <+> pretty b - -newtype CaseStmt = CaseStmt (Maybe Compare) - deriving (Eq, Read, Show) - -instance Pretty CaseStmt where - pretty (CaseStmt Nothing) = "case" - pretty (CaseStmt (Just c)) = "case" <+> pretty c - -data Compare = Compare SigSpec [SigSpec] - deriving (Eq, Read, Show) - -instance Pretty Compare where - pretty (Compare s ss) = hsep $ punctuate "," $ pretty <$> s : ss - -newtype CaseBody = CaseBody [Either Switch AssignStmt] - deriving (Eq, Read, Show) - -instance Pretty CaseBody where - pretty (CaseBody es) = vl $ either pretty pretty <$> es - -data SwitchEndStmt = SwitchEndStmt - deriving (Eq, Read, Show) - -instance Pretty SwitchEndStmt where - pretty _ = "end" <> hardline - -data Sync = Sync SyncStmt [UpdateStmt] - deriving (Eq, Read, Show) - -instance Pretty Sync where - pretty (Sync s us) = vl - [ pretty s - , indent 2 $ vl $ pretty <$> us - ] - -data SyncStmt = SyncStmt SyncType SigSpec - | SyncStmtGlobal - | SyncStmtInit - | SyncStmtAlways - deriving (Eq, Read, Show) - -instance Pretty SyncStmt where - pretty = ("sync" <+>) . \case - SyncStmt t s -> pretty t <+> pretty s - SyncStmtGlobal -> "global" - SyncStmtInit -> "init" - SyncStmtAlways -> "always" - -data SyncType = Low - | High - | Posedge - | Negedge - | Edge - deriving (Eq, Read, Show) - -instance Pretty SyncType where - pretty = \case - Low -> "low" - High -> "high" - Posedge -> "posedge" - Negedge -> "negedge" - Edge -> "edge" - -data UpdateStmt = UpdateStmt DestSigSpec SrcSigSpec - deriving (Eq, Read, Show) - -instance Pretty UpdateStmt where - pretty (UpdateStmt d s) = "update" <+> pretty d <+> pretty s - class MonadRtl m where fresh :: m Integer freshWire :: Integer -- ^ width diff --git a/lib/Bayeux/Signal.hs b/lib/Bayeux/Signal.hs index b3c13e1..dcc8bd8 100644 --- a/lib/Bayeux/Signal.hs +++ b/lib/Bayeux/Signal.hs @@ -26,6 +26,7 @@ import Control.Monad.Except import Control.Monad.Writer import Data.String import Prettyprinter hiding (width) +import Yosys.Rtl newtype Sig a = Sig{ spec :: SigSpec } deriving (Eq, IsString, Pretty, Read, Show) diff --git a/lib/Bayeux/Uart.hs b/lib/Bayeux/Uart.hs index 2255630..61c082d 100644 --- a/lib/Bayeux/Uart.hs +++ b/lib/Bayeux/Uart.hs @@ -26,6 +26,7 @@ import Data.Char import Data.Finite hiding (sub) import Data.Proxy import Data.Word +import Yosys.Rtl class MonadUart m where transmit :: Word16 -- ^ baud diff --git a/test/Test/Bayeux/Ice40/Led.hs b/test/Test/Bayeux/Ice40/Led.hs index f5ce2bc..0bdc532 100644 --- a/test/Test/Bayeux/Ice40/Led.hs +++ b/test/Test/Bayeux/Ice40/Led.hs @@ -8,6 +8,7 @@ import Prettyprinter import System.FilePath import Test.Bayeux.Rtl (prettyTest, synthTest) import Test.Tasty +import Yosys.Rtl tests :: [TestTree] tests = diff --git a/test/Test/Bayeux/Ice40/Rgb.hs b/test/Test/Bayeux/Ice40/Rgb.hs index 6207cfc..19dfdb7 100644 --- a/test/Test/Bayeux/Ice40/Rgb.hs +++ b/test/Test/Bayeux/Ice40/Rgb.hs @@ -10,6 +10,7 @@ import Prettyprinter import System.FilePath import Test.Bayeux.Rtl (prettyTest, synthTest) import Test.Tasty +import Yosys.Rtl tests :: [TestTree] tests = diff --git a/test/Test/Bayeux/Ice40/Spram.hs b/test/Test/Bayeux/Ice40/Spram.hs index 4288284..79c5e69 100644 --- a/test/Test/Bayeux/Ice40/Spram.hs +++ b/test/Test/Bayeux/Ice40/Spram.hs @@ -11,6 +11,7 @@ import Prettyprinter import System.FilePath import Test.Bayeux.Rtl (prettyTest) import Test.Tasty +import Yosys.Rtl tests :: [TestTree] tests = diff --git a/test/Test/Bayeux/Rtl.hs b/test/Test/Bayeux/Rtl.hs index d9d5957..f8af8be 100644 --- a/test/Test/Bayeux/Rtl.hs +++ b/test/Test/Bayeux/Rtl.hs @@ -20,6 +20,7 @@ import System.Process import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.Golden +import Yosys.Rtl tests :: [TestTree] tests = diff --git a/test/Test/Bayeux/Uart.hs b/test/Test/Bayeux/Uart.hs index f9edf42..4ca0e3c 100644 --- a/test/Test/Bayeux/Uart.hs +++ b/test/Test/Bayeux/Uart.hs @@ -17,6 +17,7 @@ import System.Process import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.Golden +import Yosys.Rtl tests :: [TestTree] tests =