1 files changed, 76 insertions, 0 deletions
diff --git a/src/runtime/haskell/PGF/BuildParser.hs b/src/runtime/haskell/PGF/BuildParser.hs
new file mode 100644
index 000000000..23e0725c6
--- /dev/null
+++ b/src/runtime/haskell/PGF/BuildParser.hs
@@ -0,0 +1,76 @@
+---------------------------------------------------------------------
+-- |
+-- Maintainer  : Krasimir Angelov
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- FCFG parsing, parser information
+-----------------------------------------------------------------------------
+
+module PGF.BuildParser where
+
+import GF.Data.SortedList
+import GF.Data.Assoc
+import PGF.CId
+import PGF.Data
+import PGF.Parsing.FCFG.Utilities
+
+import Data.Array.IArray
+import Data.Maybe
+import qualified Data.IntMap as IntMap
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Debug.Trace
+
+
+data ParserInfoEx
+  = ParserInfoEx { epsilonRules :: [(FunId,[FCat],FCat)]
+	         , leftcornerCats   :: Assoc FCat   [(FunId,[FCat],FCat)]
+	         , leftcornerTokens :: Assoc String [(FunId,[FCat],FCat)]
+	         , grammarToks :: [String]
+	         }
+
+------------------------------------------------------------
+-- parser information
+
+getLeftCornerTok pinfo (FFun _ _ lins)
+  | inRange (bounds syms) 0 = case syms ! 0 of
+                                FSymKS [tok] -> [tok]
+                                _            -> []
+  | otherwise               = []
+  where
+    syms = (sequences pinfo) ! (lins ! 0)
+
+getLeftCornerCat pinfo args (FFun _ _ lins)
+  | inRange (bounds syms) 0 = case syms ! 0 of
+                                FSymCat d _ -> let cat = args !! d
+                                               in case IntMap.lookup cat (productions pinfo) of
+                                                    Just set -> cat : [cat' | FCoerce cat' <- Set.toList set]
+                                                    Nothing  -> [cat]
+                                _           -> []
+  | otherwise               = []
+  where
+    syms = (sequences pinfo) ! (lins ! 0)
+
+buildParserInfo :: ParserInfo -> ParserInfoEx
+buildParserInfo pinfo =
+    ParserInfoEx { epsilonRules = epsilonrules
+	         , leftcornerCats = leftcorncats
+	         , leftcornerTokens = leftcorntoks
+	         , grammarToks = grammartoks
+	         }
+
+    where epsilonrules  = [ (ruleid,args,cat)
+                                   | (cat,set) <- IntMap.toList (productions pinfo)
+	                           , (FApply ruleid args) <- Set.toList set
+	                           , let (FFun _ _ lins) = (functions pinfo) ! ruleid
+                                   , not (inRange (bounds ((sequences pinfo) ! (lins ! 0))) 0) ]
+	  leftcorncats  = accumAssoc id [ (cat', (ruleid, args, cat))
+	                                                | (cat,set) <- IntMap.toList (productions pinfo)
+	                                                , (FApply ruleid args) <- Set.toList set
+	                                                , cat' <- getLeftCornerCat pinfo args ((functions pinfo) ! ruleid) ]
+	  leftcorntoks  = accumAssoc id [ (tok, (ruleid, args, cat))
+	                                                | (cat,set) <- IntMap.toList (productions pinfo)
+	                                                , (FApply ruleid args) <- Set.toList set
+	                                                , tok <- getLeftCornerTok pinfo ((functions pinfo) ! ruleid) ]
+	  grammartoks   = nubsort [t | lin <- elems (sequences pinfo), FSymKS [t] <- elems lin]