diff --git a/src/GF/Conversion/TypeGraph.hs b/src/GF/Conversion/TypeGraph.hs new file mode 100644 index 000000000..3a8d9f2d4 --- /dev/null +++ b/src/GF/Conversion/TypeGraph.hs @@ -0,0 +1,55 @@ +---------------------------------------------------------------------- +-- | +-- Maintainer : PL +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/10/05 11:56:42 $ +-- > CVS $Author: peb $ +-- > CVS $Revision: 1.1 $ +-- +-- Printing the type hierarchy of an abstract module in GraphViz format +----------------------------------------------------------------------------- + + +module GF.Conversion.TypeGraph (prtTypeGraph, prtFunctionGraph) where + +import GF.Formalism.GCFG +import GF.Formalism.SimpleGFC +import GF.Formalism.Utilities +import GF.Conversion.Types + +import GF.Data.Operations ((++++), (+++++)) +import GF.Infra.Print + +---------------------------------------------------------------------- +-- | SimpleGFC to TypeGraph +-- +-- assumes that the profiles in the Simple GFC names are trivial + +prtTypeGraph :: SGrammar -> String +prtTypeGraph rules = "digraph TypeGraph {" ++++ + "concentrate=true;" ++++ + "node [shape=ellipse];" +++++ + unlines (map prtTypeGraphRule rules) +++++ + "}" + +prtTypeGraphRule :: SRule -> String +prtTypeGraphRule (Rule (Abs cat cats (Name fun _prof)) _) + = unlines [ prtSCat c ++ " -> " ++ prtSCat cat ++ ";" | c <- cats ] + +prtFunctionGraph :: SGrammar -> String +prtFunctionGraph rules = "digraph FunctionGraph {" ++++ + "node [shape=ellipse];" +++++ + unlines (map prtFunctionGraphRule rules) +++++ + "}" + +prtFunctionGraphRule :: SRule -> String +prtFunctionGraphRule (Rule (Abs cat cats (Name fun _prof)) _) + = prt fun ++ " [shape=box, style=dashed];" ++++ + prt fun ++ " -> " ++ prtSCat cat ++ ";" ++++ + unlines [ prtSCat c ++ " -> " ++ prt fun ++ ";" | c <- cats ] + +prtSCat (Decl var cat args) = prt cat + + diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs index 15e909004..f5ed30009 100644 --- a/src/GF/UseGrammar/Custom.hs +++ b/src/GF/UseGrammar/Custom.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/09/29 13:20:08 $ --- > CVS $Author: aarne $ --- > CVS $Revision: 1.75 $ +-- > CVS $Date: 2005/10/05 11:56:42 $ +-- > CVS $Author: peb $ +-- > CVS $Revision: 1.76 $ -- -- A database for customizable GF shell commands. -- @@ -81,6 +81,7 @@ import qualified GF.Conversion.GFC as Cnv import qualified GF.Conversion.Types as CnvTypes import qualified GF.Conversion.Haskell as CnvHaskell import qualified GF.Conversion.Prolog as CnvProlog +import qualified GF.Conversion.TypeGraph as CnvTypeGraph import GF.Canon.Unparametrize import GF.Canon.Subexpressions @@ -278,6 +279,9 @@ customGrammarPrinter = ,(strCI "pinfo", Prt.prt . statePInfo) ,(strCI "abstract", Prt.prtAfter "\n" . Cnv.gfc2abstract . stateGrammarLang) + ,(strCI "functiongraph",CnvTypeGraph.prtFunctionGraph . uncurry Cnv.gfc2simple . stateGrammarLangOpts) + ,(strCI "typegraph", CnvTypeGraph.prtTypeGraph . uncurry Cnv.gfc2simple . stateGrammarLangOpts) + ,(strCI "gfc-haskell", CnvHaskell.prtSGrammar . uncurry Cnv.gfc2simple . stateGrammarLangOpts) ,(strCI "mcfg-haskell", CnvHaskell.prtMGrammar . stateMCFG) ,(strCI "cfg-haskell", CnvHaskell.prtCGrammar . stateCFG)