156 lines
4.5 KiB
Haskell
156 lines
4.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 = KnownNat n => Vec n Bit
|
|
type Matrix a rows cols = Vec rows (Vec cols a)
|
|
|
|
isGood :: KnownNat n => Vec n Bit -> Bool
|
|
isGood pc = (lsb pc) == high
|
|
|
|
isBad :: KnownNat n => Vec n Bit -> 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 :: KnownNat n => a -> Vec n (a -> Bit) -> Vec n 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
|
|
|
|
-- | Transition matrix for (a|b)(c|d)
|
|
delta2 :: Matrix Bit 5 5
|
|
delta2 =
|
|
-- abcdF
|
|
{- a -} (bv2v 0b00110) :>
|
|
{- b -} (bv2v 0b00110) :>
|
|
{- c -} (bv2v 0b00001) :>
|
|
{- d -} (bv2v 0b00001) :>
|
|
{- F -} (bv2v 0b00000) :>
|
|
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
|
|
|
|
genTopFn
|
|
:: (KnownNat n, Eq a)
|
|
=> Matrix Bit (n+1) (n+1) -- transition matrix
|
|
-> Vec n (a -> Bit) -- symbol acceptance criteria
|
|
-> Vec (n+1) Bit -- current state
|
|
-> a -- input symbol
|
|
-> (Vec (n+1) Bit, Maybe Bit) -- next state and result
|
|
genTopFn delta cnds pc c =
|
|
let cndsats = condSat c cnds in
|
|
let pc' = liftA2 (.&.) pc (cndsats ++ (singleton low)) 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)
|
|
|
|
topFn :: KnownNat n => Vec n Bit -> Char -> (Vec n Bit, Maybe Bit)
|
|
topFn pc c = genTopFn delta conds pc c
|
|
|
|
|
|
|
|
-- topFn :: KnownNat n => Vec n Bit -> Char -> (Vec n Bit, 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 0b11000)
|
|
-- 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]
|
|
|
|
|
|
-}
|