summaryrefslogtreecommitdiff
path: root/src/GF/Canon/GFCC/GenGFCC.hs
blob: 93c226676f5cfaa111b73dcd355e9573edec6280 (plain)
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
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

-- generate an infinite list of trees
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