From ee3ce9694c134d697bf3fa6b8910c7d863f84dab Mon Sep 17 00:00:00 2001
From: krasimir <krasimir@chalmers.se>
Date: Tue, 5 Jan 2010 08:35:33 +0000
Subject: store the label names in PMCFG

---
 src/runtime/haskell/PGF/PMCFG.hs | 15 +++++++-------
 src/runtime/haskell/PGF/Parse.hs | 42 +++++++++++++++++++++-------------------
 2 files changed, 30 insertions(+), 27 deletions(-)

(limited to 'src/runtime/haskell')

diff --git a/src/runtime/haskell/PGF/PMCFG.hs b/src/runtime/haskell/PGF/PMCFG.hs
index b9303aeb8..abf7e4380 100644
--- a/src/runtime/haskell/PGF/PMCFG.hs
+++ b/src/runtime/haskell/PGF/PMCFG.hs
@@ -36,11 +36,11 @@ data Alternative =
 data ParserInfo
     = ParserInfo { functions   :: Array FunId FFun
                  , sequences   :: Array SeqId FSeq
-	         , productions0:: IntMap.IntMap (Set.Set Production)    -- this are the original productions as they are loaded from the PGF file
-	         , productions :: IntMap.IntMap (Set.Set Production)    -- this are the productions after the filtering for useless productions
-	         , startCats   :: Map.Map CId (FCat,FCat)
-	         , totalCats   :: {-# UNPACK #-} !FCat
-	         }
+                 , productions0:: IntMap.IntMap (Set.Set Production)    -- this are the original productions as they are loaded from the PGF file
+                 , productions :: IntMap.IntMap (Set.Set Production)    -- this are the productions after the filtering for useless productions
+                 , startCats   :: Map.Map CId (FCat,FCat,Array FIndex String)  -- for every category - start/end FCat and a list of label names
+                 , totalCats   :: {-# UNPACK #-} !FCat
+                 }
 
 
 fcatString, fcatInt, fcatFloat, fcatVar :: Int
@@ -76,8 +76,9 @@ ppFun (funid,FFun fun arr) =
 ppSeq (seqid,seq) = 
   ppSeqId seqid <+> text ":=" <+> hsep (map ppSymbol (elems seq))
 
-ppStartCat (id,(start,end)) =
-  ppCId id <+> text ":=" <+> brackets (ppFCat start <+> text ".." <+> ppFCat end)
+ppStartCat (id,(start,end,labels)) =
+  ppCId id <+> text ":=" <+> (text "range " <+> brackets (ppFCat start <+> text ".." <+> ppFCat end) $$
+                              text "labels" <+> brackets (vcat (map (text . show) (elems labels))))
 
 ppSymbol (FSymCat d r) = char '<' <> int d <> comma <> int r <> char '>'
 ppSymbol (FSymLit d r) = char '<' <> int d <> comma <> int r <> char '>'
diff --git a/src/runtime/haskell/PGF/Parse.hs b/src/runtime/haskell/PGF/Parse.hs
index 44ff525b4..6de7f29a8 100644
--- a/src/runtime/haskell/PGF/Parse.hs
+++ b/src/runtime/haskell/PGF/Parse.hs
@@ -56,14 +56,15 @@ parseWithRecovery pgf lang typ open_typs toks = accept (initState pgf lang typ)
 -- startup category.
 initState :: PGF -> Language -> Type -> ParseState
 initState pgf lang (DTyp _ start _) = 
-  let items = do
-        cat <- maybe [] range (Map.lookup start (startCats pinfo))
-        (funid,args) <- foldForest (\funid args -> (:) (funid,args)) (\_ _ args -> args)
-                                   [] cat (productions pinfo)
-        let FFun fn lins = functions pinfo ! funid
-        (lbl,seqid) <- assocs lins
-        return (Active 0 0 funid seqid args (AK cat lbl))
-     
+  let items = case Map.lookup start (startCats pinfo) of
+                Just (s,e,labels) -> do cat <- range (s,e)
+                                        (funid,args) <- foldForest (\funid args -> (:) (funid,args)) (\_ _ args -> args)
+                                                                   [] cat (productions pinfo)
+                                        let FFun fn lins = functions pinfo ! funid
+                                        (lbl,seqid) <- assocs lins
+                                        return (Active 0 0 funid seqid args (AK cat lbl))
+                Nothing           -> mzero
+
       pinfo =
         case lookParser pgf lang of
           Just pinfo -> pinfo
@@ -131,8 +132,10 @@ recoveryStates open_types (EState pgf pinfo chart) =
                      }
   in (PState pgf pinfo chart (TMap.singleton [] (Set.fromList agenda)), fmap (PState pgf pinfo chart2) acc)
   where
-    type2fcats (DTyp _ cat _) = maybe [] range (Map.lookup cat (startCats pinfo))
-    
+    type2fcats (DTyp _ cat _) = case Map.lookup cat (startCats pinfo) of
+                                  Just (s,e,labels) -> range (s,e)
+                                  Nothing           -> []
+
     complete open_fcats items ac = 
       foldl (Set.fold (\(Active j' ppos funid seqid args keyc) -> 
                            (:) (Active j' (ppos+1) funid seqid args keyc)))
@@ -153,16 +156,15 @@ extractTrees (PState pgf pinfo chart items) ty@(DTyp _ start _) =
     agenda = maybe [] Set.toList mb_agenda
     (_,st) = process Nothing (\_ _ -> id) (sequences pinfo) (functions pinfo) agenda () chart
 
-    exps = do
-      cat <- maybe [] range (Map.lookup start (startCats pinfo))
-      (funid,args) <- foldForest (\funid args -> (:) (funid,args)) (\_ _ args -> args)
-                                 [] cat (productions pinfo)
-      let FFun fn lins = functions pinfo ! funid
-      lbl <- indices lins
-      Just fid <- [lookupPC (PK cat lbl 0) (passive st)]
-      (fvs,tree) <- go Set.empty 0 (0,fid)
-      guard (Set.null fvs)
-      return tree
+    exps = 
+      case Map.lookup start (startCats pinfo) of
+        Just (s,e,lbls) -> do cat <- range (s,e)
+                              lbl <- indices lbls
+                              Just fid <- [lookupPC (PK cat lbl 0) (passive st)]
+                              (fvs,tree) <- go Set.empty 0 (0,fid)
+                              guard (Set.null fvs)
+                              return tree
+        Nothing         -> mzero
 
     go rec fcat' (d,fcat)
       | fcat < totalCats pinfo = return (Set.empty,EMeta (fcat'*10+d))   -- FIXME: here we assume that every rule has at most 10 arguments
-- 
cgit v1.2.3