[clash] expand Regex.hs

haskell/clash/Regex.hs

@@ -0,0 +1,121 @@
+{-# LANGUAGE ViewPatterns #-}
+
+{-
+'Thompson machine' for the regex (a|b)|(c|d)
+ -}
+module Regex where
+
+import Clash.Prelude
+
+type PC = BitVector 5
+
+isFinal :: PC -> Bool
+isFinal pc = (lsb pc) == high
+
+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 :: Vec 3 (Vec 4 Bit)
+delta
+    --              abcF
+  = {- a -} (bv2v 0b0110) :>
+    {- b -} (bv2v 0b0001) :>
+    {- c -} (bv2v 0b0001) :>
+            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
+
+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
+  
+-- matrixProd
+--   :: (KnownNat lrows, KnownNat comm, KnownNat rcols)
+--   => Matrix Bit lrow comm
+--   -> Matrix Bit comm rcols
+--   -> Matrix Bit lrows rcols
+
+-- 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
+  
+
+-- 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)
+
+
+
+-- 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
+

haskell/clash/Voter.hs

@@ -15,11 +15,13 @@ https://link.springer.com/chapter/10.1007/3-540-44829-2_3
 import Clash.Prelude
 import qualified Data.List as L
 
+-- | Representation of a sensor
 data Sensor = Sensor {
     out :: Int     -- ^ Output value
   , valid :: Bool  -- ^ Output validity
 }
 
+-- | Possible states of system
 data State
   = VAll
   | V2NoMis Int Int -- ^ valid sensor ids
@@ -28,16 +30,26 @@ data State
   | VNone
   deriving (Generic, NFDataX)
 
-countValidSens :: Vec 3 Sensor -> Int
+-- | Count number of valid sensors
+countValidSens
+  :: Vec 3 Sensor -- ^ Sensors
+  -> Int          -- ^ Valid sensor count
 countValidSens sens = foldr (\s n -> if valid s then n+1 else n) 0 sens
 
-
-tooMuch :: Int -> Int -> Int -> Bool
+-- | Find if a range is beyond a limit
+tooMuch
+  :: Int  -- ^ Maximum tolerance limit
+  -> Int  -- ^ Range boundary
+  -> Int  -- ^ Range boundary
+  -> Bool -- ^ Tell if range is within acceptable bounds
 tooMuch limit a b =
   let val = abs $ a - b in
   val > limit
 
-isMiscomp3 :: Vec 3 Sensor -> Maybe Int
+-- | Find if there is a miscomparing sensor when there are 3 valid sensors
+isMiscomp3
+  :: Vec 3 Sensor -- ^ Sensors
+  -> Maybe Int    -- ^ Tell if there is an odd sensor
 isMiscomp3 sens =
   let v01 = tooMuch 0 (out $ sens !! 0) (out $ sens !! 1) in
   let v02 = tooMuch 0 (out $ sens !! 0) (out $ sens !! 2) in
@@ -47,13 +59,11 @@ isMiscomp3 sens =
   else if v02 && v12 then Just 2
   else Nothing
 
-validSensors :: Vec 3 Sensor -> [Int]
-validSensors sens = 
-  fst $ foldr (\s (res, curidx) ->
-                 (if valid s then curidx:res else res, curidx+1))
-        ([], 0) sens 
-
-nextState :: State -> Vec 3 Sensor -> State
+-- | Find next state of system
+nextState
+  :: State        -- ^ Current state
+  -> Vec 3 Sensor -- ^ Sensor data
+  -> State        -- ^ Next state
 nextState VAll sens = 
   if countValidSens sens < 3 then
     -- 1 sensor newly invalidated.
@@ -107,7 +117,12 @@ nextState (V1 sid) sens =
 
 nextState VNone sens = VNone
 
-nextOut :: State -> Vec 3 Sensor -> Sensor
+-- | Find next output upon given next state
+-- Output is purely dependent on state
+nextOut
+  :: State        -- ^ Next state
+  -> Vec 3 Sensor -- ^ Sensor data
+  -> Sensor       -- ^ Next output
 nextOut st sens = case st of
   VAll -> sens !! 0
   V2NoMis sid1 _ -> sens !! sid1