preparation for dep. types. The -cat option can take any type instead of just a category. The PGF API is generalized as well.

9 files changed, 130 insertions, 129 deletions

diff --git a/src/GF/Command/Abstract.hs b/src/GF/Command/Abstract.hs
index 1ae5d6dff..cf82e96c6 100644
--- a/src/GF/Command/Abstract.hs
+++ b/src/GF/Command/Abstract.hs
@@ -1,5 +1,6 @@
 module GF.Command.Abstract where
 
+import PGF.CId
 import PGF.Data
 
 type Ident = String
@@ -19,7 +20,7 @@ data Option
 
 data Value
   = VId  Ident
-  | VInt Integer
+  | VInt Int
   | VStr String
   deriving (Eq,Ord,Show)
 
@@ -29,27 +30,25 @@ data Argument
   | AMacro Ident
   deriving (Eq,Ord,Show)
 
-valIdOpts :: String -> String -> [Option] -> String
-valIdOpts flag def opts = case valOpts flag (VId def) opts of
-  VId v -> v
-  _     -> def
+valCIdOpts :: String -> CId -> [Option] -> CId
+valCIdOpts flag def opts =
+  case [v | OFlag f (VId v) <- opts, f == flag] of
+    (v:_) -> mkCId v
+    _     -> def
 
-valIntOpts :: String -> Integer -> [Option] -> Int
-valIntOpts flag def opts = fromInteger $ case valOpts flag (VInt def) opts of
-  VInt v -> v
-  _      -> def
+valIntOpts :: String -> Int -> [Option] -> Int
+valIntOpts flag def opts =
+  case [v | OFlag f (VInt v) <- opts, f == flag] of
+    (v:_) -> v
+    _     -> def
 
 valStrOpts :: String -> String -> [Option] -> String
-valStrOpts flag def opts = case valOpts flag (VStr def) opts of
-  VStr v -> v
-  _      -> def
-
-valOpts :: String -> Value -> [Option] -> Value
-valOpts flag def opts = case lookup flag flags of
-  Just v -> v
-  _ -> def
- where
-   flags = [(f,v) | OFlag f v <- opts]
+valStrOpts flag def opts =
+  case [v | OFlag f v <- opts, f == flag] of
+    (VStr v:_) -> v
+    (VId  v:_) -> v
+    (VInt v:_) -> show v
+    _          -> def
 
 isOpt :: String -> [Option] -> Bool
 isOpt o opts = elem o [x | OOpt x <- opts]
diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs
index e9a2819ba..a2850b6a2 100644
--- a/src/GF/Command/Commands.hs
+++ b/src/GF/Command/Commands.hs
@@ -164,7 +164,7 @@ allCommands cod pgf = Map.fromList [
        ],
      exec = \opts _ -> do
        let pgfr = optRestricted opts
