From 0a43025bbec5c6141d866dec1e9387ef30e12788 Mon Sep 17 00:00:00 2001 From: aarne Date: Sun, 22 Jun 2008 14:15:06 +0000 Subject: [PATCH] added -nofun and -nocat options to vt --- src-3.0/GF/Command/Commands.hs | 15 ++++++++++----- src-3.0/GF/Source/SourceToGrammar.hs | 28 +++++----------------------- src-3.0/PGF/Macros.hs | 3 +++ src-3.0/PGF/VisualizeTree.hs | 18 ++++++++++++------ 4 files changed, 30 insertions(+), 34 deletions(-) diff --git a/src-3.0/GF/Command/Commands.hs b/src-3.0/GF/Command/Commands.hs index 04c47413a..6cdd82d7e 100644 --- a/src-3.0/GF/Command/Commands.hs +++ b/src-3.0/GF/Command/Commands.hs @@ -165,8 +165,8 @@ allCommands pgf = Map.fromList [ synopsis = "generates a list of trees, by default exhaustive", explanation = unlines [ "Generates all trees of a given category, with increasing depth.", - "By default, the depth is inlimited, but this can be changed by a flag." - ---- "If a Tree argument is given, thecommand completes the Tree with values", + "By default, the depth is 4, but this can be changed by a flag." + ---- "If a Tree argument is given, the command completes the Tree with values", ---- "to the metavariables in the tree." ], flags = [ @@ -177,7 +177,7 @@ allCommands pgf = Map.fromList [ ], exec = \opts _ -> do let pgfr = optRestricted opts - let dp = return $ valIntOpts "depth" 999999 opts + let dp = return $ valIntOpts "depth" 4 opts let ts = generateAllDepth pgfr (optCat opts) dp return $ fromTrees $ take (optNumInf opts) ts }), @@ -449,7 +449,9 @@ allCommands pgf = Map.fromList [ "flag -format." ], exec = \opts ts -> do - let grph = visualizeTrees False ts -- True=digraph + let funs = not (isOpt "nofun" opts) + let cats = not (isOpt "nocat" opts) + let grph = visualizeTrees pgf (funs,cats) ts -- True=digraph if isFlag "view" opts || isFlag "format" opts then do let file s = "_grph." ++ s let view = optViewGraph opts ++ " " @@ -463,7 +465,10 @@ allCommands pgf = Map.fromList [ "p \"hello\" | vt -- parse a string and show trees as graph script", "p \"hello\" | vt -view=\"open\" -- parse a string and display trees on a Mac" ], - + options = [ + ("nofun","don't show functions but only categories"), + ("nocat","don't show categories but only functions") + ], flags = [ ("format","format of the visualization file (default \"ps\")"), ("view","program to open the resulting file (default \"gv\")") diff --git a/src-3.0/GF/Source/SourceToGrammar.hs b/src-3.0/GF/Source/SourceToGrammar.hs index 5f785f05c..e80219f30 100644 --- a/src-3.0/GF/Source/SourceToGrammar.hs +++ b/src-3.0/GF/Source/SourceToGrammar.hs @@ -684,7 +684,7 @@ transDDecl x = case x of DDDec binds exp -> transDecl $ DDec binds exp DDExp exp -> transDecl $ DExp exp --- | to deal with the old format, sort judgements in three modules, forming +-- | to deal with the old format, sort judgements in two modules, forming -- their names from a given string, e.g. file name or overriding user-given string transOldGrammar :: Options -> FilePath -> OldGrammar -> Err G.SourceGrammar transOldGrammar opts name0 x = case x of @@ -693,7 +693,7 @@ transOldGrammar opts name0 x = case x of g1 <- transGrammar $ Gr moddefs removeLiT g1 --- needed for bw compatibility with an obsolete feature where - sortTopDefs ds = [mkAbs a,mkRes ops r,mkCnc ops c] ++ map mkPack ps + sortTopDefs ds = [mkAbs a, mkCnc ops (c ++ r)] where ops = map fst ps (a,r,c,ps) = foldr srt ([],[],[],[]) ds @@ -714,14 +714,10 @@ transOldGrammar opts name0 x = case x of DefPrintCat printdefs -> (a,r,d:c,ps) DefPrintFun printdefs -> (a,r,d:c,ps) DefPrintOld printdefs -> (a,r,d:c,ps) - DefPackage m ds -> (a,r,c,(m,ds):ps) + -- DefPackage m ds -> (a,r,c,(m,ds):ps) -- OBSOLETE _ -> (a,r,c,ps) mkAbs a = MModule q (MTAbstract absName) (MBody ne (OpenIn []) (topDefs a)) - mkRes ps r = MModule q (MTResource resName) (MBody ne (OpenIn ops) (topDefs r)) - where ops = map OName ps - mkCnc ps r = MModule q (MTConcrete cncName absName) - (MBody ne (OpenIn (map OName (resName:ps))) (topDefs r)) - mkPack (m, ds) = MModule q (MTResource m) (MBody ne (OpenIn []) (topDefs ds)) + mkCnc ps r = MModule q (MTConcrete cncName absName) (MBody ne (OpenIn []) (topDefs r)) topDefs t = t ne = NoExt q = CMCompl @@ -742,21 +738,7 @@ transOldGrammar opts name0 x = case x of _:s -> (beg, takeWhile (/='.') s) transInclude :: Include -> Err [FilePath] -transInclude x = case x of - NoIncl -> return [] - Incl filenames -> return $ map trans filenames - where - trans f = case f of - FString s -> s - FIdent (PIdent (_, s)) -> modif s - FSlash filename -> '/' : trans filename - FDot filename -> '.' : trans filename - FMinus filename -> '-' : trans filename - FAddId (PIdent (_, s)) filename -> modif s ++ trans filename - modif s = let s' = BS.snoc (BS.init s) (toLower (BS.last s)) in - BS.unpack (if elem (BS.unpack s') newReservedWords then s' else s) - --- unsafe hack ; cf. GetGrammar.oldLexer - +transInclude x = Bad "Old GF with includes no more supported in GF 3.0" newReservedWords :: [String] newReservedWords = diff --git a/src-3.0/PGF/Macros.hs b/src-3.0/PGF/Macros.hs index a680cf0f9..bb5e8188b 100644 --- a/src-3.0/PGF/Macros.hs +++ b/src-3.0/PGF/Macros.hs @@ -34,6 +34,9 @@ lookType :: PGF -> CId -> Type lookType pgf f = fst $ lookMap (error $ "lookType " ++ show f) f (funs (abstract pgf)) +lookValCat :: PGF -> CId -> CId +lookValCat pgf = valCat . lookType pgf + lookParser :: PGF -> CId -> Maybe ParserInfo lookParser pgf lang = Map.lookup lang (concretes pgf) >>= parser diff --git a/src-3.0/PGF/VisualizeTree.hs b/src-3.0/PGF/VisualizeTree.hs index 1bf4dc075..0219dcbde 100644 --- a/src-3.0/PGF/VisualizeTree.hs +++ b/src-3.0/PGF/VisualizeTree.hs @@ -20,12 +20,13 @@ module PGF.VisualizeTree ( visualizeTrees import PGF.CId (prCId) import PGF.Data +import PGF.Macros (lookValCat) -visualizeTrees :: Bool -> [Tree] -> String -visualizeTrees digr = unlines . map (prGraph digr . tree2graph digr) +visualizeTrees :: PGF -> (Bool,Bool) -> [Tree] -> String +visualizeTrees pgf funscats = unlines . map (prGraph False . tree2graph pgf funscats) -tree2graph :: Bool -> Tree -> [String] -tree2graph digr = prf [] where +tree2graph :: PGF -> (Bool,Bool) -> Tree -> [String] +tree2graph pgf (funs,cats) = prf [] where prf ps t = case t of Fun cid trees -> let (nod,lab) = prn ps cid in @@ -33,10 +34,15 @@ tree2graph digr = prf [] where [ pra (j:ps) nod t | (j,t) <- zip [0..] trees] ++ concat [prf (j:ps) t | (j,t) <- zip [0..] trees] prn ps cid = - let lab = "\"" ++ prCId cid ++ "\"" + let + fun = if funs then prCId cid else "" + cat = if cats then prCat cid else "" + colon = if funs && cats then " : " else "" + lab = "\"" ++ fun ++ colon ++ cat ++ "\"" in (show(show (ps :: [Int])),lab) pra i nod t@(Fun cid _) = nod ++ arr ++ fst (prn i cid) ++ " [style = \"solid\"];" - arr = if digr then " -> " else " -- " + arr = " -- " -- if digr then " -> " else " -- " + prCat = prCId . lookValCat pgf prGraph digr ns = concat $ map (++"\n") $ [graph ++ "{\n"] ++ ns ++ ["}"] where graph = if digr then "digraph" else "graph"