ShowRefTree.hs revision 1fac5c1cbbeac0c3b506437e7be4183809943af2
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian MaederModule : $Header$
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian MaederCopyright : (c) Mihai Codescu, DFKI GmbH 2010
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian MaederLicense : GPLv2 or higher, see LICENSE.txt
4db455e0782c3be2bf1eaf8822ed20968a756444Klaus LuettichMaintainer : mihai.codescu@dfki.de
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian MaederStability : provisional
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian MaederPortability : non-portable (Logic)
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maederdisplay the logic graph
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maedermodule GUI.ShowRefTree (showRefTree) where
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maederimport qualified Data.Map as Map
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian MaedershowRefTree :: LibFunc
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian MaedershowRefTree gInfo = do
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder graph <- newIORef daVinciSort
c13568ba2a02ef26ef164dfa432efc0a01cfa1b8Thiemo Wiedemeyer nodesEdges <- newIORef (([], []) :: NodeEdgeListRef)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder GlobalMenu (UDG.Menu Nothing
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder graphParms = globalMenu $$
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder GraphTitle "Refinement Tree" $$
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder OptimiseLayout True $$
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder AllowClose (return True) $$
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder emptyGraphParms
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke graph' <- newGraph daVinciSort graphParms
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke addNodesAndEdgesRef gInfo graph' nodesEdges
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder writeIORef graph graph'
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder redraw graph'
9035db0b84603cb494e48ec767f138641d389ca0Christian Maedertype NodeEdgeListRef = ([DaVinciNode Int], [DaVinciArc (IO RTLinkLab)])
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnketype NodeEdgeListDep = ([DaVinciNode DiagNodeLab], [DaVinciArc (IO String)])
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaederaddNodesAndEdgesRef :: GInfo -> DaVinciGraphTypeSyn ->
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder IORef NodeEdgeListRef -> IO ()
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian MaederaddNodesAndEdgesRef gInfo@(GInfo { hetcatsOpts = opts}) graph nodesEdges = do
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder ost <- readIORef $ intState gInfo
9035db0b84603cb494e48ec767f138641d389ca0Christian Maeder case i_state ost of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Nothing -> return ()
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder Just ist -> do
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder le = i_libEnv ist
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder lookup' x y = Map.findWithDefault (error "lookup': node not found") y x
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder dg = lookup' le $ i_ln ist
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder rTree = refTree dg
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder vertexes = map fst $ Tree.labNodes rTree
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder subNodeMenu = LocalMenu (UDG.Menu Nothing [
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Button "Show dependency diagram" $ showDiagram gInfo dg,
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder Button "Show spec" $ showSpec dg,
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Button "Check consistency" $ checkCons gInfo])
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder subNodeTypeParms = subNodeMenu $$$
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder ValueTitle (return . rtn_name . labRT dg) $$$
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder Color (getColor opts Green True True) $$$
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder emptyNodeTypeParms
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder subNodeType <- newNodeType graph subNodeTypeParms
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder subNodeList <- mapM (newNode graph subNodeType) vertexes
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder nodes' = Map.fromList $ zip (Tree.nodes rTree) subNodeList
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke subArcMenu = LocalMenu (UDG.Menu Nothing [])
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder subArcTypeParms = subArcMenu $$$
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder ValueTitle (return $ return "") $$$
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder Color (getColor opts Black False False) $$$
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder emptyArcTypeParms
72f14a81f43b46483faa0fad38b7b067f50fa5aeChristian Maeder subArcTypeParmsT = subArcMenu $$$
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder ValueTitle (return $ return "") $$$
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Color (getColor opts Blue False False) $$$
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder emptyArcTypeParms
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder subArcTypeParmsR = subArcMenu $$$
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder ValueTitle (return $ return "") $$$
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Color (getColor opts Coral False False) $$$
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke emptyArcTypeParms
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder subArcType <- newArcType graph subArcTypeParms
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let insertSubArc (n1, n2, e) = newArc graph subArcType
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder (lookup' nodes' n1)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (lookup' nodes' n2)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder subArcList <- mapM insertSubArc $
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder filter (\ (_, _, e) -> rtl_type e == RTComp) arcs
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder subArcTypeT <- newArcType graph subArcTypeParmsT
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let insertSubArcT (n1, n2, e) = newArc graph subArcTypeT
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (lookup' nodes' n1)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (lookup' nodes' n2)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder subArcListT <- mapM insertSubArcT $
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder filter (\ (_, _, _e) -> False) -- TODO: it was easier
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder subArcTypeR <- newArcType graph subArcTypeParmsR
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let insertSubArcR (n1, n2, e) = newArc graph subArcTypeR
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (lookup' nodes' n1)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (lookup' nodes' n2)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder subArcListR <- mapM insertSubArcR $
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder filter (\ (_, _, e) -> rtl_type e == RTRefine) arcs
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder writeIORef nodesEdges (subNodeList, subArcList ++ subArcListT
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder ++ subArcListR)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedercheckCons :: GInfo -> Int -> IO ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedercheckCons gInfo n = do
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder lockGlobal gInfo
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder checkConsAux gInfo [n]
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedercheckConsAux :: GInfo -> [Int] -> IO ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedercheckConsAux gInfo [] = unlockGlobal gInfo
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedercheckConsAux gInfo (n : ns) = do
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke ost <- readIORef $ intState gInfo
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder case i_state ost of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke Nothing -> return ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Just ist -> do
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder le = i_libEnv ist
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder lookup' x y = Map.findWithDefault (error "lookup': node not found") y x
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke dg = lookup' le $ i_ln ist
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke rtlab = labRT dg n
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder rt = refTree dg
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke changeConsStatus x = let
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder oldLab = labDG dg x
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder oldNInfo = nodeInfo oldLab
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder newLab = oldLab {nodeInfo = case oldNInfo of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder DGNode o _ -> DGNode o $ mkConsStatus Cons
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke _ -> oldNInfo}
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder in [SetNodeLab oldLab (x, newLab)]
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke consLinks (s, t, l) = let
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder l' = l {dgl_type = case dgl_type l of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder ScopedLink a b _ ->
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder ScopedLink a b $ mkConsStatus Cons
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder in [DeleteEdge (s, t, l), InsertEdge (s, t, l')]
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder updateDG changes = do
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let dg' = changesDGH dg changes
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder history = snd $ splitHistory dg dg'
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder le' = Map.insert (i_ln ist) dg' le
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder lln = map DgCommandChange $ calcGlobalHistory le le'
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder nst = add2history HelpCmd ost lln
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder nwst = nst { i_state = Just ist { i_libEnv = le'}}
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke doDump (hetcatsOpts gInfo) "PrintHistory" $ do
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder putStrLn "History"
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder print $ prettyHistory history
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder writeIORef (intState gInfo) nwst
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke updateGraph gInfo (reverse $ flatHistory history)
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder case rtn_type rtlab of
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke RTRef n' -> checkConsAux gInfo $ n' : ns
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder RTPlain usig ->
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let units = map (\ (_, x, _) -> x) $
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder filter (\ (_ss, _tt, ll) -> rtl_type ll == RTComp) $ out rt n
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke in case units of
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder [] -> -- n is itself a unit, insert obligation
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder UnitSig [] nsig _ -> do -- non-parametric unit, change node
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let gn = getNode nsig
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder changes = changeConsStatus gn
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder updateDG changes
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder checkConsAux gInfo ns
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder UnitSig _ _ Nothing -> error "consCheck2"
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder UnitSig _nsigs nsig (Just usig') -> do
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let ss = getNode usig'
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke tt = getNode nsig
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder lEdges = filter (\ (x, y, _) -> x == ss && y == tt)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $ labEdges $ dgBody dg
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder ll = if null lEdges then
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke error "consCheck1"
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder else head lEdges -- parametric unit, change edge
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke changes = consLinks ll
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder updateDG changes
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder checkConsAux gInfo ns
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder _ -> checkConsAux gInfo $ units ++ ns
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowSpec :: DGraph -> Int -> IO ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowSpec dg n =
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder createTextDisplay "" (show $ labRT dg n)
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeshowDiagram :: GInfo -> DGraph -> Int -> IO ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowDiagram gInfo dg n = do
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let asDiags = archSpecDiags dg
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder rtlab = labRT dg n
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder name = rtn_name rtlab
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder when (name `elem` Map.keys asDiags) $ do
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke graph <- newIORef daVinciSort
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke nodesEdges <- newIORef (([], []) :: NodeEdgeListDep)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder GlobalMenu (UDG.Menu Nothing
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder graphParms = globalMenu $$
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder GraphTitle ("Dependency Diagram for " ++ name) $$
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder OptimiseLayout True $$
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke AllowClose (return True) $$
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder emptyGraphParms
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke graph' <- newGraph daVinciSort graphParms
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder addNodesAndEdgesDeps dg (Map.findWithDefault (error "showDiagram")
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder name asDiags)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder graph' gInfo nodesEdges
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder writeIORef graph graph'
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder redraw graph'
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowDiagSpec :: DGraph -> DiagNodeLab -> IO ()
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaedershowDiagSpec dg l = do
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let NodeSig n _ = dn_sig l
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke nlab = labDG dg n
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder g1 = globOrLocTh nlab
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder createTextDisplay ""
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke $ "Desc:\n" ++ dn_desc l ++ "\n" ++
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke "Sig:\n" ++ showDoc g1 ""
595f414df7684baf190cecdf4a9e0765a0cdf800Christian MaederaddNodesAndEdgesDeps :: DGraph -> Diag -> DaVinciGraphTypeSyn -> GInfo ->
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke IORef NodeEdgeListDep -> IO ()
e0f486fea42710332c1447a57dc3b05fe5f82109Achim MahnkeaddNodesAndEdgesDeps dg diag graph gi nodesEdges = do
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder opts = hetcatsOpts gi
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder lookup' x y = Map.findWithDefault (error "lookup': node not found") y x
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder vertexes = map snd $ Tree.labNodes $ diagGraph diag
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder arcs = Tree.labEdges $ diagGraph diag
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder subNodeMenu = LocalMenu (UDG.Menu Nothing [Button "Show desc and sig" $
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder showDiagSpec dg ])
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder subNodeTypeParms = subNodeMenu $$$
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder ValueTitle (return . (\ x ->
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder take 20 (dn_desc x) ++ "..." )) $$$
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Color (getColor opts Green True True) $$$
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder emptyNodeTypeParms
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke subNodeType <- newNodeType graph subNodeTypeParms
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke subNodeList <- mapM (newNode graph subNodeType) vertexes
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder nodes' = Map.fromList $ zip (Tree.nodes $ diagGraph diag) subNodeList
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke subArcMenu = LocalMenu (UDG.Menu Nothing [])
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke subArcTypeParms = subArcMenu $$$
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder ValueTitle (return $ return "") $$$
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder Color (getColor opts Black False False) $$$
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder emptyArcTypeParms
412e440f8acdbae3df0e2fd12ff078f3f23a2799Christian Maeder subArcType <- newArcType graph subArcTypeParms
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder let insertSubArc (n1, n2, _e) = newArc graph subArcType
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke (lookup' nodes' n1)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder (lookup' nodes' n2)
595f414df7684baf190cecdf4a9e0765a0cdf800Christian Maeder subArcList <- mapM insertSubArc arcs
e0f486fea42710332c1447a57dc3b05fe5f82109Achim Mahnke writeIORef nodesEdges (subNodeList, subArcList)