forked from GitHub/gf-core
started looking at gt -all, not ready
This commit is contained in:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user