diff --git a/lib/Bayeux.hs b/lib/Bayeux.hs index 81bede6..65f29e2 100644 --- a/lib/Bayeux.hs +++ b/lib/Bayeux.hs @@ -32,7 +32,7 @@ app = \case print $ close [] t rgbCounter :: File -rgbCounter = cycleCompile prog +rgbCounter = compile prog rgbCycle :: File -rgbCycle = cycleCompile cycleProg +rgbCycle = compile cycleProg diff --git a/lib/Bayeux/RgbCounter.hs b/lib/Bayeux/RgbCounter.hs index 52feeee..81703fd 100644 --- a/lib/Bayeux/RgbCounter.hs +++ b/lib/Bayeux/RgbCounter.hs @@ -3,13 +3,10 @@ module Bayeux.RgbCounter ( prog --- , compile , cycleProg - , cycleCompile ) where import Bayeux.Rtlil -import Control.Monad.State import Control.Monad.Writer class Monad m => MonadRgb m where @@ -24,35 +21,6 @@ prog = do g <- c `at` 23 b <- c `at` 22 rgb r g b -{- -newtype Rgb a = Rgb{ unRgb :: Writer [ModuleBody] a } - deriving (Functor, Applicative, Monad, MonadWriter [ModuleBody]) - -instance MonadRgb Rgb where - ctr = do - tell $ [ModuleBodyWire $ Wire [] $ WireStmt [WireOptionInput 1] "\\clk"] <> 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 - ] --} ---compile :: Rgb a -> File ---compile = top . execWriter . unRgb class MonadProcess m where process :: (SigSpec -> m SigSpec) -> m SigSpec @@ -88,15 +56,9 @@ cycleProg = do two = constSig 2 second = constSig 12000000 -newtype Rtl a = Rtl{ unRtl :: WriterT [ModuleBody] (State Integer) a } - deriving ( Functor, Applicative, Monad - , MonadWriter [ModuleBody] - , MonadState Integer - ) - instance MonadRgb Rtl where ctr = do - tell $ {-[ModuleBodyWire $ Wire [] $ WireStmt [WireOptionInput 1] "\\clk"] <>-} counter 32 "\\$my_counter" "\\unused" "$my_counter" "$procStmt" + tell $ counter 32 "\\$my_counter" "\\unused" "$my_counter" "$procStmt" return $ SigSpecWireId "\\$my_counter" at sigSpec ix = do @@ -152,9 +114,3 @@ instance MonadProcess Rtl where , ModuleBodyCell $ muxC cId 32 a b s y ] return $ SigSpecWireId y - -cycleCompile :: Rtl a -> File -cycleCompile = top . clocked . flip evalState 1 . execWriterT . unRtl - -clocked :: [ModuleBody] -> [ModuleBody] -clocked = (ModuleBodyWire (Wire [] $ WireStmt [WireOptionInput 1] "\\clk") :) diff --git a/lib/Bayeux/Rtlil.hs b/lib/Bayeux/Rtlil.hs index 9579205..20912c0 100644 --- a/lib/Bayeux/Rtlil.hs +++ b/lib/Bayeux/Rtlil.hs @@ -116,9 +116,13 @@ module Bayeux.Rtlil , SyncStmt(..) , SyncType(..) , UpdateStmt(..) + , -- * Compile + Rtl(..) + , compile ) where import Control.Monad.State +import Control.Monad.Writer import Data.Bits import Data.Bool import Data.String @@ -758,3 +762,15 @@ fresh = do i <- get modify (+ 1) return i + +newtype Rtl a = Rtl{ unRtl :: WriterT [ModuleBody] (State Integer) a } + deriving ( Functor, Applicative, Monad + , MonadWriter [ModuleBody] + , MonadState Integer + ) + +compile :: Rtl a -> File +compile = top . clocked . flip evalState 1 . execWriterT . unRtl + +clocked :: [ModuleBody] -> [ModuleBody] +clocked = (ModuleBodyWire (Wire [] $ WireStmt [WireOptionInput 1] "\\clk") :) diff --git a/test/Test/Bayeux/RgbCounter.hs b/test/Test/Bayeux/RgbCounter.hs index 176fd75..a07c4e5 100644 --- a/test/Test/Bayeux/RgbCounter.hs +++ b/test/Test/Bayeux/RgbCounter.hs @@ -18,16 +18,15 @@ import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.Golden - tests :: [TestTree] tests = [ testGroup "pretty" - [ prettyTest "rgbcounter" $ cycleCompile prog - , prettyTest "rgbcycle" $ cycleCompile cycleProg + [ prettyTest "rgbcounter" $ compile prog + , prettyTest "rgbcycle" $ compile cycleProg ] , testGroup "synth" - [ synthTest "rgbcounter" $ cycleCompile prog - , synthTest "rgbcycle" $ cycleCompile cycleProg + [ synthTest "rgbcounter" $ compile prog + , synthTest "rgbcycle" $ compile cycleProg ] ]