mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-10 05:29:30 -06:00
65 lines
2.3 KiB
Haskell
65 lines
2.3 KiB
Haskell
---------------------------------------------------------------------
|
|
-- |
|
|
-- 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
|
|
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]
|