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

6 files changed, 22 insertions, 25 deletions

diff --git a/src/compiler/GF/Compile/ExampleBased.hs b/src/compiler/GF/Compile/ExampleBased.hs
index 20fa4d62f..46fb8b5d7 100644
--- a/src/compiler/GF/Compile/ExampleBased.hs
+++ b/src/compiler/GF/Compile/ExampleBased.hs
@@ -59,9 +59,7 @@ convertFile conf src file = do
                     appn t >> mapM_ (appn . ("  --- " ++)) tt >> return []
     appn ")"
     return ws
-  rank ts = case probs conf of
-    Just probs -> [showExpr [] t ++ "  -- " ++ show p | (t,p) <- rankTreesByProbs probs ts]
-    _ -> map (showExpr []) ts
+  rank ts = [showExpr [] t ++ "  -- " ++ show p | (t,p) <- rankTreesByProbs pgf ts]
   appf = appendFile file
   appn s = appf s >> appf "\n"
   appv s = appn ("--- " ++ s) >> putStrLn s
@@ -69,11 +67,10 @@ convertFile conf src file = do
 data ExConfiguration = ExConf {
   resource_pgf    :: PGF,
   resource_morpho :: Morpho,
-  probs    :: Maybe Probabilities,
   verbose  :: Bool,
   language :: Language
   }
 
-configureExBased :: PGF -> Morpho -> Maybe Probabilities -> Language -> ExConfiguration
-configureExBased pgf morpho mprobs lang = ExConf pgf morpho mprobs False lang
+configureExBased :: PGF -> Morpho -> Language -> ExConfiguration
+configureExBased pgf morpho lang = ExConf pgf morpho False lang
 
diff --git a/src/compiler/GF/Compile/GrammarToPGF.hs b/src/compiler/GF/Compile/GrammarToPGF.hs
index 9b0f9293d..05ec88e72 100644
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -57,14 +57,14 @@ canon2pgf opts gr cgr@(M.MGrammar (am:cms)) = do
       where
         flags = Map.fromList [(mkCId f,C.LStr x) | (f,x) <- optionsPGF (M.flags abm)]
         
-        funs = Map.fromAscList [(i2i f, (mkType [] ty, mkArrity ma, mkDef pty)) | 
+        funs = Map.fromAscList [(i2i f, (mkType [] ty, mkArrity ma, mkDef pty, 0)) | 
                                    (f,AbsFun (Just (L _ ty)) ma pty) <- Map.toAscList (M.jments abm)]
                                    
         cats = Map.fromAscList [(i2i c, (snd (mkContext [] cont),catfuns c)) |
                                    (c,AbsCat (Just (L _ cont))) <- Map.toAscList (M.jments abm)]
 
         catfuns cat =
-              (map snd . sortBy (compare `on` fst))
+              (map (\x -> (0,snd x)) . sortBy (compare `on` fst))
                  [(loc,i2i f) | (f,AbsFun (Just (L loc ty)) _ _) <- tree2list (M.jments abm), snd (GM.valCat ty) == cat]
 
     mkConcr am cm@(lang,mo) = do
diff --git a/src/compiler/GF/Compile/PGFtoHaskell.hs b/src/compiler/GF/Compile/PGFtoHaskell.hs
index ecc70cb5e..765a0e959 100644
--- a/src/compiler/GF/Compile/PGFtoHaskell.hs
+++ b/src/compiler/GF/Compile/PGFtoHaskell.hs
@@ -200,7 +200,7 @@ hSkeleton gr =
    fns = groupBy valtypg (sortBy valtyps (map jty (Map.assocs (funs (abstract gr)))))
    valtyps (_, (_,x)) (_, (_,y)) = compare x y
    valtypg (_, (_,x)) (_, (_,y)) = x == y
-   jty (f,(ty,_,_)) = (f,catSkeleton ty)
+   jty (f,(ty,_,_,_)) = (f,catSkeleton ty)
 
 updateSkeleton :: OIdent -> HSkeleton -> (OIdent, [OIdent]) -> HSkeleton
 updateSkeleton cat skel rule =
diff --git a/src/compiler/GF/Compile/PGFtoJS.hs b/src/compiler/GF/Compile/PGFtoJS.hs
index b81e0c5d3..1e9b00169 100644
--- a/src/compiler/GF/Compile/PGFtoJS.hs
+++ b/src/compiler/GF/Compile/PGFtoJS.hs
@@ -33,8 +33,8 @@ pgf2js pgf =
 abstract2js :: String -> Abstr -> JS.Expr
 abstract2js start ds = new "GFAbstract" [JS.EStr start, JS.EObj $ map absdef2js (Map.assocs (funs ds))]
 
-absdef2js :: (CId,(Type,Int,Maybe [Equation])) -> JS.Property
-absdef2js (f,(typ,_,_)) =
+absdef2js :: (CId,(Type,Int,Maybe [Equation],Double)) -> JS.Property
+absdef2js (f,(typ,_,_,_)) =
   let (args,cat) = M.catSkeleton typ in 
     JS.Prop (JS.IdentPropName (JS.Ident (showCId f))) (new "Type" [JS.EArray [JS.EStr (showCId x) | x <- args], JS.EStr (showCId cat)])
 
diff --git a/src/compiler/GF/Compile/PGFtoLProlog.hs b/src/compiler/GF/Compile/PGFtoLProlog.hs
index e23f4e7f4..a9dc551f2 100644
--- a/src/compiler/GF/Compile/PGFtoLProlog.hs
+++ b/src/compiler/GF/Compile/PGFtoLProlog.hs
@@ -13,13 +13,13 @@ grammar2lambdaprolog_mod pgf = render $
   text "module" <+> ppCId (absname pgf) <> char '.' $$
   space $$
   vcat [ppClauses cat fns | (cat,(_,fs)) <- Map.toList (cats (abstract pgf)),
-                            let fns = [(f,fromJust (Map.lookup f (funs (abstract pgf)))) | f <- fs]]
+                            let fns = [(f,fromJust (Map.lookup f (funs (abstract pgf)))) | (_,f) <- fs]]
   where
     ppClauses cat fns =
       text "/*" <+> ppCId cat <+> text "*/" $$
