mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-26 13:02:50 -06:00
77 lines
3.2 KiB
Haskell
77 lines
3.2 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.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]
|