X-Git-Url: https://git.stderr.nl/gitweb?p=matthijs%2Fmaster-project%2Fsupport%2Ftfvec.git;a=blobdiff_plain;f=Data%2FParam%2FTFVec.hs;h=7a0fa1dcc0ab1d1d000bd497097944ebbec64297;hp=87838930a20542d6d5d5682df6a26b8ec525dd71;hb=74aad9e23f7b911124ece69b2886f4ec0c88e390;hpb=25576fe76b567e77c0778d2cbb0f952a5d5a50e0 diff --git a/Data/Param/TFVec.hs b/Data/Param/TFVec.hs index 8783893..7a0fa1d 100644 --- a/Data/Param/TFVec.hs +++ b/Data/Param/TFVec.hs @@ -50,7 +50,9 @@ module Data.Param.TFVec , concat , reverse , iterate + , iteraten , generate + , generaten , copy , copyn ) where @@ -67,7 +69,7 @@ import Prelude hiding ( zipWith, zip, unzip, concat, reverse, iterate ) import qualified Data.Foldable as DF (Foldable, foldr) import qualified Data.Traversable as DT (Traversable(traverse)) -import Language.Haskell.TH +import Language.Haskell.TH hiding (Pred) import Language.Haskell.TH.Syntax (Lift(..)) newtype (NaturalT s) => TFVec s a = TFVec {unTFVec :: [a]} @@ -93,8 +95,11 @@ singleton x = x +> empty vectorCPS :: [a] -> (forall s . NaturalT s => TFVec s a -> w) -> w vectorCPS xs = unsafeVectorCPS (toInteger (P.length xs)) xs +-- FIXME: Not the most elegant solution... but it works for now in clash vectorTH :: Lift a => [a] -> ExpQ -vectorTH xs = (vectorCPS xs) lift +-- vectorTH xs = (vectorCPS xs) lift +vectorTH [] = [| empty |] +vectorTH (x:xs) = [| x +> $(vectorTH xs) |] unsafeVector :: NaturalT s => s -> [a] -> TFVec s a unsafeVector l xs @@ -228,17 +233,23 @@ concat = liftV (P.foldr ((P.++).unTFVec) []) reverse :: TFVec s a -> TFVec s a reverse = liftV P.reverse -iterate :: NaturalT s => s -> (a -> a) -> a -> TFVec s a -iterate s f x = let s' = fromIntegerT s in TFVec (P.take s' $ P.iterate f x) +iterate :: NaturalT s => (a -> a) -> a -> TFVec s a +iterate = iteraten (undefined :: s) -generate :: NaturalT s => s -> (a -> a) -> a -> TFVec s a -generate s f x = let s' = fromIntegerT s in TFVec (P.take s' $ P.tail $ P.iterate f x) +iteraten :: NaturalT s => s -> (a -> a) -> a -> TFVec s a +iteraten s f x = let s' = fromIntegerT s in TFVec (P.take s' $ P.iterate f x) + +generate :: NaturalT s => (a -> a) -> a -> TFVec s a +generate = generaten (undefined :: s) + +generaten :: NaturalT s => s -> (a -> a) -> a -> TFVec s a +generaten s f x = let s' = fromIntegerT s in TFVec (P.take s' $ P.tail $ P.iterate f x) copy :: NaturalT s => a -> TFVec s a copy x = copyn (undefined :: s) x copyn :: NaturalT s => s -> a -> TFVec s a -copyn s x = iterate s id x +copyn s x = iteraten s id x -- ============= -- = Instances =