diff options
| -rw-r--r-- | src/GF/Infra/Dependencies.hs | 58 | ||||
| -rw-r--r-- | src/GFI.hs | 5 |
2 files changed, 63 insertions, 0 deletions
diff --git a/src/GF/Infra/Dependencies.hs b/src/GF/Infra/Dependencies.hs new file mode 100644 index 000000000..084cfce1c --- /dev/null +++ b/src/GF/Infra/Dependencies.hs @@ -0,0 +1,58 @@ +module GF.Infra.Dependencies ( + depGraph + ) where + +import GF.Grammar.Grammar +import GF.Grammar.PrGrammar +import GF.Infra.Modules +import GF.Infra.Ident + +depGraph :: SourceGrammar -> String +depGraph = prDepGraph . grammar2moddeps + +prDepGraph :: [(Ident,ModDeps)] -> String +prDepGraph deps = unlines $ [ + "digraph {" + ] ++ + map mkNode deps ++ + concatMap mkArrows deps ++ [ + "}" + ] + where + mkNode (i,dep) = unwords [prt i, "[",nodeAttr (modtype dep),"]"] + nodeAttr ty = case ty of + MTAbstract -> "style = \"solid\", shape = \"box\"" + MTConcrete _ -> "style = \"solid\", shape = \"ellipse\"" + _ -> "style = \"dashed\", shape = \"ellipse\"" + mkArrows (i,dep) = + [unwords [prt i,"->",prt j,"[",arrowAttr "of","]"] | j <- ofs dep] ++ + [unwords [prt i,"->",prt j,"[",arrowAttr "ex","]"] | j <- extendeds dep] ++ + [unwords [prt i,"->",prt j,"[",arrowAttr "op","]"] | j <- openeds dep] + arrowAttr s = case s of + "of" -> "style = \"solid\", arrowhead = \"empty\"" + "ex" -> "style = \"solid\"" + "op" -> "style = \"dashed\"" + +data ModDeps = ModDeps { + modtype :: ModuleType Ident, + ofs :: [Ident], + extendeds :: [Ident], + openeds :: [Ident], + functors :: [Ident], + interfaces :: [Ident], + instances :: [Ident] + } + +noModDeps = ModDeps MTAbstract [] [] [] [] [] [] + +grammar2moddeps :: SourceGrammar -> [(Ident,ModDeps)] +grammar2moddeps gr = [(i,depMod m) | (i,ModMod m) <- modules gr] where + depMod m = noModDeps{ + modtype = mtype m, + ofs = case mtype m of + MTConcrete i -> [i] + MTInstance i -> [i] + _ -> [], + extendeds = map fst (extend m), + openeds = map openedModule (opens m) + } diff --git a/src/GFI.hs b/src/GFI.hs index cbc9b5e84..748fcfe55 100644 --- a/src/GFI.hs +++ b/src/GFI.hs @@ -8,6 +8,7 @@ import GF.Command.Abstract import GF.Command.Parse import GF.Data.ErrM import GF.Grammar.API -- for cc command +import GF.Infra.Dependencies import GF.Infra.UseIO import GF.Infra.Option import GF.System.Readline @@ -101,6 +102,10 @@ loop opts gfenv0 = do Ok x -> putStrLn $ enc (showTerm style x) Bad s -> putStrLn $ enc s loopNewCPU gfenv + "dg":ws -> do + writeFile "_gfdepgraph.dot" (depGraph sgr) + putStrLn "wrote graph in file _gfdepgraph.dot" + loopNewCPU gfenv "i":args -> do gfenv' <- case parseOptions args of Ok (opts',files) -> |