GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-07 02:02:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

now the datatype Tree is only internal. All API functions are working with Expr directly. Commands gt, gr, p and rf filter out the output via the typechecker

Browse Source
This commit is contained in:
krasimir
2009-09-08 08:40:28 +00:00
parent 4f878c1f91
commit be3dc0ef9e
23 changed files with 272 additions and 322 deletions
Download Patch File Download Diff File Expand all files Collapse all files

45
src/PGF/Generate.hs
View File

@@ -3,30 +3,37 @@ module PGF.Generate where
import PGF.CId
import PGF.Data
import PGF.Macros
import PGF.TypeCheck
import qualified Data.Map as M
import System.Random
-- generate an infinite list of trees exhaustively
generate :: PGF -> Type -> Maybe Int -> [Tree]
generate pgf (DTyp _ cat _) dp = concatMap (\i -> gener i cat) depths
generate :: PGF -> Type -> Maybe Int -> [Expr]
generate pgf ty@(DTyp _ cat _) dp = filter (\e -> case checkExpr pgf e ty of
Left _ -> False
Right _ -> True )
(concatMap (\i -> gener i cat) depths)
where
gener 0 c = [Fun f [] | (f, ([],_)) <- fns c]
gener 0 c = [EFun f | (f, ([],_)) <- fns c]
gener i c = [
tr |
(f, (cs,_)) <- fns c,
let alts = map (gener (i-1)) cs,
ts <- combinations alts,
let tr = Fun f ts,
let tr = foldl EApp (EFun f) ts,
depth tr >= i
]
fns c = [(f,catSkeleton ty) | (f,ty) <- functionsToCat pgf c]
depths = maybe [0 ..] (\d -> [0..d]) dp
-- generate an infinite list of trees randomly
genRandom :: StdGen -> PGF -> Type -> [Tree]
genRandom gen pgf (DTyp _ cat _) = genTrees (randomRs (0.0, 1.0 :: Double) gen) cat where
genRandom :: StdGen -> PGF -> Type -> [Expr]
genRandom gen pgf ty@(DTyp _ cat _) = filter (\e -> case checkExpr pgf e ty of
Left _ -> False
Right _ -> True )
(genTrees (randomRs (0.0, 1.0 :: Double) gen) cat)
where
timeout = 47 -- give up
genTrees ds0 cat =
@@ -36,17 +43,17 @@ genRandom gen pgf (DTyp _ cat _) = genTrees (randomRs (0.0, 1.0 :: Double) gen)
(genTrees ds2 cat) -- else (drop k ds)
genTree rs = gett rs where
gett ds cid | cid == cidString = (Lit (LStr "foo"), 1)
gett ds cid | cid == cidInt = (Lit (LInt 12345), 1)
gett ds cid | cid == cidFloat = (Lit (LFlt 12345), 1)
gett [] _ = (Lit (LStr "TIMEOUT"), 1) ----
gett ds cid | cid == cidString = (ELit (LStr "foo"), 1)
gett ds cid | cid == cidInt = (ELit (LInt 12345), 1)
gett ds cid | cid == cidFloat = (ELit (LFlt 12345), 1)
gett [] _ = (ELit (LStr "TIMEOUT"), 1) ----
gett ds cat = case fns cat of
[] -> (Meta 0,1)
[] -> (EMeta 0,1)
fs -> let
d:ds2 = ds
(f,args) = getf d fs
(ts,k) = getts ds2 args
in (Fun f ts, k+1)
in (foldl EApp (EFun f) ts, k+1)
getf d fs = let lg = (length fs) in
fs !! (floor (d * fromIntegral lg))
getts ds cats = case cats of
@@ -57,15 +64,3 @@ genRandom gen pgf (DTyp _ cat _) = genTrees (randomRs (0.0, 1.0 :: Double) gen)
_ -> ([],0)
fns cat = [(f,(fst (catSkeleton ty))) | (f,ty) <- functionsToCat pgf cat]
{-
-- 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
searchParse :: Int -> PGF -> CId -> [String] -> [Exp]
searchParse i pgf cat ws = [t | t <- gen, s <- lins t, words s == ws] where
gen = take i $ generate pgf cat
lins t = [linearize pgf lang t | lang <- cncnames pgf]
-}