module Lava.Retime
( timeTransform
)
where
import Lava.Signal
import Lava.Generic
import Lava.Sequent
import Lava.Netlist
import Data.List
( isPrefixOf
)
timeTransform :: (Generic a, Generic b) => (a -> b) -> ([a] -> [b])
timeTransform :: (a -> b) -> [a] -> [b]
timeTransform circ :: a -> b
circ [] = []
timeTransform circ :: a -> b
circ inps :: [a]
inps@(inp :: a
inp:_) =
(Struct Symbol -> b) -> [Struct Symbol] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Struct Symbol -> b
forall a. Generic a => Struct Symbol -> a
construct
([Struct Symbol] -> [b]) -> (a -> [Struct Symbol]) -> a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct [Symbol] -> [Struct Symbol]
forall a. Struct [a] -> [Struct a]
transStruct
(Struct [Symbol] -> [Struct Symbol])
-> (a -> Struct [Symbol]) -> a -> [Struct Symbol]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (S [Symbol] -> [Symbol]) -> Struct Symbol -> Struct [Symbol]
forall (f :: * -> *) a. Functor f => (S a -> a) -> f Symbol -> f a
netlist S [Symbol] -> [Symbol]
phi
(Struct Symbol -> Struct [Symbol])
-> (a -> Struct Symbol) -> a -> Struct [Symbol]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Struct Symbol
forall a. Generic a => a -> Struct Symbol
struct
(b -> Struct Symbol) -> (a -> b) -> a -> Struct Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
circ
(a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a -> a
forall a. Generic a => String -> a -> a
symbolize String
tag
(a -> [b]) -> a -> [b]
forall a b. (a -> b) -> a -> b
$ a
inp
where
n :: Int
n = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
inps
phi :: S [Symbol] -> [Symbol]
phi (DelayBool ini :: [Symbol]
ini next :: [Symbol]
next) =
(Symbol -> Symbol -> S Symbol) -> [Symbol] -> [Symbol] -> [Symbol]
forall t. (t -> Symbol -> S Symbol) -> [t] -> [Symbol] -> [Symbol]
delay Symbol -> Symbol -> S Symbol
forall s. s -> s -> S s
DelayBool [Symbol]
ini [Symbol]
next
phi (DelayInt ini :: [Symbol]
ini next :: [Symbol]
next) =
(Symbol -> Symbol -> S Symbol) -> [Symbol] -> [Symbol] -> [Symbol]
forall t. (t -> Symbol -> S Symbol) -> [t] -> [Symbol] -> [Symbol]
delay Symbol -> Symbol -> S Symbol
forall s. s -> s -> S s
DelayInt [Symbol]
ini [Symbol]
next
phi (VarBool s :: String
s) | String
tag String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s =
String -> [Symbol]
var (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
tag) String
s)
phi (VarInt s :: String
s) | String
tag String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s =
String -> [Symbol]
var (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
tag) String
s)
phi s :: S [Symbol]
s =
Int -> [Symbol] -> [Symbol]
forall a. Int -> [a] -> [a]
take Int
n ([Symbol] -> [Symbol]
forall a. [a] -> [a]
cycle ((S Symbol -> Symbol) -> [S Symbol] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map S Symbol -> Symbol
symbol (S [Symbol] -> [S Symbol]
forall a. S [a] -> [S a]
zips S [Symbol]
s)))
delay :: (t -> Symbol -> S Symbol) -> [t] -> [Symbol] -> [Symbol]
delay del :: t -> Symbol -> S Symbol
del ~(ini0 :: t
ini0:_) next :: [Symbol]
next =
(S Symbol -> Symbol
symbol (t -> Symbol -> S Symbol
del t
ini0 ([Symbol] -> Symbol
forall a. [a] -> a
last [Symbol]
next)) Symbol -> [Symbol] -> [Symbol]
forall a. a -> [a] -> [a]
: Int -> [Symbol] -> [Symbol]
forall t a. (Eq t, Num t) => t -> [a] -> [a]
list (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) ([Symbol] -> [Symbol]
forall a. [a] -> [a]
init [Symbol]
next))
var :: String -> [Symbol]
var s :: String
s =
(a -> Symbol) -> [a] -> [Symbol]
forall a b. (a -> b) -> [a] -> [b]
map (String -> a -> Symbol
forall a. Generic a => String -> a -> Symbol
pickSymbol String
s) [a]
inps
list :: t -> [a] -> [a]
list 0 _ = []
list n :: t
n ~(x :: a
x:xs :: [a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> [a] -> [a]
list (t
nt -> t -> t
forall a. Num a => a -> a -> a
-1) [a]
xs
tag :: String
tag = "#retime#"