diff --git a/lib/Bayeux/RgbCounter.hs b/lib/Bayeux/RgbCounter.hs index 6758b90..42fc005 100644 --- a/lib/Bayeux/RgbCounter.hs +++ b/lib/Bayeux/RgbCounter.hs @@ -11,7 +11,6 @@ module Bayeux.RgbCounter import Bayeux.Rtlil import Control.Monad.State import Control.Monad.Writer -import Data.String class Monad m => MonadRgb m where ctr :: m SigSpec @@ -120,12 +119,8 @@ instance MonadRgb Rtl where instance MonadProcess Rtl where process f = do - i <- get - modify (+ 1) - let old = fromString $ "\\ident" <> show i - j <- get - modify (+ 1) - let procStmt = fromString $ "$ident" <> show j + old <- freshWireId + procStmt <- freshProcStmt tell [ModuleBodyWire $ Wire [] $ WireStmt [WireOptionWidth 32] old] srcSig <- f $ SigSpecWireId old tell [ModuleBodyProcess $ updateP procStmt @@ -135,34 +130,24 @@ instance MonadProcess Rtl where return $ SigSpecWireId old increment a = do - i <- get - modify (+ 1) - let y = fromString $ "\\ident" <> show i - j <- get - modify (+ 1) - let cId = fromString $ "$ident" <> show j + y <- freshWireId + cId <- freshCellId tell [ ModuleBodyWire $ Wire [] $ WireStmt [WireOptionWidth 32] y , ModuleBodyCell $ addC cId False 32 False 32 32 a (SigSpecConstant $ ConstantInteger 1) y ] return $ SigSpecWireId y + eq a b = do - i <- get - modify (+ 1) - let y = fromString $ "\\ident" <> show i - j <- get - modify (+ 1) - let cId = fromString $ "$ident" <> show j + y <- freshWireId + cId <- freshCellId tell [ ModuleBodyWire $ Wire [] $ WireStmt [WireOptionWidth 1] y , ModuleBodyCell $ eqC cId False 32 False 32 1 a b y ] return $ SigSpecWireId y + mux s a b = do - i <- get - modify (+ 1) - let y = fromString $ "\\ident" <> show i - j <- get - modify (+ 1) - let cId = fromString $ "$ident" <> show j + y <- freshWireId + cId <- freshCellId tell [ ModuleBodyWire $ Wire [] $ WireStmt [WireOptionWidth 32] y , ModuleBodyCell $ muxC cId 32 a b s y ] diff --git a/lib/Bayeux/Rtlil.hs b/lib/Bayeux/Rtlil.hs index 60ee74b..a9b7f1d 100644 --- a/lib/Bayeux/Rtlil.hs +++ b/lib/Bayeux/Rtlil.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -112,8 +113,13 @@ module Bayeux.Rtlil , SyncStmt(..) , SyncType(..) , UpdateStmt(..) + , -- * Identifier generation + freshCellId + , freshProcStmt + , freshWireId ) where +import Control.Monad.State import Data.Bits import Data.Bool import Data.String @@ -321,7 +327,7 @@ instance Pretty WireStmt where pretty (WireStmt os i) = "wire" <+> hsep (pretty <$> os) <+> pretty i newtype WireId = WireId Ident - deriving (Eq, IsString, Pretty, Read, Show) + deriving (Eq, IsString, Monoid, Pretty, Read, Semigroup, Show) data WireOption = WireOptionWidth Integer | WireOptionOffset Integer @@ -386,7 +392,7 @@ instance Pretty CellStmt where pretty (CellStmt t i) = "cell" <+> pretty t <+> pretty i newtype CellId = CellId Ident - deriving (Eq, IsString, Pretty, Read, Show) + deriving (Eq, IsString, Monoid, Pretty, Read, Semigroup, Show) newtype CellType = CellType Ident deriving (Eq, IsString, Pretty, Read, Show) @@ -600,7 +606,7 @@ instance Pretty Process where ] newtype ProcStmt = ProcStmt Ident - deriving (Eq, IsString, Read, Show) + deriving (Eq, IsString, Monoid, Read, Semigroup, Show) instance Pretty ProcStmt where pretty (ProcStmt i) = "process" <+> pretty i @@ -738,3 +744,18 @@ data UpdateStmt = UpdateStmt DestSigSpec SrcSigSpec instance Pretty UpdateStmt where pretty (UpdateStmt d s) = "update" <+> pretty d <+> pretty s + +fresh :: MonadState Integer m => m Integer +fresh = do + i <- get + modify (+ 1) + return i + +freshWireId :: MonadState Integer m => m WireId +freshWireId = ("\\wire" <>) . fromString . show <$> fresh + +freshCellId :: MonadState Integer m => m CellId +freshCellId = ("$cell" <>) . fromString . show <$> fresh + +freshProcStmt :: MonadState Integer m => m ProcStmt +freshProcStmt = ("$proc" <>) . fromString . show <$> fresh diff --git a/test/Test/Bayeux/RgbCounter/golden/rgbcycle.pretty b/test/Test/Bayeux/RgbCounter/golden/rgbcycle.pretty index ad64994..ff39c4f 100644 --- a/test/Test/Bayeux/RgbCounter/golden/rgbcycle.pretty +++ b/test/Test/Bayeux/RgbCounter/golden/rgbcycle.pretty @@ -2,158 +2,158 @@ autoidx 0 module \top wire input 1 \clk - wire width 32 \ident1 - wire width 1 \ident3 + wire width 32 \wire1 + wire width 1 \wire3 - cell $eq $ident4 + cell $eq $cell4 parameter \A_SIGNED 0 parameter \A_WIDTH 32 parameter \B_SIGNED 0 parameter \B_WIDTH 32 parameter \Y_WIDTH 1 - connect \A \ident1 + connect \A \wire1 connect \B 12000000 - connect \Y \ident3 + connect \Y \wire3 end - wire width 32 \ident5 + wire width 32 \wire5 - cell $add $ident6 + cell $add $cell6 parameter \A_SIGNED 0 parameter \A_WIDTH 32 parameter \B_SIGNED 0 parameter \B_WIDTH 32 parameter \Y_WIDTH 32 - connect \A \ident1 + connect \A \wire1 connect \B 1 - connect \Y \ident5 + connect \Y \wire5 end - wire width 32 \ident7 + wire width 32 \wire7 - cell $mux $ident8 + cell $mux $cell8 parameter \WIDTH 32 - connect \A \ident5 + connect \A \wire5 connect \B 0 - connect \S \ident3 - connect \Y \ident7 + connect \S \wire3 + connect \Y \wire7 end - process $ident2 + process $proc2 sync posedge \clk - update \ident1 \ident7 + update \wire1 \wire7 end - wire width 1 \ident9 + wire width 1 \wire9 - cell $eq $ident10 + cell $eq $cell10 parameter \A_SIGNED 0 parameter \A_WIDTH 32 parameter \B_SIGNED 0 parameter \B_WIDTH 32 parameter \Y_WIDTH 1 - connect \A \ident1 + connect \A \wire1 connect \B 0 - connect \Y \ident9 + connect \Y \wire9 end - wire width 32 \ident11 - wire width 1 \ident13 + wire width 32 \wire11 + wire width 1 \wire13 - cell $eq $ident14 + cell $eq $cell14 parameter \A_SIGNED 0 parameter \A_WIDTH 32 parameter \B_SIGNED 0 parameter \B_WIDTH 32 parameter \Y_WIDTH 1 - connect \A \ident11 + connect \A \wire11 connect \B 2 - connect \Y \ident13 + connect \Y \wire13 end - wire width 32 \ident15 + wire width 32 \wire15 - cell $add $ident16 + cell $add $cell16 parameter \A_SIGNED 0 parameter \A_WIDTH 32 parameter \B_SIGNED 0 parameter \B_WIDTH 32 parameter \Y_WIDTH 32 - connect \A \ident11 + connect \A \wire11 connect \B 1 - connect \Y \ident15 + connect \Y \wire15 end - wire width 32 \ident17 + wire width 32 \wire17 - cell $mux $ident18 + cell $mux $cell18 parameter \WIDTH 32 - connect \A \ident15 + connect \A \wire15 connect \B 0 - connect \S \ident13 - connect \Y \ident17 + connect \S \wire13 + connect \Y \wire17 end - wire width 32 \ident19 + wire width 32 \wire19 - cell $mux $ident20 + cell $mux $cell20 parameter \WIDTH 32 - connect \A \ident11 - connect \B \ident17 - connect \S \ident9 - connect \Y \ident19 + connect \A \wire11 + connect \B \wire17 + connect \S \wire9 + connect \Y \wire19 end - process $ident12 + process $proc12 sync posedge \clk - update \ident11 \ident19 + update \wire11 \wire19 end - wire width 1 \ident21 + wire width 1 \wire21 - cell $eq $ident22 + cell $eq $cell22 parameter \A_SIGNED 0 parameter \A_WIDTH 32 parameter \B_SIGNED 0 parameter \B_WIDTH 32 parameter \Y_WIDTH 1 - connect \A \ident11 + connect \A \wire11 connect \B 0 - connect \Y \ident21 + connect \Y \wire21 end - wire width 1 \ident23 + wire width 1 \wire23 - cell $eq $ident24 + cell $eq $cell24 parameter \A_SIGNED 0 parameter \A_WIDTH 32 parameter \B_SIGNED 0 parameter \B_WIDTH 32 parameter \Y_WIDTH 1 - connect \A \ident11 + connect \A \wire11 connect \B 1 - connect \Y \ident23 + connect \Y \wire23 end - wire width 1 \ident25 + wire width 1 \wire25 - cell $eq $ident26 + cell $eq $cell26 parameter \A_SIGNED 0 parameter \A_WIDTH 32 parameter \B_SIGNED 0 parameter \B_WIDTH 32 parameter \Y_WIDTH 1 - connect \A \ident11 + connect \A \wire11 connect \B 2 - connect \Y \ident25 + connect \Y \wire25 end wire output 2 \red @@ -167,11 +167,11 @@ module \top parameter \RGB2_CURRENT "0b111111" connect \CURREN 1'1 connect \RGB0 \red - connect \RGB0PWM \ident21 + connect \RGB0PWM \wire21 connect \RGB1 \green - connect \RGB1PWM \ident23 + connect \RGB1PWM \wire23 connect \RGB2 \blue - connect \RGB2PWM \ident25 + connect \RGB2PWM \wire25 connect \RGBLEDEN 1'1 end