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


-}