forked from GitHub/gf-core
started looking at gt -all, not ready
This commit is contained in:
@@ -28,6 +28,7 @@ import qualified GF.Grammar.MMacros as MMacros
|
|||||||
import qualified GF.Compile.GrammarToCanon as GrammarToCanon
|
import qualified GF.Compile.GrammarToCanon as GrammarToCanon
|
||||||
import GF.Grammar.Values
|
import GF.Grammar.Values
|
||||||
import GF.UseGrammar.GetTree
|
import GF.UseGrammar.GetTree
|
||||||
|
import GF.UseGrammar.Generate (generateAll) ---- should be in API
|
||||||
import GF.UseGrammar.Treebank
|
import GF.UseGrammar.Treebank
|
||||||
|
|
||||||
import GF.Shell.ShellCommands
|
import GF.Shell.ShellCommands
|
||||||
@@ -302,6 +303,10 @@ execC co@(comm, opts0) sa@(sh@(st,(h,_,_,_)),a) = checkOptions st co >> case com
|
|||||||
_ -> do
|
_ -> do
|
||||||
ts <- randomTreesIO opts gro (optIntOrN opts flagNumber 1)
|
ts <- randomTreesIO opts gro (optIntOrN opts flagNumber 1)
|
||||||
returnArg (ATrms ts) sa
|
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
|
CGenerateTrees -> do
|
||||||
let
|
let
|
||||||
a' = case a of
|
a' = case a of
|
||||||
|
|||||||
@@ -17,7 +17,7 @@
|
|||||||
-- guarantee the correctness of bindings\/dependences.
|
-- 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.Canon.GFC
|
||||||
import GF.Grammar.LookAbs
|
import GF.Grammar.LookAbs
|
||||||
@@ -29,7 +29,6 @@ import GF.Grammar.SGrammar
|
|||||||
import GF.Data.Operations
|
import GF.Data.Operations
|
||||||
import GF.Data.Zipper
|
import GF.Data.Zipper
|
||||||
import GF.Infra.Option
|
import GF.Infra.Option
|
||||||
|
|
||||||
import Data.List
|
import Data.List
|
||||||
|
|
||||||
-- Generate all trees of given category and depth. AR 30/4/2004
|
-- 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
|
mt' = maybe Nothing (return . tr2str) mt
|
||||||
ifm = oElem withMetas opts
|
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
|
-- do the main thing with a simpler data structure
|
||||||
|
|||||||
Reference in New Issue
Block a user