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

1 files changed, 20 insertions, 25 deletions

diff --git a/src/PGF/Generate.hs b/src/PGF/Generate.hs
index 94be66245..5add00a78 100644
--- a/src/PGF/Generate.hs
+++ b/src/PGF/Generate.hs
@@ -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]
--}