refactor the API for random generation again. Now PGF contains probabilities in the abstract syntax

11 files changed, 106 insertions, 112 deletions

diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs
index e71992ecc..c750e66fe 100644
--- a/src/runtime/haskell/PGF.hs
+++ b/src/runtime/haskell/PGF.hs
@@ -105,8 +105,6 @@ module PGF(
            generateFrom,        generateFromDepth,
            generateRandom,      generateRandomDepth,
            generateRandomFrom,  generateRandomFromDepth,
-           
-           RandomSelector(..),           
 
            -- ** Morphological Analysis
            Lemma, Analysis, Morpho,
@@ -269,8 +267,8 @@ functions pgf = Map.keys (funs (abstract pgf))
 
 functionType pgf fun =
   case Map.lookup fun (funs (abstract pgf)) of
-    Just (ty,_,_) -> Just ty
-    Nothing       -> Nothing
+    Just (ty,_,_,_) -> Just ty
+    Nothing         -> Nothing
 
 -- | Converts an expression to normal form
 compute :: PGF -> Expr -> Expr
@@ -280,20 +278,20 @@ browse :: PGF -> CId -> Maybe (String,[CId],[CId])
 browse pgf id = fmap (\def -> (def,producers,consumers)) definition
   where
     definition = case Map.lookup id (funs (abstract pgf)) of
-                   Just (ty,_,Just eqs) -> Just $ render (text "fun" <+> ppCId id <+> colon <+> ppType 0 [] ty $$
-                                                          if null eqs
-                                                            then empty
-                                                            else text "def" <+> vcat [let scope = foldl pattScope [] patts
-                                                                                          ds    = map (ppPatt 9 scope) patts
-                                                                                      in ppCId id <+> hsep ds <+> char '=' <+> ppExpr 0 scope res | Equ patts res <- eqs])
-                   Just (ty,_,Nothing ) -> Just $ render (text "data" <+> ppCId id <+> colon <+> ppType 0 [] ty)
+                   Just (ty,_,Just eqs,_) -> Just $ render (text "fun" <+> ppCId id <+> colon <+> ppType 0 [] ty $$
+                                                            if null eqs
+                                                              then empty
+                                                              else text "def" <+> vcat [let scope = foldl pattScope [] patts
+                                                                                            ds    = map (ppPatt 9 scope) patts
+                                                                                        in ppCId id <+> hsep ds <+> char '=' <+> ppExpr 0 scope res | Equ patts res <- eqs])
+                   Just (ty,_,Nothing, _) -> Just $ render (text "data" <+> ppCId id <+> colon <+> ppType 0 [] ty)
                    Nothing   -> case Map.lookup id (cats (abstract pgf)) of
                                   Just (hyps,_) -> Just $ render (text "cat" <+> ppCId id <+> hsep (snd (mapAccumL (ppHypo 4) [] hyps)))
                                   Nothing       -> Nothing
 
     (producers,consumers) = Map.foldWithKey accum ([],[]) (funs (abstract pgf))
       where
-        accum f (ty,_,_) (plist,clist) = 
+        accum f (ty,_,_,_) (plist,clist) = 
           let !plist' = if id `elem` ps then f : plist else plist
               !clist' = if id `elem` cs then f : clist else clist
           in (plist',clist')
diff --git a/src/runtime/haskell/PGF/Data.hs b/src/runtime/haskell/PGF/Data.hs
index ec119fc0d..f82d33644 100644
--- a/src/runtime/haskell/PGF/Data.hs
+++ b/src/runtime/haskell/PGF/Data.hs
@@ -25,8 +25,8 @@ data PGF = PGF {
 
 data Abstr = Abstr {
   aflags  :: Map.Map CId Literal,                     -- ^ value of a flag
-  funs    :: Map.Map CId (Type,Int,Maybe [Equation]), -- ^ type, arrity and definition of function
-  cats    :: Map.Map CId ([Hypo],[CId])               -- ^ 1. context of a category
+  funs    :: Map.Map CId (Type,Int,Maybe [Equation],Double), -- ^ type, arrity and definition of function + probability
+  cats    :: Map.Map CId ([Hypo],[(Double, CId)])     -- ^ 1. context of a category
                                                       -- ^ 2. functions of a category. The order in the list is important,
                                                       -- this is the order in which the type singatures are given in the source.
                                                       -- The termination of the exhaustive generation might depend on this.
diff --git a/src/runtime/haskell/PGF/Expr.hs b/src/runtime/haskell/PGF/Expr.hs
index 9ab25bbcb..71e35be5e 100644
--- a/src/runtime/haskell/PGF/Expr.hs
+++ b/src/runtime/haskell/PGF/Expr.hs
@@ -318,22 +318,22 @@ data Value
   | VClosure Env Expr

   | VImplArg Value

 

-type Sig = ( Map.Map CId (Type,Int,Maybe [Equation])    -- type and def of a fun

-           , Int -> Maybe Expr                          -- lookup for metavariables

+type Sig = ( Map.Map CId (Type,Int,Maybe [Equation],Double)    -- type and def of a fun

+           , Int -> Maybe Expr                                 -- lookup for metavariables

            )

 type Env = [Value]

 

 eval :: Sig -> Env -> Expr -> Value

 eval sig env (EVar i)     = env !! i

 eval sig env (EFun f)     = case Map.lookup f (fst sig) of

-                              Just (_,a,meqs) -> case meqs of

-                                                   Just eqs -> if a == 0

-                                                                 then case eqs of

-                                                                        Equ [] e : _ -> eval sig [] e

-                                                                        _            -> VConst f []

-                                                                 else VApp f []

-                                                   Nothing  -> VApp f []

-                              Nothing        -> error ("unknown function "++showCId f)

+                              Just (_,a,meqs,_) -> case meqs of

+                                                     Just eqs -> if a == 0

+                                                                   then case eqs of

+                                                                          Equ [] e : _ -> eval sig [] e

+                                                                          _            -> VConst f []

+                                                                   else VApp f []

+                                                     Nothing  -> VApp f []

+                              Nothing           -> error ("unknown function "++showCId f)

 eval sig env (EApp e1 e2) = apply sig env e1 [eval sig env e2]

 eval sig env (EAbs b x e) = VClosure env (EAbs b x e)

 eval sig env (EMeta i)    = case snd sig i of

@@ -347,12 +347,12 @@ apply :: Sig -> Env -> Expr -> [Value] -> Value
 apply sig env e            []     = eval sig env e

 apply sig env (EVar i)     vs     = applyValue sig (env !! i) vs

 apply sig env (EFun f)     vs     = case Map.lookup f (fst sig) of

-                                      Just (_,a,meqs) -> case meqs of

-                                                           Just eqs -> if a <= length vs

-                                                                         then match sig f eqs vs

-                                                                         else VApp f vs

-                                                           Nothing  -> VApp f vs

-                                      Nothing      -> error ("unknown function "++showCId f)

+                                      Just (_,a,meqs,_) -> case meqs of

+                                                             Just eqs -> if a <= length vs

+                                                                           then match sig f eqs vs

+                                                                           else VApp f vs

+                                                             Nothing  -> VApp f vs

+                                      Nothing           -> error ("unknown function "++showCId f)

 apply sig env (EApp e1 e2) vs     = apply sig env e1 (eval sig env e2 : vs)

 apply sig env (EAbs _ x e) (v:vs) = apply sig (v:env) e vs

 apply sig env (EMeta i)    vs     = case snd sig i of

diff --git a/src/runtime/haskell/PGF/Forest.hs b/src/runtime/haskell/PGF/Forest.hs
index 58f0209a8..7a80a5ea8 100644
--- a/src/runtime/haskell/PGF/Forest.hs
+++ b/src/runtime/haskell/PGF/Forest.hs
@@ -72,7 +72,7 @@ bracketedTokn f@(Forest abs cnc forest root) =
                                                  cat = case isLindefCId fun of

                                                          Just cat -> cat

                                                          Nothing  -> case Map.lookup fun (funs abs) of

-                                                                       Just (DTyp _ cat _,_,_) -> cat

+                                                                       Just (DTyp _ cat _,_,_,_) -> cat

                                                  largs  = map (render forest) args

                                                  ltable = mkLinTable cnc isTrusted [] funid largs

                                              in ((cat,fid),either (const []) id $ getAbsTrees f arg Nothing,ltable)

diff --git a/src/runtime/haskell/PGF/Generate.hs b/src/runtime/haskell/PGF/Generate.hs
index 797e5e229..55bfd72d9 100644
--- a/src/runtime/haskell/PGF/Generate.hs
+++ b/src/runtime/haskell/PGF/Generate.hs
@@ -3,8 +3,6 @@ module PGF.Generate
          , generateFrom,        generateFromDepth
          , generateRandom,      generateRandomDepth
          , generateRandomFrom,  generateRandomFromDepth
-         
-         , RandomSelector(..)
          ) where
 
 import PGF.CId
@@ -17,6 +15,7 @@ import PGF.Probabilistic
 import qualified Data.Map as Map
 import qualified Data.IntMap as IntMap
 import Control.Monad
+import Control.Monad.Identity
 import System.Random
 
 -- | Generates an exhaustive possibly infinite list of
@@ -44,24 +43,24 @@ generateFromDepth pgf e dp = generateForMetas False pgf (\ty -> generateAllDepth
 -- | Generates an infinite list of random abstract syntax expressions.
 -- This is usefull for tree bank generation which after that can be used
 -- for grammar testing.
-generateRandom :: RandomGen g => RandomSelector g -> PGF -> Type -> [Expr]
-generateRandom sel pgf ty = 
-    generate sel pgf ty Nothing
+generateRandom :: RandomGen g => g -> PGF -> Type -> [Expr]
+generateRandom g pgf ty = 
+    generate (Identity g) pgf ty Nothing
 
 -- | A variant of 'generateRandom' which also takes as argument
 -- the upper limit of the depth of the generated expression.
-generateRandomDepth :: RandomGen g => RandomSelector g -> PGF -> Type -> Maybe Int -> [Expr]
-generateRandomDepth sel pgf ty dp = generate sel pgf ty dp
+generateRandomDepth :: RandomGen g => g -> PGF -> Type -> Maybe Int -> [Expr]
+generateRandomDepth g pgf ty dp = generate (Identity g) pgf ty dp
 
 -- | Random generation based on template
-generateRandomFrom :: RandomGen g => RandomSelector g -> PGF -> Expr -> [Expr]
-generateRandomFrom sel pgf e = 
-  generateForMetas True pgf (\ty -> generate sel pgf ty Nothing) e
+generateRandomFrom :: RandomGen g => g -> PGF -> Expr -> [Expr]
+generateRandomFrom g pgf e = 
+  generateForMetas True pgf (\ty -> generate (Identity g) pgf ty Nothing) e
 
 -- | Random generation based on template with a limitation in the depth.
-generateRandomFromDepth :: RandomGen g => RandomSelector g -> PGF -> Expr -> Maybe Int -> [Expr]
-generateRandomFromDepth sel pgf e dp = 
-  generateForMetas True pgf (\ty -> generate sel pgf ty dp) e
+generateRandomFromDepth :: RandomGen g => g -> PGF -> Expr -> Maybe Int -> [Expr]
+generateRandomFromDepth g pgf e dp = 
+  generateForMetas True pgf (\ty -> generate (Identity g) pgf ty dp) e
 
 
 
@@ -103,8 +102,8 @@ prove abs scope tty@(TTyp env (DTyp [] cat es)) dp = do
     clauses cat =
       do fn <- select abs cat
          case Map.lookup fn (funs abs) of
-           Just (ty,_,_) -> return (fn,ty)
-           Nothing       -> mzero
+           Just (ty,_,_,_) -> return (fn,ty)
+           Nothing         -> mzero
 
     mkEnv env []                = return (env,[])
     mkEnv env ((bt,x,ty):hypos) = do
@@ -175,46 +174,23 @@ instance Selector () where
                                      Just (_,fns) -> iter s fns
                                      Nothing      -> CFail)
     where
-      iter s []       = CFail
-      iter s (fn:fns) = CBranch (COk () s fn) (iter s fns)
-
--- | The random selector data type is used to specify the random number generator
--- and the distribution among the functions with the same result category.
--- The distribution is even for 'RandSel' and weighted for 'WeightSel'.
-data RandomSelector g = RandSel   g
-                      | WeightSel g Probabilities
-
-instance RandomGen g => Selector (RandomSelector g) where
-  splitSelector (RandSel g)         = let (g1,g2) = split g
-                                      in (RandSel g1, RandSel g2)
-  splitSelector (WeightSel g probs) = let (g1,g2) = split g
-                                      in (WeightSel g1 probs, WeightSel g2 probs)
-
-  select abs cat = GenM (\sel s -> case sel of
-                                     RandSel g         -> case Map.lookup cat (cats abs) of
-                                                            Just (_,fns) -> do_rand   g s (length fns) fns
-                                                            Nothing      -> CFail
-                                     WeightSel g probs -> case Map.lookup cat (catProbs probs) of
-                                                            Just fns     -> do_weight g s 1.0 fns
-                                                            Nothing      -> CFail)
+      iter s []           = CFail
+      iter s ((_,fn):fns) = CBranch (COk () s fn) (iter s fns)
+
+instance RandomGen g => Selector (Identity g) where
+  splitSelector (Identity g) = let (g1,g2) = split g
+                               in (Identity g1, Identity g2)
+
+  select abs cat = GenM (\(Identity g) s ->
+                                      case Map.lookup cat (cats abs) of
+                                        Just (_,fns) -> do_rand g s 1.0 fns
+                                        Nothing      -> CFail)
     where
-      do_rand g s n []  = CFail
-      do_rand g s n fns = let n'        = n-1
-                              (i,g')    = randomR (0,n') g
+      do_rand g s p []  = CFail
+      do_rand g s p fns = let (d,g')    = randomR (0.0,p) g
                               (g1,g2)   = split g'
-                              (fn,fns') = pick i fns
-                          in CBranch (COk (RandSel g1) s fn) (do_rand g2 s n' fns')
-
-      do_weight g s p []  = CFail
-      do_weight g s p fns = let (d,g')    = randomR (0.0,p) g
-                                (g1,g2)   = split g'
-                                (p',fn,fns') = hit d fns
-                            in CBranch (COk (RandSel g1) s fn) (do_weight g2 s (p-p') fns')
-
-      pick :: Int -> [a] -> (a,[a])
-      pick 0 (x:xs) = (x,xs)
-      pick n (x:xs) = let (x',xs') = pick (n-1) xs
-                      in (x',x:xs')
+                              (p',fn,fns') = hit d fns
+                          in CBranch (COk (Identity g1) s fn) (do_rand g2 s (p-p') fns')
 
       hit :: Double -> [(Double,a)] -> (Double,a,[(Double,a)])
       hit d (px@(p,x):xs)
diff --git a/src/runtime/haskell/PGF/Linearize.hs b/src/runtime/haskell/PGF/Linearize.hs
index 1daeb50f6..49cc4564c 100644
--- a/src/runtime/haskell/PGF/Linearize.hs
+++ b/src/runtime/haskell/PGF/Linearize.hs
@@ -96,7 +96,7 @@ linTree pgf lang e =
             Nothing        -> concat [toApp fid prod | (fid,set) <- IntMap.toList prods, prod <- Set.toList set]
           where
             toApp fid (PApply funid pargs) =
-              let Just (ty,_,_) = Map.lookup f (funs (abstract pgf))
+              let Just (ty,_,_,_) = Map.lookup f (funs (abstract pgf))
                   (args,res) = catSkeleton ty
               in [(funid,(res,fid),zip args [fid | PArg _ fid <- pargs])]
             toApp _   (PCoerce fid) = 
diff --git a/src/runtime/haskell/PGF/Macros.hs b/src/runtime/haskell/PGF/Macros.hs
index ae984cfdf..40c2a754f 100644
--- a/src/runtime/haskell/PGF/Macros.hs
+++ b/src/runtime/haskell/PGF/Macros.hs
@@ -21,18 +21,18 @@ mapConcretes f pgf = pgf { concretes = Map.map f (concretes pgf) }
 lookType :: PGF -> CId -> Type
 lookType pgf f = 
   case lookMap (error $ "lookType " ++ show f) f (funs (abstract pgf)) of
-    (ty,_,_) -> ty
+    (ty,_,_,_) -> ty
 
 lookDef :: PGF -> CId -> Maybe [Equation]
 lookDef pgf f = 
   case lookMap (error $ "lookDef " ++ show f) f (funs (abstract pgf)) of
-    (_,a,eqs) -> eqs
+    (_,a,eqs,_) -> eqs
 
 isData :: PGF -> CId -> Bool
 isData pgf f =
   case Map.lookup f (funs (abstract pgf)) of
-    Just (_,_,Nothing) -> True             -- the encoding of data constrs
-    _                  -> False
+    Just (_,_,Nothing,_) -> True             -- the encoding of data constrs
+    _                    -> False
 
 lookValCat :: PGF -> CId -> CId
 lookValCat pgf = valCat . lookType pgf
@@ -65,7 +65,7 @@ lookConcrFlag pgf lang f = Map.lookup f $ cflags $ lookConcr pgf lang
 
 functionsToCat :: PGF -> CId -> [(CId,Type)]
 functionsToCat pgf cat =
-  [(f,ty) | f <- fs, Just (ty,_,_) <- [Map.lookup f $ funs $ abstract pgf]]
+  [(f,ty) | (_,f) <- fs, Just (ty,_,_,_) <- [Map.lookup f $ funs $ abstract pgf]]
  where 
    (_,fs) = lookMap ([],[]) cat $ cats $ abstract pgf
 
@@ -81,7 +81,7 @@ restrictPGF :: (CId -> Bool) -> PGF -> PGF
 restrictPGF cond pgf = pgf {
   abstract = abstr {
     funs = Map.filterWithKey (\c _ -> cond c) (funs abstr),
-    cats = Map.map (\(hyps,fs) -> (hyps,filter cond fs)) (cats abstr)
+    cats = Map.map (\(hyps,fs) -> (hyps,filter (cond . snd) fs)) (cats abstr)
     }
   }  ---- restrict concrs also, might be needed
  where
diff --git a/src/runtime/haskell/PGF/Paraphrase.hs b/src/runtime/haskell/PGF/Paraphrase.hs
index 3835b73c7..8213518ff 100644
--- a/src/runtime/haskell/PGF/Paraphrase.hs
+++ b/src/runtime/haskell/PGF/Paraphrase.hs
@@ -53,7 +53,7 @@ fromDef pgf t@(Fun f ts) = defDown t ++ defUp t where
               isClosed d || (length equs == 1 && isLinear d)]
 
   equss = [(f,[(Fun f (map patt2tree ps), expr2tree d) | (Equ ps d) <- eqs]) | 
-                       (f,(_,_,Just eqs)) <- Map.assocs (funs (abstract pgf)), not (null eqs)]
+                       (f,(_,_,Just eqs,_)) <- Map.assocs (funs (abstract pgf)), not (null eqs)]
 
   trequ s f e = True ----trace (s ++ ": " ++ show f ++ "  " ++ show e) True
 
diff --git a/src/runtime/haskell/PGF/Printer.hs b/src/runtime/haskell/PGF/Printer.hs
index ae23b96da..a7a34bc00 100644
--- a/src/runtime/haskell/PGF/Printer.hs
+++ b/src/runtime/haskell/PGF/Printer.hs
@@ -28,17 +28,17 @@ ppAbs name a = text "abstract" <+> ppCId name <+> char '{' $$
 ppFlag :: CId -> Literal -> Doc
 ppFlag flag value = text "flag" <+> ppCId flag <+> char '=' <+> ppLit value <+> char ';'
 
-ppCat :: CId -> ([Hypo],[CId]) -> Doc
+ppCat :: CId -> ([Hypo],[(Double,CId)]) -> Doc
 ppCat c (hyps,_) = text "cat" <+> ppCId c <+> hsep (snd (mapAccumL (ppHypo 4) [] hyps)) <+> char ';'
 
-ppFun :: CId -> (Type,Int,Maybe [Equation]) -> Doc
-ppFun f (t,_,Just eqs) = text "fun" <+> ppCId f <+> colon <+> ppType 0 [] t <+> char ';' $$
-                         if null eqs
-                           then empty
-                           else text "def" <+> vcat [let scope = foldl pattScope [] patts
-                                                         ds    = map (ppPatt 9 scope) patts
-                                                     in ppCId f <+> hsep ds <+> char '=' <+> ppExpr 0 scope res <+> char ';' | Equ patts res <- eqs]
-ppFun f (t,_,Nothing)  = text "data" <+> ppCId f <+> colon <+> ppType 0 [] t <+> char ';'
+ppFun :: CId -> (Type,Int,Maybe [Equation],Double) -> Doc
+ppFun f (t,_,Just eqs,_) = text "fun" <+> ppCId f <+> colon <+> ppType 0 [] t <+> char ';' $$
+                           if null eqs
+                             then empty
+                             else text "def" <+> vcat [let scope = foldl pattScope [] patts
+                                                           ds    = map (ppPatt 9 scope) patts
+                                                       in ppCId f <+> hsep ds <+> char '=' <+> ppExpr 0 scope res <+> char ';' | Equ patts res <- eqs]
+ppFun f (t,_,Nothing,_)  = text "data" <+> ppCId f <+> colon <+> ppType 0 [] t <+> char ';'
 
 ppCnc :: Language -> Concr -> Doc
 ppCnc name cnc =
diff --git a/src/runtime/haskell/PGF/Probabilistic.hs b/src/runtime/haskell/PGF/Probabilistic.hs
index a256983c9..873f17be4 100644
--- a/src/runtime/haskell/PGF/Probabilistic.hs
+++ b/src/runtime/haskell/PGF/Probabilistic.hs
@@ -2,6 +2,8 @@ module PGF.Probabilistic
          ( Probabilities(..)
          , mkProbabilities                 -- :: PGF -> M.Map CId Double -> Probabilities
          , defaultProbabilities            -- :: PGF -> Probabilities
+         , getProbabilities
+         , setProbabilities
          , showProbabilities               -- :: Probabilities -> String
          , readProbabilitiesFromFile       -- :: FilePath -> PGF -> IO Probabilities
 
@@ -15,7 +17,7 @@ import PGF.Macros
 
 import qualified Data.Map as Map
 import Data.List (sortBy,partition)
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, fromJust)
 
 -- | An abstract data structure which represents
 -- the probabilities for the different functions in a grammar.
@@ -51,7 +53,7 @@ mkProbabilities pgf probs =
       cats1 = Map.map (\(_,fs) -> fill fs) (cats (abstract pgf))
   in Probs funs1 cats1
   where
-    fill fs = pad [(Map.lookup f probs,f) | f <- fs]
+    fill fs = pad [(Map.lookup f probs,f) | (_,f) <- fs]
       where
         pad :: [(Maybe Double,a)] -> [(Double,a)]
         pad pfs = [(fromMaybe deflt mb_p,f) | (mb_p,f) <- pfs]
@@ -64,16 +66,34 @@ mkProbabilities pgf probs =
 defaultProbabilities :: PGF -> Probabilities
 defaultProbabilities pgf = mkProbabilities pgf Map.empty
 
+getProbabilities :: PGF -> Probabilities
+getProbabilities pgf = Probs {
+  funProbs = Map.map (\(_,_,_,p) -> p) (funs (abstract pgf)),
+  catProbs = Map.map (\(_,fns) -> fns) (cats (abstract pgf))
+  }
+
+setProbabilities :: Probabilities -> PGF -> PGF
+setProbabilities probs pgf = pgf {
+  abstract = (abstract pgf) {
+    funs = mapUnionWith (\(ty,a,df,_) p -> (ty,a,df,p)) (funs (abstract pgf)) (funProbs probs),
+    cats = mapUnionWith (\(hypos,_) fns -> (hypos,fns)) (cats (abstract pgf)) (catProbs probs)
+  }}
+  where
+    mapUnionWith f map1 map2 = 
+      Map.mapWithKey (\k v -> f v (fromJust (Map.lookup k map2))) map1
+
 -- | compute the probability of a given tree
-probTree :: Probabilities -> Expr -> Double
-probTree probs t = case t of
-  EApp f e -> probTree probs f * probTree probs e
-  EFun f   -> maybe 1 id $ Map.lookup f (funProbs probs)
+probTree :: PGF -> Expr -> Double
+probTree pgf t = case t of
+  EApp f e -> probTree pgf f * probTree pgf e
+  EFun f   -> case Map.lookup f (funs (abstract pgf)) of
+                Just (_,_,_,p) -> p
+                Nothing        -> 1
   _ -> 1
 
 -- | rank from highest to lowest probability
-rankTreesByProbs :: Probabilities -> [Expr] -> [(Expr,Double)]
-rankTreesByProbs probs ts = sortBy (\ (_,p) (_,q) -> compare q p) 
-  [(t, probTree probs t) | t <- ts]
+rankTreesByProbs :: PGF -> [Expr] -> [(Expr,Double)]
+rankTreesByProbs pgf ts = sortBy (\ (_,p) (_,q) -> compare q p) 
+  [(t, probTree pgf t) | t <- ts]
 
 
diff --git a/src/runtime/haskell/PGF/TypeCheck.hs b/src/runtime/haskell/PGF/TypeCheck.hs
index 359a188a7..d95e50c5e 100644
--- a/src/runtime/haskell/PGF/TypeCheck.hs
+++ b/src/runtime/haskell/PGF/TypeCheck.hs
@@ -101,8 +101,8 @@ lookupCatHyps cat = TcM (\abstr ms -> case Map.lookup cat (cats abstr) of
 
 lookupFunType :: CId -> TcM TType
 lookupFunType fun = TcM (\abstr ms -> case Map.lookup fun (funs abstr) of
-                                        Just (ty,_,_) -> Ok ms (TTyp [] ty)
-                                        Nothing       -> Fail (UnknownFun fun))
+                                        Just (ty,_,_,_) -> Ok ms (TTyp [] ty)
+                                        Nothing         -> Fail (UnknownFun fun))
 
 newMeta :: Scope -> TType -> TcM MetaId
 newMeta scope tty = TcM (\abstr ms -> let metaid = IntMap.size ms + 1