diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,12 @@ # Changelog for [`clash-prelude` package](http://hackage.haskell.org/package/clash-prelude) -## 0.7.2 +## 0.7.3 *April 22nd 2015* * New features: + * Add the vector functions: `zip3`, `unzip3`, and `zipWith3` + * Use version 0.2 of the [`ghc-typelits-natnormalise` package](http://hackage.haskell.org/package/ghc-typelits-natnormalise) + +## 0.7.2 *April 20th 2015* +* New features: * Support for GHC 7.10 => only works with GHC 7.10 and higher * Use http://hackage.haskell.org/package/ghc-typelits-natnormalise typechecker plugin for better type-level natural number handling @@ -11,12 +16,12 @@ ## 0.7 *March 13th 2015* * New features: - * Switch types of 'bundle' and 'bundle'', and 'unbundle' and 'unbundle''. + * Switch types of `bundle` and `bundle'`, and `unbundle` and `unbundle'`. * Rename all explicitly clocked versions of Signal functions, to the primed - name of the implicitly clocked Signal functions. E.g. 'cregister' is now - called 'register'' (where the implicitly clocked function is callled 'register') - * Add new instances for 'DSignal' - * Add experimental 'antiDelay' function for 'DSignal' + name of the implicitly clocked Signal functions. E.g. `cregister` is now + called `register'` (where the implicitly clocked function is callled `register`) + * Add new instances for `DSignal` + * Add experimental `antiDelay` function for `DSignal` * Generalize lifted functions over Signals (e.g. (.==.)) * Fixes bugs: diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ [![Build Status](https://travis-ci.org/clash-lang/clash-prelude.svg?branch=master)](https://travis-ci.org/clash-lang/clash-prelude) = WARNING = -Only works with GHC-7.8.* (http://www.haskell.org/ghc/download_ghc_7_8_3)! +Only works with GHC-7.10.* (http://www.haskell.org/ghc/download_ghc_7_10_1)! diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,51 +1,2 @@ -{-# OPTIONS_GHC -Wall #-} -module Main (main) where - -import Data.List ( nub ) -import Data.Version ( showVersion ) -import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName ) -import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) ) -import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) -import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles ) -import Distribution.Simple.BuildPaths ( autogenModulesDir ) -import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref)) -import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) ) -import Distribution.Text ( display ) -import Distribution.Verbosity ( Verbosity, normal ) -import System.FilePath ( () ) - -main :: IO () -main = defaultMainWithHooks simpleUserHooks - { buildHook = \pkg lbi hooks flags -> do - generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi - buildHook simpleUserHooks pkg lbi hooks flags - , postHaddock = \args flags pkg lbi -> do - copyFiles normal (haddockOutputDir flags pkg) [] - postHaddock simpleUserHooks args flags pkg lbi - } - -haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath -haddockOutputDir flags pkg = destDir where - baseDir = case haddockDistPref flags of - NoFlag -> "." - Flag x -> x - destDir = baseDir "doc" "html" display (packageName pkg) - -generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () -generateBuildModule verbosity pkg lbi = do - let dir = autogenModulesDir lbi - createDirectoryIfMissingVerbose verbosity True dir - withLibLBI pkg lbi $ \_ libcfg -> do - withTestLBI pkg lbi $ \suite suitecfg -> do - rewriteFile (dir "Build_" ++ testName suite ++ ".hs") $ unlines - [ "module Build_" ++ testName suite ++ " where" - , "deps :: [String]" - , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg)) - ] - where - formatdeps = map (formatone . snd) - formatone p = case packageName p of - PackageName n -> n ++ "-" ++ showVersion (packageVersion p) - -testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] -testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys +import Distribution.Simple +main = defaultMain diff --git a/clash-prelude.cabal b/clash-prelude.cabal --- a/clash-prelude.cabal +++ b/clash-prelude.cabal @@ -1,5 +1,5 @@ Name: clash-prelude -Version: 0.7.2 +Version: 0.7.3 Synopsis: CAES Language for Synchronous Hardware - Prelude library Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that @@ -28,9 +28,9 @@ License-file: LICENSE Author: Christiaan Baaij Maintainer: Christiaan Baaij -Copyright: Copyright © 2013-2014 University of Twente +Copyright: Copyright © 2013-2015 University of Twente Category: Hardware -Build-type: Custom +Build-type: Simple Extra-source-files: README.md CHANGELOG.md @@ -118,7 +118,7 @@ data-default >= 0.5.3, integer-gmp >= 0.5.1.0, ghc-prim >= 0.3.1.0, - ghc-typelits-natnormalise >= 0.1.1, + ghc-typelits-natnormalise >= 0.2, singletons >= 1.0, template-haskell >= 2.9.0.0, th-lift >= 0.5.6 @@ -134,7 +134,6 @@ buildable: False else build-depends: - base >= 4 && < 5, - directory >= 1.0, - doctest >= 0.9.1 && < 0.10, - filepath + base >= 4 && < 5, + doctest >= 0.9.1 && < 0.10, + Glob >= 0.7 && < 0.8 diff --git a/src/CLaSH/Prelude.hs b/src/CLaSH/Prelude.hs --- a/src/CLaSH/Prelude.hs +++ b/src/CLaSH/Prelude.hs @@ -99,8 +99,8 @@ foldl1, foldr, foldr1, head, init, iterate, last, length, map, repeat, replicate, reverse, scanl, scanr, - splitAt, tail, take, unzip, zip, - zipWith) + splitAt, tail, take, unzip, unzip3, + zip, zip3, zipWith, zipWith3) import CLaSH.Class.BitPack import CLaSH.Class.Num diff --git a/src/CLaSH/Signal.hs b/src/CLaSH/Signal.hs --- a/src/CLaSH/Signal.hs +++ b/src/CLaSH/Signal.hs @@ -69,6 +69,10 @@ import CLaSH.Signal.Explicit (SystemClock, systemClock, simulateB') import CLaSH.Signal.Bundle (Bundle (..), Unbundled') +-- $setup +-- >>> let oscillate = register False (not1 oscillate) +-- >>> let count = regEn 0 oscillate (count + 1) + -- * Implicitly clocked synchronous signal -- | Signal synchronised to the \"system\" clock, which has a period of 1000. @@ -96,10 +100,8 @@ -- -- We get: -- --- >>> let oscillate = register False (not1 oscillate) -- >>> sampleN 8 oscillate -- [False,True,False,True,False,True,False,True] --- >>> let count = regEn 0 oscillate (count + 1) -- >>> sampleN 8 count -- [0,0,1,1,2,2,3,3] regEn :: a -> Signal Bool -> Signal a -> Signal a diff --git a/src/CLaSH/Signal/Delayed.hs b/src/CLaSH/Signal/Delayed.hs --- a/src/CLaSH/Signal/Delayed.hs +++ b/src/CLaSH/Signal/Delayed.hs @@ -55,10 +55,13 @@ -- >>> let delay3 = delay (0 :> 0 :> 0 :> Nil) -- >>> let delay2 = delayI :: DSignal (n - 2) Int -> DSignal n Int -- >>> :{ --- let mac x y = acc +-- let mac :: DSignal 0 Int -> DSignal 0 Int -> DSignal 0 Int +-- mac x y = feedback (mac' x y) -- where --- acc' = (x * y) + antiDelay d1 acc --- acc = delay (singleton 0) acc' +-- mac' :: DSignal 0 Int -> DSignal 0 Int -> DSignal 0 Int +-- -> (DSignal 0 Int, DSignal 1 Int) +-- mac' a b acc = let acc' = a * b + acc +-- in (acc, delay (singleton 0) acc') -- :} -- @@ -128,7 +131,6 @@ -> DSignal n a delayI = delay (repeat def) -{-# WARNING feedback "This function does not work in GHC 7.10.1, use 'antiDelay' instead" #-} -- | Feed the delayed result of a function back to its input: -- -- @ diff --git a/src/CLaSH/Sized/Vector.hs b/src/CLaSH/Sized/Vector.hs --- a/src/CLaSH/Sized/Vector.hs +++ b/src/CLaSH/Sized/Vector.hs @@ -29,12 +29,12 @@ , head, tail, last, init , take, takeI, drop, dropI, at, select, selectI -- ** Combining 'Vec'tors - , (++), (+>>), (<<+), concat, zip, unzip, shiftInAt0, shiftInAtN + , (++), (+>>), (<<+), concat, zip, unzip, zip3, unzip3, shiftInAt0, shiftInAtN , shiftOutFrom0, shiftOutFromN -- ** Splitting 'Vec'tors , splitAt, splitAtI, unconcat, unconcatI, merge -- ** Applying functions to 'Vec'tor elements - , map, zipWith + , map, zipWith, zipWith3 , foldr, foldl, foldr1, foldl1, fold , scanl, scanr, sscanl, sscanr , mapAccumL, mapAccumR @@ -66,8 +66,8 @@ foldl1, foldr, foldr1, head, init, iterate, last, length, map, repeat, replicate, reverse, scanl, scanr, - splitAt, tail, take, unzip, zip, - zipWith) + splitAt, tail, take, unzip, unzip3, + zip, zip3, zipWith, zipWith3) import qualified Prelude as P import Unsafe.Coerce (unsafeCoerce) @@ -94,8 +94,7 @@ -- :} -- -- >>> :{ --- let sortVL :: (Ord a, KnownNat (n+1)) => Vec (n + 2) a -> Vec (n + 2) a --- sortVL xs = map fst sorted <: (snd (last sorted)) +-- let sortVL xs = map fst sorted <: (snd (last sorted)) -- where -- lefts = head xs :> map snd (init sorted) -- rights = tail xs @@ -470,6 +469,18 @@ zipWith _ Nil _ = Nil zipWith f (x :> xs) ys = f x (head ys) :> zipWith f xs (tail ys) +{-# INLINE zipWith3 #-} +-- | 'zipWith3' generalises 'zip3' by zipping with the function given +-- as the first argument, instead of a tupling function. +-- +-- > zipWith3 f (x1 :> x2 :> ... xn :> Nil) (y1 :> y2 :> ... :> yn :> Nil) (z1 :> z2 :> ... :> zn :> Nil) == (f x1 y1 z1 :> f x2 y2 z2 :> ... :> f xn yn zn :> Nil) +-- +-- __NB:__ 'zipWith3' is /strict/ in its second argument, and /lazy/ in its +-- third and fourth. This matters when 'zipWith3' is used in a recursive setting. +-- See 'lazyV' for more information. +zipWith3 :: (a -> b -> c -> d) -> Vec n a -> Vec n b -> Vec n c -> Vec n d +zipWith3 f us vs ws = zipWith (\a (b,c) -> f a b c) us (zip vs ws) + {-# INLINABLE foldr #-} -- | 'foldr', applied to a binary operator, a starting value (typically -- the right-identity of the operator), and a vector, reduces the vector @@ -662,6 +673,14 @@ zip :: Vec n a -> Vec n b -> Vec n (a,b) zip = zipWith (,) +{-# INLINE zip3 #-} +-- | 'zip' takes three vectors and returns a vector of corresponding triplets. +-- +-- >>> zip3 (1:>2:>3:>4:>Nil) (4:>3:>2:>1:>Nil) (5:>6:>7:>8:>Nil) +-- <(1,4,5),(2,3,6),(3,2,7),(4,1,8)> +zip3 :: Vec n a -> Vec n b -> Vec n c -> Vec n (a,b,c) +zip3 = zipWith3 (,,) + {-# INLINE unzip #-} -- | 'unzip' transforms a vector of pairs into a vector of first components -- and a vector of second components. @@ -671,6 +690,18 @@ unzip :: Vec n (a,b) -> (Vec n a, Vec n b) unzip xs = (map fst xs, map snd xs) +{-# INLINE unzip3 #-} +-- | 'unzip3' transforms a vector of triplets into a vector of first components, +-- a vector of second components, and a vector of third components. +-- +-- >>> unzip3 ((1,4,5):>(2,3,6):>(3,2,7):>(4,1,8):>Nil) +-- (<1,2,3,4>,<4,3,2,1>,<5,6,7,8>) +unzip3 :: Vec n (a,b,c) -> (Vec n a, Vec n b, Vec n c) +unzip3 xs = ( map (\(x,_,_) -> x) xs + , map (\(_,y,_) -> y) xs + , map (\(_,_,z) -> z) xs + ) + {-# NOINLINE index_int #-} index_int :: KnownNat n => Vec n a -> Int -> a index_int xs i@(I# n0) @@ -814,9 +845,9 @@ -- __NB__: vector elements have an __ASCENDING__ subscript starting from 0 and -- ending at 'maxIndex'. -- --- >>> at (snat :: SNat 1) ((1:>2:>3:>4:>5:>Nil) :: Vec 5 Int) +-- >>> at (snat :: SNat 1) (1:>2:>3:>4:>5:>Nil) -- 2 --- >>> at d1 ((1:>2:>3:>4:>5:>Nil) :: Vec 5 Int) +-- >>> at d1 (1:>2:>3:>4:>5:>Nil) -- 2 at :: SNat m -> Vec (m + (n + 1)) a -> a at n xs = head $ snd $ splitAt n xs @@ -978,7 +1009,6 @@ -- In this case, adding 'lazyV' on 'zipWith's second argument: -- -- @ --- sortVL :: (Ord a, KnownNat (n+1)) => Vec (n + 2) a -> Vec (n + 2) a -- sortVL xs = 'map' fst sorted '<:' (snd ('last' sorted)) -- where -- lefts = 'head' xs :> map snd ('init' sorted) @@ -1072,7 +1102,7 @@ -- append' xs ys = 'dfold' (Proxy :: Proxy (Append m a)) (const (':>')) ys xs -- @ -- --- We now see that @append@ has the appropriate type: +-- We now see that @append'@ has the appropriate type: -- -- >>> :t append' -- append' :: Vec k a -> Vec m a -> Vec (k + m) a diff --git a/src/CLaSH/Tutorial.hs b/src/CLaSH/Tutorial.hs --- a/src/CLaSH/Tutorial.hs +++ b/src/CLaSH/Tutorial.hs @@ -87,12 +87,8 @@ -- sorted = zipWith compareSwapL lefts rights -- :} -- --- >>> :set -XMonoLocalBinds --- >>> :set -XTypeOperators --- >>> :set -XDataKinds -- >>> :{ --- let sortVL :: (Ord a, KnownNat (n+1)) => Vec (n + 2) a -> Vec (n + 2) a --- sortVL xs = map fst sorted <: (snd (last sorted)) +-- let sortVL xs = map fst sorted <: (snd (last sorted)) -- where -- lefts = head xs :> map snd (init sorted) -- rights = tail xs @@ -1116,7 +1112,6 @@ In this case, adding 'lazyV' on 'zipWith's second argument: @ - sortVL :: (Ord a, KnownNat (n+1)) => Vec (n + 2) a -> Vec (n + 2) a sortVL xs = 'map' fst sorted '<:' (snd ('last' sorted)) where lefts = 'head' xs :> map snd ('init' sorted) diff --git a/tests/doctests.hs b/tests/doctests.hs new file mode 100644 --- /dev/null +++ b/tests/doctests.hs @@ -0,0 +1,9 @@ +module Main where + +import System.FilePath.Glob (glob) +import Test.DocTest (doctest) + +main :: IO () +main = glob "src/**/*.hs" >>= + doctest . (["-optP-include", + "-optPdist/build/autogen/cabal_macros.h"] ++) diff --git a/tests/doctests.hsc b/tests/doctests.hsc deleted file mode 100644 --- a/tests/doctests.hsc +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ForeignFunctionInterface #-} -module Main where - -import Build_doctests (deps) -import Control.Monad -import Data.List -import System.Directory -import System.FilePath -import Test.DocTest - -##if defined(mingw32_HOST_OS) -##if defined(i386_HOST_ARCH) -##define USE_CP -import Control.Applicative -import Control.Exception -import Foreign.C.Types -foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool -foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt -##elif defined(x86_64_HOST_ARCH) -##define USE_CP -import Control.Applicative -import Control.Exception -import Foreign.C.Types -foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool -foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt -##endif -##endif - --- | Run in a modified codepage where we can print UTF-8 values on Windows. -withUnicode :: IO a -> IO a -##ifdef USE_CP -withUnicode m = do - cp <- c_GetConsoleCP - (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp -##else -withUnicode m = m -##endif - -main :: IO () -main = withUnicode $ getSources >>= \sources -> doctest $ - "-isrc" - : "-idist/build/autogen" - : "-optP-include" - : "-optPdist/build/autogen/cabal_macros.h" - : "-hide-all-packages" - : map ("-package="++) deps ++ sources - -getSources :: IO [FilePath] -getSources = filter (isSuffixOf ".hs") <$> go "src" - where - go dir = do - (dirs, files) <- getFilesAndDirectories dir - (files ++) . concat <$> mapM go dirs - -getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) -getFilesAndDirectories dir = do - c <- map (dir ) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir - (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c