-      vcat [snd (ppClause (abstract pgf) 0 1 [] f ty) <> dot | (f,(ty,_,Nothing)) <- fns] $$
+      vcat [snd (ppClause (abstract pgf) 0 1 [] f ty) <> dot | (f,(ty,_,Nothing,_)) <- fns] $$
       space $$
-      vcat [vcat (map (\eq -> equation2clause (abstract pgf) f eq <> dot) eqs) | (f,(_,_,Just eqs)) <- fns] $$
+      vcat [vcat (map (\eq -> equation2clause (abstract pgf) f eq <> dot) eqs) | (f,(_,_,Just eqs,_)) <- fns] $$
       space
 
 grammar2lambdaprolog_sig pgf = render $
@@ -27,10 +27,10 @@ grammar2lambdaprolog_sig pgf = render $
   space $$
   vcat [ppCat c hyps <> dot | (c,(hyps,_)) <- Map.toList (cats (abstract pgf))] $$
   space $$
-  vcat [ppFun f ty <> dot | (f,(ty,_,Nothing)) <- Map.toList (funs (abstract pgf))] $$
+  vcat [ppFun f ty <> dot | (f,(ty,_,Nothing,_)) <- Map.toList (funs (abstract pgf))] $$
   space $$
   vcat [ppExport c hyps <> dot | (c,(hyps,_)) <- Map.toList (cats (abstract pgf))] $$
-  vcat [ppFunPred f (hyps ++ [(Explicit,wildCId,DTyp [] c es)]) <> dot | (f,(DTyp hyps c es,_,Just _)) <- Map.toList (funs (abstract pgf))]
+  vcat [ppFunPred f (hyps ++ [(Explicit,wildCId,DTyp [] c es)]) <> dot | (f,(DTyp hyps c es,_,Just _,_)) <- Map.toList (funs (abstract pgf))]
 
 ppCat :: CId -> [Hypo] -> Doc
 ppCat c hyps = text "kind" <+> ppKind c <+> text "type"
@@ -157,8 +157,8 @@ expr2goal abstr scope goals i (EApp e1 e2) args =
   in expr2goal abstr scope goals' i' e1 (e2':args)
 expr2goal abstr scope goals i (EFun f)     args =
   case Map.lookup f (funs abstr) of
-    Just (_,_,Just _) -> let e = EFun (mkVar i)
-                         in (foldl EApp (EFun f) (args++[e]) : goals, i+1, e)
-    _                 -> (goals,i,foldl EApp (EFun f) args)
+    Just (_,_,Just _,_) -> let e = EFun (mkVar i)
+                           in (foldl EApp (EFun f) (args++[e]) : goals, i+1, e)
+    _                   -> (goals,i,foldl EApp (EFun f) args)
 expr2goal abstr scope goals i (EVar j)     args =
   (goals,i,foldl EApp (EVar j) args)
diff --git a/src/compiler/GF/Compile/PGFtoProlog.hs b/src/compiler/GF/Compile/PGFtoProlog.hs
index d5839916b..9f456ca93 100644
--- a/src/compiler/GF/Compile/PGFtoProlog.hs
+++ b/src/compiler/GF/Compile/PGFtoProlog.hs
@@ -62,22 +62,22 @@ plAbstract (name, Abstr aflags funs cats) =
     clauseHeader "%% def(?Fun, ?Expr)" 
                      (concatMap plFundef (Map.assocs funs))
 
-plCat :: (CId, ([Hypo],[CId])) -> String
+plCat :: (CId, ([Hypo],[(Double,CId)])) -> String
 plCat (cat, (hypos,_)) = plFact "cat" (plTypeWithHypos typ) 
     where ((_,subst), hypos') = mapAccumL alphaConvertHypo emptyEnv hypos
           args = reverse [EFun x | (_,x) <- subst]
           typ = DTyp hypos' cat args
 
-plFun :: (CId, (Type, Int, Maybe [Equation])) -> String
-plFun (fun, (typ,_,_)) = plFact "fun" (plp fun : plTypeWithHypos typ')
+plFun :: (CId, (Type, Int, Maybe [Equation], Double)) -> String
+plFun (fun, (typ,_,_,_)) = plFact "fun" (plp fun : plTypeWithHypos typ')
     where typ' = snd $ alphaConvert emptyEnv typ
 
 plTypeWithHypos :: Type -> [String]
 plTypeWithHypos (DTyp hypos cat args) = [plTerm (plp cat) (map plp args), plList (map (\(_,x,ty) -> plOper ":" (plp x) (plp ty)) hypos)]
 
-plFundef :: (CId, (Type,Int,Maybe [Equation])) -> [String]
-plFundef (fun, (_,_,Nothing )) = []
-plFundef (fun, (_,_,Just eqs)) = [plFact "def" [plp fun, plp fundef']]
+plFundef :: (CId, (Type,Int,Maybe [Equation],Double)) -> [String]
+plFundef (fun, (_,_,Nothing ,_)) = []
+plFundef (fun, (_,_,Just eqs,_)) = [plFact "def" [plp fun, plp fundef']]
     where fundef' = snd $ alphaConvert emptyEnv eqs