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

11 files changed, 72 insertions, 83 deletions

diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs
index 63e3208b5..10322715b 100644
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -278,8 +278,8 @@ allCommands env@(pgf, mos) = Map.fromList [
        ],
      exec = \opts _ -> do
        let file = optFile opts
-       mprobs <- optProbs opts pgf
-       let conf = configureExBased pgf (optMorpho opts) mprobs (optLang opts)
+       pgf <- optProbs opts pgf
+       let conf = configureExBased pgf (optMorpho opts) (optLang opts)
        (file',ws) <- parseExamplesInGrammar conf file
        if null ws then return () else putStrLn ("unknown words: " ++ unwords ws)
        return (fromString ("wrote " ++ file')),
@@ -309,15 +309,11 @@ allCommands env@(pgf, mos) = Map.fromList [
        ("probs", "file with biased probabilities (format 'f 0.4' one by line)")
        ],
      exec = \opts xs -> do
-       let pgfr = optRestricted opts
+       pgf <- optProbs opts (optRestricted opts)
        gen <- newStdGen
-       mprobs <- optProbs opts pgfr
-       let sel = case mprobs of
-                   Just probs -> WeightSel gen probs
-                   Nothing    -> RandSel   gen
        let ts  = case mexp xs of
-                   Just ex -> generateRandomFrom sel pgfr ex
-                   Nothing -> generateRandom     sel pgfr (optType opts)
+                   Just ex -> generateRandomFrom gen pgf ex
+                   Nothing -> generateRandom     gen pgf (optType opts)
        returnFromExprs $ take (optNum opts) ts
      }),
   ("gt", emptyCommandInfo {
@@ -389,8 +385,11 @@ allCommands env@(pgf, mos) = Map.fromList [
        "  .gfo   compiled GF source",
        "  .pgf   precompiled grammar in Portable Grammar Format"
        ],
+     flags = [
+       ("probs","file with biased probabilities for generation")
+       ],
      options = [ 
-       -- ["prob", "retain", "gfo", "src", "no-cpu", "cpu", "quiet", "verbose"]
+       -- ["gfo", "src", "no-cpu", "cpu", "quiet", "verbose"]
        ("retain","retain operations (used for cc command)"),
        ("src",   "force compilation from source"),
        ("v",     "be verbose - show intermediate status information")
@@ -461,9 +460,9 @@ allCommands env@(pgf, mos) = Map.fromList [
      exec = \opts xs -> do
          let lang = optLang opts
          let typ  = optType opts
-         mprobs <- optProbs opts pgf
+         pgf <- optProbs opts pgf
          let mt = mexp xs 
-         morphologyQuiz mt mprobs pgf lang typ
+         morphologyQuiz mt pgf lang typ
          return void,
      flags = [
        ("lang","language of the quiz"),
@@ -639,9 +638,8 @@ allCommands env@(pgf, mos) = Map.fromList [
        "'function probability', e.g. 'youPol_Pron  0.01'."
        ],
      exec = \opts ts -> do
-         mprobs <- optProbs opts pgf
-         let probs = maybe (defaultProbabilities pgf) id mprobs
-         let tds = rankTreesByProbs probs ts
+         pgf <- optProbs opts pgf
+         let tds = rankTreesByProbs pgf ts
          if isOpt "v" opts
            then putStrLn $ 
                   unlines [showExpr []  t ++ "\t--" ++ show d | (t,d) <- tds]
@@ -667,8 +665,8 @@ allCommands env@(pgf, mos) = Map.fromList [
          let to   = valCIdOpts "to"   (optLang opts) opts
          let typ  = optType opts
          let mt   = mexp xs
-         mprobs <- optProbs opts pgf
-         translationQuiz mt mprobs pgf from to typ
+         pgf <- optProbs opts pgf
+         translationQuiz mt pgf from to typ
          return void,
      flags = [
        ("from","translate from this language"),
@@ -887,7 +885,7 @@ allCommands env@(pgf, mos) = Map.fromList [
                                                                 if null (functionsToCat pgf id)
                                                                   then empty
                                                                   else space $$
-                                                                       vcat [ppFun fid (ty,0,Just []) | (fid,ty) <- functionsToCat pgf id])
+                                                                       vcat [ppFun fid (ty,0,Just [],0) | (fid,ty) <- functionsToCat pgf id])
                                      Nothing   -> do putStrLn ("unknown category of function identifier "++show id)
                                                      return void
          [e]         -> case inferExpr pgf e of
@@ -979,12 +977,11 @@ allCommands env@(pgf, mos) = Map.fromList [
      ""   -> []
      cats -> mapMaybe readType (chunks ',' cats)
 
-   optProbs opts pgfr = case valStrOpts "probs" "" opts of
-     ""   -> return Nothing
+   optProbs opts pgf = case valStrOpts "probs" "" opts of
+     ""   -> return pgf
      file -> do
-       ps <- readProbabilitiesFromFile file pgf ---- pgfr!
---       putStrLn $ showProbabilities ps 
-       return $ Just ps
+       probs <- readProbabilitiesFromFile file pgf
+       return (setProbabilities probs pgf)
 
    optFile opts = valStrOpts "file" "_gftmp" opts
 
@@ -1038,7 +1035,7 @@ allCommands env@(pgf, mos) = Map.fromList [
      | otherwise             = do fmt <- readOutputFormat (valStrOpts "printer" "pgf_pretty" opts)
                                   return $ fromString $ concatMap snd $ exportPGF noOptions fmt pgf
 
-   funsigs pgf = [(f,ty) | (f,(ty,_,_)) <- Map.assocs (funs (abstract pgf))]
+   funsigs pgf = [(f,ty) | (f,(ty,_,_,_)) <- Map.assocs (funs (abstract pgf))]
    showFun (f,ty) = showCId f ++ " : " ++ showType [] ty ++ " ;"
 
    morphos opts s = 
@@ -1096,16 +1093,14 @@ stringOpOptions = sort $ [
 treeOpOptions pgf = [(op,expl) | (op,(expl,Left  _)) <- allTreeOps pgf]
 treeOpFlags   pgf = [(op,expl) | (op,(expl,Right _)) <- allTreeOps pgf]
 
-translationQuiz :: Maybe Expr -> Maybe Probabilities ->
-                   PGF -> Language -> Language -> Type -> IO ()
-translationQuiz mex mprobs pgf ig og typ = do
-  tts <- translationList mex mprobs pgf ig og typ infinity
+translationQuiz :: Maybe Expr -> PGF -> Language -> Language -> Type -> IO ()
+translationQuiz mex pgf ig og typ = do
+  tts <- translationList mex pgf ig og typ infinity
   mkQuiz "Welcome to GF Translation Quiz." tts
 
-morphologyQuiz :: Maybe Expr -> Maybe Probabilities -> 
-                  PGF -> Language -> Type -> IO ()
-morphologyQuiz mex mprobs pgf ig typ = do
-  tts <- morphologyList mex mprobs pgf ig typ infinity
+morphologyQuiz :: Maybe Expr -> PGF -> Language -> Type -> IO ()
+morphologyQuiz mex pgf ig typ = do
+  tts <- morphologyList mex pgf ig typ infinity
   mkQuiz "Welcome to GF Morphology Quiz." tts
 
 -- | the maximal number of precompiled quiz problems
diff --git a/src/compiler/GF/Compile.hs b/src/compiler/GF/Compile.hs
index ecb533c3f..7c1290d7e 100644
--- a/src/compiler/GF/Compile.hs
+++ b/src/compiler/GF/Compile.hs
@@ -42,6 +42,7 @@ import PGF.CId
 import PGF.Data
 import PGF.Macros
 import PGF.Optimize
+import PGF.Probabilistic
 
 
 -- | Compiles a number of source files and builds a 'PGF' structure for them.
@@ -55,9 +56,13 @@ link :: Options -> Ident -> SourceGrammar -> IOE PGF
 link opts cnc gr = do
   let isv = (verbAtLeast opts Normal)
   putPointE Normal opts "linking ... " $ do
-    gc <- ioeIO (mkCanon2pgf opts cnc gr)
-    ioeIO $ putStrLn "OK" 
-    return $ if flag optOptimizePGF opts then optimizePGF gc else gc
+    pgf <- ioeIO (mkCanon2pgf opts cnc gr)
+    probs <- ioeIO (maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf)
+    ioeIO $ putStrLn "OK"     
+    pgf <- return $ setProbabilities probs 
+             $ if flag optOptimizePGF opts then optimizePGF pgf else pgf
+    ioeIO $ putStrLn (showProbabilities (getProbabilities pgf))
+    return pgf
 
 batchCompile :: Options -> [FilePath] -> IOE SourceGrammar
 batchCompile opts files = do
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
 
 
diff --git a/src/compiler/GF/Infra/Option.hs b/src/compiler/GF/Infra/Option.hs
index a45d46a39..aac652768 100644
--- a/src/compiler/GF/Infra/Option.hs
+++ b/src/compiler/GF/Infra/Option.hs
@@ -155,7 +155,7 @@ data Flags = Flags {
       optGFLibPath       :: Maybe FilePath,
       optRecomp          :: Recomp,
       optPrinter         :: [Printer],
-      optProb            :: Bool,
+      optProbsFile       :: Maybe FilePath,
       optRetainResource  :: Bool,
       optName            :: Maybe String,
       optAbsName         :: Maybe String,
@@ -255,7 +255,7 @@ defaultFlags = Flags {
       optGFLibPath       = Nothing,
       optRecomp          = RecompIfNewer,
       optPrinter         = [],
-      optProb            = False,
+      optProbsFile       = Nothing,
       optRetainResource  = False,
 
       optName            = Nothing,
@@ -329,7 +329,7 @@ optDescr =
      Option [] ["strip"] (NoArg (printer PrinterStrip))
                  "Remove name qualifiers when pretty-printing.",
      Option [] ["retain"] (NoArg (set $ \o -> o { optRetainResource = True })) "Retain opers.",
-     Option [] ["prob"] (NoArg (prob True)) "Read probabilities from '--# prob' pragmas.",
+     Option [] ["probs"] (ReqArg probsFile "file.probs") "Read probabilities from file.",
      Option ['n'] ["name"] (ReqArg name "NAME") 
            (unlines ["Use NAME as the name of the output. This is used in the output file names, ",
                      "with suffixes depending on the formats, and, when relevant, ",
@@ -399,7 +399,7 @@ optDescr =
        gfLibPath   x = set $ \o -> o { optGFLibPath = Just x }
        recomp      x = set $ \o -> o { optRecomp = x }
        printer     x = set $ \o -> o { optPrinter = x : optPrinter o }
-       prob        x = set $ \o -> o { optProb = x }
+       probsFile   x = set $ \o -> o { optProbsFile = Just x }
 
        name        x = set $ \o -> o { optName = Just x }
        absName     x = set $ \o -> o { optAbsName = Just x }
diff --git a/src/compiler/GF/Quiz.hs b/src/compiler/GF/Quiz.hs
index 1a221c21d..0b37660c8 100644
--- a/src/compiler/GF/Quiz.hs
+++ b/src/compiler/GF/Quiz.hs
@@ -38,32 +38,24 @@ mkQuiz msg tts = do
   teachDialogue qas msg
 
 translationList :: 
-  Maybe Expr -> Maybe Probabilities -> 
-  PGF -> Language -> Language -> Type -> Int -> IO [(String,[String])]
-translationList mex mprobs pgf ig og typ number = do
+  Maybe Expr -> PGF -> Language -> Language -> Type -> Int -> IO [(String,[String])]
+translationList mex pgf ig og typ number = do
   gen <- newStdGen
-  let sel = case mprobs of
-              Just probs -> WeightSel gen probs
-              Nothing    -> RandSel   gen
-  let ts  = take number $ case mex of
-                            Just ex -> generateRandomFrom sel pgf ex
-                            Nothing -> generateRandom     sel pgf typ
+  let ts   = take number $ case mex of
+                             Just ex -> generateRandomFrom gen pgf ex
+                             Nothing -> generateRandom     gen pgf typ
   return $ map mkOne $ ts
  where
    mkOne t = (norml (linearize pgf ig t), map (norml . linearize pgf og) (homonyms t))
    homonyms = parse pgf ig typ . linearize pgf ig
 
 morphologyList :: 
-  Maybe Expr -> Maybe Probabilities -> 
-  PGF -> Language -> Type -> Int -> IO [(String,[String])]
-morphologyList mex mprobs pgf ig typ number = do
+  Maybe Expr -> PGF -> Language -> Type -> Int -> IO [(String,[String])]
+morphologyList mex pgf ig typ number = do
   gen <- newStdGen
-  let sel = case mprobs of
-              Just probs -> WeightSel gen probs
-              Nothing    -> RandSel   gen
-  let ts = take (max 1 number) $ case mex of
-                                   Just ex -> generateRandomFrom sel pgf ex
-                                   Nothing -> generateRandom     sel pgf typ
+  let ts   = take (max 1 number) $ case mex of
+                                     Just ex -> generateRandomFrom gen pgf ex
+                                     Nothing -> generateRandom     gen pgf typ
   let ss    = map (tabularLinearizes pgf ig) ts
   let size  = length (head (head ss))
   let forms = take number $ randomRs (0,size-1) gen
diff --git a/src/compiler/GF/Speech/VoiceXML.hs b/src/compiler/GF/Speech/VoiceXML.hs
index f3f05d3d7..40976dc02 100644
--- a/src/compiler/GF/Speech/VoiceXML.hs
+++ b/src/compiler/GF/Speech/VoiceXML.hs
@@ -39,7 +39,7 @@ grammar2vxml pgf cnc = showsXMLDoc (skel2vxml name language start skel qs) ""
 type Skeleton = [(CId, [(CId, [CId])])]
 
 pgfSkeleton :: PGF -> Skeleton
-pgfSkeleton pgf = [(c,[(f,fst (catSkeleton (lookType pgf f))) | f <- fs]) 
+pgfSkeleton pgf = [(c,[(f,fst (catSkeleton (lookType pgf f))) | (_,f) <- fs]) 
                    | (c,(_,fs)) <- Map.toList (cats (abstract pgf))]
 
 --