129 lines
3.5 KiB
Haskell
129 lines
3.5 KiB
Haskell
{-# LANGUAGE ViewPatterns #-}
|
|
|
|
{-
|
|
'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 = Vec 4 Bit
|
|
type Matrix a rows cols = Vec rows (Vec cols a)
|
|
|
|
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) -> Vec 4 Bit
|
|
condSat c cnds = map (\f -> f c) cnds
|
|
|
|
-- | Transition matrix for a(b|c)
|
|
delta :: Matrix Bit 4 4
|
|
--delta :: Vec 3 (Vec 4 Bit)
|
|
delta =
|
|
-- abcF
|
|
{- a -} (bv2v 0b0110) :>
|
|
{- b -} (bv2v 0b0001) :>
|
|
{- c -} (bv2v 0b0001) :>
|
|
{- F -} (bv2v 0b0000) :>
|
|
Nil
|
|
|
|
dotProduct :: KnownNat n => Vec n Bit -> Vec n Bit -> Bit
|
|
dotProduct a b =
|
|
foldr (\b res -> xor b res) low
|
|
$ zipWith (.&.) a b
|
|
|
|
vecMatrixProd
|
|
:: (KnownNat rows, KnownNat cols)
|
|
=> Vec rows Bit
|
|
-> Matrix Bit cols rows -- ^ Matrix in transposed form
|
|
-> Vec cols Bit
|
|
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
|
|
|
|
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)
|
|
|
|
topEntity
|
|
:: Clock System
|
|
-> Reset System
|
|
-> Enable System
|
|
-> Signal System Char
|
|
-> Signal System (Maybe Bit)
|
|
topEntity = exposeClockResetEnable $ mealy topFn (bv2v 0b1000)
|
|
|
|
|
|
|
|
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]
|
|
|
|
|
|
-}
|