diff --git a/lib/Bayeux/Rgb.hs b/lib/Bayeux/Rgb.hs index 6a190b0..3629b20 100644 --- a/lib/Bayeux/Rgb.hs +++ b/lib/Bayeux/Rgb.hs @@ -2,19 +2,39 @@ {-# LANGUAGE OverloadedStrings #-} module Bayeux.Rgb - ( prog + ( MonadRgb(..) + , prog , cycleProg ) where import Bayeux.Rtlil import Control.Monad.Writer -class Monad m => MonadRgb m where - ctr :: m SigSpec - at :: SigSpec -> Integer -> m SigSpec - rgb :: SigSpec -> SigSpec -> SigSpec -> m () +-- | PWM inputs, width=1 +class MonadRgb m where + rgb :: SigSpec -- ^ red + -> SigSpec -- ^ green + -> SigSpec -- ^ blue + -> m () -prog :: MonadRgb m => m () +instance MonadRgb Rtl where + rgb r g b = tell + [ ModuleBodyWire $ Wire [] $ WireStmt [WireOptionOutput 2] "\\red" + , ModuleBodyWire $ Wire [] $ WireStmt [WireOptionOutput 3] "\\green" + , ModuleBodyWire $ Wire [] $ WireStmt [WireOptionOutput 4] "\\blue" + , ModuleBodyCell $ sbRgbaDrv r g b + ] + +increment :: MonadRtl m => SigSpec -> m SigSpec +increment a = binary addC False 32 False 32 32 a $ SigSpecConstant $ ConstantInteger 1 + +ctr :: MonadRtl m => m SigSpec +ctr = process 32 increment + +eq :: MonadRtl m => SigSpec -> SigSpec -> m SigSpec +eq = binary eqC False 32 False 32 1 + +prog :: Monad m => MonadRtl m => MonadRgb m => m () prog = do c <- ctr r <- c `at` 24 @@ -22,29 +42,18 @@ prog = do b <- c `at` 22 rgb r g b -class MonadProcess m where - process :: (SigSpec -> m SigSpec) -> m SigSpec - increment :: SigSpec -> m SigSpec - eq :: SigSpec -> SigSpec -> m SigSpec - - -- | If S == 1 then B else A - mux :: SigSpec -- ^ S - -> SigSpec -- ^ A - -> SigSpec -- ^ B - -> m SigSpec -- ^ Y - -cycleProg :: MonadProcess m => MonadRgb m => m () +cycleProg :: Monad m => MonadRtl m => MonadRgb m => m () cycleProg = do - t <- process $ \timer -> do + t <- process 32 $ \timer -> do t1Sec <- timer `eq` second timer' <- increment timer - mux t1Sec timer' zero + mux 32 t1Sec timer' zero tEqZ <- t `eq` zero - c <- process $ \color -> do + c <- process 32 $ \color -> do cEqBlue <- color `eq` two c' <- increment color - color' <- mux cEqBlue c' zero - mux tEqZ color color' + color' <- mux 32 cEqBlue c' zero + mux 32 tEqZ color color' pwmR <- c `eq` zero pwmG <- c `eq` one pwmB <- c `eq` two @@ -55,62 +64,3 @@ cycleProg = do one = constSig 1 two = constSig 2 second = constSig 12000000 - -instance MonadRgb Rtl where - ctr = do - tell $ counter 32 "\\$my_counter" "\\unused" "$my_counter" "$procStmt" - return $ SigSpecWireId "\\$my_counter" - - at sigSpec ix = do - tell - [ ModuleBodyWire $ Wire [] $ WireStmt [WireOptionWidth 1] n - , ModuleBodyConnStmt $ ConnStmt (SigSpecWireId n) (SigSpecSlice sigSpec ix Nothing) - ] - return $ SigSpecWireId n - where - n | ix == 24 = "\\pwm_r" - | ix == 23 = "\\pwm_g" - | otherwise = "\\pwm_b" - - rgb r g b = do - tell [ ModuleBodyWire $ Wire [] $ WireStmt [WireOptionOutput 2] "\\red" - , ModuleBodyWire $ Wire [] $ WireStmt [WireOptionOutput 3] "\\green" - , ModuleBodyWire $ Wire [] $ WireStmt [WireOptionOutput 4] "\\blue" - , ModuleBodyCell $ sbRgbaDrv r g b - ] - -instance MonadProcess Rtl where - process f = do - old <- freshWireId - procStmt <- freshProcStmt - tell [ModuleBodyWire $ Wire [] $ WireStmt [WireOptionWidth 32] old] - srcSig <- f $ SigSpecWireId old - tell [ModuleBodyProcess $ updateP procStmt - (DestSigSpec $ SigSpecWireId old) - (SrcSigSpec $ srcSig) - ] - return $ SigSpecWireId old - - increment a = do - 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 - 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 - y <- freshWireId - cId <- freshCellId - tell [ ModuleBodyWire $ Wire [] $ WireStmt [WireOptionWidth 32] y - , ModuleBodyCell $ muxC cId 32 a b s y - ] - return $ SigSpecWireId y diff --git a/lib/Bayeux/Rtlil.hs b/lib/Bayeux/Rtlil.hs index 20912c0..a73af09 100644 --- a/lib/Bayeux/Rtlil.hs +++ b/lib/Bayeux/Rtlil.hs @@ -24,7 +24,6 @@ module Bayeux.Rtlil , Constant(..) , ModuleEndStmt(..) , initial - , counter , -- ** Attribute statements AttrStmt(..) , -- ** Signal specifications @@ -116,14 +115,16 @@ module Bayeux.Rtlil , SyncStmt(..) , SyncType(..) , UpdateStmt(..) - , -- * Compile - Rtl(..) + , -- * Monad + MonadRtl(..) + , shl, shr, sshl, sshr + , Rtl(..) , compile ) where import Control.Monad.State import Control.Monad.Writer -import Data.Bits +import Data.Bits hiding (shift) import Data.Bool import Data.String import Data.Text (Text) @@ -267,31 +268,6 @@ initial outputIdent output = bs = binaryDigits output in ConstantValue $ Value size bs -counter - :: Integer -- ^ width - -> WireId -- ^ old - -> WireId -- ^ new - -> CellId -- ^ add - -> ProcStmt -- ^ update - -> [ModuleBody] -counter w old new addId procStmt = - [ ModuleBodyWire $ Wire [] $ WireStmt [WireOptionWidth w] old -- $ WireId $ "\\" <> old - , ModuleBodyWire $ Wire [] $ WireStmt [WireOptionWidth w] new -- $ WireId new - , ModuleBodyCell $ addC - addId - False - w - False - w - w - (SigSpecWireId old) - (SigSpecConstant $ ConstantInteger 1) - new - , ModuleBodyProcess $ updateP procStmt - (DestSigSpec $ SigSpecWireId old) - (SrcSigSpec $ SigSpecWireId new) - ] - data AttrStmt = AttrStmt Ident Constant deriving (Eq, Read, Show) @@ -332,7 +308,7 @@ instance Pretty WireStmt where newtype WireId = WireId Ident deriving (Eq, IsString, Monoid, Pretty, Read, Semigroup, Show) -freshWireId :: MonadState Integer m => m WireId +freshWireId :: Functor m => MonadRtl m => m WireId freshWireId = ("\\wire" <>) . fromString . show <$> fresh data WireOption = WireOptionWidth Integer @@ -400,7 +376,7 @@ instance Pretty CellStmt where newtype CellId = CellId Ident deriving (Eq, IsString, Monoid, Pretty, Read, Semigroup, Show) -freshCellId :: MonadState Integer m => m CellId +freshCellId :: Functor m => MonadRtl m => m CellId freshCellId = ("$cell" <>) . fromString . show <$> fresh newtype CellType = CellType Ident @@ -435,7 +411,7 @@ unaryCell -> Integer -- ^ \\A_WIDTH -> Integer -- ^ \\Y_WIDTH -> SigSpec -- ^ A - -> WireId -- ^ Y + -> SigSpec -- ^ Y -> Cell unaryCell cellStmt aSigned aWidth yWidth a y = Cell [] @@ -444,7 +420,7 @@ unaryCell cellStmt aSigned aWidth yWidth a y = Cell , CellParameter Nothing "\\A_WIDTH" $ ConstantInteger aWidth , CellParameter Nothing "\\Y_WIDTH" $ ConstantInteger yWidth , CellConnect "\\A" a - , CellConnect "\\Y" $ SigSpecWireId y + , CellConnect "\\Y" y ] CellEndStmt @@ -455,7 +431,7 @@ notC, posC, negC, reduceAndC, reduceOrC, reduceXorC, reduceXnorC, reduceBoolC, l -> Integer -> Integer -> SigSpec - -> WireId + -> SigSpec -> Cell notC = unaryCell . CellStmt "$not" @@ -477,7 +453,7 @@ binaryCell -> Integer -- ^ \\Y_WIDTH -> SigSpec -- ^ A -> SigSpec -- ^ B - -> WireId -- ^ Y + -> SigSpec -- ^ Y -> Cell binaryCell cellStmt aSigned aWidth bSigned bWidth yWidth a b y = Cell [] @@ -489,7 +465,7 @@ binaryCell cellStmt aSigned aWidth bSigned bWidth yWidth a b y = Cell , CellParameter Nothing "\\Y_WIDTH" $ ConstantInteger yWidth , CellConnect "\\A" a , CellConnect "\\B" b - , CellConnect "\\Y" $ SigSpecWireId y + , CellConnect "\\Y" y ] CellEndStmt @@ -505,7 +481,7 @@ shiftCell -> Integer -> SigSpec -> SigSpec - -> WireId + -> SigSpec -> Cell shiftCell cellStmt aSigned aWidth = binaryCell cellStmt aSigned aWidth False @@ -519,7 +495,7 @@ andC, orC, xorC, xnorC, logicAndC, logicOrC, eqxC, nexC, powC, ltC, leC, eqC, ne -> Integer -> SigSpec -> SigSpec - -> WireId + -> SigSpec -> Cell shlC, shrC, sshlC, sshrC @@ -530,7 +506,7 @@ shlC, shrC, sshlC, sshrC -> Integer -> SigSpec -> SigSpec - -> WireId + -> SigSpec -> Cell andC = binaryCell . CellStmt "$and" @@ -567,7 +543,7 @@ muxC -> SigSpec -- ^ A -> SigSpec -- ^ B -> SigSpec -- ^ S - -> WireId -- ^ Y + -> SigSpec -- ^ Y -> Cell muxC cellId w a b s y = Cell [] @@ -576,7 +552,7 @@ muxC cellId w a b s y = Cell , CellConnect "\\A" a , CellConnect "\\B" b , CellConnect "\\S" s - , CellConnect "\\Y" $ SigSpecWireId y + , CellConnect "\\Y" y ] CellEndStmt @@ -620,7 +596,7 @@ newtype ProcStmt = ProcStmt Ident instance Pretty ProcStmt where pretty (ProcStmt i) = "process" <+> pretty i -freshProcStmt :: MonadState Integer m => m ProcStmt +freshProcStmt :: Functor m => MonadRtl m => m ProcStmt freshProcStmt = ("$proc" <>) . fromString . show <$> fresh data ProcessBody = ProcessBody [AssignStmt] (Maybe Switch) [AssignStmt] [Sync] @@ -757,11 +733,74 @@ 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 +class MonadRtl m where + fresh :: m Integer + freshWire :: Integer -- ^ width + -> m SigSpec + + process :: Integer -- ^ width + -> (SigSpec -> m SigSpec) + -> m SigSpec + -- | Output width=1 + at :: SigSpec -> Integer -> m SigSpec + + -- | If S == 1 then B else A + mux :: Integer -- ^ width + -> SigSpec -- ^ S + -> SigSpec -- ^ A + -> SigSpec -- ^ B + -> m SigSpec -- ^ Y + + unary :: ( CellId + -> Bool + -> Integer + -> Integer + -> SigSpec + -> SigSpec + -> Cell + ) + -> Bool + -> Integer + -> Integer + -> SigSpec + -> m SigSpec + binary :: ( CellId + -> Bool + -> Integer + -> Bool + -> Integer + -> Integer + -> SigSpec + -> SigSpec + -> SigSpec + -> Cell + ) + -> Bool + -> Integer + -> Bool + -> Integer + -> Integer + -> SigSpec + -> SigSpec + -> m SigSpec + + shift :: ( CellId + -> Bool + -> Integer + -> Integer + -> Integer + -> SigSpec + -> SigSpec + -> SigSpec + -> Cell + ) + -> Bool + -> Integer + -> Integer + -> Integer + -> SigSpec + -> SigSpec + -> m SigSpec newtype Rtl a = Rtl{ unRtl :: WriterT [ModuleBody] (State Integer) a } deriving ( Functor, Applicative, Monad @@ -769,6 +808,63 @@ newtype Rtl a = Rtl{ unRtl :: WriterT [ModuleBody] (State Integer) a } , MonadState Integer ) +instance MonadRtl Rtl where + fresh = state $ \i -> (i, i + 1) + freshWire w = do + wId <- freshWireId + tell [ModuleBodyWire $ Wire [] $ WireStmt [WireOptionWidth w] wId] + return $ SigSpecWireId wId + + process w f = do + old <- freshWire w + procStmt <- freshProcStmt + srcSig <- f old + tell [ModuleBodyProcess $ updateP procStmt (DestSigSpec old) (SrcSigSpec srcSig)] + return old + + at sigSpec ix = do + y <- freshWire 1 + tell [ModuleBodyConnStmt $ ConnStmt y (SigSpecSlice sigSpec ix Nothing)] + return y + + mux w s a b = do + y <- freshWire w + cId <- freshCellId + tell [ModuleBodyCell $ muxC cId w a b s y] + return y + + unary cFn aSigned aWidth yWidth a = do + y <- freshWire yWidth + cId <- freshCellId + tell [ModuleBodyCell $ cFn cId aSigned aWidth yWidth a y] + return y + + binary cFn aSigned aWidth bSigned bWidth yWidth a b = do + y <- freshWire yWidth + cId <- freshCellId + tell [ModuleBodyCell $ cFn cId aSigned aWidth bSigned bWidth yWidth a b y] + return y + + shift cFn aSigned aWidth bWidth yWidth a b = do + y <- freshWire yWidth + cId <- freshCellId + tell [ModuleBodyCell $ cFn cId aSigned aWidth bWidth yWidth a b y] + return y + +shl, shr, sshl, sshr + :: MonadRtl m + => Bool + -> Integer + -> Integer + -> Integer + -> SigSpec + -> SigSpec + -> m SigSpec +shl = shift shlC +shr = shift shrC +sshl = shift sshlC +sshr = shift sshrC + compile :: Rtl a -> File compile = top . clocked . flip evalState 1 . execWriterT . unRtl diff --git a/test/Test/Bayeux/Rgb/golden/rgbcounter.pretty b/test/Test/Bayeux/Rgb/golden/rgbcounter.pretty index b94f765..63e4d33 100644 --- a/test/Test/Bayeux/Rgb/golden/rgbcounter.pretty +++ b/test/Test/Bayeux/Rgb/golden/rgbcounter.pretty @@ -2,35 +2,35 @@ autoidx 0 module \top wire input 1 \clk - wire width 32 \$my_counter - wire width 32 \unused + wire width 32 \wire1 + wire width 32 \wire3 - cell $add $my_counter + cell $add $cell4 parameter \A_SIGNED 0 parameter \A_WIDTH 32 parameter \B_SIGNED 0 parameter \B_WIDTH 32 parameter \Y_WIDTH 32 - connect \A \$my_counter + connect \A \wire1 connect \B 1 - connect \Y \unused + connect \Y \wire3 end - process $procStmt + process $proc2 sync posedge \clk - update \$my_counter \unused + update \wire1 \wire3 end - wire width 1 \pwm_r - connect \pwm_r \$my_counter [24] - wire width 1 \pwm_g - connect \pwm_g \$my_counter [23] - wire width 1 \pwm_b - connect \pwm_b \$my_counter [22] + wire width 1 \wire5 + connect \wire5 \wire1 [24] + wire width 1 \wire6 + connect \wire6 \wire1 [23] + wire width 1 \wire7 + connect \wire7 \wire1 [22] wire output 2 \red wire output 3 \green wire output 4 \blue @@ -42,11 +42,11 @@ module \top parameter \RGB2_CURRENT "0b111111" connect \CURREN 1'1 connect \RGB0 \red - connect \RGB0PWM \pwm_r + connect \RGB0PWM \wire5 connect \RGB1 \green - connect \RGB1PWM \pwm_g + connect \RGB1PWM \wire6 connect \RGB2 \blue - connect \RGB2PWM \pwm_b + connect \RGB2PWM \wire7 connect \RGBLEDEN 1'1 end diff --git a/test/Test/Bayeux/Rtlil.hs b/test/Test/Bayeux/Rtlil.hs index c9bb33d..153f743 100644 --- a/test/Test/Bayeux/Rtlil.hs +++ b/test/Test/Bayeux/Rtlil.hs @@ -28,7 +28,7 @@ tests = (SigSpecWireId "\\pwm_g") (SigSpecWireId "\\pwm_b") , prettyTest "fiatLux" fiatLux - , prettyTest "add" $ addC "\\adder" False 32 False 32 33 (SigSpecWireId "\\a") (SigSpecWireId "\\b") "\\y" + , prettyTest "add" $ addC "\\adder" False 32 False 32 33 (SigSpecWireId "\\a") (SigSpecWireId "\\b") (SigSpecWireId "\\y") , prettyTest "counter" $ counter 8 "\\old" "\\new" "$old" "$procStmt" ] , testGroup "synth" @@ -37,6 +37,31 @@ tests = ] ] +counter + :: Integer -- ^ width + -> WireId -- ^ old + -> WireId -- ^ new + -> CellId -- ^ add + -> ProcStmt -- ^ update + -> [ModuleBody] +counter w old new addId procStmt = + [ ModuleBodyWire $ Wire [] $ WireStmt [WireOptionWidth w] old -- $ WireId $ "\\" <> old + , ModuleBodyWire $ Wire [] $ WireStmt [WireOptionWidth w] new -- $ WireId new + , ModuleBodyCell $ addC + addId + False + w + False + w + w + (SigSpecWireId old) + (SigSpecConstant $ ConstantInteger 1) + (SigSpecWireId new) + , ModuleBodyProcess $ updateP procStmt + (DestSigSpec $ SigSpecWireId old) + (SrcSigSpec $ SigSpecWireId new) + ] + prettyTest :: Pretty a => TestName -> a -> TestTree prettyTest n = goldenVsString n (curDir n <.> "pretty") . return . fromString . T.unpack . render . pretty @@ -64,16 +89,16 @@ rtlilLed = File Nothing , ModuleBodyCell $ addC "$increment" False 26 False 32 32 (SigSpecWireId "\\counter") (SigSpecConstant $ ConstantInteger 1) - "\\counter_plus_one" + (SigSpecWireId "\\counter_plus_one") , ModuleBodyCell $ notC "$not$1" False 1 1 (SigSpecSlice (SigSpecWireId "\\counter") 23 Nothing) - "\\LED_R" + (SigSpecWireId "\\LED_R") , ModuleBodyCell $ notC "$not$2" False 1 1 (SigSpecSlice (SigSpecWireId "\\counter") 24 Nothing) - "\\LED_G" + (SigSpecWireId "\\LED_G") , ModuleBodyCell $ notC "$not$3" False 1 1 (SigSpecSlice (SigSpecWireId "\\counter") 25 Nothing) - "\\LED_B" + (SigSpecWireId "\\LED_B") , ModuleBodyProcess $ Process [] "$run"