module Lava.Retime
  ( timeTransform
  )
 where

import Lava.Signal
import Lava.Generic
import Lava.Sequent
import Lava.Netlist

import Data.List
  ( isPrefixOf
  )

----------------------------------------------------------------
-- time transformation

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#"

----------------------------------------------------------------
-- the end.