Skip to content

Instantly share code, notes, and snippets.

@christiaanb
Created April 26, 2016 08:01
Show Gist options
  • Save christiaanb/0b3dd2224ec4da06d6596b080db70aae to your computer and use it in GitHub Desktop.
Save christiaanb/0b3dd2224ec4da06d6596b080db70aae to your computer and use it in GitHub Desktop.
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}
module SerialDecoder where
import CLaSH.Prelude
import CLaSH.Prelude.DataFlow
import CLaSH.Prelude.Explicit
import Data.Maybe
import Prelude hiding (repeat, length, replicate)
--import Flow
--import Signal
-- whether or not data is being requested, serial in
type In i = (Bool, i)
-- par out, shift clock, shift register clock inhibit, shift register should load
type Out n i = (Maybe (Vec n i), Bool, Bool, Bool)
data DecodeST n i idx where
Halted :: DecodeST n i idx
ReadShift :: Maybe (Vec n i) -> DecodeST n i idx
RcvBit :: idx -> Vec n i -> Maybe (Vec n i) -> DecodeST n i idx
clockStep :: DecodeST n i idx -> (Bool, DecodeST n i idx)
clockStep = (,) False
decodeSTSizeS :: KnownNat n => DecodeST n i idx -> SNat n
decodeSTSizeS _ = snat
dstSize :: KnownNat n => DecodeST n i idx -> Integer
dstSize d = snatToInteger $ decodeSTSizeS d
-- the actual state is a pair, the shift clock + DecodeST
mooreTransition :: (KnownNat n) => (Bool, DecodeST n i Integer) -> (In i) -> (Bool, DecodeST n i Integer)
mooreTransition (False, x) _ = (True, x)
mooreTransition (_ , _) (False, _) = clockStep Halted
mooreTransition (_, Halted) (True, _) = clockStep $ ReadShift Nothing
mooreTransition (_, st@(ReadShift ov)) _ = clockStep $ RcvBit (dstSize st) (replicate (decodeSTSizeS st) undefined) ov
mooreTransition (_, (RcvBit idx v _)) (_, i) | 0 == (fromEnum idx) = clockStep $ ReadShift (Just $ replace 0 i v)
mooreTransition (_, (RcvBit idx v ov)) (_, i) = clockStep $ RcvBit (pred idx) (replace idx i v) ov
mooreOutput :: KnownNat n => (Bool, DecodeST n i idx) -> Out n i
mooreOutput (clk, Halted) = (Nothing, clk, True, True)
mooreOutput (clk, (ReadShift ov)) = (ov, clk, True, False)
mooreOutput (clk, (RcvBit _ _ ov)) = (ov, clk, False, True)
serialDecoder' :: (KnownNat n) => SNat n -> SClock clk -> Unbundled' clk (In i) -> Unbundled' clk (Out n i)
serialDecoder' n clk = mooreB' clk mooreTransition mooreOutput (False, Halted)
-- MAIN
type IOClock = Clk "io" 2000
ioclock :: SClock IOClock
ioclock = sclock
type IOSignal a = Signal' IOClock a
ioRegister :: a -> IOSignal a -> IOSignal a
ioRegister a s = register' ioclock a s
type IOBundled' a = Unbundled' IOClock a
newtype Board wc_ins wc_outs = Board {
boardF :: (KnownNat wc_ins, KnownNat wc_outs) =>
IOSignal (BitVector wc_ins) ->
IOBundled' (LEDs, BitVector wc_outs) }
type LEDs = BitVector 5
topLevel :: Board 1 7
topLevel = Board (\ ins -> let decode = serialDecoder' d8 ioclock
inSig = (unpack :: Bit -> Bool) <$> ins
(pout, shclk, inhout, modeout) = decode $ ((,) $ pure True) inSig
pout' = fromMaybe <$> pure (repeat False) <*> pout
poutB = (pack :: Vec 8 Bool -> BitVector 8) <$> pout'
shclkB = (pack :: Bool -> Bit) <$> shclk
inhoutB = (pack :: Bool -> Bit) <$> inhout
modeoutB = (pack :: Bool -> Bit) <$> modeout
shiftOutB = (++#) <$> shclkB <*> ((++#) <$> inhoutB <*> modeoutB)
ledsOut = slice <$> pure d4 <*> pure d0 <*> poutB
wingsOut = (++#) <$> shiftOutB <*> pure ($$(bLit "0000") :: BitVector 4)
in (ledsOut, wingsOut))
{-# ANN topEntity
(defTop {
t_name = "clash",
t_inputs = ["wing_c_in"],
t_outputs = ["leds", "wing_c_out"],
t_extraIn = [("reset_switch", 1),
("master_osc", 1)],
t_clocks = [ClockSource {
c_name = "main_clock",
c_inp = [("crystal_in", "master_osc(0)")],
c_outp = [("system_clk", show systemClock),
("io_clk", show (sclock :: SClock IOClock))],
c_reset = Just ("master_reset", "reset_switch(0)"),
c_lock = "locked",
c_sync = False }]
}) #-}
topEntity = boardF topLevel
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment