diff --git a/doc/gf-history.html b/doc/gf-history.html index 5a50baa46..71306c798 100644 --- a/doc/gf-history.html +++ b/doc/gf-history.html @@ -25,6 +25,7 @@ weight random generation (gr -prob) and to rank parse results (p -prob). They are read from a separate file (flag i -probs=File, format --# prob Fun Double) or from the top-level grammar file itself (option i -prob). +To see the probabilities, use pg -printer=probs.
As a by-product, the probabilistic random generation algorithm is available for any context-free abstract syntax. Use the flag diff --git a/examples/TWA.cf b/examples/TWA.cf index 32ae7b73f..bb23fbd01 100644 --- a/examples/TWA.cf +++ b/examples/TWA.cf @@ -49,5 +49,5 @@ I. Pro ::= "I" ; --# prob 0.60 -- [0.15, 0.40,0.40, 0.40, 0.05, 0.30, 0.35, 0.40, 0.05, 0.75, 0.50] -- -- J&M have different figures, but they seem to be wrong. For --- instance, the products have 12 terms although the trees have only +-- instance, their products have 12 terms although the trees have only -- 11 constructors. diff --git a/grammars/health/HealthEng.gf b/grammars/health/HealthEng.gf index b834d8020..73341879e 100644 --- a/grammars/health/HealthEng.gf +++ b/grammars/health/HealthEng.gf @@ -1,6 +1,9 @@ -- use this path to read the grammar from the same directory --# -path=.:../../lib/resource-0.6/abstract:../prelude:../../lib/resource-0.6/english -concrete HealthEng of Health = open PredicationEng, ResourceEng, ResourceExtEng, Prelude, Predef, SyntaxEng, ExtraEng, ParadigmsEng in { +concrete HealthEng of Health = open PredicationEng, +StructuralEng, +--ResourceEng, +ResourceExtEng, Prelude, Predef, SyntaxEng, ExtraEng, ParadigmsEng in { flags startcat=Phr ; lexer=text ; parser=chart ; unlexer=text ; diff --git a/src/GF/Grammar/Compute.hs b/src/GF/Grammar/Compute.hs index 9920a8f6f..26409ce27 100644 --- a/src/GF/Grammar/Compute.hs +++ b/src/GF/Grammar/Compute.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/06/14 20:09:57 $ +-- > CVS $Date: 2005/11/01 15:39:12 $ -- > CVS $Author: aarne $ --- > CVS $Revision: 1.18 $ +-- > CVS $Revision: 1.19 $ -- -- Computation of source terms. Used in compilation and in @cc@ command. ----------------------------------------------------------------------------- @@ -81,8 +81,8 @@ computeTermOpt rec gr = comp where case (f',a') of (Abs x b,_) -> comp (ext x a' g) b (QC _ _,_) -> returnC $ App f' a' - (FV fs, _) -> mapM (\c -> comp g (App c a')) fs >>= return . FV - (_, FV as) -> mapM (\c -> comp g (App f' c)) as >>= return . FV + (FV fs, _) -> mapM (\c -> comp g (App c a')) fs >>= return . variants + (_, FV as) -> mapM (\c -> comp g (App f' c)) as >>= return . variants (Alias _ _ d, _) -> comp g (App d a') @@ -100,7 +100,7 @@ computeTermOpt rec gr = comp where P t l -> do t' <- comp g t case t' of - FV rs -> mapM (\c -> comp g (P c l)) rs >>= returnC . FV + FV rs -> mapM (\c -> comp g (P c l)) rs >>= returnC . variants R r -> maybe (prtBad "no value for label" l) (comp g . snd) $ lookup l $ reverse r @@ -132,21 +132,21 @@ computeTermOpt rec gr = comp where T _ [(PV z,c)] -> comp (ext z v' g) c --- another optimization T _ [(PT _ (PV z),c)] -> comp (ext z v' g) c - FV ccs -> mapM (\c -> comp g (S c v')) ccs >>= returnC . FV + FV ccs -> mapM (\c -> comp g (S c v')) ccs >>= returnC . variants V ptyp ts -> do vs <- allParamValues gr ptyp ps <- mapM term2patt vs let cc = zip ps ts case v' of - FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . FV + FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . variants _ -> case matchPattern cc v' of Ok (c,g') -> comp (g' ++ g) c _ | isCan v' -> prtBad ("missing case" +++ prt v' +++ "in") t _ -> return $ S t' v' -- if v' is not canonical T _ cc -> case v' of - FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . FV + FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . variants _ -> case matchPattern cc v' of Ok (c,g') -> comp (g' ++ g) c _ | isCan v' -> prtBad ("missing case" +++ prt v' +++ "in") t @@ -189,10 +189,10 @@ computeTermOpt rec gr = comp where ] (FV ks,_) -> do kys <- mapM (comp g . flip Glue y) ks - return $ FV kys + return $ variants kys (_,FV ks) -> do xks <- mapM (comp g . Glue x) ks - return $ FV xks + return $ variants xks _ -> do mapM_ checkNoArgVars [x,y] @@ -220,7 +220,7 @@ computeTermOpt rec gr = comp where _ -> returnC $ C a' b' -- reduce free variation as much as you can - FV [t] -> comp g t + FV ts -> mapM (comp g) ts >>= returnC . variants -- merge record extensions if you can ExtR r s -> do @@ -278,8 +278,9 @@ computeTermOpt rec gr = comp where returnC = return --- . computed - variants [t] = t - variants ts = FV ts + variants ts = case nub ts of + [t] -> t + ts -> FV ts isCan v = case v of Con _ -> True