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