diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,24 @@ # Changelog for [`clash-prelude` package](http://hackage.haskell.org/package/clash-prelude) +## 0.10 *October 3rd 2015* +* New features: + * The Vec constructor `:>` is now an explicitly bidirectional pattern synonym (the actual constructor has been renamed to Cons). + As a result, pattern matching on `:>` is now synthesisable by the CLaSH compiler. + * The function `<:` is replaced by the the explicitly bidirectional pattern synonym `:<`. + This allows you to pattern match on: "all but the last element of a vector" and "the last element" of the vector. + Because it is a bidirectional pattern, `:<` can also be used as an expression that appends an element to the tail of a vector. + * Add a `transpose` function in `CLaSH.Sized.Vector`. + * Add `stencil1d` and `stensil2d` stencil computation functions in `CLaSH.Sized.Vector`. + * Add `permute`, `backpermute`, `scatter`, and `gather` permutation functions in `CLaSH.Sized.Vector`. + * Add specialised permutation functions `interleave`, `rotateLeft`, and `rotateRight` in `CLaSH.Sized.Vector`. + * `sscanl` and `sscanr` in `CLaSH.Sized.Vector` are renamed to `postscanl` and postscanr` to be more in line with existing Haskell packages such as `vector` and `accelerate`. + * The `Foldable` and `Traversable` instances of `Vec` now only works for non-empty vectors. + * Where possible, members of the `Foldable` instance of `Vec` are described in terms of `fold`, which builds a tree (of depth `log(n)`) of computations, instead of `foldr` which had depth `n` computations. + This reduces the critical path length in your circuits when using these functions. + * `maxIndex` and `length` in `CLaSH.Sized.Vector` return an `Int` instead of an `Integer`. + * Add functions that involve an index into a vector to the `CLaSH.Sized.Vector` module: `indices`, `indicesI`, `imap`, `izipWith`, `ifoldr`, `ifoldl`, `findIndex`, `elemIndex`. + * `CLaSH.Sized.Vector`'s `fold`, `dfold`, `vfold`, and `toList` are now synthesisable by the CLaSH compiler. + ## 0.9.3 *September 21st 2015* * Fixes bugs: * Cannot build against singletons-0.2 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,35 @@ +# CλaSH - A functional hardware description language + [![Build Status](https://travis-ci.org/clash-lang/clash-prelude.svg?branch=master)](https://travis-ci.org/clash-lang/clash-prelude) [![Hackage](https://img.shields.io/hackage/v/clash-prelude.svg)](https://hackage.haskell.org/package/clash-prelude) [![Hackage Dependencies](https://img.shields.io/hackage-deps/v/clash-prelude.svg?style=flat)](http://packdeps.haskellers.com/feed?needle=exact%3Aclash-prelude) -= WARNING = -Only works with GHC-7.10.* (http://www.haskell.org/ghc/download_ghc_7_10_1)! +__WARNING__ +Only works with GHC-7.10.* (http://www.haskell.org/ghc/download_ghc_7_10_2)! + +CλaSH (pronounced ‘clash’) is a functional hardware description language that +borrows both its syntax and semantics from the functional programming language +Haskell. The CλaSH compiler transforms these high-level descriptions to +low-level synthesizable VHDL, Verilog, or SystemVerilog. + +Features of CλaSH: + + * Strongly typed (like VHDL), yet with a very high degree of type inference, + enabling both safe and fast prototying using consise descriptions (like + Verilog). + + * Interactive REPL: load your designs in an interpreter and easily test all + your component without needing to setup a test bench. + + * Higher-order functions, with type inference, result in designs that are + fully parametric by default. + + * Synchronous sequential circuit design based on streams of values, called + `Signal`s, lead to natural descriptions of feedback loops. + + * Support for multiple clock domains, with type safe clock domain crossing. + +# Support +For updates and questions join the mailing list +clash-language+subscribe@googlegroups.com or read the +[forum](https://groups.google.com/d/forum/clash-language) diff --git a/clash-prelude.cabal b/clash-prelude.cabal --- a/clash-prelude.cabal +++ b/clash-prelude.cabal @@ -1,14 +1,30 @@ Name: clash-prelude -Version: 0.9.3 +Version: 0.10 Synopsis: CAES Language for Synchronous Hardware - Prelude library Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that borrows both its syntax and semantics from the functional programming language - Haskell. The merits of using a functional language to describe hardware comes - from the fact that combinational circuits can be directly modeled as - mathematical functions and that functional languages lend themselves very well - at describing and (de-)composing mathematical functions. + Haskell. The CλaSH compiler transforms these high-level descriptions to + low-level synthesizable VHDL, Verilog, or SystemVerilog. . + Features of CλaSH: + . + * Strongly typed (like VHDL), yet with a very high degree of type inference, + enabling both safe and fast prototying using consise descriptions (like + Verilog). + . + * Interactive REPL: load your designs in an interpreter and easily test all + your component without needing to setup a test bench. + . + * Higher-order functions, with type inference, result in designs that are + fully parametric by default. + . + * Synchronous sequential circuit design based on streams of values, called + @Signal@s, lead to natural descriptions of feedback loops. + . + * Support for multiple clock domains, with type safe clock domain crossing. + . + . This package provides: . * Prelude library containing datatypes and functions for circuit design @@ -142,8 +158,11 @@ lens >= 4.9, QuickCheck >= 2.7 && <2.9, singletons >= 1.0 && <3.0, - template-haskell >= 2.9.0.0, - th-lift >= 0.5.6 + template-haskell >= 2.9.0.0 + + -- Newer GHCs have -XDeriveLift + if impl(ghc<7.11) + Build-depends: th-lift >= 0.5.6 if flag(doclinks) CPP-Options: -DDOCLINKS diff --git a/doc/csSort.svg b/doc/csSort.svg new file mode 100644 --- /dev/null +++ b/doc/csSort.svg @@ -0,0 +1,3 @@ + + + Produced by OmniGraffle 6.1.3 2015-10-01 15:10:32 +0000Canvas 1Layer 17csRowcsRowcsRowcsRow<>3911199131379 diff --git a/doc/fold.svg b/doc/fold.svg new file mode 100644 --- /dev/null +++ b/doc/fold.svg @@ -0,0 +1,3 @@ + + + Produced by OmniGraffle 6.1.3 2015-10-01 14:19:28 +0000Canvas 1Layer 1x0fx1fxnf ...ffff ... ... diff --git a/doc/ifoldl.svg b/doc/ifoldl.svg new file mode 100644 --- /dev/null +++ b/doc/ifoldl.svg @@ -0,0 +1,3 @@ + + + Produced by OmniGraffle 6.1.3 2015-10-01 14:40:22 +0000Canvas 1Layer 1x0fx1fxnf ...zLayer 2‘0’‘1’‘n’ diff --git a/doc/ifoldr.svg b/doc/ifoldr.svg new file mode 100644 --- /dev/null +++ b/doc/ifoldr.svg @@ -0,0 +1,3 @@ + + + Produced by OmniGraffle 6.1.3 2015-10-01 14:36:30 +0000Canvas 1Layer 1x0fx1fxnf ...z‘0’‘1’‘n’ diff --git a/doc/imap.svg b/doc/imap.svg new file mode 100644 --- /dev/null +++ b/doc/imap.svg @@ -0,0 +1,3 @@ + + + Produced by OmniGraffle 6.1.3 2015-10-01 14:28:15 +0000Canvas 1Layer 1x0fx1fxnf . . .‘0’‘1’’n’ diff --git a/doc/izipWith.svg b/doc/izipWith.svg new file mode 100644 --- /dev/null +++ b/doc/izipWith.svg @@ -0,0 +1,3 @@ + + + Produced by OmniGraffle 6.1.3 2015-10-01 14:32:11 +0000Canvas 1Layer 1x0fx1fxnf . . .y0y1yn‘0’‘1’‘n’ diff --git a/src/CLaSH/Prelude.hs b/src/CLaSH/Prelude.hs --- a/src/CLaSH/Prelude.hs +++ b/src/CLaSH/Prelude.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators #-} @@ -97,7 +98,10 @@ -- ** Type-level functions , module CLaSH.Promoted.Ord -- ** Template Haskell - , Lift (..), deriveLift + , Lift (..) +#if __GLASGOW_HASKELL__ < 711 + , deriveLift +#endif -- ** Type classes -- *** CLaSH , module CLaSH.Class.BitPack @@ -117,7 +121,10 @@ import Data.Bits import Data.Default import GHC.TypeLits -import Language.Haskell.TH.Lift (Lift(..),deriveLift) +import Language.Haskell.TH.Syntax (Lift(..)) +#if __GLASGOW_HASKELL__ < 711 +import Language.Haskell.TH.Lift (deriveLift) +#endif import Prelude hiding ((++), (!!), concat, drop, foldl, foldl1, foldr, foldr1, head, init, iterate, last, length, map, repeat, diff --git a/src/CLaSH/Prelude/BlockRam.hs b/src/CLaSH/Prelude/BlockRam.hs --- a/src/CLaSH/Prelude/BlockRam.hs +++ b/src/CLaSH/Prelude/BlockRam.hs @@ -518,7 +518,7 @@ -- cycle blockRam# clk content wr rd en din = register' clk undefined dout where - szI = fromInteger $ maxIndex content + szI = maxIndex content dout = runST $ do arr <- newListArray (0,szI) (toList content) traverse (ramT arr) (bundle' clk (wr,rd,en,din)) diff --git a/src/CLaSH/Prelude/Explicit.hs b/src/CLaSH/Prelude/Explicit.hs --- a/src/CLaSH/Prelude/Explicit.hs +++ b/src/CLaSH/Prelude/Explicit.hs @@ -4,6 +4,7 @@ {-# LANGUAGE Unsafe #-} +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {-# OPTIONS_HADDOCK show-extensions #-} {-| @@ -99,7 +100,7 @@ -> Vec (n + 1) (Signal' clk a) -- ^ Window of at least size 1 window' clk x = res where - res = x :> prev + res = x `Cons` prev prev = case natVal (asNatProxy prev) of 0 -> repeat def _ -> let next = x +>> prev diff --git a/src/CLaSH/Prelude/ROM.hs b/src/CLaSH/Prelude/ROM.hs --- a/src/CLaSH/Prelude/ROM.hs +++ b/src/CLaSH/Prelude/ROM.hs @@ -79,7 +79,7 @@ -> a -- ^ The value of the ROM at address @rd@ asyncRom# content rd = arr ! rd where - szI = fromInteger (maxIndex content) + szI = maxIndex content arr = listArray (0,szI) (toList content) {-# INLINE rom #-} @@ -169,5 +169,5 @@ -- ^ The value of the ROM at address @rd@ from the previous clock cycle rom# clk content rd = register' clk undefined ((arr !) <$> rd) where - szI = fromInteger (maxIndex content) + szI = maxIndex content arr = listArray (0,szI) (toList content) diff --git a/src/CLaSH/Prelude/Testbench.hs b/src/CLaSH/Prelude/Testbench.hs --- a/src/CLaSH/Prelude/Testbench.hs +++ b/src/CLaSH/Prelude/Testbench.hs @@ -177,7 +177,7 @@ genT :: Index l -> (Index l,a) genT s = (s',samples !! s) where - maxI = fromInteger (maxIndex samples) + maxI = toEnum (maxIndex samples) s' = if s < maxI then s + 1 @@ -235,7 +235,7 @@ genT :: Index l -> (Index l,(a,Bool)) genT s = (s',(samples !! s,finished)) where - maxI = fromInteger (maxIndex samples) + maxI = toEnum (maxIndex samples) s' = if s < maxI then s + 1 diff --git a/src/CLaSH/Signal/Bundle.hs b/src/CLaSH/Signal/Bundle.hs --- a/src/CLaSH/Signal/Bundle.hs +++ b/src/CLaSH/Signal/Bundle.hs @@ -30,7 +30,7 @@ import CLaSH.Sized.Index (Index) import CLaSH.Sized.Signed (Signed) import CLaSH.Sized.Unsigned (Unsigned) -import CLaSH.Sized.Vector (Vec) +import CLaSH.Sized.Vector (Vec, traverse#) -- | Isomorphism between a 'CLaSH.Signal.Signal' of a product type (e.g. a tuple) and a -- product type of 'CLaSH.Signal.Signal''s. @@ -204,4 +204,4 @@ {-# NOINLINE vecBundle# #-} vecBundle# :: SClock t -> Vec n (Signal' t a) -> Signal' t (Vec n a) -vecBundle# _ = sequenceA +vecBundle# _ = traverse# id diff --git a/src/CLaSH/Signal/Internal.hs b/src/CLaSH/Signal/Internal.hs --- a/src/CLaSH/Signal/Internal.hs +++ b/src/CLaSH/Signal/Internal.hs @@ -444,7 +444,7 @@ clearBit a i = fmap (`clearBit` i) a testBit = error "'testBit' undefined for 'Signal'', use 'testbit1'" bitSizeMaybe _ = bitSizeMaybe (undefined :: a) - bitSize _ = bitSize (undefined :: a) + bitSize _ = maybe 0 id (bitSizeMaybe (undefined :: a)) isSigned _ = isSigned (undefined :: a) shiftL a i = fmap (`shiftL` i) a unsafeShiftL a i = fmap (`unsafeShiftL` i) a diff --git a/src/CLaSH/Sized/Internal/BitVector.hs b/src/CLaSH/Sized/Internal/BitVector.hs --- a/src/CLaSH/Sized/Internal/BitVector.hs +++ b/src/CLaSH/Sized/Internal/BitVector.hs @@ -231,7 +231,7 @@ maxBound = maxBound# {-# NOINLINE minBound# #-} -minBound# :: KnownNat n => BitVector n +minBound# :: BitVector n minBound# = BV 0 {-# NOINLINE maxBound# #-} @@ -355,7 +355,7 @@ reduceXor# :: BitVector n -> BitVector 1 reduceXor# (BV i) = BV (toInteger (popCount i `mod` 2)) -instance KnownNat n => Default (BitVector n) where +instance Default (BitVector n) where def = minBound# -- * Accessors diff --git a/src/CLaSH/Sized/Internal/Signed.hs b/src/CLaSH/Sized/Internal/Signed.hs --- a/src/CLaSH/Sized/Internal/Signed.hs +++ b/src/CLaSH/Sized/Internal/Signed.hs @@ -304,7 +304,7 @@ {-# NOINLINE rem# #-} rem# (S a) (S b) = S (a `rem` b) -div#,mod# :: KnownNat n => Signed n -> Signed n -> Signed n +div#,mod# :: Signed n -> Signed n -> Signed n {-# NOINLINE div# #-} div# (S a) (S b) = S (a `div` b) {-# NOINLINE mod# #-} diff --git a/src/CLaSH/Sized/Internal/Unsigned.hs b/src/CLaSH/Sized/Internal/Unsigned.hs --- a/src/CLaSH/Sized/Internal/Unsigned.hs +++ b/src/CLaSH/Sized/Internal/Unsigned.hs @@ -204,7 +204,7 @@ maxBound = maxBound# {-# NOINLINE minBound# #-} -minBound# :: KnownNat n => Unsigned n +minBound# :: Unsigned n minBound# = U 0 {-# NOINLINE maxBound# #-} @@ -375,7 +375,7 @@ resize# :: KnownNat m => Unsigned n -> Unsigned m resize# (U i) = fromInteger_INLINE i -instance KnownNat n => Default (Unsigned n) where +instance Default (Unsigned n) where def = minBound# instance KnownNat n => Lift (Unsigned n) where 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 @@ -4,6 +4,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MagicHash #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} @@ -11,6 +12,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE Trustworthy #-} @@ -24,37 +26,78 @@ Maintainer : Christiaan Baaij -} module CLaSH.Sized.Vector - ( -- * 'Vec'tor constructors - Vec(..), (<:), singleton - -- * Standard 'Vec'tor functions - -- ** Extracting sub-'Vec'tors - , head, tail, last, init - , take, takeI, drop, dropI, at, select, selectI - -- ** Combining 'Vec'tors - , (++), (+>>), (<<+), 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, zipWith3 + ( -- * 'Vec'tor data type + Vec(..) + -- * Accessors + -- ** Length information + , length, maxIndex, lengthS + -- ** Indexing + , (!!), head, last, at + , indices, indicesI + , findIndex, elemIndex + -- ** Extracting sub-vectors (slicing) + , tail, init + , take, takeI, drop, dropI + , select, selectI + -- *** Splitting + , splitAt, splitAtI + , unconcat, unconcatI + -- * Construction + -- ** Initialisation + , singleton + , replicate, replicateI, repeat + , iterate, iterateI, generate, generateI + -- *** Initialisation from a list + , v + -- ** Concatenation + , pattern (:>), pattern (:<) + , (++), (+>>), (<<+), concat + , shiftInAt0, shiftInAtN , shiftOutFrom0, shiftOutFromN + , merge + -- * Modifying vectors + , replace + -- ** Permutations + , permute, backpermute, scatter, gather + -- *** Specialised permutations + , reverse, transpose, interleave + , rotateLeft, rotateRight, rotateLeftS, rotateRightS + -- * Element-wise operations + -- ** Mapping + , map, imap + -- ** Zipping + , zipWith, zipWith3 + , zip, zip3 + , izipWith + -- ** Unzipping + , unzip, unzip3 + -- * Folding , foldr, foldl, foldr1, foldl1, fold - , scanl, scanr, sscanl, sscanr - , mapAccumL, mapAccumR - -- ** Special folds + , ifoldr, ifoldl + -- ** Specialised folds , dfold, vfold - -- ** Indexing 'Vec'tors - , (!!), replace, maxIndex, length - -- ** Generating 'Vec'tors - , replicate, repeat, iterate, iterateI, generate, generateI - -- ** Misc - , reverse, toList, v, lazyV, asNatProxy - -- ** Functions for the 'BitPack' instance + -- * Prefix sums (scans) + , scanl, scanr, postscanl, postscanr + , mapAccumL, mapAccumR + -- * Stencil computations + , stencil1d, stencil2d + , windows1d, windows2d + -- * Conversions + , toList + -- * Misc + , lazyV, asNatProxy + -- * Primitives + -- ** 'Eq' instance + , eq# + , neq# + -- ** 'Traversable' instance + , traverse# + -- ** 'BitPack' instance , concatBitVector# , unconcatBitVector# ) where -import Control.Lens (Index, Ixed (..), IxValue) +import qualified Control.Lens as Lens import Data.Default (Default (..)) import qualified Data.Foldable as F import Data.Proxy (Proxy (..)) @@ -75,8 +118,9 @@ import Test.QuickCheck (Arbitrary (..), CoArbitrary (..)) import Unsafe.Coerce (unsafeCoerce) -import CLaSH.Promoted.Nat (SNat (..), UNat (..), withSNat, toUNat) +import CLaSH.Promoted.Nat (SNat (..), UNat (..), snat, withSNat, toUNat) import CLaSH.Sized.Internal.BitVector (BitVector, (++#), split#) +import CLaSH.Sized.Index (Index) import CLaSH.Class.BitPack (BitPack (..)) @@ -90,7 +134,7 @@ -- >>> import CLaSH.Prelude -- >>> let compareSwapL a b = if a < b then (a,b) else (b,a) -- >>> :{ --- let sortV xs = map fst sorted <: (snd (last sorted)) +-- let sortV xs = map fst sorted :< (snd (last sorted)) -- where -- lefts = head xs :> map snd (init sorted) -- rights = tail xs @@ -98,7 +142,7 @@ -- :} -- -- >>> :{ --- let 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 @@ -106,7 +150,7 @@ -- :} -- -- >>> :{ --- let sortV_flip xs = map fst sorted <: (snd (last sorted)) +-- let sortV_flip xs = map fst sorted :< (snd (last sorted)) -- where -- lefts = head xs :> map snd (init sorted) -- rights = tail xs @@ -118,23 +162,47 @@ -- >>> type instance Apply (Append m a) l = Vec (l + m) a -- >>> let append' xs ys = dfold (Proxy :: Proxy (Append m a)) (const (:>)) ys xs -- >>> let cs a b = if a > b then (a,b) else (b,a) --- >>> let csRow y xs = let (y',xs') = mapAccumL cs y xs in xs' <: y' +-- >>> let csRow y xs = let (y',xs') = mapAccumL cs y xs in xs' :< y' -- >>> let csSort = vfold csRow --- | Fixed size vectors +infixr 5 `Cons` +-- | Fixed size vectors. -- -- * Lists with their length encoded in their type -- * 'Vec'tor elements have an __ASCENDING__ subscript starting from 0 and -- ending at 'maxIndex' (== 'length' - 1). +data Vec :: Nat -> * -> * where + Nil :: Vec 0 a + Cons :: a -> Vec n a -> Vec (n + 1) a +{-# WARNING Cons "Use ':>' instead of 'Cons'" #-} + +-- | Add an element to the head of a vector. -- -- >>> 3:>4:>5:>Nil -- <3,4,5> -- >>> let x = 3:>4:>5:>Nil -- >>> :t x -- x :: Num a => Vec 3 a -data Vec :: Nat -> * -> * where - Nil :: Vec 0 a - (:>) :: a -> Vec n a -> Vec (n + 1) a +-- +-- Can be used as a pattern: +-- +-- >>> let f (x :> y :> _) = x + y +-- >>> :t f +-- f :: Num a => Vec ((n + 1) + 1) a -> a +-- >>> f (3:>4:>5:>6:>7:>Nil) +-- 7 +-- +-- Also in conjunctions with ':<': +-- +-- >>> let g (a :> b :> (_ :< y :< x)) = a + b + x + y +-- >>> :t g +-- g :: Num a => Vec ((((n + 1) + 1) + 1) + 1) a -> a +-- >>> g (1:>2:>3:>4:>5:>Nil) +-- 12 +pattern (:>) :: a -> Vec n a -> Vec (n + 1) a +pattern (:>) x xs <- ((\ys -> (head ys,tail ys)) -> (x,xs)) + where + (:>) x xs = Cons x xs infixr 5 :> @@ -143,8 +211,8 @@ where punc :: Vec m a -> String punc Nil = "" - punc (x :> Nil) = show x - punc (x :> xs) = show x P.++ "," P.++ punc xs + punc (x `Cons` Nil) = show x + punc (x `Cons` xs) = show x P.++ "," P.++ punc xs instance Eq a => Eq (Vec n a) where (==) = eq# @@ -167,19 +235,31 @@ pure = repeat fs <*> xs = zipWith ($) fs xs -instance F.Foldable (Vec n) where - foldr = foldr +instance (KnownNat m, m ~ (n+1)) => F.Foldable (Vec m) where + fold = fold mappend + foldMap f = fold mappend . map f + foldr = foldr + foldl = foldl + foldr1 = foldr1 + foldl1 = foldl1 + toList = toList + null _ = False + length = length + maximum = fold (\x y -> if x >= y then x else y) + minimum = fold (\x y -> if x <= y then x else y) + sum = fold (+) + product = fold (*) instance Functor (Vec n) where fmap = map -instance Traversable (Vec n) where +instance (KnownNat m, m ~ (n+1)) => Traversable (Vec m) where traverse = traverse# {-# NOINLINE traverse# #-} traverse# :: Applicative f => (a -> f b) -> Vec n a -> f (Vec n b) -traverse# _ Nil = pure Nil -traverse# f (x :> xs) = (:>) <$> f x <*> traverse# f xs +traverse# _ Nil = pure Nil +traverse# f (x `Cons` xs) = Cons <$> f x <*> traverse# f xs instance (Default a, KnownNat n) => Default (Vec n a) where def = repeat def @@ -190,7 +270,7 @@ -- >>> singleton 5 -- <5> singleton :: a -> Vec 1 a -singleton = (:> Nil) +singleton = (`Cons` Nil) {-# NOINLINE head #-} -- | Extract the first element of a vector @@ -206,7 +286,7 @@ -- In the first argument of ‘head’, namely ‘Nil’ -- In the expression: head Nil head :: Vec (n + 1) a -> a -head (x :> _) = x +head (x `Cons` _) = x {-# NOINLINE tail #-} -- | Extract the elements after the head of a vector @@ -222,7 +302,7 @@ -- In the first argument of ‘tail’, namely ‘Nil’ -- In the expression: tail Nil tail :: Vec (n + 1) a -> Vec n a -tail (_ :> xs) = xs +tail (_ `Cons` xs) = xs {-# NOINLINE last #-} -- | Extract the last element of a vector @@ -238,8 +318,8 @@ -- In the first argument of ‘last’, namely ‘Nil’ -- In the expression: last Nil last :: Vec (n + 1) a -> a -last (x :> Nil) = x -last (_ :> y :> ys) = last (y :> ys) +last (x `Cons` Nil) = x +last (_ `Cons` y `Cons` ys) = last (y `Cons` ys) {-# NOINLINE init #-} -- | Extract all the elements of a vector except the last element @@ -255,8 +335,8 @@ -- In the first argument of ‘init’, namely ‘Nil’ -- In the expression: init Nil init :: Vec (n + 1) a -> Vec n a -init (_ :> Nil) = Nil -init (x :> y :> ys) = x :> init (y :> ys) +init (_ `Cons` Nil) = Nil +init (x `Cons` y `Cons` ys) = x `Cons` init (y `Cons` ys) {-# INLINE shiftInAt0 #-} -- | Shift in elements to the head of a vector, bumping out elements at the @@ -297,20 +377,36 @@ zs = xs ++ ys (zsL,zsR) = splitAtI zs -infixl 5 <: -{-# INLINE (<:) #-} +infixl 5 :< -- | Add an element to the tail of a vector. -- --- >>> (3:>4:>5:>Nil) <: 1 +-- >>> (3:>4:>5:>Nil) :< 1 -- <3,4,5,1> --- >>> let x = (3:>4:>5:>Nil) <: 1 +-- >>> let x = (3:>4:>5:>Nil) :< 1 -- >>> :t x -- x :: Num a => Vec 4 a -(<:) :: Vec n a -> a -> Vec (n + 1) a -xs <: x = xs ++ singleton x +-- +-- Can be used as a pattern: +-- +-- >>> let f (_ :< y :< x) = y + x +-- >>> :t f +-- f :: Num a => Vec ((n + 1) + 1) a -> a +-- >>> f (3:>4:>5:>6:>7:>Nil) +-- 13 +-- +-- Also in conjunctions with ':>': +-- +-- >>> let g (a :> b :> (_ :< y :< x)) = a + b + x + y +-- >>> :t g +-- g :: Num a => Vec ((((n + 1) + 1) + 1) + 1) a -> a +-- >>> g (1:>2:>3:>4:>5:>Nil) +-- 12 +pattern (:<) :: Vec n a -> a -> Vec (n+1) a +pattern (:<) xs x <- ((\ys -> (init ys,last ys)) -> (xs,x)) + where + (:<) xs x = xs ++ singleton x infixr 4 +>> -{-# INLINE (+>>) #-} -- | Add an element to the head of a vector, and extract all but the last -- element. -- @@ -320,9 +416,10 @@ -- <> (+>>) :: KnownNat n => a -> Vec n a -> Vec n a s +>> xs = fst (shiftInAt0 xs (singleton s)) +{-# INLINE (+>>) #-} + infixl 4 <<+ -{-# INLINE (<<+) #-} -- | Add an element to the tail of a vector, and extract all but the first -- element. -- @@ -332,9 +429,9 @@ -- <> (<<+) :: Vec n a -> a -> Vec n a xs <<+ s = fst (shiftInAtN xs (singleton s)) +{-# INLINE (<<+) #-} -{-# INLINE shiftOutFrom0 #-} --- | Shift @m@ elements out from the head of a vector, filling up the tail with +-- | Shift /m/ elements out from the head of a vector, filling up the tail with -- 'Default' values. The result is a tuple containing: -- -- * The new vector @@ -348,9 +445,9 @@ -> (Vec (m + n) a, Vec m a) -- ^ (The new vector, shifted out elements) shiftOutFrom0 m xs = shiftInAtN xs (replicate m def) +{-# INLINE shiftOutFrom0 #-} -{-# INLINE shiftOutFromN #-} --- | Shift @m@ elements out from the tail of a vector, filling up the head with +-- | Shift /m/ elements out from the tail of a vector, filling up the head with -- 'Default' values. The result is a tuple containing: -- -- * The new vector @@ -364,19 +461,19 @@ -> (Vec (m + n) a, Vec m a) -- ^ (The new vector, shifted out elements) shiftOutFromN m xs = shiftInAt0 xs (replicate m def) +{-# INLINE shiftOutFromN #-} infixr 5 ++ -{-# NOINLINE (++) #-} --- | Append two vectors +-- | Append two vectors. -- -- >>> (1:>2:>3:>Nil) ++ (7:>8:>Nil) -- <1,2,3,7,8> (++) :: Vec n a -> Vec m a -> Vec (n + m) a -Nil ++ ys = ys -(x :> xs) ++ ys = x :> xs ++ ys +Nil ++ ys = ys +(x `Cons` xs) ++ ys = x `Cons` xs ++ ys +{-# NOINLINE (++) #-} -{-# NOINLINE splitAt #-} --- | Split a vector into two vectors at the given point +-- | Split a vector into two vectors at the given point. -- -- >>> splitAt (snat :: SNat 3) (1:>2:>3:>7:>8:>Nil) -- (<1,2,3>,<7,8>) @@ -384,74 +481,73 @@ -- (<1,2,3>,<7,8>) splitAt :: SNat m -> Vec (m + n) a -> (Vec m a, Vec n a) splitAt n xs = splitAtU (toUNat n) xs +{-# NOINLINE splitAt #-} splitAtU :: UNat m -> Vec (m + n) a -> (Vec m a, Vec n a) -splitAtU UZero ys = (Nil,ys) -splitAtU (USucc s) (y :> ys) = let (as,bs) = splitAtU s ys - in (y :> as, bs) +splitAtU UZero ys = (Nil,ys) +splitAtU (USucc s) (y `Cons` ys) = let (as,bs) = splitAtU s ys + in (y `Cons` as, bs) -{-# INLINE splitAtI #-} -- | Split a vector into two vectors where the length of the two is determined --- by the context +-- by the context. -- -- >>> splitAtI (1:>2:>3:>7:>8:>Nil) :: (Vec 2 Int, Vec 3 Int) -- (<1,2>,<3,7,8>) splitAtI :: KnownNat m => Vec (m + n) a -> (Vec m a, Vec n a) splitAtI = withSNat splitAt +{-# INLINE splitAtI #-} -{-# NOINLINE concat #-} --- | Concatenate a vector of vectors +-- | Concatenate a vector of vectors. -- -- >>> concat ((1:>2:>3:>Nil) :> (4:>5:>6:>Nil) :> (7:>8:>9:>Nil) :> (10:>11:>12:>Nil) :> Nil) -- <1,2,3,4,5,6,7,8,9,10,11,12> concat :: Vec n (Vec m a) -> Vec (n * m) a -concat Nil = Nil -concat (x :> xs) = x ++ concat xs +concat Nil = Nil +concat (x `Cons` xs) = x ++ concat xs +{-# NOINLINE concat #-} -{-# NOINLINE unconcat #-} --- | Split a vector of (n * m) elements into a vector of vectors with length m, --- where m is given +-- | Split a vector of \(n * m)\ elements into a vector of \"vectors of length +-- /m/\", where the length /m/ is given. -- -- >>> unconcat d4 (1:>2:>3:>4:>5:>6:>7:>8:>9:>10:>11:>12:>Nil) -- <<1,2,3,4>,<5,6,7,8>,<9,10,11,12>> unconcat :: KnownNat n => SNat m -> Vec (n * m) a -> Vec n (Vec m a) unconcat n xs = unconcatU (withSNat toUNat) (toUNat n) xs +{-# NOINLINE unconcat #-} unconcatU :: UNat n -> UNat m -> Vec (n * m) a -> Vec n (Vec m a) unconcatU UZero _ _ = Nil unconcatU (USucc n') m ys = let (as,bs) = splitAtU m ys - in as :> unconcatU n' m bs + in as `Cons` unconcatU n' m bs -{-# INLINE unconcatI #-} --- | Split a vector of (n * m) elements into a vector of vectors with length m, --- where m is determined by the context +-- | Split a vector of /(n * m)/ elements into a vector of \"vectors of length +-- /m/\", where the length /m/ is determined by the context. -- -- >>> unconcatI (1:>2:>3:>4:>5:>6:>7:>8:>9:>10:>11:>12:>Nil) :: Vec 2 (Vec 6 Int) -- <<1,2,3,4,5,6>,<7,8,9,10,11,12>> unconcatI :: (KnownNat n, KnownNat m) => Vec (n * m) a -> Vec n (Vec m a) unconcatI = withSNat unconcat +{-# INLINE unconcatI #-} -{-# NOINLINE merge #-} -- | Merge two vectors, alternating their elements, i.e., -- -- >>> merge (1 :> 2 :> 3 :> 4 :> Nil) (5 :> 6 :> 7 :> 8 :> Nil) -- <1,5,2,6,3,7,4,8> -merge :: Vec n a -> Vec n a -> Vec (n + n) a -merge Nil Nil = Nil -merge (x :> xs) (y :> ys) = x :> y :> merge xs ys +merge :: KnownNat n => Vec n a -> Vec n a -> Vec (2 * n) a +merge x y = concat (transpose (x :> singleton y)) +{-# INLINE merge #-} -{-# NOINLINE reverse #-} --- | Returns the elements in a vector in reverse order +-- | The elements in a vector in reverse order. -- -- >>> reverse (1:>2:>3:>4:>Nil) -- <4,3,2,1> reverse :: Vec n a -> Vec n a -reverse Nil = Nil -reverse (x :> xs) = reverse xs <: x +reverse Nil = Nil +reverse (x `Cons` xs) = reverse xs :< x +{-# NOINLINE reverse #-} -{-# NOINLINE map #-} --- | 'map' @f xs@ is the vector obtained by applying @f@ to each element --- of @xs@, i.e., +-- | \"'map' @f xs@\" is the vector obtained by applying /f/ to each element +-- of /xs/, i.e., -- -- > map f (x1 :> x2 :> ... :> xn :> Nil) == (f x1 :> f x2 :> ... :> f xn :> Nil) -- @@ -459,18 +555,131 @@ -- -- <> map :: (a -> b) -> Vec n a -> Vec n b -map _ Nil = Nil -map f (x :> xs) = f x :> map f xs +map _ Nil = Nil +map f (x `Cons` xs) = f x `Cons` map f xs +{-# NOINLINE map #-} -{-# NOINLINE zipWith #-} +-- | Apply a function of every element of a vector and its index. +-- +-- >>> :t imap (+) (2 :> 2 :> 2 :> 2 :> Nil) +-- imap (+) (2 :> 2 :> 2 :> 2 :> Nil) :: Vec 4 (Index 4) +-- >>> imap (+) (2 :> 2 :> 2 :> 2 :> Nil) +-- <2,3,*** Exception: 4 is out of bounds: [0..3] +-- >>> imap (\i a -> fromIntegral i + a) (2 :> 2 :> 2 :> 2 :> Nil) :: Vec 4 (Unsigned 8) +-- <2,3,4,5> +-- +-- \"'imap' @f xs@\" corresponds to the following circuit layout: +-- +-- <> +imap :: forall n a b . KnownNat n => (Index n -> a -> b) -> Vec n a -> Vec n b +imap f = go 0 + where + go :: Index n -> Vec m a -> Vec m b + go _ Nil = Nil + go n (x `Cons` xs) = f n x `Cons` go (n+1) xs +{-# NOINLINE imap #-} + +-- | Zip two vectors with a functions that also takes the elements' indices. +-- +-- >>> izipWith (\i a b -> i + a + b) (2 :> 2 :> Nil) (3 :> 3:> Nil) +-- <*** Exception: 3 is out of bounds: [0..1] +-- >>> izipWith (\i a b -> fromIntegral i + a + b) (2 :> 2 :> Nil) (3 :> 3 :> Nil) :: Vec 2 (Unsigned 8) +-- <5,6> +-- +-- \"'imap' @f xs@\" corresponds to the following circuit layout: +-- +-- <> +-- +-- __NB:__ 'izipWith' is /strict/ in its second argument, and /lazy/ in its +-- third. This matters when 'izipWith' is used in a recursive setting. See +-- 'lazyV' for more information. +izipWith :: KnownNat n => (Index n -> a -> b -> c) -> Vec n a -> Vec n b + -> Vec n c +izipWith f xs ys = imap (\i -> uncurry (f i)) (zip xs ys) +{-# INLINE izipWith #-} + +-- | Right fold (function applied to each element and its index) +-- +-- >>> let findLeftmost x xs = ifoldr (\i a b -> if a == x then Just i else b) Nothing xs +-- >>> findLeftmost 3 (1:>3:>2:>4:>3:>5:>6:>Nil) +-- Just 1 +-- >>> findLeftmost 8 (1:>3:>2:>4:>3:>5:>6:>Nil) +-- Nothing +-- +-- \"'ifoldr' @f z xs@\" corresponds to the following circuit layout: +-- +-- <> +ifoldr :: KnownNat n => (Index n -> a -> b -> b) -> b -> Vec n a -> b +ifoldr f z xs = head ws + where + ws = izipWith f xs ((tail ws)) :< z +{-# INLINE ifoldr #-} + +-- | Left fold (function applied to each element and its index) +-- +-- >>> let findRightmost x xs = ifoldl (\a i b -> if b == x then Just i else a) Nothing xs +-- >>> findRightmost 3 (1:>3:>2:>4:>3:>5:>6:>Nil) +-- Just 4 +-- >>> findRightmost 8 (1:>3:>2:>4:>3:>5:>6:>Nil) +-- Nothing +-- +-- \"'ifoldl' @f z xs@\" corresponds to the following circuit layout: +-- +-- <> +ifoldl :: KnownNat n => (a -> Index n -> b -> a) -> a -> Vec n b -> a +ifoldl f z xs = last ws + where + ws = z `Cons` izipWith (\i b a -> f a i b) xs (init ws) +{-# INLINE ifoldl #-} + +-- | Generate a vector of indices. +-- +-- >>> indices d4 +-- <0,1,2,3> +indices :: KnownNat n => SNat n -> Vec n (Index n) +indices _ = indicesI +{-# INLINE indices #-} + +-- | Generate a vector of indices, where the length of the vector is determined +-- by the context. +-- +-- >>> indicesI :: Vec 4 (Index 4) +-- <0,1,2,3> +indicesI :: KnownNat n => Vec n (Index n) +indicesI = imap const (repeat ()) +{-# INLINE indicesI #-} + +-- | \"'findIndex' @p xs@\" returns the index of the /first/ element of /xs/ +-- satisfying the predicate /p/, or 'Nothing' if there is no such element. +-- +-- >>> findIndex (> 3) (1:>3:>2:>4:>3:>5:>6:>Nil) +-- Just 3 +-- >>> findIndex (> 8) (1:>3:>2:>4:>3:>5:>6:>Nil) +-- Nothing +findIndex :: KnownNat n => (a -> Bool) -> Vec n a -> Maybe (Index n) +findIndex f = ifoldr (\i a b -> if f a then Just i else b) Nothing +{-# INLINE findIndex #-} + +-- | \"'elemIndex' @a xs@\" returns the index of the /first/ element which is +-- equal (by '==') to the query element /a/, or 'Nothing' if there is no such +-- element. +-- +-- >>> elemIndex 3 (1:>3:>2:>4:>3:>5:>6:>Nil) +-- Just 1 +-- >>> elemIndex 8 (1:>3:>2:>4:>3:>5:>6:>Nil) +-- Nothing +elemIndex :: (KnownNat n, Eq a) => a -> Vec n a -> Maybe (Index n) +elemIndex x = findIndex (x ==) +{-# INLINE elemIndex #-} + -- | 'zipWith' generalises 'zip' by zipping with the function given -- as the first argument, instead of a tupling function. --- For example, @'zipWith' (+)@ is applied to two vectors to produce the +-- For example, \"'zipWith' @(+)@\" applied to two vectors produces the -- vector of corresponding sums. -- -- > zipWith f (x1 :> x2 :> ... xn :> Nil) (y1 :> y2 :> ... :> yn :> Nil) == (f x1 y1 :> f x2 y2 :> ... :> f xn yn :> Nil) -- --- @zipWith f xs ys@ corresponds to the following circuit layout: +-- \"'zipWith' @f xs ys@\" corresponds to the following circuit layout: -- -- <> -- @@ -478,16 +687,16 @@ -- third. This matters when 'zipWith' is used in a recursive setting. See -- 'lazyV' for more information. zipWith :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c -zipWith _ Nil _ = Nil -zipWith f (x :> xs) ys = f x (head ys) :> zipWith f xs (tail ys) +zipWith _ Nil _ = Nil +zipWith f (x `Cons` xs) ys = f x (head ys) `Cons` zipWith f xs (tail ys) +{-# NOINLINE zipWith #-} -{-# 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) -- --- @zipWith3 f xs ys zs@ corresponds to the following circuit layout: +-- \"'zipWith3' @f xs ys zs@\" corresponds to the following circuit layout: -- -- <> -- @@ -496,8 +705,8 @@ -- 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) +{-# INLINE zipWith3 #-} -{-# INLINABLE foldr #-} -- | 'foldr', applied to a binary operator, a starting value (typically -- the right-identity of the operator), and a vector, reduces the vector -- using the binary operator, from right to left: @@ -508,7 +717,7 @@ -- >>> foldr (/) 1 (5 :> 4 :> 3 :> 2 :> Nil) -- 1.875 -- --- @foldr f z xs@ corresponds to the following circuit layout: +-- \"'foldr' @f z xs@\" corresponds to the following circuit layout: -- -- <> -- @@ -517,9 +726,10 @@ -- associative, as @"'fold' f xs"@ produces a structure with a depth of -- O(log_2(@'length' xs@)). foldr :: (a -> b -> b) -> b -> Vec n a -> b -foldr f z xs = head (scanr f z xs) +foldr _ z Nil = z +foldr f z (x `Cons` xs) = f x (foldr f z xs) +{-# NOINLINE foldr #-} -{-# INLINABLE foldl #-} -- | 'foldl', applied to a binary operator, a starting value (typically -- the left-identity of the operator), and a vector, reduces the vector -- using the binary operator, from left to right: @@ -530,7 +740,7 @@ -- >>> foldl (/) 1 (5 :> 4 :> 3 :> 2 :> Nil) -- 8.333333333333333e-3 -- --- @foldl f z xs@ corresponds to the following circuit layout: +-- \"'foldl' @f z xs@\" corresponds to the following circuit layout: -- -- <> -- @@ -540,8 +750,8 @@ -- O(log_2(@'length' xs@)). foldl :: (b -> a -> b) -> b -> Vec n a -> b foldl f z xs = last (scanl f z xs) +{-# INLINE foldl #-} -{-# INLINABLE foldr1 #-} -- | 'foldr1' is a variant of 'foldr' that has no starting value argument, -- and thus must be applied to non-empty vectors. -- @@ -552,7 +762,7 @@ -- >>> foldr1 (/) (5 :> 4 :> 3 :> 2 :> 1 :> Nil) -- 1.875 -- --- @foldr1 f xs@ corresponds to the following circuit layout: +-- \"'foldr1' @f xs@\" corresponds to the following circuit layout: -- -- <> -- @@ -562,8 +772,8 @@ -- O(log_2(@'length' xs@)). foldr1 :: (a -> a -> a) -> Vec (n + 1) a -> a foldr1 f xs = foldr f (last xs) (init xs) +{-# INLINE foldr1 #-} -{-# INLINE foldl1 #-} -- | 'foldl1' is a variant of 'foldl' that has no starting value argument, -- and thus must be applied to non-empty vectors. -- @@ -574,7 +784,7 @@ -- >>> foldl1 (/) (1 :> 5 :> 4 :> 3 :> 2 :> Nil) -- 8.333333333333333e-3 -- --- @foldl1 f xs@ corresponds to the following circuit layout: +-- \"'foldl1' @f xs@\" corresponds to the following circuit layout: -- -- <> -- @@ -584,16 +794,15 @@ -- O(log_2(@'length' xs@)). foldl1 :: (a -> a -> a) -> Vec (n + 1) a -> a foldl1 f xs = foldl f (head xs) (tail xs) +{-# INLINE foldl1 #-} -{-# NOINLINE fold #-} -- | 'fold' is a variant of 'foldr1' and 'foldl1', but instead of reducing from -- right to left, or left to right, it reduces a vector using a tree-like -- structure. The depth, or delay, of the structure produced by -- \"@'fold' f xs@\", is hence @O(log_2('length' xs))@, and not -- @O('length' xs)@. -- --- __NB__: The binary operator \"@f@ in @'fold' f xs@\" must be associative. --- __NB__: Not synthesisable +-- __NB__: The binary operator \"@f@\" in \"@'fold' f xs@\" must be associative. -- -- > fold f (x1 :> x2 :> ... :> xn1 :> xn :> Nil) == ((x1 `f` x2) `f` ...) `f` (... `f` (xn1 `f` xn)) -- > fold f (x1 :> Nil) == x1 @@ -601,6 +810,10 @@ -- -- >>> fold (+) (5 :> 4 :> 3 :> 2 :> 1 :> Nil) -- 15 +-- +-- \"'fold' @f xs@\" corresponds to the following circuit layout: +-- +-- <> fold :: (a -> a -> a) -> Vec (n + 1) a -> a fold f vs = fold' (toList vs) where @@ -608,8 +821,8 @@ fold' xs = fold' ys `f` fold' zs where (ys,zs) = P.splitAt (P.length xs `div` 2) xs +{-# NOINLINE fold #-} -{-# INLINE scanl #-} -- | 'scanl' is similar to 'foldl', but returns a vector of successive reduced -- values from the left: -- @@ -618,7 +831,7 @@ -- >>> scanl (+) 0 (5 :> 4 :> 3 :> 2 :> Nil) -- <0,5,9,12,14> -- --- @scanl f z xs@ corresponds to the following circuit layout: +-- \"'scanl' @f z xs@\" corresponds to the following circuit layout: -- -- <> -- @@ -628,23 +841,23 @@ scanl :: (b -> a -> b) -> b -> Vec n a -> Vec (n + 1) b scanl f z xs = ws where - ws = z :> zipWith (flip f) xs (init ws) + ws = z `Cons` zipWith (flip f) xs (init ws) +{-# INLINE scanl #-} -{-# INLINE sscanl #-} --- | 'sscanl' is a variant of 'scanl' where the first result is dropped: +-- | 'postscanl' is a variant of 'scanl' where the first result is dropped: -- --- > sscanl f z (x1 :> x2 :> ... :> Nil) == (z `f` x1) :> ((z `f` x1) `f` x2) :> ... :> Nil +-- > postscanl f z (x1 :> x2 :> ... :> Nil) == (z `f` x1) :> ((z `f` x1) `f` x2) :> ... :> Nil -- --- >>> sscanl (+) 0 (5 :> 4 :> 3 :> 2 :> Nil) +-- >>> postscanl (+) 0 (5 :> 4 :> 3 :> 2 :> Nil) -- <5,9,12,14> -- --- @sscanl f z xs@ corresponds to the following circuit layout: +-- \"'postscanl' @f z xs@\" corresponds to the following circuit layout: -- -- <> -sscanl :: (b -> a -> b) -> b -> Vec n a -> Vec n b -sscanl f z xs = tail (scanl f z xs) +postscanl :: (b -> a -> b) -> b -> Vec n a -> Vec n b +postscanl f z xs = tail (scanl f z xs) +{-# INLINE postscanl #-} -{-# INLINE scanr #-} -- | 'scanr' is similar to 'foldr', but returns a vector of successive reduced -- values from the right: -- @@ -653,7 +866,7 @@ -- >>> scanr (+) 0 (5 :> 4 :> 3 :> 2 :> Nil) -- <14,9,5,2,0> -- --- @scanr f z xs@ corresponds to the following circuit layout: +-- \"'scanr' @f z xs@\" corresponds to the following circuit layout: -- -- <> -- @@ -663,23 +876,23 @@ scanr :: (a -> b -> b) -> b -> Vec n a -> Vec (n + 1) b scanr f z xs = ws where - ws = zipWith f xs ((tail ws)) <: z + ws = zipWith f xs ((tail ws)) :< z +{-# INLINE scanr #-} -{-# INLINE sscanr #-} --- | 'sscanr' is a variant of 'scanr' that where the last result is dropped: +-- | 'postscanr' is a variant of 'scanr' that where the last result is dropped: -- --- > sscanr f z (... :> xn1 :> xn :> Nil) == ... :> (xn1 `f` (xn `f` z)) :> (xn `f` z) :> Nil +-- > postscanr f z (... :> xn1 :> xn :> Nil) == ... :> (xn1 `f` (xn `f` z)) :> (xn `f` z) :> Nil -- --- >>> sscanr (+) 0 (5 :> 4 :> 3 :> 2 :> Nil) +-- >>> postscanr (+) 0 (5 :> 4 :> 3 :> 2 :> Nil) -- <14,9,5,2> -- --- @sscanr f z xs@ corresponds to the following circuit layout: +-- \"'postscanr' @f z xs@\" corresponds to the following circuit layout: -- -- <> -sscanr :: (a -> b -> b) -> b -> Vec n a -> Vec n b -sscanr f z xs = init (scanr f z xs) +postscanr :: (a -> b -> b) -> b -> Vec n a -> Vec n b +postscanr f z xs = init (scanr f z xs) +{-# INLINE postscanr #-} -{-# INLINE mapAccumL #-} -- | The 'mapAccumL' function behaves like a combination of 'map' and 'foldl'; -- it applies a function to each element of a vector, passing an accumulating -- parameter from left to right, and returning a final value of this accumulator @@ -688,19 +901,19 @@ -- >>> mapAccumL (\acc x -> (acc + x,acc + 1)) 0 (1 :> 2 :> 3 :> 4 :> Nil) -- (10,<1,2,4,7>) -- --- @mapAccumL f acc xs@ corresponds to the following circuit layout: +-- \"'mapAccumL' @f acc xs@\" corresponds to the following circuit layout: -- -- <> mapAccumL :: (acc -> x -> (acc,y)) -> acc -> Vec n x -> (acc,Vec n y) mapAccumL f acc xs = (acc',ys) where - accs = acc :> accs' + accs = acc `Cons` accs' ws = zipWith (flip f) xs (init accs) accs' = map fst ws ys = map snd ws acc' = last accs +{-# INLINE mapAccumL #-} -{-# INLINE mapAccumR #-} -- | The 'mapAccumR' function behaves like a combination of 'map' and 'foldr'; -- it applies a function to each element of a vector, passing an accumulating -- parameter from right to left, and returning a final value of this accumulator @@ -709,35 +922,35 @@ -- >>> mapAccumR (\acc x -> (acc + x,acc + 1)) 0 (1 :> 2 :> 3 :> 4 :> Nil) -- (10,<10,8,5,1>) -- --- @mapAccumR f acc xs@ corresponds to the following circuit layout: +-- \"'mapAccumR' @f acc xs@\" corresponds to the following circuit layout: -- -- <> mapAccumR :: (acc -> x -> (acc,y)) -> acc -> Vec n x -> (acc, Vec n y) mapAccumR f acc xs = (acc',ys) where - accs = accs' <: acc + accs = accs' :< acc ws = zipWith (flip f) xs (tail accs) accs' = map fst ws ys = map snd ws acc' = head accs +{-# INLINE mapAccumR #-} -{-# INLINE zip #-} -- | 'zip' takes two vectors and returns a vector of corresponding pairs. -- -- >>> zip (1:>2:>3:>4:>Nil) (4:>3:>2:>1:>Nil) -- <(1,4),(2,3),(3,2),(4,1)> zip :: Vec n a -> Vec n b -> Vec n (a,b) zip = zipWith (,) +{-# INLINE zip #-} -{-# 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 zip3 #-} -{-# INLINE unzip #-} -- | 'unzip' transforms a vector of pairs into a vector of first components -- and a vector of second components. -- @@ -745,8 +958,8 @@ -- (<1,2,3,4>,<4,3,2,1>) unzip :: Vec n (a,b) -> (Vec n a, Vec n b) unzip xs = (map fst xs, map snd xs) +{-# INLINE unzip #-} -{-# 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. -- @@ -757,8 +970,8 @@ , map (\(_,y,_) -> y) xs , map (\(_,_,z) -> z) xs ) +{-# INLINE unzip3 #-} -{-# NOINLINE index_int #-} index_int :: KnownNat n => Vec n a -> Int -> a index_int xs i@(I# n0) | isTrue# (n0 <# 0#) = error "CLaSH.Sized.Vector.(!!): negative index" @@ -770,12 +983,12 @@ , " is larger than maximum index " , show (maxIndex xs) ]) - sub (y:>(!ys)) n = if isTrue# (n ==# 0#) - then y - else sub ys (n -# 1#) + sub (y `Cons` (!ys)) n = if isTrue# (n ==# 0#) + then y + else sub ys (n -# 1#) +{-# NOINLINE index_int #-} -{-# INLINE (!!) #-} --- | Vector index (subscript) operator. +-- | \"@xs@ '!!' @n@\" returns the /n/'th element of /xs/. -- -- __NB__: vector elements have an __ASCENDING__ subscript starting from 0 and -- ending at 'maxIndex'. @@ -790,24 +1003,25 @@ -- *** Exception: CLaSH.Sized.Vector.(!!): index 14 is larger than maximum index 4 (!!) :: (KnownNat n, Enum i) => Vec n a -> i -> a xs !! i = index_int xs (fromEnum i) +{-# INLINE (!!) #-} -{-# NOINLINE maxIndex #-} --- | Index (subscript) of the last element in a 'Vec'tor +-- | The index (subscript) of the last element in a 'Vec'tor as an 'Int' +-- value. -- -- >>> maxIndex (6 :> 7 :> 8 :> Nil) -- 2 -maxIndex :: KnownNat n => Vec n a -> Integer +maxIndex :: KnownNat n => Vec n a -> Int maxIndex = subtract 1 . length +{-# NOINLINE maxIndex #-} -{-# NOINLINE length #-} --- | Length of a 'Vec'tor as an Integer +-- | The length of a 'Vec'tor as an 'Int' value. -- -- >>> length (6 :> 7 :> 8 :> Nil) -- 3 -length :: KnownNat n => Vec n a -> Integer -length = natVal . asNatProxy +length :: KnownNat n => Vec n a -> Int +length = fromInteger . natVal . asNatProxy +{-# NOINLINE length #-} -{-# NOINLINE replace_int #-} replace_int :: KnownNat n => Vec n a -> Int -> a -> Vec n a replace_int xs i@(I# n0) a | isTrue# (n0 <# 0#) = error "CLaSH.Sized.Vector.replace: negative index" @@ -819,12 +1033,13 @@ , " is larger than maximum index " , show (maxIndex xs) ]) - sub (y:>(!ys)) n b = if isTrue# (n ==# 0#) - then b :> ys - else y :> sub ys (n -# 1#) b + sub (y `Cons` (!ys)) n b = if isTrue# (n ==# 0#) + then b `Cons` ys + else y `Cons` sub ys (n -# 1#) b +{-# NOINLINE replace_int #-} -{-# INLINE replace #-} --- | Replace an element of a vector at the given index (subscript). +-- | \"'replace' @n a xs@\" returns the vector /xs/ where the /n/'th element is +-- replaced by /a/. -- -- __NB__: vector elements have an __ASCENDING__ subscript starting from 0 and -- ending at 'maxIndex'. @@ -837,9 +1052,9 @@ -- <1,2,3,4,*** Exception: CLaSH.Sized.Vector.replace: index 9 is larger than maximum index 4 replace :: (KnownNat n, Enum i) => i -> a -> Vec n a -> Vec n a replace i y xs = replace_int xs (fromEnum i) y +{-# INLINE replace #-} -{-# INLINABLE take #-} --- | 'take' @n@, applied to a vector @xs@, returns the @n@-length prefix of @xs@ +-- | \"'take' @n xs@\" returns the /n/-length prefix of /xs/. -- -- >>> take (snat :: SNat 3) (1:>2:>3:>4:>5:>Nil) -- <1,2,3> @@ -859,17 +1074,17 @@ -- In an equation for ‘it’: it = take d4 (1 :> 2 :> Nil) take :: SNat m -> Vec (m + n) a -> Vec m a take n = fst . splitAt n +{-# INLINE take #-} -{-# INLINE takeI #-} --- | 'takeI' @xs@, returns the prefix of @xs@ as demanded by the context +-- | \"'takeI' @xs@\" returns the prefix of /xs/ as demanded by the context. -- -- >>> takeI (1:>2:>3:>4:>5:>Nil) :: Vec 2 Int -- <1,2> takeI :: KnownNat m => Vec (m + n) a -> Vec m a takeI = withSNat take +{-# INLINE takeI #-} -{-# INLINE drop #-} --- | 'drop' @n xs@ returns the suffix of @xs@ after the first @n@ elements +-- | \"'drop' @n xs@\" returns the suffix of /xs/ after the first /n/ elements. -- -- >>> drop (snat :: SNat 3) (1:>2:>3:>4:>5:>Nil) -- <4,5> @@ -886,17 +1101,17 @@ -- In a stmt of an interactive GHCi command: print it drop :: SNat m -> Vec (m + n) a -> Vec n a drop n = snd . splitAt n +{-# INLINE drop #-} -{-# INLINE dropI #-} --- | 'dropI' @xs@, returns the suffix of @xs@ as demanded by the context +-- | \"'dropI' @xs@\" returns the suffix of /xs/ as demanded by the context. -- -- >>> dropI (1:>2:>3:>4:>5:>Nil) :: Vec 2 Int -- <4,5> dropI :: KnownNat m => Vec (m + n) a -> Vec n a dropI = withSNat drop +{-# INLINE dropI #-} -{-# INLINE at #-} --- | 'at' @n xs@ returns @n@'th element of @xs@ +-- | \"'at' @n xs@\" returns /n/'th element of /xs/ -- -- __NB__: vector elements have an __ASCENDING__ subscript starting from 0 and -- ending at 'maxIndex'. @@ -907,10 +1122,10 @@ -- 2 at :: SNat m -> Vec (m + (n + 1)) a -> a at n xs = head $ snd $ splitAt n xs +{-# INLINE at #-} -{-# NOINLINE select #-} --- | 'select' @f s n xs@ selects @n@ elements with stepsize @s@ and --- offset @f@ from @xs@ +-- | \"'select' @f s n xs@\" selects /n/ elements with step-size /s/ and +-- offset @f@ from /xs/. -- -- >>> select (snat :: SNat 1) (snat :: SNat 2) (snat :: SNat 3) (1:>2:>3:>4:>5:>6:>7:>8:>Nil) -- <2,4,6> @@ -925,12 +1140,13 @@ select f s n xs = select' (toUNat n) $ drop f xs where select' :: UNat n -> Vec i a -> Vec n a - select' UZero _ = Nil - select' (USucc n') vs@(x :> _) = x :> select' n' (drop s (unsafeCoerce vs)) + select' UZero _ = Nil + select' (USucc n') vs@(x `Cons` _) = x `Cons` + select' n' (drop s (unsafeCoerce vs)) +{-# NOINLINE select #-} -{-# INLINE selectI #-} --- | 'selectI' @f s xs@ selects as many elements as demanded by the context --- with stepsize @s@ and offset @f@ from @xs@ +-- | \"'selectI' @f s xs@\" selects as many elements as demanded by the context +-- with step-size /s/ and offset /f/ from /xs/. -- -- >>> selectI d1 d2 (1:>2:>3:>4:>5:>6:>7:>8:>Nil) :: Vec 2 Int -- <2,4> @@ -940,9 +1156,9 @@ -> Vec (f + i) a -> Vec n a selectI f s xs = withSNat (\n -> select f s n xs) +{-# INLINE selectI #-} -{-# NOINLINE replicate #-} --- | 'replicate' @n a@ returns a vector that has @n@ copies of @a@ +-- | \"'replicate' @n a@\" returns a vector that has /n/ copies of /a/. -- -- >>> replicate (snat :: SNat 3) 6 -- <6,6,6> @@ -950,23 +1166,33 @@ -- <6,6,6> replicate :: SNat n -> a -> Vec n a replicate n a = replicateU (toUNat n) a +{-# NOINLINE replicate #-} replicateU :: UNat n -> a -> Vec n a replicateU UZero _ = Nil -replicateU (USucc s) x = x :> replicateU s x +replicateU (USucc s) x = x `Cons` replicateU s x -{-# INLINE repeat #-} --- | 'repeat' @a@ creates a vector with as many copies of @a@ as demanded by the --- context +-- | \"'replicateI' @a@\" creates a vector with as many copies of /a/ as +-- demanded by the context. -- +-- >>> replicateI 6 :: Vec 5 Int +-- <6,6,6,6,6> +replicateI :: KnownNat n => a -> Vec n a +replicateI = withSNat replicate +{-# INLINE replicateI #-} +{-# WARNING replicateI "Use 'repeat' instead of 'replicateI'" #-} + +-- | \"'repeat' @a@\" creates a vector with as many copies of /a/ as demanded +-- by the context. +-- -- >>> repeat 6 :: Vec 5 Int -- <6,6,6,6,6> repeat :: KnownNat n => a -> Vec n a repeat = withSNat replicate +{-# INLINE repeat #-} -{-# INLINE iterate #-} --- | 'iterate' @n f x@ returns a vector starting with @x@ followed by @n@ --- repeated applications of @f@ to @x@ +-- | \"'iterate' @n f x@\" returns a vector starting with /x/ followed by +-- /n/ repeated applications of /f/ to /x/. -- -- > iterate (snat :: SNat 4) f x == (x :> f x :> f (f x) :> f (f (f x)) :> Nil) -- > iterate d4 f x == (x :> f x :> f (f x) :> f (f (f x)) :> Nil) @@ -974,33 +1200,33 @@ -- >>> iterate d4 (+1) 1 -- <1,2,3,4> -- --- @interate n f z@ corresponds to the following circuit layout: +-- \"'interate' @n f z@\" corresponds to the following circuit layout: -- -- <> iterate :: SNat n -> (a -> a) -> a -> Vec n a iterate (SNat _) = iterateI +{-# INLINE iterate #-} -{-# INLINE iterateI #-} --- | 'iterate' @f x@ returns a vector starting with @x@ followed by @n@ --- repeated applications of @f@ to @x@, where @n@ is determined by the context +-- | \"'iterate' @f x@\" returns a vector starting with @x@ followed by @n@ +-- repeated applications of @f@ to @x@, where @n@ is determined by the context. -- -- > iterateI f x :: Vec 3 a == (x :> f x :> f (f x) :> Nil) -- -- >>> iterateI (+1) 1 :: Vec 3 Int -- <1,2,3> -- --- @interateI f z@ corresponds to the following circuit layout: +-- \"'interateI' @f z@\" corresponds to the following circuit layout: -- -- <> iterateI :: KnownNat n => (a -> a) -> a -> Vec n a iterateI f a = xs where - xs = init (a :> ws) + xs = init (a `Cons` ws) ws = map f (lazyV xs) +{-# INLINE iterateI #-} -{-# INLINE generate #-} --- | 'generate' @n f x@ returns a vector with @n@ repeated applications of @f@ --- to @x@ +-- | \"'generate' @n f x@\" returns a vector with @n@ repeated applications of +-- @f@ to @x@. -- -- > generate (snat :: SNat 4) f x == (f x :> f (f x) :> f (f (f x)) :> f (f (f (f x))) :> Nil) -- > generate d4 f x == (f x :> f (f x) :> f (f (f x)) :> f (f (f (f x))) :> Nil) @@ -1008,38 +1234,297 @@ -- >>> generate d4 (+1) 1 -- <2,3,4,5> -- --- @generate n f z@ corresponds to the following circuit layout: +-- \"'generate' @n f z@\" corresponds to the following circuit layout: -- -- <> generate :: SNat n -> (a -> a) -> a -> Vec n a generate (SNat _) f a = iterateI f (f a) +{-# INLINE generate #-} -{-# INLINE generateI #-} --- | 'generate' @f x@ returns a vector with @n@ repeated applications of @f@ --- to @x@, where @n@ is determined by the context +-- | \"'generateI' @f x@\" returns a vector with @n@ repeated applications of +-- @f@ to @x@, where @n@ is determined by the context. -- -- > generateI f x :: Vec 3 a == (f x :> f (f x) :> f (f (f x)) :> Nil) -- -- >>> generateI (+1) 1 :: Vec 3 Int -- <2,3,4> -- --- @generateI f z@ corresponds to the following circuit layout: +-- \"'generateI' @f z@\" corresponds to the following circuit layout: -- -- <> generateI :: KnownNat n => (a -> a) -> a -> Vec n a generateI f a = iterateI f (f a) +{-# INLINE generateI #-} -{-# INLINE toList #-} --- | Convert a vector to a list +-- | Transpose a matrix: go from row-major to column-major -- +-- >>> let xss = (1:>2:>Nil):>(3:>4:>Nil):>(5:>6:>Nil):>Nil +-- >>> xss +-- <<1,2>,<3,4>,<5,6>> +-- >>> transpose xss +-- <<1,3,5>,<2,4,6>> +transpose :: KnownNat n => Vec m (Vec n a) -> Vec n (Vec m a) +transpose = traverse# id +{-# NOINLINE transpose #-} + +-- | 1-dimensional stencil computations +-- +-- \"'stencil1d' @stX f xs@\", where /xs/ has /stX + n/ elements, applies the +-- stencil computation /f/ on: /n + 1/ overlapping (1D) windows of length /stX/, +-- drawn from /xs/. The resulting vector has /n + 1/ elements. +-- +-- >>> let xs = (1:>2:>3:>4:>5:>6:>Nil) +-- >>> :t xs +-- xs :: Num a => Vec 6 a +-- >>> :t stencil1d d2 sum xs +-- stencil1d d2 sum xs :: Num b => Vec 5 b +-- >>> stencil1d d2 sum xs +-- <3,5,7,9,11> +stencil1d :: KnownNat (n + 1) + => SNat (stX + 1) -- ^ Windows length /stX/, at least size 1 + -> (Vec (stX + 1) a -> b) -- ^ The stencil (function) + -> Vec ((stX + n) + 1) a + -> Vec (n + 1) b +stencil1d stX f xs = map f (windows1d stX xs) +{-# INLINE stencil1d #-} + +-- | 2-dimensional stencil computations +-- +-- \"'stencil2d' @stY stX f xss@\", where /xss/ is a matrix of /stY + m/ rows +-- of /stX + n/ elements, applies the stencil computation /f/ on: +-- /(m + 1) * (n + 1)/ overlapping (2D) windows of /stY/ rows of /stX/ elements, +-- drawn from /xss/. The result matrix has /m + 1/ rows of /n + 1/ elements. +-- +-- >>> let xss = ((1:>2:>3:>4:>Nil):>(5:>6:>7:>8:>Nil):>(9:>10:>11:>12:>Nil):>(13:>14:>15:>16:>Nil):>Nil) +-- >>> :t xss +-- xss :: Num a => Vec 4 (Vec 4 a) +-- >>> :t stencil2d d2 d2 (sum . map sum) xss +-- stencil2d d2 d2 (sum . map sum) xss :: Num a => Vec 3 (Vec 3 a) +-- >>> stencil2d d2 d2 (sum . map sum) xss +-- <<14,18,22>,<30,34,38>,<46,50,54>> +stencil2d :: (KnownNat (n + 1), KnownNat (m+1)) + => SNat (stY + 1) -- ^ Window hight /stY/, at least size 1 + -> SNat (stX + 1) -- ^ Window width /stX/, at least size 1 + -> (Vec (stY + 1) (Vec (stX + 1) a) -> b) -- ^ The stencil (function) + -> Vec ((stY + m) + 1) (Vec ((stX + n) + 1) a) + -> Vec (m + 1) (Vec (n + 1) b) +stencil2d stY stX f xss = (map.map) f (windows2d stY stX xss) +{-# INLINE stencil2d #-} + +-- | \"'windows1d' @stX xs@\", where the vector /xs/ has /stX + n/ elements, +-- returns a vector of /n + 1/ overlapping (1D) windows of /xs/ of length /stX/. +-- +-- >>> let xs = (1:>2:>3:>4:>5:>6:>Nil) +-- >>> :t xs +-- xs :: Num a => Vec 6 a +-- >>> :t windows1d d2 xs +-- windows1d d2 xs :: Num a => Vec 5 (Vec 2 a) +-- >>> windows1d d2 xs +-- <<1,2>,<2,3>,<3,4>,<4,5>,<5,6>> +windows1d :: KnownNat (n + 1) + => SNat (stX + 1) -- ^ Length of the window, at least size 1 + -> Vec ((stX + n) + 1) a + -> Vec (n + 1) (Vec (stX + 1) a) +windows1d stX xs = map (take stX) (rotations xs) + where + rotateL ys = tail ys :< head ys + rotations ys = iterateI rotateL ys +{-# INLINE windows1d #-} + +-- | \"'windows2d' @stY stX xss@\", where matrix /xss/ has /stY + m/ rows of +-- /stX + n/, returns a matrix of /m+1/ rows of /n+1/ elements. The elements +-- of this new matrix are the overlapping (2D) windows of /xss/, where every +-- window has /stY/ rows of /stX/ elements. +-- +-- >>> let xss = ((1:>2:>3:>4:>Nil):>(5:>6:>7:>8:>Nil):>(9:>10:>11:>12:>Nil):>(13:>14:>15:>16:>Nil):>Nil) +-- >>> :t xss +-- xss :: Num a => Vec 4 (Vec 4 a) +-- >>> :t windows2d d2 d2 xss +-- windows2d d2 d2 xss :: Num a => Vec 3 (Vec 3 (Vec 2 (Vec 2 a))) +-- >>> windows2d d2 d2 xss +-- <<<<1,2>,<5,6>>,<<2,3>,<6,7>>,<<3,4>,<7,8>>>,<<<5,6>,<9,10>>,<<6,7>,<10,11>>,<<7,8>,<11,12>>>,<<<9,10>,<13,14>>,<<10,11>,<14,15>>,<<11,12>,<15,16>>>> +windows2d :: (KnownNat (n+1),KnownNat (m+1)) + => SNat (stY + 1) -- ^ Window hight /stY/, at least size 1 + -> SNat (stX + 1) -- ^ Window width /stX/, at least size 1 + -> Vec ((stY + m) + 1) (Vec (stX + n + 1) a) + -> Vec (m + 1) (Vec (n + 1) (Vec (stY + 1) (Vec (stX + 1) a))) +windows2d stY stX xss = map (transpose . (map (windows1d stX))) + (windows1d stY xss) +{-# INLINE windows2d #-} + +-- | Forward permutation specified by an index mapping, /ix/. The result vector +-- is initialised by the given defaults, /def/, and an further values that are +-- permuted into the result are added to the current value using the given +-- combination function, /f/. +-- +-- The combination function must be /associative/ and /commutative/. +permute :: (Enum i, KnownNat n, KnownNat m) + => (a -> a -> a) -- ^ Combination function, /f/ + -> Vec n a -- ^ Default values, /def/ + -> Vec m i -- ^ Index mapping, /is/ + -> Vec (m + k) a -- ^ Vector to be permuted, /xs/ + -> Vec n a +permute f defs is xs = ys + where + ixs = zip is (takeI xs) + ys = foldl (\ks (i,x) -> let ki = ks!!i in replace i (f x ki) ks) defs ixs +{-# INLINE permute #-} + +-- | Backwards permutation specified by an index mapping, /is/, from the +-- destination vector specifying which element of the source vector /xs/ to +-- read. +-- +-- \"'backpermute' @xs is@\" is equivalent to \"'map' @(xs '!!') is@\". +-- +-- For example: +-- +-- >>> let input = 1:>9:>6:>4:>4:>2:>0:>1:>2:>Nil +-- >>> let from = 1:>3:>7:>2:>5:>3:>Nil +-- >>> backpermute input from +-- <9,4,1,6,2,4> +backpermute :: (Enum i, KnownNat n) + => Vec n a -- ^ Source vector, /xs/ + -> Vec m i -- ^ Index mapping, /is/ + -> Vec m a +backpermute xs = map (xs!!) +{-# INLINE backpermute #-} + +-- | Copy elements from the source vector, /xs/, to the destination vector +-- according to an index mapping /is/. This is a forward permute operation where +-- a /to/ vector encodes an input to output index mapping. Output elements for +-- indices that are not mapped assume the value in the default vector /def/. +-- +-- For example: +-- +-- >>> let defVec = 0:>0:>0:>0:>0:>0:>0:>0:>0:>Nil +-- >>> let to = 1:>3:>7:>2:>5:>8:>Nil +-- >>> let input = 1:>9:>6:>4:>4:>2:>5:>Nil +-- >>> scatter defVec to input +-- <0,1,4,9,0,4,0,6,2> +-- +-- __NB__: If the same index appears in the index mapping more than once, the +-- latest mapping is chosen. +scatter :: (Enum i, KnownNat n, KnownNat m) + => Vec n a -- ^ Default values, /def/ + -> Vec m i -- ^ Index mapping, /is/ + -> Vec (m + k) a -- ^ Vector to be scattered, /xs/ + -> Vec n a +scatter = permute const +{-# INLINE scatter #-} + +-- | Backwards permutation specified by an index mapping, /is/, from the +-- destination vector specifying which element of the source vector /xs/ to +-- read. +-- +-- \"'gather' @xs is@\" is equivalent to \"'map' @(xs '!!') is@\". +-- +-- For example: +-- +-- >>> let input = 1:>9:>6:>4:>4:>2:>0:>1:>2:>Nil +-- >>> let from = 1:>3:>7:>2:>5:>3:>Nil +-- >>> gather input from +-- <9,4,1,6,2,4> +gather :: (Enum i, KnownNat n) + => Vec n a -- ^ Source vector, /xs/ + -> Vec m i -- ^ Index mapping, /is/ + -> Vec m a +gather xs = map (xs!!) +{-# INLINE gather #-} + +-- | \"'interleave' @d xs@\" creates a vector: +-- +-- @ +-- \ +-- @ +-- +-- >>> let xs = 1 :> 2 :> 3 :> 4 :> 5 :> 6 :> 7 :> 8 :> 9 :> Nil +-- >>> interleave d3 xs +-- <1,4,7,2,5,8,3,6,9> +interleave :: (KnownNat n, KnownNat d) + => SNat d -- ^ Interleave step, /d/ + -> Vec (n * d) a + -> Vec (d * n) a +interleave d = concat . transpose . unconcat d +{-# INLINE interleave #-} + +-- | /Dynamically/ rotate a 'Vec'tor to the left: +-- +-- >>> let xs = 1 :> 2 :> 3 :> 4 :> Nil +-- >>> rotateLeft xs 1 +-- <2,3,4,1> +-- >>> rotateLeft xs 2 +-- <3,4,1,2> +-- >>> rotateLeft xs (-1) +-- <4,1,2,3> +-- +-- __NB:__ use `rotateLeftS` if you want to rotate left by a /static/ amount. +rotateLeft :: (Enum i, KnownNat n) + => Vec n a + -> i + -> Vec n a +rotateLeft xs i = map ((xs !!) . (`mod` len)) (iterateI (+1) i') + where + i' = fromEnum i + len = length xs +{-# INLINE rotateLeft #-} + +-- | /Dynamically/ rotate a 'Vec'tor to the right: +-- +-- >>> let xs = 1 :> 2 :> 3 :> 4 :> Nil +-- >>> rotateRight xs 1 +-- <4,1,2,3> +-- >>> rotateRight xs 2 +-- <3,4,1,2> +-- >>> rotateRight xs (-1) +-- <2,3,4,1> +-- +-- __NB:__ use `rotateRightS` if you want to rotate right by a /static/ amount. +rotateRight :: (Enum i, KnownNat n) + => Vec n a + -> i + -> Vec n a +rotateRight xs i = map ((xs !!) . (`mod` len)) (iterateI (+1) i') + where + i' = negate (fromEnum i) + len = length xs +{-# INLINE rotateRight #-} + +-- | /Statically/ rotate a 'Vec'tor to the left: +-- +-- >>> let xs = 1 :> 2 :> 3 :> 4 :> Nil +-- >>> rotateLeftS xs d1 +-- <2,3,4,1> +-- +-- __NB:__ use `rotateLeft` if you want to rotate left by a /dynamic/ amount. +rotateLeftS :: Vec (d + n) a + -> SNat d + -> Vec (n + d) a +rotateLeftS xs d = let (l,r) = splitAt d xs in r ++ l +{-# INLINE rotateLeftS #-} + +-- | /Statically/ rotate a 'Vec'tor to the right: +-- +-- >>> let xs = 1 :> 2 :> 3 :> 4 :> Nil +-- >>> rotateRightS xs d1 +-- <4,1,2,3> +-- +-- __NB:__ use `rotateRight` if you want to rotate right by a /dynamic/ amount. +rotateRightS :: forall n d a . (KnownNat n) + => Vec (n + d) a + -> SNat d + -> Vec (d + n) a +rotateRightS xs _ = let (l,r) = splitAtI xs :: (Vec n a, Vec d a) in r ++ l +{-# INLINE rotateRightS #-} + +-- | Convert a vector to a list. +-- -- >>> toList (1:>2:>3:>Nil) -- [1,2,3] --- --- __NB__: Not synthesisable toList :: Vec n a -> [a] toList = foldr (:) [] +{-# INLINE toList #-} --- | Create a vector literal from a list literal +-- | Create a vector literal from a list literal. -- -- > $(v [1::Signed 8,2,3,4,5]) == (8:>2:>3:>4:>5:>Nil) :: Vec 5 (Signed 8) -- @@ -1055,14 +1540,19 @@ asNatProxy :: Vec n a -> Proxy n asNatProxy _ = Proxy -{-# NOINLINE lazyV #-} --- | For when your vector functions are too strict in their arguments +-- | Length of a 'Vec'tor as an 'SNat' value +lengthS :: KnownNat n => Vec n a -> SNat n +lengthS _ = snat +{-# INLINE lengthS #-} + +-- | What you should use when your vector functions are too strict in their +-- arguments. -- -- For example: -- -- @ -- -- Bubble sort for 1 iteration --- sortV xs = 'map' fst sorted '<:' (snd ('last' sorted)) +-- sortV xs = 'map' fst sorted ':<' (snd ('last' sorted)) -- where -- lefts = 'head' xs :> 'map' snd ('init' sorted) -- rights = 'tail' xs @@ -1081,7 +1571,7 @@ -- In this case, adding 'lazyV' on 'zipWith's second argument: -- -- @ --- sortVL xs = 'map' fst sorted '<:' (snd ('last' sorted)) +-- sortVL xs = 'map' fst sorted ':<' (snd ('last' sorted)) -- where -- lefts = 'head' xs :> map snd ('init' sorted) -- rights = 'tail' xs @@ -1097,7 +1587,7 @@ -- meaning of the code: -- -- @ --- sortV_flip xs = 'map' fst sorted '<:' (snd ('last' sorted)) +-- sortV_flip xs = 'map' fst sorted ':<' (snd ('last' sorted)) -- where -- lefts = 'head' xs :> 'map' snd ('init' sorted) -- rights = 'tail' xs @@ -1112,14 +1602,12 @@ lazyV = lazyV' (repeat undefined) where lazyV' :: Vec n a -> Vec n a -> Vec n a - lazyV' Nil _ = Nil - lazyV' (_ :> xs) ys = head ys :> lazyV' xs (tail ys) + lazyV' Nil _ = Nil + lazyV' (_ `Cons` xs) ys = head ys `Cons` lazyV' xs (tail ys) +{-# NOINLINE lazyV #-} -{-# NOINLINE dfold #-} -- | A /dependently/ typed fold. -- --- __NB__: Not synthesisable --- -- Using lists, we can define @append@ ('Prelude.++') using 'Prelude.foldr': -- -- >>> import qualified Prelude @@ -1188,23 +1676,21 @@ -> (p $ 0) -- ^ Initial element -> Vec k a -- ^ Vector to fold over -> (p $ k) -dfold _ _ z Nil = z -dfold p f z (x :> (xs :: Vec l a)) = f (Proxy :: Proxy l) x (dfold p f z xs) +dfold _ _ z Nil = z +dfold p f z (x `Cons` (xs :: Vec l a)) = f (Proxy :: Proxy l) x (dfold p f z xs) +{-# NOINLINE dfold #-} data V (a :: *) (f :: TyFun Nat *) :: * type instance Apply (V a) l = Vec l a -{-# NOINLINE vfold #-} -- | Specialised version of 'dfold' that builds a triangular computational -- structure. -- --- __NB__: Not synthesisable --- -- Example: -- -- @ -- cs a b = if a > b then (a,b) else (b,a) --- csRow y xs = let (y',xs') = 'mapAccumL' cs y xs in xs' '<:' y' +-- csRow y xs = let (y',xs') = 'mapAccumL' cs y xs in xs' ':<' y' -- csSort = 'vfold' csRow -- @ -- @@ -1212,18 +1698,21 @@ -- -- >>> csSort (7 :> 3 :> 9 :> 1 :> Nil) -- <1,3,7,9> +-- +-- The circuit layout of @csSort@, build using 'vfold', is: +-- +-- <> vfold :: (forall l . a -> Vec l b -> Vec (l + 1) b) -> Vec k a -> Vec k b vfold f xs = dfold (Proxy :: Proxy (V a)) (const f) Nil xs - +{-# INLINE vfold #-} instance (KnownNat n, KnownNat (BitSize a), BitPack a) => BitPack (Vec n a) where type BitSize (Vec n a) = n * (BitSize a) pack = concatBitVector# . map pack unpack = map unpack . unconcatBitVector# -{-# NOINLINE concatBitVector# #-} concatBitVector# :: KnownNat m => Vec n (BitVector m) -> BitVector (n * m) @@ -1232,34 +1721,35 @@ concatBitVector' :: KnownNat m => Vec n (BitVector m) -> BitVector (n * m) - concatBitVector' Nil = 0 - concatBitVector' (x :> xs) = concatBitVector' xs ++# x + concatBitVector' Nil = 0 + concatBitVector' (x `Cons` xs) = concatBitVector' xs ++# x +{-# NOINLINE concatBitVector# #-} -{-# NOINLINE unconcatBitVector# #-} unconcatBitVector# :: (KnownNat n, KnownNat m) => BitVector (n * m) -> Vec n (BitVector m) unconcatBitVector# bv = withSNat (\s -> ucBV (toUNat s) bv) +{-# NOINLINE unconcatBitVector# #-} -{-# INLINE ucBV #-} ucBV :: forall n m . KnownNat m => UNat n -> BitVector (n * m) -> Vec n (BitVector m) ucBV UZero _ = Nil ucBV (USucc n) bv = let (bv',x :: BitVector m) = split# bv - in ucBV n bv' <: x + in ucBV n bv' :< x +{-# INLINE ucBV #-} instance Lift a => Lift (Vec n a) where - lift Nil = [| Nil |] - lift (x:>xs) = [| x :> $(lift xs) |] + lift Nil = [| Nil |] + lift (x `Cons` xs) = [| x :> $(lift xs) |] instance (KnownNat n, Arbitrary a) => Arbitrary (Vec n a) where - arbitrary = sequence $ repeat arbitrary - shrink = sequence . fmap shrink + arbitrary = traverse# id $ repeat arbitrary + shrink = traverse# id . fmap shrink instance CoArbitrary a => CoArbitrary (Vec n a) where coarbitrary = coarbitrary . toList -type instance Index (Vec n a) = Int -type instance IxValue (Vec n a) = a -instance KnownNat n => Ixed (Vec n a) where +type instance Lens.Index (Vec n a) = Int +type instance Lens.IxValue (Vec n a) = a +instance KnownNat n => Lens.Ixed (Vec n a) where ix i f xs = replace_int xs i <$> f (index_int xs i) diff --git a/src/CLaSH/Tutorial.hs b/src/CLaSH/Tutorial.hs --- a/src/CLaSH/Tutorial.hs +++ b/src/CLaSH/Tutorial.hs @@ -94,7 +94,7 @@ -- >>> :set -fplugin GHC.TypeLits.Normalise -- >>> let compareSwapL a b = if a < b then (a,b) else (b,a) -- >>> :{ --- let sortV xs = map fst sorted <: (snd (last sorted)) +-- let sortV xs = map fst sorted :< (snd (last sorted)) -- where -- lefts = head xs :> map snd (init sorted) -- rights = tail xs @@ -102,7 +102,7 @@ -- :} -- -- >>> :{ --- let 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 @@ -654,7 +654,7 @@ of coefficients. @ -dotp as bs = 'foldl' (+) 0 ('zipWith' (*) as bs) +dotp as bs = 'sum' ('zipWith' (*) as bs) fir coeffs x_t = y_t where @@ -662,7 +662,7 @@ xs = 'window' x_t topEntity :: 'Signal' ('Signed' 16) -> 'Signal' ('Signed' 16) -topEntity = fir $('v' [0::'Signal' ('Signed' 16),1,2,3]) +topEntity = fir (0 ':>' 1 ':>' 2 ':>' 3 ':>' 'Nil') @ Here we can see that, although the CλaSH compiler does not support recursion, @@ -1632,7 +1632,7 @@ @ -- Bubble sort for 1 iteration - sortV xs = 'map' fst sorted '<:' (snd ('last' sorted)) + sortV xs = 'map' fst sorted ':<' (snd ('last' sorted)) where lefts = 'head' xs :> 'map' snd ('init' sorted) rights = 'tail' xs @@ -1651,7 +1651,7 @@ In this case, adding 'lazyV' on 'zipWith's second argument: @ - sortVL xs = 'map' fst sorted '<:' (snd ('last' sorted)) + sortVL xs = 'map' fst sorted ':<' (snd ('last' sorted)) where lefts = 'head' xs :> map snd ('init' sorted) rights = 'tail' xs @@ -1683,7 +1683,7 @@ is the following function that performs one iteration of bubble sort: @ - sortV xs = 'map' fst sorted <: (snd ('last' sorted)) + sortV xs = 'map' fst sorted :< (snd ('last' sorted)) where lefts = 'head' xs :> 'map' snd ('init' sorted) rights = 'tail' xs @@ -1710,10 +1710,9 @@ * __GADT pattern matching__ While pattern matching for regular ADTs is supported, pattern matching for - GADTs is __not__. The 'Vec'tor type, which is also a GADT, is __no__ - exception! You can use the extraction and indexing functions of - "CLaSH.Sized.Vector" to get access to individual ranges / elements of a - 'Vec'tor. + GADTs is __not__. The constructors 'Cons' and 'Nil' of the 'Vec'tor type, + which is also a GADT, are __no__ exception! However, you can use the + convenient ':>' pattern synonym. * __Floating point types__