module ForSyDe.Deep.Backend.GraphML.Traverse
(writeGraphMLM,
module ForSyDe.Deep.Backend.GraphML.Traverse.GraphMLM) where
import ForSyDe.Deep.Backend.GraphML.Traverse.GraphMLM
import ForSyDe.Deep.Backend.GraphML.FileIO
import ForSyDe.Deep.Backend.GraphML.AST
import ForSyDe.Deep.System.SysDef
import ForSyDe.Deep.Netlist.Traverse
import ForSyDe.Deep.Netlist
import ForSyDe.Deep.OSharing
import Data.Traversable.GenericZipWith
import System.Directory
import System.FilePath
import Control.Monad.State
writeGraphMLM :: GraphMLM ()
writeGraphMLM = do
rootDir <- gets (sid.globalSysDef.global)
let graphmlDir = rootDir </> "graphml"
liftIO $ createDirectoryIfMissing True graphmlDir
liftIO $ setCurrentDirectory graphmlDir
writeLocalGraphMLM
rec <- isRecursiveSet
when rec $ do subs <- gets (subSys.globalSysDef.global)
let writeSub s =
withLocalST (initLocalST ((readURef.unPrimSysDef) s))
writeLocalGraphMLM
mapM_ writeSub subs
liftIO $ setCurrentDirectory (".." </> "..")
writeLocalGraphMLM :: GraphMLM ()
writeLocalGraphMLM = do
lSysDefVal <- gets (currSysDef.local)
let lSysDefId = sid lSysDefVal
debugMsg $ "Compiling system definition `" ++ lSysDefId ++ "' ...\n"
let nl = netlist lSysDefVal
intOutsInfo <- traverseGraphML nl
LocalTravResult nodes edges <- gets (localRes.local)
let outIds = map fst (oIface lSysDefVal)
outNodes = map (\id -> OutNode id (id ++ "_in")) outIds
outEdges =
zipWith (\(IntSignalInfo n pId) id ->
GraphMLEdge n pId (OutNode id (id ++ "_in")) (id ++ "_in"))
intOutsInfo
outIds
finalGraph = GraphMLGraph lSysDefId (nodes ++ outNodes)
(edges ++ outEdges)
yFiles <- genyFilesMarkup
return ()
liftIO $ writeGraph yFiles finalGraph (lSysDefId ++ ".graphml")
traverseGraphML :: Netlist [] -> GraphMLM [IntSignalInfo]
traverseGraphML = traverseSEIO newGraphML defineGraphML
newGraphML :: NlNode NlSignal -> GraphMLM [(NlNodeOut, IntSignalInfo)]
newGraphML node = do
let id = case node of
InPort id -> id
Proc pid _ -> pid
insNode = zipWithTF (\_ n -> id ++ "_in" ++ show n) node [(1::Int)..]
taggedOutsNode = zipWith (\t n -> (t, id ++ "_out" ++ show n))
(outTags node)
[(1::Int)..]
gMLNode = ProcNode insNode (map snd taggedOutsNode)
return $ map (\(t,out) -> (t, IntSignalInfo gMLNode out)) taggedOutsNode
defineGraphML :: [(NlNodeOut, IntSignalInfo)]
-> NlNode IntSignalInfo
-> GraphMLM ()
defineGraphML outs ins = do
let id = case ins of
InPort id -> id
Proc pid _ -> pid
formalInL = [id ++ "_in" ++ show n | n <- [(1::Int)..]]
outPids = map (\(_, IntSignalInfo _ pid) -> pid) outs
insFormal = zipWithTF (\_ n -> n) ins formalInL
node = ProcNode insFormal outPids
actualInL = arguments ins
inEdges = zipWith (\(IntSignalInfo aN aPid) fPid ->
GraphMLEdge aN aPid node fPid ) actualInL formalInL
mapM_ addEdge inEdges
addNode node