[clash] Regex.hs testbench works

haskell/clash/Regex.hs

@@ -1,53 +1,46 @@
 {-# LANGUAGE ViewPatterns #-}
 
 {-
-'Thompson machine' for the regex (a|b)|(c|d)
+'Thompson machine' for the regex a(b|c)
  -}
 module Regex where
 
 import Clash.Prelude
+import Clash.Explicit.Testbench
+import qualified Data.List as L
 
-type PC = BitVector 5
+type PC = Vec 4 Bit
+type Matrix a rows cols = Vec rows (Vec cols a)
 
-isFinal :: PC -> Bool
-isFinal pc = (lsb pc) == high
+isGood :: PC -> Bool
+isGood pc = (lsb pc) == high
+
+isBad :: PC -> Bool
+isBad pc = reduceOr pc == low
 
 conds :: Vec 4 (Char -> Bit)
 conds
   = map (\c -> \x -> if c == x then high else low)
         ('a' :> 'b' :> 'c' :> 'd' :> Nil)
 
--- condSat :: Char -> Vec 4 (Char -> Bit) -> BitVector 4
--- condSat c cnds = pack $ map (\f -> f c) cnds
-
 condSat :: Char -> Vec 4 (Char -> Bit) -> Vec 4 Bit
 condSat c cnds = map (\f -> f c) cnds
 
-type Matrix a rows cols = Vec rows (Vec cols a)
-
 -- | Transition matrix for a(b|c)
-delta :: Matrix Bit 3 4
+delta :: Matrix Bit 4 4
 --delta :: Vec 3 (Vec 4 Bit)
-delta
-    --              abcF
-  = {- a -} (bv2v 0b0110) :>
-    {- b -} (bv2v 0b0001) :>
-    {- c -} (bv2v 0b0001) :>
+delta = 
+  --              abcF
+  {- a -} (bv2v 0b0110) :>
+  {- b -} (bv2v 0b0001) :>
+  {- c -} (bv2v 0b0001) :>
+  {- F -} (bv2v 0b0000) :>
             Nil
 
--- dotProduct x bv = pack $ map (\b -> xor x b) (bv2v bv)
-
--- dotProduct :: KnownNat n => BitVector n -> BitVector n -> Bit
--- dotProduct a b =
---   let a' = bv2v a in
---   let b' = bv2v b in
---     foldr (\b res -> xor b res) low
---   $ zipWith (.|.) a' b'
-
 dotProduct :: KnownNat n => Vec n Bit -> Vec n Bit -> Bit
 dotProduct a b =
     foldr (\b res -> xor b res) low
-  $ zipWith (.|.) a b
+  $ zipWith (.&.) a b
 
 vecMatrixProd
   :: (KnownNat rows, KnownNat cols)
@@ -57,65 +50,79 @@ vecMatrixProd
 vecMatrixProd vec mat
   = map (\v -> dotProduct vec v) mat
 
-matrixProd
-  :: (KnownNat lrows, KnownNat comm, KnownNat rcols)
-  => Matrix Bit lrows comm
-  -> Matrix Bit comm rcols
-  -> Matrix Bit lrows rcols
-matrixProd m1 m2 = map (\vec -> vecMatrixProd vec (transpose m2)) m1
-  
 -- matrixProd
 --   :: (KnownNat lrows, KnownNat comm, KnownNat rcols)
---   => Matrix Bit lrow comm
+--   => Matrix Bit lrows comm
 --   -> Matrix Bit comm rcols
 --   -> Matrix Bit lrows rcols
+-- matrixProd m1 m2 = map (\vec -> vecMatrixProd vec (transpose m2)) m1
 
--- matrixProd
---   :: (KnownNat lrows, KnownNat comm, KnownNat rcols)
---   => Vec lrows (BitVector comm)
---   -> Vec comm (BitVector rcols)
---   -> Vec lrows (BitVector rcols)
--- matrixProd m1 m2
---   = \bv acc -> dotProduct bv acc
+topFn :: PC -> Char -> (PC, Maybe Bit)
+topFn pc c = 
+  let cndsats = condSat c conds in
+  let pc' = bv2v $ (pack pc) .&. (pack cndsats) in
+  let npc = vecMatrixProd pc' (transpose delta) in
+  let res = if isGood npc then Just high
+            else if isBad npc then Just low
+            else Nothing in
+  (npc, res)
   
-
--- zipRows :: KnownNat n => BitVector n -> BitVector n -> BitVector n
--- zipRows a b =
---   let a' = bv2v a in
---   let b' = bv2v b in
---   pack $ zipWith (.|.) a' b'
-
--- collapseProd :: KnownNat n => BitVector n -> Bit
--- collapseProd bv = foldr (\b res -> xor b res) low (bv2v bv)
-
-
--- foo :: Bit -> BitVector 4 -> BitVector 1
--- foo v bv
---   = pack
---   $ foldr (\b res -> xor b res) low
---   $ map (\b -> v .|. b) (bv2v bv)
+topEntity
+  :: Clock System
+  -> Reset System
+  -> Enable System
+  -> Signal System Char
+  -> Signal System (Maybe Bit)
+topEntity = exposeClockResetEnable $ mealy topFn (bv2v 0b1000)
 
 
 
--- delta :: Vec 4 (BitVector 5)
--- delta
---     --        abcdF
---   = {- a -} 0b00110 :>
---     {- b -} 0b00110 :>
---     {- c -} 0b00001 :>
---     {- d -} 0b00001 :>
---             Nil
--- 
--- 
--- 
--- topFn :: State -> Char -> (State, Maybe Bool)
--- 
--- 
--- topEntity
---   :: Clock System
---   -> Reset System
---   -> Enable System
---   -> Signal System Char
---   -> Signal System (Maybe Bool)
--- topEntity = exposeClockResetEnable $ mealy topFn Nothing
+testBench :: Signal System Bool
+testBench = done
+  where
+    --testInput      = stimuliGenerator clk rst ('-' :> 'a' :> 'b' :> Nil)
+    --expectedOutput = outputVerifier' clk rst (Nothing :> Nothing :> Just high :> Nil)
+    testInput      = stimuliGenerator clk rst ('a' :> 'b' :> Nil)
+    expectedOutput = outputVerifier' clk rst (Nothing :> Just high :> Nil)
+    done           = expectedOutput (topEntity clk rst enableGen testInput)
+    --done           = expectedOutput (topEntity <$> testInput)
+    clk            = tbSystemClockGen (not <$> done)
+    rst            = systemResetGen
 
+-- λ> L.take 5 $ sample testBench
+--
+-- cycle(<Clock: System>): 0, outputVerifier
+-- expected value: Nothing, not equal to actual value: Just 1
+-- [False
+-- cycle(<Clock: System>): 1, outputVerifier
+-- expected value: Nothing, not equal to actual value: Just 1
+-- ,False
+-- cycle(<Clock: System>): 2, outputVerifier
+-- expected value: Just 1, not equal to actual value: Nothing
+-- ,False,True,True]
+
+
+
+{-
+
+cycle(<Clock: System>): 0, outputVerifier
+expected value: Nothing, not equal to actual value: Just 0
+[False
+cycle(<Clock: System>): 1, outputVerifier
+expected value: Nothing, not equal to actual value: Just 0
+,False
+cycle(<Clock: System>): 2, outputVerifier
+expected value: Nothing, not equal to actual value: Just 0
+,False
+cycle(<Clock: System>): 3, outputVerifier
+expected value: Just 1, not equal to actual value: Just 0
+,False,True]
+λ> topFn (bv2v 0b0110) 'b'
+(0 :> 0 :> 0 :> 1 :> Nil,Just 1)
+λ> L.take 5 $ sample testBench
+[False,False,False,True,True]
+λ> L.take 15 $ sample testBench
+[False,False,False,True,True,True,True,True,True,True,True,True,True,True,True]
+
+
+-}