-       ts <- generateRandom pgfr (optCat opts)
+       ts <- generateRandom pgfr (optType opts)
        return $ fromTrees $ take (optNum opts) ts
      }),
   ("gt", emptyCommandInfo {
@@ -185,7 +185,7 @@ allCommands cod pgf = Map.fromList [
      exec = \opts _ -> do
        let pgfr = optRestricted opts
        let dp = return $ valIntOpts "depth" 4 opts
-       let ts = generateAllDepth pgfr (optCat opts) dp
+       let ts = generateAllDepth pgfr (optType opts) dp
        return $ fromTrees $ take (optNumInf opts) ts
      }),
   ("h", emptyCommandInfo {
@@ -285,8 +285,8 @@ allCommands cod pgf = Map.fromList [
      synopsis = "start a morphology quiz",
      exec = \opts _ -> do
          let lang = optLang opts
-         let cat  = optCat opts
-         morphologyQuiz cod pgf lang cat
+         let typ  = optType opts
+         morphologyQuiz cod pgf lang typ
          return void,
      flags = [
        ("lang","language of the quiz"),
@@ -405,7 +405,7 @@ allCommands cod pgf = Map.fromList [
        ("tree","convert strings into trees")
        ],
      exec = \opts arg -> do 
-       let file = valIdOpts "file" "_gftmp" opts
+       let file = valStrOpts "file" "_gftmp" opts
        s <- readFile file
        return $ case opts of
          _ | isOpt "lines" opts && isOpt "tree" opts -> 
@@ -420,10 +420,10 @@ allCommands cod pgf = Map.fromList [
      longname = "translation_quiz",
      synopsis = "start a translation quiz",
      exec = \opts _ -> do
-         let from = valIdOpts "from" (optLang opts) opts
-         let to   = valIdOpts "to"   (optLang opts) opts
-         let cat  = optCat opts
-         translationQuiz cod pgf from to cat
+         let from = valCIdOpts "from" (optLang opts) opts
+         let to   = valCIdOpts "to"   (optLang opts) opts
+         let typ  = optType opts
+         translationQuiz cod pgf from to typ
          return void,
      flags = [
        ("from","translate from this language"),
@@ -516,7 +516,7 @@ allCommands cod pgf = Map.fromList [
      longname = "write_file",
      synopsis = "send string or tree to a file",
      exec = \opts arg -> do
-         let file = valIdOpts "file" "_gftmp" opts
+         let file = valStrOpts "file" "_gftmp" opts
          if isOpt "append" opts 
            then appendFile file (enc (toString arg))
            else writeFile file (enc (toString arg))
@@ -530,7 +530,7 @@ allCommands cod pgf = Map.fromList [
  where
    enc = encodeUnicode cod
    lin opts t = unlines [linearize pgf lang t    | lang <- optLangs opts]
-   par opts s = concat  [parse pgf lang (optCat opts) s | lang <- optLangs opts, canParse pgf lang]
+   par opts s = concat  [parse pgf lang (optType opts) s | lang <- optLangs opts, canParse pgf lang]
  
    void = ([],[])
 
@@ -539,21 +539,21 @@ allCommands cod pgf = Map.fromList [
      _ -> unlines [linear opts lang t | lang <- optLangs opts] 
     
    linear opts lang = let unl = unlex opts lang in case opts of
-       _ | isOpt "all"    opts -> allLinearize unl pgf (mkCId lang)
-       _ | isOpt "table"  opts -> tableLinearize unl pgf (mkCId lang)
-       _ | isOpt "term"   opts -> termLinearize pgf (mkCId lang)
-       _ | isOpt "record" opts -> recordLinearize pgf (mkCId lang)
+       _ | isOpt "all"    opts -> allLinearize unl pgf lang
+       _ | isOpt "table"  opts -> tableLinearize unl pgf lang
+       _ | isOpt "term"   opts -> termLinearize pgf lang
+       _ | isOpt "record" opts -> recordLinearize pgf lang
        _  -> unl . linearize pgf lang
 
    treebank opts t = unlines $ 
-     (abstractName pgf ++ ": " ++ showTree t) :
-     [lang ++ ": " ++ linear opts lang t | lang <- optLangs opts]
+     (prCId (abstractName pgf) ++ ": " ++ showTree t) :
+     [prCId lang ++ ": " ++ linear opts lang t | lang <- optLangs opts]
 
    unlex opts lang = stringOps (getUnlex opts lang ++ map prOpt opts)
 
    getUnlex opts lang = case words (valStrOpts "unlexer" "" opts) of
      lexs -> case lookup lang 
-               [(la,tail le) | lex <- lexs, let (la,le) = span (/='=') lex, not (null le)] of
+               [(mkCId la,tail le) | lex <- lexs, let (la,le) = span (/='=') lex, not (null le)] of
        Just le -> chunks ',' le
        _ -> []
 
@@ -571,13 +571,17 @@ allCommands cod pgf = Map.fromList [
        _ -> map prOpt opts
 
    optRestricted opts = 
-     restrictPGF (\f -> and [hasLin pgf (mkCId la) f | la <- optLangs opts]) pgf
+     restrictPGF (\f -> and [hasLin pgf la f | la <- optLangs opts]) pgf
 
-   optLangs opts = case valIdOpts "lang" "" opts of
+   optLangs opts = case valStrOpts "lang" "" opts of
      "" -> languages pgf
-     lang -> chunks ',' lang
-   optLang opts = head $ optLangs opts ++ ["#NOLANG"] 
-   optCat opts = valIdOpts "cat" (lookStartCat pgf) opts
+     lang -> map mkCId (chunks ',' lang)
+   optLang opts = head $ optLangs opts ++ [wildCId]
+   optType opts = 
+     let str = valStrOpts "cat" (lookStartCat pgf) opts
+     in case readType str of
+          Just ty -> ty
+          Nothing -> error ("Can't parse '"++str++"' as type")
    optComm opts = valStrOpts "command" "" opts
    optViewFormat opts = valStrOpts "format" "ps" opts
    optViewGraph opts = valStrOpts "view" "gv" opts
@@ -591,17 +595,17 @@ allCommands cod pgf = Map.fromList [
    toString = unwords . toStrings
 
    prGrammar opts = case opts of
-     _ | isOpt "cats" opts -> unwords $ categories pgf
+     _ | isOpt "cats" opts -> unwords $ map prCId $ categories pgf
      _ | isOpt "fullform" opts -> concatMap 
-          (prFullFormLexicon . buildMorpho pgf . mkCId) $ optLangs opts
+          (prFullFormLexicon . buildMorpho pgf) $ optLangs opts
      _ | isOpt "missing" opts -> 
-           unlines $ [unwords (la:":": map prCId cs) | 
-                       la <- optLangs opts, let cs = missingLins pgf (mkCId la)]
-     _ -> case valIdOpts "printer" "pgf" opts of
+           unlines $ [unwords (prCId la:":": map prCId cs) | 
+                       la <- optLangs opts, let cs = missingLins pgf la]
+     _ -> case valStrOpts "printer" "pgf" opts of
        v -> concatMap snd $ exportPGF noOptions (read v) pgf
 
    morphos opts s = 
-     [lookupMorpho (buildMorpho pgf (mkCId la)) s | la <- optLangs opts]
+     [lookupMorpho (buildMorpho pgf la) s | la <- optLangs opts]
 
    -- ps -f -g s returns g (f s)
    stringOps opts s = foldr app s (reverse opts) where
@@ -643,14 +647,14 @@ stringOpOptions = [
 
 treeOpOptions pgf = [(op,expl) | (op,(expl,_)) <- allTreeOps pgf]
 
-translationQuiz :: String -> PGF -> Language -> Language -> Category -> IO ()
-translationQuiz cod pgf ig og cat = do
-  tts <- translationList pgf ig og cat infinity
+translationQuiz :: String -> PGF -> Language -> Language -> Type -> IO ()
+translationQuiz cod pgf ig og typ = do
+  tts <- translationList pgf ig og typ infinity
   mkQuiz cod "Welcome to GF Translation Quiz." tts
 
-morphologyQuiz :: String -> PGF -> Language -> Category -> IO ()
-morphologyQuiz cod pgf ig cat = do
-  tts <- morphologyList pgf ig cat infinity
+morphologyQuiz :: String -> PGF -> Language -> Type -> IO ()
+morphologyQuiz cod pgf ig typ = do
+  tts <- morphologyList pgf ig typ infinity
   mkQuiz cod "Welcome to GF Morphology Quiz." tts
 
 -- | the maximal number of precompiled quiz problems
diff --git a/src/GF/Quiz.hs b/src/GF/Quiz.hs
index 92969aa3c..bfdd9a54a 100644
--- a/src/GF/Quiz.hs
+++ b/src/GF/Quiz.hs
@@ -39,19 +39,19 @@ mkQuiz cod msg tts = do
   teachDialogue qas msg
 
 translationList :: 
-  PGF -> Language -> Language -> Category -> Int -> IO [(String,[String])]
-translationList pgf ig og cat number = do
-  ts <- generateRandom pgf cat >>= return . take number
+  PGF -> Language -> Language -> Type -> Int -> IO [(String,[String])]
+translationList pgf ig og typ number = do
+  ts <- generateRandom pgf typ >>= return . take number
   return $ map mkOne $ ts
  where
    mkOne t = (norml (linearize pgf ig t), map (norml . linearize pgf og) (homonyms t))
-   homonyms = nub . parse pgf ig cat . linearize pgf ig
+   homonyms = nub . parse pgf ig typ . linearize pgf ig
 
-morphologyList :: PGF -> Language -> Category -> Int -> IO [(String,[String])]
-morphologyList pgf ig cat number = do
-  ts  <- generateRandom pgf cat >>= return . take (max 1 number)
+morphologyList :: PGF -> Language -> Type -> Int -> IO [(String,[String])]
+morphologyList pgf ig typ number = do
+  ts  <- generateRandom pgf typ >>= return . take (max 1 number)
   gen <- newStdGen
-  let ss    = map (tabularLinearize pgf (mkCId ig)) ts
+  let ss    = map (tabularLinearize pgf ig) ts
   let size  = length (head ss)
   let forms = take number $ randomRs (0,size-1) gen
   return [(head (snd (head pws)) +++ par, ws) | 
diff --git a/src/GFI.hs b/src/GFI.hs
index 1e9cfba2f..59c792eb5 100644
--- a/src/GFI.hs
+++ b/src/GFI.hs
@@ -148,7 +148,7 @@ importInEnv gfenv opts files
                pgf0 = multigrammar (commandenv gfenv)
            pgf1 <- importGrammar pgf0 opts' files
            if (verbAtLeast opts Normal)
-             then putStrLnFlush $ unwords $ "\nLanguages:" : languages pgf1
+             then putStrLnFlush $ unwords $ "\nLanguages:" : map prCId (languages pgf1)
              else return ()
            return $ gfenv { commandenv = mkCommandEnv (coding gfenv) pgf1 }
 
@@ -177,10 +177,11 @@ welcome = unlines [
   "Bug reports: http://trac.haskell.org/gf/"
   ]
 
-prompt env = absname ++ "> " where
-  absname = case abstractName (multigrammar env) of
-    "_" -> ""  --- created by new Ident handling 22/5/2008
-    n   -> n
+prompt env 
+  | abs == wildCId = "> "
+  | otherwise      = prCId abs ++ "> "
+  where
+    abs = abstractName (multigrammar env)
 
 data GFEnv = GFEnv {
   sourcegrammar :: Grammar, -- gfo grammar -retain
@@ -201,7 +202,7 @@ wordCompletion gfenv line0 prefix0 p =
     CmplCmd pref
       -> ret ' ' [name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name]
     CmplStr (Just (Command _ opts _)) s
-      -> do mb_state0 <- try (evaluate (initState pgf (optLang opts) (optCat  opts)))
+      -> do mb_state0 <- try (evaluate (initState pgf (optLang opts) (optType opts)))
             case mb_state0 of
               Right state0 -> let ws     = words (take (length s - length prefix) s)
                               in case foldM nextState state0 ws of
@@ -230,8 +231,8 @@ wordCompletion gfenv line0 prefix0 p =
 
     pgf    = multigrammar cmdEnv
     cmdEnv = commandenv gfenv
-    optLang opts = valIdOpts "lang" (head (languages pgf)) opts
-    optCat  opts = valIdOpts "cat"  (lookStartCat pgf)     opts
+    optLang opts = valCIdOpts "lang" (head (languages pgf)) opts
+    optType opts = DTyp [] (mkCId (valStrOpts "type" (lookStartCat pgf) opts)) []
     
     ret c [x] = return [x++[c]]
     ret _ xs  = return xs
diff --git a/src/PGF.hs b/src/PGF.hs
index 65697fe8a..f989e3969 100644
--- a/src/PGF.hs
+++ b/src/PGF.hs
@@ -89,19 +89,19 @@ import Control.Monad
 -- Interface
 ---------------------------------------------------
 
--- | This is just a string with the language name.
+-- | This is just a 'CId' with the language name.
 -- A language name is the identifier that you write in the 
 -- top concrete or abstract module in GF after the 
 -- concrete/abstract keyword. Example:
 -- 
 -- > abstract Lang = ...
 -- > concrete LangEng of Lang = ...
-type Language     = String
+type Language     = CId
 
--- | This is just a string with the category name.
+-- | This is just a 'CId' with the category name.
 -- The categories are defined in the abstract syntax
 -- with the \'cat\' keyword.
-type Category     = String
+type Category     = CId
 
 -- | Reads file in Portable Grammar Format and produces
 -- 'PGF' structure. The file is usually produced with:
@@ -118,7 +118,7 @@ linearize    :: PGF -> Language -> Tree -> String
 -- contain more than one element if the grammar is ambiguous.
 -- Throws an exception if the given language cannot be used
 -- for parsing, see 'canParse'.
-parse        :: PGF -> Language -> Category -> String -> [Tree]
+parse        :: PGF -> Language -> Type -> String -> [Tree]
 
 -- | Checks whether the given language can be used for parsing.
 canParse     :: PGF -> Language -> Bool
@@ -133,7 +133,7 @@ linearizeAllLang :: PGF -> Tree -> [(Language,String)]
 
 -- | The same as 'parseAllLang' but does not return
 -- the language.
-parseAll     :: PGF -> Category -> String -> [[Tree]]
+parseAll     :: PGF -> Type -> String -> [[Tree]]
 
 -- | Tries to parse the given string with all available languages.
 -- Languages which cannot be used for parsing (see 'canParse')
@@ -143,31 +143,31 @@ parseAll     :: PGF -> Category -> String -> [[Tree]]
 -- (this is a list, since grammars can be ambiguous). 
 -- Only those languages
 -- for which at least one parsing is possible are listed.
-parseAllLang :: PGF -> Category -> String -> [(Language,[Tree])]
+parseAllLang :: PGF -> Type -> String -> [(Language,[Tree])]
 
 -- | Creates an initial parsing state for a given language and
 -- startup category.
-initState :: PGF -> Language -> Category -> Incremental.ParseState
+initState :: PGF -> Language -> Type -> Incremental.ParseState
 
 -- | This function extracts the list of all completed parse trees
 -- that spans the whole input consumed so far. The trees are also
 -- limited by the category specified, which is usually
 -- the same as the startup category.
-extractExps :: Incremental.ParseState -> Category -> [Tree]
+extractExps :: Incremental.ParseState -> Type -> [Tree]
 
 -- | The same as 'generateAllDepth' but does not limit
 -- the depth in the generation.
-generateAll      :: PGF -> Category -> [Tree]
+generateAll      :: PGF -> Type -> [Tree]
 
 -- | 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   :: PGF -> Category -> IO [Tree]
+generateRandom   :: PGF -> Type -> IO [Tree]
 
 -- | Generates an exhaustive possibly infinite list of
 -- abstract syntax expressions. A depth can be specified
 -- to limit the search space.
-generateAllDepth :: PGF -> Category -> Maybe Int -> [Tree]
+generateAllDepth :: PGF -> Type -> Maybe Int -> [Tree]
 
 -- | List of all languages available in the given grammar.
 languages    :: PGF -> [Language]
@@ -197,7 +197,7 @@ startCat   :: PGF -> Category
 -- is empty or ends in whitespace, the last word is considred
 -- to be the empty string. This means that the completions
 -- will be all possible next words.
-complete :: PGF -> Language -> Category -> String 
+complete :: PGF -> Language -> Type -> String 
          -> [String] -- ^ Possible word completions of, 
                      -- including the given input.
 
@@ -211,61 +211,58 @@ readPGF f = do
   g <- parseGrammar s
   return $! toPGF g
 
-linearize pgf lang = concat . take 1 . PGF.Linearize.linearizes pgf (mkCId lang)
+linearize pgf lang = concat . take 1 . PGF.Linearize.linearizes pgf lang
 
-parse pgf lang cat s = 
-  case Map.lookup (mkCId lang) (concretes pgf) of
+parse pgf lang typ s = 
+  case Map.lookup lang (concretes pgf) of
     Just cnc -> case parser cnc of
                   Just pinfo -> if Map.lookup (mkCId "erasing") (cflags cnc) == Just "on"
-                                  then Incremental.parse pinfo (mkCId cat) (words s)
-                                  else case parseFCFG "topdown" pinfo (mkCId cat) (words s) of
+                                  then Incremental.parse pinfo typ (words s)
+                                  else case parseFCFG "topdown" pinfo typ (words s) of
                                          Ok x  -> x
                                          Bad s -> error s
-                  Nothing    -> error ("No parser built for language: " ++ lang)
-    Nothing  -> error ("Unknown language: " ++ lang)
+                  Nothing    -> error ("No parser built for language: " ++ prCId lang)
+    Nothing  -> error ("Unknown language: " ++ prCId lang)
 
-canParse pgf cnc = isJust (lookParser pgf (mkCId cnc))
+canParse pgf cnc = isJust (lookParser pgf cnc)
 
 linearizeAll mgr = map snd . linearizeAllLang mgr
 linearizeAllLang mgr t = 
   [(lang,PGF.linearize mgr lang t) | lang <- languages mgr]
 
-parseAll mgr cat = map snd . parseAllLang mgr cat
+parseAll mgr typ = map snd . parseAllLang mgr typ
 
-parseAllLang mgr cat s = 
-  [(lang,ts) | lang <- languages mgr, canParse mgr lang, let ts = parse mgr lang cat s, not (null ts)]
+parseAllLang mgr typ s = 
+  [(lang,ts) | lang <- languages mgr, canParse mgr lang, let ts = parse mgr lang typ s, not (null ts)]
 
-initState pgf lang cat =
-  case lookParser pgf langCId of
-    Just pinfo -> Incremental.initState pinfo catCId
-    _          -> error ("Unknown language: " ++ lang)
-  where
-    langCId = mkCId lang
-    catCId  = mkCId cat
+initState pgf lang typ =
+  case lookParser pgf lang of
+    Just pinfo -> Incremental.initState pinfo typ
+    _          -> error ("Unknown language: " ++ prCId lang)
 
-extractExps state cat = Incremental.extractExps state (mkCId cat)
+extractExps state typ = Incremental.extractExps state typ
 
 generateRandom pgf cat = do
   gen <- newStdGen
-  return $ genRandom gen pgf (mkCId cat)
+  return $ genRandom gen pgf cat
 
-generateAll pgf cat = generate pgf (mkCId cat) Nothing
-generateAllDepth pgf cat = generate pgf (mkCId cat)
+generateAll pgf cat = generate pgf cat Nothing
+generateAllDepth pgf cat = generate pgf cat
 
-abstractName pgf = prCId (absname pgf)
+abstractName pgf = absname pgf
 
-languages pgf = [prCId l | l <- cncnames pgf]
+languages pgf = cncnames pgf
 
 languageCode pgf lang = 
-    fmap (replace '_' '-') $ lookConcrFlag pgf (mkCId lang) (mkCId "language")
+    fmap (replace '_' '-') $ lookConcrFlag pgf lang (mkCId "language")
 
-categories pgf = [prCId c | c <- Map.keys (cats (abstract pgf))]
+categories pgf = Map.keys (cats (abstract pgf))
 
-startCat pgf = lookStartCat pgf
+startCat pgf = mkCId (lookStartCat pgf)
 
-complete pgf from cat input = 
+complete pgf from typ input = 
          let (ws,prefix) = tokensAndPrefix input
-             state0 = initState pgf from cat
+             state0 = initState pgf from typ
          in case foldM Incremental.nextState state0 ws of
               Nothing -> []
               Just state -> let compls = Incremental.getCompletions state prefix
diff --git a/src/PGF/Generate.hs b/src/PGF/Generate.hs
index 518c2c71b..94be66245 100644
--- a/src/PGF/Generate.hs
+++ b/src/PGF/Generate.hs
@@ -8,8 +8,8 @@ import qualified Data.Map as M
 import System.Random
 
 -- generate an infinite list of trees exhaustively
-generate :: PGF -> CId -> Maybe Int -> [Tree]
-generate pgf cat dp = concatMap (\i -> gener i cat) depths
+generate :: PGF -> Type -> Maybe Int -> [Tree]
+generate pgf (DTyp _ cat _) dp = concatMap (\i -> gener i cat) depths
  where
   gener 0 c = [Fun f [] | (f, ([],_)) <- fns c]
   gener i c = [
@@ -24,8 +24,8 @@ generate pgf cat dp = concatMap (\i -> gener i cat) depths
   depths = maybe [0 ..] (\d -> [0..d]) dp
 
 -- generate an infinite list of trees randomly
-genRandom :: StdGen -> PGF -> CId -> [Tree]
-genRandom gen pgf cat = genTrees (randomRs (0.0, 1.0 :: Double) gen) cat where
+genRandom :: StdGen -> PGF -> Type -> [Tree]
+genRandom gen pgf (DTyp _ cat _) = genTrees (randomRs (0.0, 1.0 :: Double) gen) cat where
 
   timeout = 47 -- give up
 
diff --git a/src/PGF/Parsing/FCFG.hs b/src/PGF/Parsing/FCFG.hs
index fe56f8712..088c9f480 100644
--- a/src/PGF/Parsing/FCFG.hs
+++ b/src/PGF/Parsing/FCFG.hs
@@ -30,10 +30,10 @@ import qualified Data.Map as Map
 
 parseFCFG :: String           -- ^ parsing strategy
          -> ParserInfo        -- ^ compiled grammar (fcfg) 
-         -> CId               -- ^ starting category
+         -> Type              -- ^ start type
          -> [String]          -- ^ input tokens
          -> Err [Tree]        -- ^ resulting GF terms
-parseFCFG "bottomup"    pinfo start toks = return $ Active.parse "b"  pinfo start toks 
-parseFCFG "topdown"     pinfo start toks = return $ Active.parse "t"  pinfo start toks 
-parseFCFG "incremental" pinfo start toks = return $ Incremental.parse pinfo start toks 
-parseFCFG strat         pinfo start toks = fail   $ "FCFG parsing strategy not defined: " ++ strat
+parseFCFG "bottomup"    pinfo typ toks = return $ Active.parse "b"  pinfo typ toks 
+parseFCFG "topdown"     pinfo typ toks = return $ Active.parse "t"  pinfo typ toks 
+parseFCFG "incremental" pinfo typ toks = return $ Incremental.parse pinfo typ toks 
+parseFCFG strat         pinfo typ toks = fail   $ "FCFG parsing strategy not defined: " ++ strat
diff --git a/src/PGF/Parsing/FCFG/Active.hs b/src/PGF/Parsing/FCFG/Active.hs
index 0927a719b..ad1db7220 100644
--- a/src/PGF/Parsing/FCFG/Active.hs
+++ b/src/PGF/Parsing/FCFG/Active.hs
@@ -37,8 +37,8 @@ makeFinalEdge cat 0 0 = (cat, [EmptyRange])
 makeFinalEdge cat i j = (cat, [makeRange i j])
 
 -- | the list of categories = possible starting categories
-parse :: String -> ParserInfo -> CId -> [FToken] -> [Tree]
-parse strategy pinfo start toks = nubsort $ filteredForests >>= forest2trees
+parse :: String -> ParserInfo -> Type -> [FToken] -> [Tree]
+parse strategy pinfo (DTyp _ start _) toks = nubsort $ filteredForests >>= forest2trees
   where
     inTokens = input toks
     starts = Map.findWithDefault [] start (startCats pinfo)
diff --git a/src/PGF/Parsing/FCFG/Incremental.hs b/src/PGF/Parsing/FCFG/Incremental.hs
index e5f64365f..38c2e6c95 100644
--- a/src/PGF/Parsing/FCFG/Incremental.hs
+++ b/src/PGF/Parsing/FCFG/Incremental.hs
@@ -22,11 +22,11 @@ import PGF.CId
 import PGF.Data

 import Debug.Trace

 

-parse :: ParserInfo -> CId -> [String] -> [Tree]

-parse pinfo start toks = maybe [] (\ps -> extractExps ps start) (foldM nextState (initState pinfo start) toks)

+parse :: ParserInfo -> Type -> [String] -> [Tree]

+parse pinfo typ toks = maybe [] (\ps -> extractExps ps typ) (foldM nextState (initState pinfo typ) toks)

 

-initState :: ParserInfo -> CId -> ParseState

-initState pinfo start = 

+initState :: ParserInfo -> Type -> ParseState

+initState pinfo (DTyp _ start _) = 

   let items = do

         cat <- fromMaybe [] (Map.lookup start (startCats pinfo))

         (funid,args) <- foldForest (\funid args -> (:) (funid,args)) (\_ _ args -> args)

@@ -97,8 +97,8 @@ getCompletions (State pinfo chart items) w =
       | isPrefixOf w tok = Map.insertWith Set.union tok (Set.singleton item) map

       | otherwise        = map

 

-extractExps :: ParseState -> CId -> [Tree]

-extractExps (State pinfo chart items) start = exps

+extractExps :: ParseState -> Type -> [Tree]

+extractExps (State pinfo chart items) (DTyp _ start _) = exps

   where

     (_,st) = process (\_ _ -> id) (sequences pinfo) (functions pinfo) (Set.toList items) () chart