1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
module GF.Canon.GFCC.GenGFCC where
import GF.Canon.GFCC.DataGFCC
import GF.Canon.GFCC.AbsGFCC
import GF.Data.Operations
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
-- 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]
|
