mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-27 05:22:50 -06:00
83 lines
2.8 KiB
Haskell
83 lines
2.8 KiB
Haskell
----------------------------------------------------------------------
|
|
-- |
|
|
-- Module : ParseCF
|
|
-- Maintainer : PL
|
|
-- Stability : (stable)
|
|
-- Portability : (portable)
|
|
--
|
|
-- > CVS $Date: 2005/04/21 16:22:49 $
|
|
-- > CVS $Author: bringert $
|
|
-- > CVS $Revision: 1.2 $
|
|
--
|
|
-- Chart parsing of grammars in CF format
|
|
-----------------------------------------------------------------------------
|
|
|
|
module GF.OldParsing.ParseCF (parse, alternatives) where
|
|
|
|
import GF.System.Tracing
|
|
import GF.Printing.PrintParser
|
|
import GF.Printing.PrintSimplifiedTerm
|
|
|
|
import GF.Data.SortedList (nubsort)
|
|
import GF.Data.Assoc
|
|
import qualified GF.CF.CF as CF
|
|
import qualified GF.CF.CFIdent as CFI
|
|
import GF.OldParsing.Utilities
|
|
import GF.OldParsing.CFGrammar
|
|
import qualified GF.OldParsing.ParseCFG as P
|
|
|
|
type Token = CFI.CFTok
|
|
type Name = CFI.CFFun
|
|
type Category = CFI.CFCat
|
|
|
|
alternatives :: [(String, [String])]
|
|
alternatives = [ ("gb", ["G","GB","_gen","_genBU"]),
|
|
("gt", ["GT","_genTD"]),
|
|
("ibn", ["","I","B","IB","IBN","_inc","BU","_incBU"]),
|
|
("ibb", ["BB","IBB","BU_BUF","_incBU_BUF"]),
|
|
("ibt", ["BT","IBT","BU_TDF","_incBU_TDF"]),
|
|
("iba", ["BA","IBA","BU_BTF","BU_TBF","_incBU_BTF","_incBU_TBF"]),
|
|
("itn", ["T","IT","ITN","TD","_incTD"]),
|
|
("itb", ["TB","ITB","TD_BUF","_incTD_BUF"])
|
|
]
|
|
|
|
parse :: String -> CF.CF -> Category -> CF.CFParser
|
|
parse = buildParser . P.parse
|
|
|
|
buildParser :: CFParser Name Category Token -> CF.CF -> Category -> CF.CFParser
|
|
buildParser parser cf start tokens = trace "ParseCF" $
|
|
(parseResults, parseInformation)
|
|
where parseInformation = prtSep "\n" trees
|
|
parseResults = {-take maxTake-} [ (tree2cfTree t, []) | t <- trees ]
|
|
theInput = input tokens
|
|
edges = tracePrt "#edges" (prt.length) $
|
|
parser pInf [start] theInput
|
|
chart = tracePrt "#chart" (prt . map (length.snd) . aAssocs) $
|
|
edges2chart theInput $ map (fmap addCategory) edges
|
|
forests = tracePrt "#forests" (prt.length) $
|
|
chart2forests chart (const False) $
|
|
uncurry Edge (inputBounds theInput) start
|
|
trees = tracePrt "#trees" (prt.length) $
|
|
concatMap forest2trees forests
|
|
pInf = pInfo $ cf2grammar cf (nubsort tokens)
|
|
|
|
|
|
addCategory (Rule cat rhs name) = Rule cat rhs (name, cat)
|
|
|
|
tree2cfTree (TNode (name, cat) trees) = CF.CFTree (name, (cat, map tree2cfTree trees))
|
|
|
|
cf2grammar :: CF.CF -> [Token] -> Grammar Name Category Token
|
|
cf2grammar cf tokens = [ Rule cat rhs name |
|
|
(name, (cat, rhs0)) <- cfRules,
|
|
rhs <- mapM item2symbol rhs0 ]
|
|
where cfRules = concatMap (CF.predefRules (CF.predefOfCF cf)) tokens ++
|
|
CF.rulesOfCF cf
|
|
item2symbol (CF.CFNonterm cat) = [Cat cat]
|
|
item2symbol item = map Tok $ filter (CF.matchCFTerm item) tokens
|
|
|
|
-- maxTake :: Int
|
|
-- maxTake = 500
|
|
-- maxTake = maxBound
|
|
|
|
|