kansas-lava-cores 0.1.2 → 0.1.2.1
raw patch · 7 files changed
+114/−63 lines, 7 filesdep +filepathdep ~cmdargsdep ~kansas-lavadep ~sized-typessetup-changednew-uploader
Dependencies added: filepath
Dependency ranges changed: cmdargs, kansas-lava, sized-types
Files
- Hardware/KansasLava/Boards/Spartan3e.hs +1/−1
- Hardware/KansasLava/Boards/UCF.hs +51/−34
- Hardware/KansasLava/LCD/ST7066U.hs +1/−1
- Hardware/KansasLava/RS232.hs +15/−15
- Hardware/KansasLava/Simulators/Polyester.hs +25/−4
- Setup.hs +4/−0
- kansas-lava-cores.cabal +17/−8
Hardware/KansasLava/Boards/Spartan3e.hs view
@@ -115,7 +115,7 @@ -- | show out a suggested UCF file for Spartan3e, for a specific circuit. writeUCF :: FilePath -> KLEG -> IO ()-writeUCF = copyUCF "Spartan3e.ucf"+writeUCF = copyUCF "Spartan3e.ucf" (Just "CLK_50MHZ") ------------------------------------------------------------ -- instance
Hardware/KansasLava/Boards/UCF.hs view
@@ -1,44 +1,61 @@-module Hardware.KansasLava.Boards.UCF (copyUCF) where- +module Hardware.KansasLava.Boards.UCF (+ filterUCF+ , copyUCFFrom+ , copyUCF+ ) where+ import Language.KansasLava as KL-import System.IO import Data.Char+import Data.Maybe (maybeToList)+import System.FilePath ((</>)) import Paths_kansas_lava_cores -copyUCF :: FilePath -> FilePath -> KLEG -> IO ()-copyUCF src dest kleg = do- let inputs = theSrcs kleg- let findMe = concat- [ case toStdLogicType ty of- SL -> [ nm ]- SLV n -> [ nm ++ "<" ++ show i ++ ">" - | i <- [0..(n-1)]- ]- | (nm,ty) <- (theSrcs kleg) ++ map (\ (a,b,c) -> (a,b)) (theSinks kleg)- ]+filterUCF :: Maybe String -> KLEG -> String -> String+filterUCF rawClock kleg ucf = unlines (hdr ++ lns)+ where+ hdr = [ "# Generated automatically by kansas-lava-cores"+ , "#" ++ show portsUsed+ ] - let isComment ('#':_) = True- isComment xs | all isSpace xs = True- isComment _ = False+ lns = [ commentUnless (allowLine ln) ln | ln <- lines ucf ] - let getName xs | take 5 xs == "NET \""- = Just (takeWhile (/= '"') (drop 5 xs))- getName _ = Nothing+ allowLine s = case getName s of+ Nothing -> True+ Just nm -> nm `elem` portsUsed - let hdr = unlines - [ "# Generated automatically by kansas-lava-cores"- , "#" ++ show findMe- ]+ portsUsed = maybeToList rawClock ++ concatMap (uncurry portsFrom) ports+ where+ ports = inputs ++ outputs+ inputs = theSrcs kleg+ outputs = map (\ (a,b,_) -> (a,b)) $ theSinks kleg - filename <- getDataFileName ("UCF/" ++ src)- big_ucf <- readFile filename- let lns = unlines- [ let allow = case getName ln of- Nothing -> True- Just nm -> nm `elem` findMe- in (if allow then "" else "# -- ") ++ ln- | ln <- lines big_ucf- ]+ getName xs+ | take 5 xs == "NET \"" = Just (takeWhile (/= '"') (drop 5 xs))+ | otherwise = Nothing - writeFile dest (hdr ++ lns)+commentUnless :: Bool -> String -> String+commentUnless True ln = ln+commentUnless False ln = "# -- " ++ ln++_isComment :: String -> Bool+_isComment ('#':_) = True+_isComment xs | all isSpace xs = True+ | otherwise = False++portsFrom nm ty = case toStdLogicType ty of+ SL -> [ nm ]+ SLV n -> [ leg i | i <- [0..(n-1)] ]+ where+ leg i = nm ++ "<" ++ show i ++ ">"++copyUCFFrom :: FilePath -> Maybe String -> FilePath -> KLEG -> IO ()+copyUCFFrom src rawClock dest kleg = do+ big_ucf <- readFile src+ let small_ucf = filterUCF rawClock kleg big_ucf+ writeFile dest small_ucf++copyUCF :: FilePath -> Maybe String -> FilePath -> KLEG -> IO ()+copyUCF fileName rawClock dest kleg = do+ src <- getDataFileName ("UCF" </> fileName)+ copyUCFFrom src rawClock dest kleg
Hardware/KansasLava/LCD/ST7066U.hs view
@@ -160,7 +160,7 @@ -} return (commentS "ack" (var ack),pack (reg rs,reg sf_d,commentS "lcd_e" $ reg lcd_e)) -waitFor :: (Rep b, Num b) => Reg s c b -> Signal c b -> RTL s c () -> RTL s c ()+waitFor :: (Rep b, Eq b, Num b) => Reg s c b -> Signal c b -> RTL s c () -> RTL s c () waitFor counter count nextOp = do CASE [ IF (reg counter ./=. count) $ do counter := reg counter + 1
Hardware/KansasLava/RS232.hs view
@@ -17,13 +17,13 @@ import qualified Language.KansasLava as KL import Data.Maybe as Maybe import Data.Char as Char-import Control.Monad +import Control.Monad import Data.Default import Data.Word import Debug.Trace --- Lava implementation of RS232 +-- Lava implementation of RS232 type SAMPLE_RATE = X16 @@ -81,7 +81,7 @@ findBit :: forall sig c . (sig ~ Signal c) => (Num (sig X10)) => sig U8 -> sig X10 -> sig Bool findBit byte x = (bitwise) byte .!. ((unsigned) (loopingDecS x) :: sig X8) -rs232out :: forall clk sig a . (Clock clk, sig a ~ Signal clk a)+rs232out :: forall clk sig a . (Clock clk, sig ~ Signal clk) => Integer -- ^ Baud Rate. -> Integer -- ^ Clock rate, in Hz. -> Patch (sig (Enabled U8)) (sig Bool)@@ -89,9 +89,9 @@ rs232out baudRate clkRate ~(inp0,()) = (toAck (ready .&&. in_en),out) where -- at the baud rate for transmission- fastTick :: Signal clk Bool + fastTick :: Signal clk Bool fastTick = rate (Witness :: Witness X16) $--- accurateTo +-- accurateTo (fromIntegral baudRate / fromIntegral clkRate) -- 0.99 @@ -117,7 +117,7 @@ CASE [ IF (ix .==. maxBound) $ do state := pureS TX_Idle , OTHERWISE $ do- state := funMap (\ x -> if x == maxBound + state := funMap (\ x -> if x == maxBound then return (TX_Send 0) else return (TX_Send (x + 1))) ix ]@@ -139,7 +139,7 @@ -- There is no Ack or Ready, because there is no way to pause the 232. -- For the same reason, this does not use a Patch. -rs232in :: forall clk sig a . (Clock clk, sig a ~ Signal clk a) +rs232in :: forall clk sig a . (Clock clk, sig ~ Signal clk) => Integer -- ^ Baud Rate. -> Integer -- ^ Clock rate, in Hz. -> Patch (sig Bool) (sig (Enabled U8))@@ -148,21 +148,21 @@ where -- 16 times the baud rate for transmission, -- so we can spot the start bit's edge.- fastTick :: Signal clk Bool + fastTick :: Signal clk Bool fastTick = rate (Witness :: Witness X16) $--- accurateTo +-- accurateTo (16 * fromIntegral baudRate / fromIntegral clkRate) -- 0.99- + -- the filter, currently length 4 -- in_vals = in_val0 : map (register True) (take 4 in_vals)- + -- if 4 highs (lows) then go high (low), otherwise as you were. inp = in_val0 {-- inp = register True + inp = register True (cASE [ (foldr1 (.&&.) in_vals, high) , (foldr1 (.&&.) (map bitNot in_vals), low) ]@@ -192,11 +192,11 @@ , OTHERWISE $ do counter := reg counter + 1 ]- + -- We have a 3 sample average, so we wait an aditional 5 -- to be in the middle of the 16-times super-sample. -- So, 5 is 16 / 2 - 3- WHEN ((reg reading .==. high) .&&. (lowCounter .==. 8)) $ CASE + WHEN ((reg reading .==. high) .&&. (lowCounter .==. 8)) $ CASE [ IF (highCounter .<. 9) $ do theByte ((unsigned) highCounter) := inp , IF ((highCounter .==. 9) .&&.@@ -206,7 +206,7 @@ -- This should be the stop bit outVal := enabledS $ findByte [ reg (theByte (fromIntegral i))- | i <- [1..8]+ | i <- [1..8] :: [Int] ] -- start looking for the start bit now counter := 0
Hardware/KansasLava/Simulators/Polyester.hs view
@@ -30,6 +30,7 @@ import Data.Typeable import Control.Exception import Control.Concurrent+import Control.Applicative import Control.Monad import Data.Char import Control.Monad.Fix@@ -57,9 +58,20 @@ -> PolyesterEnv -> IO (a,[Stepper])) +instance Functor Polyester where+ fmap f (Polyester p) = Polyester $ \ inp st -> do+ (x, s) <- p inp st+ return (f x, s) +instance Applicative Polyester where+ pure x = Polyester $ \ _ _ -> return (x, [])+ (Polyester pf) <*> (Polyester px) = Polyester $ \ inp st -> do+ (f, s1) <- pf inp st+ (x, s2) <- px inp st+ return (f x, s1 ++ s2)+ instance Monad Polyester where- return a = Polyester $ \ _ _ -> return (a,[])+ return = pure (Polyester f) >>= k = Polyester $ \ inp st -> do (a,s1) <- f inp st let Polyester g = k a@@ -299,10 +311,19 @@ AT :: ANSI () -> (Int,Int) -> ANSI () BIND :: ANSI b -> (b -> ANSI a) -> ANSI a RETURN :: a -> ANSI a- ++instance Functor ANSI where+ fmap f m = m `BIND` (RETURN . f)++instance Applicative ANSI where+ pure = RETURN+ mf <*> mx = BIND mf $ \f ->+ BIND mx $ \x ->+ RETURN (f x)+ instance Monad ANSI where- return a = RETURN a- m >>= k = BIND m k+ return = pure+ (>>=) = BIND showANSI :: ANSI a -> IO a showANSI (REVERSE ascii) = do
Setup.hs view
@@ -1,2 +1,6 @@+module Main (main) where+ import Distribution.Simple++main :: IO () main = defaultMain
kansas-lava-cores.cabal view
@@ -1,5 +1,5 @@ Name: kansas-lava-cores-Version: 0.1.2+Version: 0.1.2.1 Synopsis: FPGA Cores Written in Kansas Lava. Description: Kansas Lava Cores is a collection of libraries, written in Kansas Lava,@@ -37,13 +37,14 @@ Library Build-Depends: base >= 4 && < 5,- kansas-lava == 0.2.4,+ kansas-lava >= 0.2.4.1 && < 0.2.5, sized-types >= 0.3.4, ansi-terminal >= 0.5.5, data-default, directory, bytestring,- network+ network,+ filepath Exposed-modules: Hardware.KansasLava.FIFO@@ -70,15 +71,16 @@ if flag(spartan3e) || flag(all) Build-Depends: base >= 4 && < 5,- kansas-lava == 0.2.4,- sized-types >= 0.3.4,+ kansas-lava >= 0.2.4.1 && < 0.2.5 ,+ sized-types >= 0.3.4 && < 0.4, ansi-terminal >= 0.5.5, data-default, directory, bytestring, network, random,- cmdargs==0.8+ cmdargs,+ filepath buildable: True else Build-depends: base@@ -93,14 +95,15 @@ if flag(unit) || flag(all) Build-Depends: base >= 4 && < 5,- kansas-lava == 0.2.4,+ kansas-lava >= 0.2.4.1 && < 0.2.5, sized-types >= 0.3.4, ansi-terminal >= 0.5.5, data-default, directory, bytestring, network,- random+ random,+ filepath buildable: True Other-modules: Chunker@@ -122,3 +125,9 @@ source-repository head type: git location: git://github.com/ku-fpg/kansas-lava-cores.git++source-repository this+ type: git+ location: git://github.com/ku-fpg/kansas-lava-cores.git+ branch: kansas-lava-cores-0.1.2+ tag: 0.1.2.1