Move Rtl monad to Rtlil module

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

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") :)

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") :)

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
       ]
   ]