diff options
Diffstat (limited to 'src/GF/UseGrammar')
| -rw-r--r-- | src/GF/UseGrammar/Custom.hs | 6 | ||||
| -rw-r--r-- | src/GF/UseGrammar/Generate.hs | 25 |
2 files changed, 20 insertions, 11 deletions
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) |