module Feldspar.Compiler.Transformation.GraphUtils
( tupleWalk
, tupleZip
, tupleZipList
, replaceVars
) where
import Feldspar.Core.Graph
import Feldspar.Core.Types
import Data.List
class RepVars a where
replaceVars:: [(Variable, Variable -> Variable)] -> a -> a
instance RepVars (Node, [Hierarchy]) where
replaceVars chLs (node, hs) = (replaceVars chLs node, map (replaceVars chLs) hs)
instance RepVars Hierarchy where
replaceVars chLs (Hierarchy ndHrs) = Hierarchy (map (replaceVars chLs) ndHrs)
instance RepVars Node where
replaceVars chLs (node@(Node {input = nInp, function = nFunc}))
= node{input= replaceVars chLs nInp, function = replaceVars chLs nFunc}
instance RepVars (Tuple Source) where
replaceVars chLs (One (Constant x)) = One (Constant x)
replaceVars chLs (One (Variable x)) = One (Variable (replaceVars chLs x))
replaceVars chLs (Tup tls) = Tup (map (replaceVars chLs) tls)
instance RepVars Variable where
replaceVars chLs (nId, ls)
= case find (\((v,_),_) -> v == nId) chLs of
Nothing -> (nId, ls)
Just ((v,vls),tr) -> case vls of
[] -> tr (nId, ls)
_ -> if (vls == ls) then (tr (nId,ls)) else (nId,ls)
instance RepVars Function where
replaceVars chLs (NoInline str ifc) = (NoInline str (replaceVars chLs ifc))
replaceVars chLs (Parallel ifc) = (Parallel (replaceVars chLs ifc))
replaceVars chLs (IfThenElse ifc1 ifc2) = (IfThenElse (replaceVars chLs ifc1) (replaceVars chLs ifc2))
replaceVars chLs (While ifc1 ifc2) = (While (replaceVars chLs ifc1) (replaceVars chLs ifc2))
replaceVars chLs fun = fun
instance RepVars Interface where
replaceVars chLs ifc@ (Interface {interfaceOutput = ifOut})
= ifc{interfaceOutput = replaceVars chLs ifOut}
tupleWalk :: ([Int] -> a -> b) -> Tuple a -> [b]
tupleWalk = tupleWalk' [] where
tupleWalk' :: [Int] -> ([Int] -> a -> b) -> Tuple a -> [b]
tupleWalk' p f (One x) = [f p x]
tupleWalk' p f (Tup xs) = concatMap ff $ zip xs [0..] where
ff (x,idx) = tupleWalk' (p ++ [idx]) f x
tupleZip :: (Tuple a, Tuple b) -> Tuple (a,b)
tupleZip (One x, One y) = One (x,y)
tupleZip (Tup xs, Tup ys) = Tup (map tupleZip $ zip xs ys)
tupleZip _ = error "Error: Tuples with different structure are zipped."
tupleZipList :: (Tuple a, Tuple b) -> [(a,b)]
tupleZipList (One x, One y) = [(x,y)]
tupleZipList (Tup xs, Tup ys) = concatMap tupleZipList $ zip xs ys
tupleZipList _ = error "Error: Tuples with different structure are zipped."