gt -atoms

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)