+ 6/10 (AR) New commands dc = define_command and dt = define_tree to define macros in a GF session. See help for details and examples. diff --git a/src/GF/API.hs b/src/GF/API.hs index d9c9afe49..b0953e083 100644 --- a/src/GF/API.hs +++ b/src/GF/API.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/06/02 17:31:57 $ +-- > CVS $Date: 2005/10/12 12:38:29 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.37 $ +-- > CVS $Revision: 1.38 $ -- -- Application Programmer's Interface to GF; also used by Shell. AR 10/11/2001 ----------------------------------------------------------------------------- @@ -189,14 +189,13 @@ randomTreesIO opts gr n = do generateTrees :: Options -> GFGrammar -> Maybe Tree -> [Tree] generateTrees opts gr mt = optIntOrAll opts flagNumber - [tr | t <- Gen.generateTrees gr' ifm cat dpt mn mt, Ok tr <- [mkTr t]] + [tr | t <- Gen.generateTrees opts gr' cat dpt mn mt, Ok tr <- [mkTr t]] where mkTr = annotate gr' . qualifTerm (absId gr) gr' = grammar gr cat = firstAbsCat opts gr dpt = maybe 3 id $ getOptInt opts flagDepth mn = getOptInt opts flagAlts - ifm = oElem withMetas opts speechGenerate :: Options -> String -> IO () speechGenerate opts str = do diff --git a/src/GF/Grammar/PatternMatch.hs b/src/GF/Grammar/PatternMatch.hs index 79969c2f3..cbf77063d 100644 --- a/src/GF/Grammar/PatternMatch.hs +++ b/src/GF/Grammar/PatternMatch.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/04/21 16:22:26 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.6 $ +-- > CVS $Date: 2005/10/12 12:38:29 $ +-- > CVS $Author: aarne $ +-- > CVS $Revision: 1.7 $ -- -- pattern matching for both concrete and abstract syntax. AR -- 16\/6\/2003 ----------------------------------------------------------------------------- @@ -65,12 +65,14 @@ tryMatch (p,t) = do do matches <- mapM tryMatch (zip pp tt) return (concat matches) (PP q p pp, ([], QC r f, tt)) | - q `eqStrIdent` r && p `eqStrIdent` f && length pp == length tt -> + -- q `eqStrIdent` r && --- not for inherited AR 10/10/2005 + p `eqStrIdent` f && length pp == length tt -> do matches <- mapM tryMatch (zip pp tt) return (concat matches) ---- hack for AppPredef bug (PP q p pp, ([], Q r f, tt)) | - q `eqStrIdent` r && p `eqStrIdent` f && length pp == length tt -> + -- q `eqStrIdent` r && --- + p `eqStrIdent` f && length pp == length tt -> do matches <- mapM tryMatch (zip pp tt) return (concat matches) diff --git a/src/GF/Shell/HelpFile.hs b/src/GF/Shell/HelpFile.hs index b6c1c9a5e..b139ba647 100644 --- a/src/GF/Shell/HelpFile.hs +++ b/src/GF/Shell/HelpFile.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/10/06 14:21:34 $ +-- > CVS $Date: 2005/10/12 12:38:30 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.16 $ +-- > CVS $Revision: 1.17 $ -- -- Help on shell commands. Generated from HelpFile by 'make help'. -- PLEASE DON'T EDIT THIS FILE. @@ -289,6 +289,7 @@ txtHelpFile = "\n -metas also return trees that include metavariables" ++ "\n flags:" ++ "\n -depth generate to this depth (default 3)" ++ + "\n -atoms take this number of atomic rules of each category (default unlimited)" ++ "\n -alts take this number of alternatives at each branch (default unlimited)" ++ "\n -cat generate in this category" ++ "\n -lang use the abstract syntax of this grammar" ++ diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs index b41dc0b69..08996fb5c 100644 --- a/src/GF/Shell/ShellCommands.hs +++ b/src/GF/Shell/ShellCommands.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/10/06 10:02:34 $ +-- > CVS $Date: 2005/10/12 12:38:30 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.41 $ +-- > CVS $Revision: 1.42 $ -- -- The datatype of shell commands and the list of their options. ----------------------------------------------------------------------------- @@ -176,7 +176,7 @@ optionsOfCommand co = case co of CParse -> both "new newer cfg mcfg n ign raw v lines all" "cat lang lexer parser number rawtrees" CTranslate _ _ -> opts "cat lexer parser" CGenerateRandom -> flags "cat lang number depth" - CGenerateTrees -> both "metas" "depth alts cat lang number" + CGenerateTrees -> both "metas one" "depth alts cat lang number" CPutTerm -> flags "transform number" CWrapTerm _ -> opts "c" CMorphoAnalyse -> both "short" "lang" diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs index 8db581d18..ee68c9b3c 100644 --- a/src/GF/UseGrammar/Custom.hs +++ b/src/GF/UseGrammar/Custom.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/10/05 20:02:20 $ +-- > CVS $Date: 2005/10/12 12:38:30 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.77 $ +-- > CVS $Revision: 1.78 $ -- -- A database for customizable GF shell commands. -- @@ -344,7 +344,7 @@ customTermCommand = ,(strCI "generate", \g t -> let gr = grammar g cat = actCat $ tree2loc t --- not needed in - [tr | t <- generateTrees gr False cat 2 Nothing (Just t), + [tr | t <- generateTrees noOptions gr cat 2 Nothing (Just t), Ok tr <- [annotate gr $ MM.qualifTerm (absId g) t]]) ,(strCI "typecheck", \g t -> err (const []) (return . loc2tree) (reCheckStateReject (grammar g) (tree2loc t))) diff --git a/src/GF/UseGrammar/Generate.hs b/src/GF/UseGrammar/Generate.hs index c19435410..941695f8b 100644 --- a/src/GF/UseGrammar/Generate.hs +++ b/src/GF/UseGrammar/Generate.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/05/30 18:39:44 $ +-- > CVS $Date: 2005/10/12 12:38:30 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.15 $ +-- > CVS $Revision: 1.16 $ -- -- Generate all trees of given category and depth. AR 30\/4\/2004 -- @@ -28,6 +28,7 @@ import GF.Grammar.Grammar (Cat) import GF.Data.Operations import GF.Data.Zipper +import GF.Infra.Option import Data.List @@ -39,18 +40,20 @@ import Data.List -- | the main function takes an abstract syntax and returns a list of trees -generateTrees :: GFCGrammar -> Bool -> Cat -> Int -> Maybe Int -> Maybe Tree -> [Exp] -generateTrees gr ifm cat n mn mt = map str2tr $ generate gr' ifm cat' n mn mt' +generateTrees :: Options -> GFCGrammar -> Cat -> Int -> Maybe Int -> Maybe Tree -> [Exp] +generateTrees opts gr cat n mn mt = map str2tr $ generate gr' ifm cat' n mn mt' where - gr' = gr2sgr gr + gr' = gr2sgr ats gr cat' = prt $ snd cat - mt' = maybe Nothing (return . tr2str) mt + mt' = maybe Nothing (return . tr2str) mt + ifm = oElem withMetas opts + ats = getOptInt opts (aOpt "atoms") ------------------------------------------ -- translate grammar to simpler form and generated trees back -gr2sgr :: GFCGrammar -> SGrammar -gr2sgr gr = buildTree [(c,rs) | rs@((_,(_,c)):_) <- rules] where +gr2sgr :: Maybe Int -> GFCGrammar -> SGrammar +gr2sgr un gr = buildTree [(c,rs) | rs@((_,(_,c)):_) <- prune rules] where rules = groupBy (\x y -> scat x == scat y) $ sortBy (\x y -> compare (scat x) (scat y)) @@ -62,6 +65,12 @@ gr2sgr gr = buildTree [(c,rs) | rs@((_,(_,c)):_) <- rules] where trCat (m,c) = prt c --- scat (_,(_,c)) = c + prune rs = maybe rs (\n -> map (onlyAtoms n) rs) $ un + onlyAtoms n rs = + let (rs1,rs2) = partition atom rs + in take n rs1 ++ rs2 + atom = null . fst . snd + -- str2tr :: STree -> Exp str2tr t = case t of SApp (f,ts) -> mkApp (trId f) (map str2tr ts) diff --git a/src/HelpFile b/src/HelpFile index 147bee228..c28a9d2fc 100644 --- a/src/HelpFile +++ b/src/HelpFile @@ -260,6 +260,7 @@ gt, generate_trees: gt Tree? -metas also return trees that include metavariables flags: -depth generate to this depth (default 3) + -atoms take this number of atomic rules of each category (default unlimited) -alts take this number of alternatives at each branch (default unlimited) -cat generate in this category -lang use the abstract syntax of this grammar