mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-20 18:29:33 -06:00
refactor the API for random generation again. Now PGF contains probabilities in the abstract syntax
This commit is contained in:
krasimir
@@ -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')
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
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 (Identity g) where
|
||||
splitSelector (Identity g) = let (g1,g2) = split g
|
||||
in (Identity g1, Identity g2)
|
||||
|
||||
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)
|
||||
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)
|
||||
|
||||
@@ -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) =
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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 =
|
||||
|
||||
@@ -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]
|
||||
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user