started looking at gt -all, not ready

This commit is contained in:
aarne
2006-06-28 12:31:16 +00:00
parent 171e7dec50
commit 538ea8889e
2 changed files with 18 additions and 2 deletions

View File

@@ -28,6 +28,7 @@ import qualified GF.Grammar.MMacros as MMacros
import qualified GF.Compile.GrammarToCanon as GrammarToCanon
import GF.Grammar.Values
import GF.UseGrammar.GetTree
import GF.UseGrammar.Generate (generateAll) ---- should be in API
import GF.UseGrammar.Treebank
import GF.Shell.ShellCommands
@@ -302,6 +303,10 @@ execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case com
_ -> do
ts <- randomTreesIO opts gro (optIntOrN opts flagNumber 1)
returnArg (ATrms ts) sa
CGenerateTrees | oElem showAll opts -> do
let cat = firstAbsCat opts gro
justOutput opts (generateAll opts (putStrLn . prt_) cgr cat) sa
CGenerateTrees -> do
let
a' = case a of

View File

@@ -17,7 +17,7 @@
-- guarantee the correctness of bindings\/dependences.
-----------------------------------------------------------------------------
module GF.UseGrammar.Generate (generateTrees) where
module GF.UseGrammar.Generate (generateTrees,generateAll) where
import GF.Canon.GFC
import GF.Grammar.LookAbs
@@ -29,7 +29,6 @@ import GF.Grammar.SGrammar
import GF.Data.Operations
import GF.Data.Zipper
import GF.Infra.Option
import Data.List
-- Generate all trees of given category and depth. AR 30/4/2004
@@ -48,6 +47,18 @@ generateTrees opts gr cat n mn mt = map str2tr $ generate gr' ifm cat' n mn mt'
mt' = maybe Nothing (return . tr2str) mt
ifm = oElem withMetas opts
generateAll :: Options -> (Exp -> IO ()) -> GFCGrammar -> Cat -> IO ()
generateAll opts io gr cat = mapM_ (io . str2tr) $ gen cat'
where
gr' = gr2sgr opts emptyProbs gr
cat' = prt $ snd cat
gen c = [SApp (f, xs) |
(f,(cs,_)) <- funs c,
xs <- combinations (map gen cs)
]
funs c = errVal [] $ lookupTree id c gr'
------------------------------------------
-- do the main thing with a simpler data structure