{-# LANGUAGE TemplateHaskell, FlexibleInstances, ScopedTypeVariables,
MultiParamTypeClasses, UndecidableInstances #-}
module ForSyDe.Deep.System.SysFun.Instances () where
import Data.Dynamic
import Control.Monad (liftM)
import Language.Haskell.TH.Syntax (runIO, runQ, lift)
import System.IO.Unsafe (unsafePerformIO)
import ForSyDe.Deep.Config (maxTupleSize)
import ForSyDe.Deep.System.SysFun (
SysFun(..),
SysFunToSimFun(..),
SysFunToIOSimFun(..),
funOutInstances)
import ForSyDe.Deep.Netlist
import ForSyDe.Deep.System.SysDef()
import ForSyDe.Deep.Process.ProcType (ProcType(..))
import Data.Typeable.FSDTypeRepLib
instance (ProcType a, SysFun f) => SysFun (Signal a -> f) where
applySysFun f ids = (outSignals, currInType : nextInTypeReps, outTypeReps)
where (outSignals, nextInTypeReps, outTypeReps) =
case ids of
[] -> applySysFun (f (Signal (newInPort "default"))) []
(i:is) -> applySysFun (f (Signal (newInPort i))) is
currInType = fsdTypeOf (undefined :: Signal a)
fromListSysFun f accum s = fromListSysFun f ((unSignal s):accum)
instance (ProcType a, SysFunToSimFun sysFun simFun) =>
SysFunToSimFun (Signal a -> sysFun) ([a] -> simFun) where
fromDynSimFun f accum s = fromDynSimFun f ((map toDyn s):accum)
instance (ProcType a, SysFunToIOSimFun sysFun simFun) =>
SysFunToIOSimFun (Signal a -> sysFun) ([a] -> simFun) where
fromTHStrSimFun f accum s = fromTHStrSimFun f ((map unsafeLift s):accum)
where unsafeLift = unsafePerformIO.runQ.lift
$(let concatMapM f xs = liftM concat (mapM f xs)
listFunOutInstances = liftM (\(a,b,c) -> [a,b,c]) . funOutInstances
msg = "Generating and compiling " ++ show maxTupleSize ++
" output instances of " ++
show ''SysFun ++ ", " ++ show ''SysFunToSimFun ++
" and " ++ show ''SysFunToIOSimFun ++
", this might take some time ... \n"
in runIO (putStrLn $ msg) >>
concatMapM listFunOutInstances [0..maxTupleSize]
)