move GF.Parsing.FCFG.PInfo to GF.GFCC.BuildParser and rename FCFPInfo to ParserInfo

src-3.0/GF/GFCC/BuildParser.hs

@@ -0,0 +1,84 @@
+---------------------------------------------------------------------
+-- |
+-- Maintainer  : Krasimir Angelov
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- FCFG parsing, parser information
+-----------------------------------------------------------------------------
+
+module GF.GFCC.BuildParser where
+
+import GF.Infra.PrintClass
+import GF.Formalism.Utilities
+import GF.Data.SortedList
+import GF.Data.Assoc
+import GF.GFCC.CId
+import GF.GFCC.DataGFCC
+
+import Data.Array
+import Data.Maybe
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Debug.Trace
+
+
+------------------------------------------------------------
+-- parser information
+
+getLeftCornerTok (FRule _ _ _ _ lins)
+  | inRange (bounds syms) 0 = case syms ! 0 of
+                                FSymTok tok -> [tok]
+                                _           -> []
+  | otherwise               = []
+  where
+    syms = lins ! 0
+
+getLeftCornerCat (FRule _ _ args _ lins)
+  | inRange (bounds syms) 0 = case syms ! 0 of
+                                FSymCat _ d -> [args !! d]
+                                _           -> []
+  | otherwise               = []
+  where
+    syms = lins ! 0
+
+buildParserInfo :: FGrammar -> ParserInfo
+buildParserInfo (grammar,startup) = -- trace (unlines [prt (x,Set.toList set) | (x,set) <- Map.toList leftcornFilter]) $
+    ParserInfo { allRules = allrules
+               , topdownRules = topdownrules
+	       -- , emptyRules = emptyrules
+	       , epsilonRules = epsilonrules
+	       , leftcornerCats = leftcorncats
+	       , leftcornerTokens = leftcorntoks
+	       , grammarCats = grammarcats
+	       , grammarToks = grammartoks
+	       , startupCats = startup
+	       }
+
+    where allrules = listArray (0,length grammar-1) grammar
+	  topdownrules  = accumAssoc id [(cat,  ruleid) | (ruleid, FRule _ _ _ cat _) <- assocs allrules]
+	  epsilonrules  = [ ruleid | (ruleid, FRule _ _ _ _ lins) <- assocs allrules,
+                            not (inRange (bounds (lins ! 0)) 0) ]
+	  leftcorncats  = accumAssoc id [ (cat, ruleid) | (ruleid, rule) <- assocs allrules, cat <- getLeftCornerCat rule ]
+	  leftcorntoks  = accumAssoc id [ (tok, ruleid) | (ruleid, rule) <- assocs allrules, tok <- getLeftCornerTok rule ]
+	  grammarcats   = aElems topdownrules
+	  grammartoks   = nubsort [t | (FRule _ _ _ _ lins) <- grammar, lin <- elems lins, FSymTok t <- elems lin]
+
+
+----------------------------------------------------------------------
+-- pretty-printing of statistics
+
+instance Print ParserInfo where
+    prt pI = "[ allRules=" ++ sl (elems . allRules) ++
+	     "; tdRules=" ++ sla topdownRules ++
+	     -- "; emptyRules=" ++ sl emptyRules ++ 
+	     "; epsilonRules=" ++ sl epsilonRules ++ 
+	     "; lcCats=" ++ sla leftcornerCats ++
+	     "; lcTokens=" ++ sla leftcornerTokens ++
+	     "; categories=" ++ sl grammarCats ++ 
+	     " ]"
+
+	where sl  f = show $ length $ f pI
+	      sla f = let (as, bs) = unzip $ aAssocs $ f pI
+		       in show (length as) ++ "/" ++ show (length (concat bs))
+

src-3.0/GF/GFCC/DataGFCC.hs

@@ -35,7 +35,7 @@ data Concr = Concr {
   lindefs :: Map.Map CId Term,      -- lin default of a cat
   printnames :: Map.Map CId Term,   -- printname of a cat or a fun
   paramlincats :: Map.Map CId Term, -- lin type of cat, with printable param names
-  parser  :: Maybe FCFPInfo     -- parser
+  parser  :: Maybe ParserInfo       -- parser
   }
 
 data Type =
