summaryrefslogtreecommitdiff
path: root/src/GF/Canon/GFCC/GenGFCC.hs
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2007-10-05 13:38:10 +0000
committeraarne <aarne@cs.chalmers.se>2007-10-05 13:38:10 +0000
commit2905d5552c1530185609fe892e0e9e2c4994ca1d (patch)
tree7b73558c7a1ea5ba21a597fe1a7a8e2f1c0929d6 /src/GF/Canon/GFCC/GenGFCC.hs
parent1b4f7c9741b87f7085f0a8b70034e5ce7cfe668a (diff)
removed Canon/GFCC
Diffstat (limited to 'src/GF/Canon/GFCC/GenGFCC.hs')
-rw-r--r--src/GF/Canon/GFCC/GenGFCC.hs78
1 files changed, 0 insertions, 78 deletions
diff --git a/src/GF/Canon/GFCC/GenGFCC.hs b/src/GF/Canon/GFCC/GenGFCC.hs
deleted file mode 100644
index cd15ae9cf..000000000
--- a/src/GF/Canon/GFCC/GenGFCC.hs
+++ /dev/null
@@ -1,78 +0,0 @@
-module GF.Canon.GFCC.GenGFCC where
-
-import GF.Canon.GFCC.DataGFCC
-import GF.Canon.GFCC.AbsGFCC
-
-import qualified Data.Map as M
-import System.Random
-
--- generate an infinite list of trees exhaustively
-generate :: GFCC -> CId -> [Exp]
-generate gfcc cat = concatMap (\i -> gener i cat) [0..]
- where
- gener 0 c = [Tr (AC f) [] | (f, Typ [] _) <- fns c]
- gener i c = [
- tr |
- (f, Typ cs _) <- fns c,
- let alts = map (gener (i-1)) cs,
- ts <- combinations alts,
- let tr = Tr (AC f) ts,
- depth tr >= i
- ]
- fns cat =
- let fs = maybe [] id $ M.lookup cat $ cats $ abstract gfcc
- in [(f,ty) | f <- fs, Just ty <- [M.lookup f $ funs $ abstract gfcc]]
- depth tr = case tr of
- Tr _ [] -> 1
- Tr _ ts -> maximum (map depth ts) + 1
-
-combinations :: [[a]] -> [[a]]
-combinations t = case t of
- [] -> [[]]
- aa:uu -> [a:u | a <- aa, u <- combinations uu]
-
--- generate an infinite list of trees randomly
-generateRandom :: StdGen -> GFCC -> CId -> [Exp]
-generateRandom gen gfcc cat = genTrees (randomRs (0.0, 1.0) gen) cat where
-
- timeout = 47 -- give up
-
- genTrees ds0 cat =
- let (ds,ds2) = splitAt (timeout+1) ds0 -- for time out, else ds
- (t,k) = genTree ds cat
- in (if k>timeout then id else (t:))
- (genTrees ds2 cat) -- else (drop k ds)
-
- genTree rs = gett rs where
- gett ds (CId "String") = (Tr (AS "foo") [], 1)
- gett ds (CId "Int") = (Tr (AI 12345) [], 1)
- gett [] _ = (Tr (AS "TIMEOUT") [], 1) ----
- gett ds cat = case fns cat of
- [] -> (Tr AM [],1)
- fs -> let
- d:ds2 = ds
- (f,args) = getf d fs
- (ts,k) = getts ds2 args
- in (Tr (AC f) ts, k+1)
- getf d fs = let lg = (length fs) in
- fs !! (floor (d * fromIntegral lg))
- getts ds cats = case cats of
- c:cs -> let
- (t, k) = gett ds c
- (ts,ks) = getts (drop k ds) cs
- in (t:ts, k + ks)
- _ -> ([],0)
-
- fns cat =
- let fs = maybe [] id $ M.lookup cat $ cats $ abstract gfcc
- in [(f,cs) | f <- fs,
- Just (Typ cs _) <- [M.lookup f $ funs $ abstract gfcc]]
-
--- brute-force parsing method; only returns the first result
--- note: you cannot throw away rules with unknown words from the grammar
--- because it is not known which field in each rule may match the input
-
-parse :: Int -> GFCC -> CId -> [String] -> [Exp]
-parse i gfcc cat ws = [t | t <- gen, s <- lins t, words s == ws] where
- gen = take i $ generate gfcc cat
- lins t = [linearize gfcc lang t | lang <- cncnames gfcc]