@@ -100,20 +100,20 @@ data FRule     = FRule CId [Profile] [FCat] FCat (Array FIndex (Array FPointPos
 
 type RuleId = Int
 
-data FCFPInfo
-    = FCFPInfo { allRules           :: Array RuleId FRule
-               , topdownRules       :: Assoc FCat [RuleId]
-		 -- ^ used in 'GF.Parsing.MCFG.Active' (Earley):
-	         -- , emptyRules    :: [RuleId]
-	       , epsilonRules       :: [RuleId]
-		 -- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury):
-	       , leftcornerCats     :: Assoc FCat   [RuleId]
-	       , leftcornerTokens   :: Assoc FToken [RuleId]
-		 -- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury):
-	       , grammarCats        :: [FCat]
-	       , grammarToks        :: [FToken]
-	       , startupCats        :: Map.Map CId [FCat]
-	       }
+data ParserInfo
+    = ParserInfo { allRules           :: Array RuleId FRule
+                 , topdownRules       :: Assoc FCat [RuleId]
+	  	   -- ^ used in 'GF.Parsing.MCFG.Active' (Earley):
+	           -- , emptyRules    :: [RuleId]
+	         , epsilonRules       :: [RuleId]
+		   -- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury):
+	         , leftcornerCats     :: Assoc FCat   [RuleId]
+	         , leftcornerTokens   :: Assoc FToken [RuleId]
+		   -- ^ used in 'GF.Parsing.MCFG.Active' (Kilbury):
+	         , grammarCats        :: [FCat]
+	         , grammarToks        :: [FToken]
+	         , startupCats        :: Map.Map CId [FCat]
+	         }
 
 
 fcatString, fcatInt, fcatFloat, fcatVar :: Int

src-3.0/GF/GFCC/GFCCtoJS.hs

@@ -85,7 +85,7 @@ children :: JS.Ident
 children = JS.Ident "cs"
 
 -- Parser
-parser2js :: String -> FCFPInfo -> [JS.Expr]
+parser2js :: String -> ParserInfo -> [JS.Expr]
 parser2js start p  = [new "Parser" [JS.EStr start,
                                     JS.EArray $ map frule2js (Array.elems (allRules p)),
                                     JS.EObj $ map cats (Map.assocs (startupCats p))]]

src-3.0/GF/GFCC/Macros.hs

@@ -2,10 +2,10 @@ module GF.GFCC.Macros where
 
 import GF.GFCC.CId
 import GF.GFCC.DataGFCC
-import GF.Parsing.FCFG.PInfo (fcfPInfoToFGrammar)
 import GF.Infra.PrintClass
 import Control.Monad
-import qualified Data.Map as Map
+import qualified Data.Map   as Map
+import qualified Data.Array as Array
 import Data.Maybe
 import Data.List
 
@@ -31,11 +31,14 @@ lookType :: GFCC -> CId -> Type
 lookType gfcc f = 
   fst $ lookMap (error $ "lookType " ++ show f) f (funs (abstract gfcc))
 
-lookParser :: GFCC -> CId -> Maybe FCFPInfo
+lookParser :: GFCC -> CId -> Maybe ParserInfo
 lookParser gfcc lang = parser $ lookMap (error "no lang") lang $ concretes gfcc
 
 lookFCFG :: GFCC -> CId -> Maybe FGrammar
-lookFCFG gfcc lang = fmap fcfPInfoToFGrammar $ lookParser gfcc lang
+lookFCFG gfcc lang = fmap toFGrammar $ lookParser gfcc lang
+  where
+    toFGrammar :: ParserInfo -> FGrammar
+    toFGrammar pinfo = (Array.elems (allRules pinfo), startupCats pinfo)
 
 lookStartCat :: GFCC -> String
 lookStartCat gfcc = fromMaybe "S" $ msum $ Data.List.map (Map.lookup (mkCId "startcat"))

src-3.0/GF/GFCC/Raw/ConvertGFCC.hs

@@ -3,10 +3,10 @@ module GF.GFCC.Raw.ConvertGFCC (toGFCC,fromGFCC) where
 import GF.GFCC.CId
 import GF.GFCC.DataGFCC
 import GF.GFCC.Raw.AbsGFCCRaw
+import GF.GFCC.BuildParser (buildParserInfo)
 
 import GF.Infra.PrintClass
 import GF.Formalism.Utilities
-import GF.Parsing.FCFG.PInfo (buildFCFPInfo)
 
 import qualified Data.Array as Array
 import qualified Data.Map   as Map
@@ -66,8 +66,8 @@ toConcr = foldl add (Concr {
     add cnc (App "param" ts)     = cnc { paramlincats = mkTermMap ts }
     add cnc (App "parser" ts)    = cnc { parser = Just (toPInfo ts) }
 
-toPInfo :: [RExp] -> FCFPInfo
-toPInfo [App "rules" rs, App "startupcats" cs] = buildFCFPInfo (rules, cats)
+toPInfo :: [RExp] -> ParserInfo
+toPInfo [App "rules" rs, App "startupcats" cs] = buildParserInfo (rules, cats)
   where 
     rules = map toFRule rs
     cats = Map.fromList [(mkCId c, map expToInt fs) | App c fs <- cs]
@@ -204,7 +204,7 @@ fromTerm e = case e of
 
 -- ** Parsing info
 
-fromPInfo :: FCFPInfo -> RExp
+fromPInfo :: ParserInfo -> RExp
 fromPInfo p = App "parser" [
           App "rules"         [fromFRule rule | rule <- Array.elems (allRules p)],
           App "startupcats"   [App (prCId f) (map intToExp cs) | (f,cs) <- Map.toList (startupCats p)]