diff --git a/src/GF/Canon/GFCC/FCFGParsing.hs b/src/GF/Canon/GFCC/FCFGParsing.hs deleted file mode 100644 index 2bd953f0f..000000000 --- a/src/GF/Canon/GFCC/FCFGParsing.hs +++ /dev/null @@ -1,114 +0,0 @@ -module GF.Canon.GFCC.FCFGParsing (parserLang,PF.buildFCFPInfo,PF.FCFPInfo) where - -import GF.Canon.GFCC.DataGFCC -import GF.Canon.GFCC.AbsGFCC -import GF.Conversion.SimpleToFCFG (convertGrammar,FCat(..)) - -import GF.Data.SortedList -import GF.Data.Assoc -import GF.Formalism.Utilities --(forest2trees) -import qualified GF.Data.Operations as Op - -import GF.Formalism.FCFG -import qualified GF.Parsing.FCFG as PF -import GF.Canon.GFCC.ErrM -import GF.Infra.PrintClass - -parserLang :: GFCC -> CId -> CFCat -> [CFTok] -> Err [Exp] -parserLang mgr lang = parse info where - fcfgs = convertGrammar mgr - info = PF.buildFCFPInfo $ maybe (error "no parser") id $ lookup lang fcfgs - -type CFTok = String ---- -type CFCat = CId ---- -type Fun = CId ---- - -cfCat2Ident = id ---- - -wordsCFTok :: CFTok -> [String] -wordsCFTok = return ---- - - --- main parsing function - -parse :: --- String -> -- ^ parsing algorithm (mcfg or cfg) --- String -> -- ^ parsing strategy - PF.FCFPInfo -> -- ^ compiled grammar (fcfg) --- Ident.Ident -> -- ^ abstract module name - CFCat -> -- ^ starting category - [CFTok] -> -- ^ input tokens - Err [Exp] -- ^ resulting GF terms - -parse pinfo startCat inString = e2e $ - - do let inTokens = inputMany (map wordsCFTok inString) - forests <- selectParser pinfo startCat inTokens - let filteredForests = forests >>= applyProfileToForest - trees = nubsort $ filteredForests >>= forest2trees - - return $ map tree2term trees - - --- parsing via FCFG -selectParser pinfo startCat inTokens - = do let startCats = filter isStart $ PF.grammarCats fcfpi - isStart cat = cat' == cfCat2Ident startCat - where CId x = fcat2cid cat - cat' = CId x - fcfpi = pinfo - fcfParser <- PF.parseFCF "bottomup" - let chart = fcfParser fcfpi startCats inTokens - (i,j) = inputBounds inTokens - finalEdges = [PF.makeFinalEdge cat i j | cat <- startCats] - return $ map cnv_forests $ chart2forests chart (const False) finalEdges - -cnv_forests FMeta = FMeta -cnv_forests (FNode (Name (CId n) p) fss) = FNode (Name (CId n) (map cnv_profile p)) (map (map cnv_forests) fss) -cnv_forests (FString x) = FString x -cnv_forests (FInt x) = FInt x -cnv_forests (FFloat x) = FFloat x - -cnv_profile (Unify x) = Unify x -cnv_profile (Constant x) = Constant (cnv_forests2 x) - -cnv_forests2 FMeta = FMeta -cnv_forests2 (FNode (CId n) fss) = FNode (CId n) (map (map cnv_forests2) fss) -cnv_forests2 (FString x) = FString x -cnv_forests2 (FInt x) = FInt x -cnv_forests2 (FFloat x) = FFloat x - ----------------------------------------------------------------------- --- parse trees to GFCC terms - -tree2term :: SyntaxTree Fun -> Exp -tree2term (TNode f ts) = Tr (AC f) (map tree2term ts) - -tree2term (TString s) = Tr (AS s) [] -tree2term (TInt n) = Tr (AI n) [] -tree2term (TFloat f) = Tr (AF f) [] -tree2term (TMeta) = Tr AM [] - ----------------------------------------------------------------------- --- conversion and unification of forests - --- simplest implementation -applyProfileToForest :: SyntaxForest FName -> [SyntaxForest Fun] -applyProfileToForest (FNode name@(Name fun profile) children) - | isCoercionF name = concat chForests - | otherwise = [ FNode fun chForests | not (null chForests) ] - where chForests = concat [ applyProfileM unifyManyForests profile forests | - forests0 <- children, - forests <- mapM applyProfileToForest forests0 ] -applyProfileToForest (FString s) = [FString s] -applyProfileToForest (FInt n) = [FInt n] -applyProfileToForest (FFloat f) = [FFloat f] -applyProfileToForest (FMeta) = [FMeta] - ---- - -e2e :: Op.Err a -> Err a -e2e e = case e of - Op.Ok v -> Ok v - Op.Bad s -> Bad s - diff --git a/src/GF/Canon/GFCC/GFCCAPI.hs b/src/GF/Canon/GFCC/GFCCAPI.hs index f04808037..0ee273f02 100644 --- a/src/GF/Canon/GFCC/GFCCAPI.hs +++ b/src/GF/Canon/GFCC/GFCCAPI.hs @@ -21,7 +21,7 @@ import GF.Canon.GFCC.AbsGFCC import GF.Canon.GFCC.ParGFCC import GF.Canon.GFCC.PrintGFCC import GF.Canon.GFCC.ErrM -import GF.Canon.GFCC.FCFGParsing +import GF.Parsing.FCFG import qualified GF.Canon.GFCC.GenGFCC as G import GF.Conversion.SimpleToFCFG (convertGrammar,FCat(..)) @@ -82,7 +82,11 @@ file2gfcc f = linearize mgr lang = GF.Canon.GFCC.DataGFCC.linearize (gfcc mgr) (CId lang) parse mgr lang cat s = - err error id $ parserLang (gfcc mgr) (CId lang) (CId cat) (words s) + case lookup lang (parsers mgr) of + Nothing -> error "no parser" + Just pinfo -> case parseFCF "bottomup" pinfo (CId cat) (words s) of + Ok x -> x + Bad s -> error s linearizeAll mgr = map snd . linearizeAllLang mgr linearizeAllLang mgr t = diff --git a/src/GF/Parsing/FCFG.hs b/src/GF/Parsing/FCFG.hs index 91b4201b7..7784285e1 100644 --- a/src/GF/Parsing/FCFG.hs +++ b/src/GF/Parsing/FCFG.hs @@ -8,25 +8,91 @@ ----------------------------------------------------------------------------- module GF.Parsing.FCFG - (parseFCF, module GF.Parsing.FCFG.PInfo) where + (parseFCF,buildFCFPInfo,FCFPInfo(..),makeFinalEdge) where -import GF.Data.Operations (Err(..)) +import GF.Data.SortedList +import GF.Data.Assoc +import GF.Infra.PrintClass + +import GF.Formalism.FCFG import GF.Formalism.Utilities -import GF.Parsing.FCFG.PInfo import qualified GF.Parsing.FCFG.Active as Active -import GF.Infra.PrintClass +import GF.Parsing.FCFG.PInfo + +import GF.Canon.GFCC.AbsGFCC +import GF.Canon.GFCC.ErrM + ---------------------------------------------------------------------- -- parsing -parseFCF :: String -> Err (FCFParser) -parseFCF prs | prs `elem` strategies = Ok $ parseFCF' prs - | otherwise = Bad $ "FCFG parsing strategy not defined: " ++ prs +-- main parsing function -strategies = words "bottomup topdown" +parseFCF :: + String -> -- ^ parsing strategy + FCFPInfo -> -- ^ compiled grammar (fcfg) + CId -> -- ^ starting category + [String] -> -- ^ input tokens + Err [Exp] -- ^ resulting GF terms +parseFCF strategy pinfo startCat inString = + do let inTokens = input inString + startCats = filter isStart $ grammarCats pinfo + isStart cat = fcat2cid cat == startCat + fcfParser <- parseFCF strategy + let chart = fcfParser pinfo startCats inTokens + (i,j) = inputBounds inTokens + finalEdges = [makeFinalEdge cat i j | cat <- startCats] + forests = map cnv_forests $ chart2forests chart (const False) finalEdges + filteredForests = forests >>= applyProfileToForest + trees = nubsort $ filteredForests >>= forest2trees + return $ map tree2term trees + where + parseFCF :: String -> Err (FCFParser) + parseFCF "bottomup" = Ok $ Active.parse "b" + parseFCF "topdown" = Ok $ Active.parse "t" + parseFCF strat = Bad $ "FCFG parsing strategy not defined: " ++ strat -parseFCF' :: String -> FCFParser -parseFCF' "bottomup" pinfo starts toks = Active.parse "b" pinfo starts toks -parseFCF' "topdown" pinfo starts toks = Active.parse "t" pinfo starts toks + +cnv_forests FMeta = FMeta +cnv_forests (FNode (Name (CId n) p) fss) = FNode (Name (CId n) (map cnv_profile p)) (map (map cnv_forests) fss) +cnv_forests (FString x) = FString x +cnv_forests (FInt x) = FInt x +cnv_forests (FFloat x) = FFloat x + +cnv_profile (Unify x) = Unify x +cnv_profile (Constant x) = Constant (cnv_forests2 x) + +cnv_forests2 FMeta = FMeta +cnv_forests2 (FNode (CId n) fss) = FNode (CId n) (map (map cnv_forests2) fss) +cnv_forests2 (FString x) = FString x +cnv_forests2 (FInt x) = FInt x +cnv_forests2 (FFloat x) = FFloat x + +---------------------------------------------------------------------- +-- parse trees to GFCC terms + +tree2term :: SyntaxTree CId -> Exp +tree2term (TNode f ts) = Tr (AC f) (map tree2term ts) + +tree2term (TString s) = Tr (AS s) [] +tree2term (TInt n) = Tr (AI n) [] +tree2term (TFloat f) = Tr (AF f) [] +tree2term (TMeta) = Tr AM [] + +---------------------------------------------------------------------- +-- conversion and unification of forests + +-- simplest implementation +applyProfileToForest :: SyntaxForest FName -> [SyntaxForest CId] +applyProfileToForest (FNode name@(Name fun profile) children) + | isCoercionF name = concat chForests + | otherwise = [ FNode fun chForests | not (null chForests) ] + where chForests = concat [ applyProfileM unifyManyForests profile forests | + forests0 <- children, + forests <- mapM applyProfileToForest forests0 ] +applyProfileToForest (FString s) = [FString s] +applyProfileToForest (FInt n) = [FInt n] +applyProfileToForest (FFloat f) = [FFloat f] +applyProfileToForest (FMeta) = [FMeta] diff --git a/src/GF/Parsing/GFC.hs b/src/GF/Parsing/GFC.hs index 948d3577b..2486efd81 100644 --- a/src/GF/Parsing/GFC.hs +++ b/src/GF/Parsing/GFC.hs @@ -25,8 +25,9 @@ import qualified GF.Grammar.Grammar as Grammar import qualified GF.Grammar.Macros as Macros import qualified GF.Canon.AbsGFC as AbsGFC import qualified GF.Canon.GFCC.AbsGFCC as AbsGFCC +import qualified GF.Canon.GFCC.ErrM as ErrM import qualified GF.Infra.Ident as Ident -import GF.CF.CFIdent (CFCat, cfCat2Ident, CFTok, wordsCFTok) +import GF.CF.CFIdent (CFCat, cfCat2Ident, CFTok, wordsCFTok, prCFTok) import GF.Data.SortedList import GF.Data.Assoc @@ -73,26 +74,12 @@ parse :: String -- ^ parsing algorithm (mcfg or cfg) -> [CFTok] -- ^ input tokens -> Err [Grammar.Term] -- ^ resulting GF terms -parse prs strategy pinfo abs startCat inString = - do let inTokens = tracePrt "Parsing.GFC - input tokens" prt $ - inputMany (map wordsCFTok inString) - forests <- selectParser prs strategy pinfo startCat inTokens - traceM "Parsing.GFC - nr. unfiltered forests" (prt (length forests)) - traceM "Parsing.GFC - nr. unfiltered trees" (prt (length (forests >>= forest2trees))) - let filteredForests = tracePrt "Parsing.GFC - nr. forests" (prt . length) $ - forests >>= applyProfileToForest - -- compactFs = tracePrt "#compactForests" (prt . length) $ - -- tracePrt "compactForests" (prtBefore "\n") $ - -- compactForests forests - trees = tracePrt "Parsing.GFC - nr. trees" (prt . length) $ - nubsort $ filteredForests >>= forest2trees - -- compactFs >>= forest2trees - return $ map (tree2term abs) trees - -- parsing via CFG -selectParser "c" strategy pinfo startCat inTokens - = do let startCats = tracePrt "Parsing.GFC - starting CF categories" prt $ +parse "c" strategy pinfo abs startCat inString + = do let inTokens = tracePrt "Parsing.GFC - input tokens" prt $ + inputMany (map wordsCFTok inString) + let startCats = tracePrt "Parsing.GFC - starting CF categories" prt $ filter isStart $ map fst $ aAssocs $ PC.topdownRules cfpi isStart cat = ccat2scat cat == cfCat2Ident startCat cfpi = cfPInfo pinfo @@ -103,11 +90,25 @@ selectParser "c" strategy pinfo startCat inTokens C.grammar2chart cfChart finalEdges = tracePrt "Parsing.GFC - final chart edges" prt $ map (uncurry Edge (inputBounds inTokens)) startCats - return $ chart2forests chart (const False) finalEdges + forests = chart2forests chart (const False) finalEdges + traceM "Parsing.GFC - nr. unfiltered forests" (prt (length forests)) + traceM "Parsing.GFC - nr. unfiltered trees" (prt (length (forests >>= forest2trees))) + let filteredForests = tracePrt "Parsing.GFC - nr. forests" (prt . length) $ + forests >>= applyProfileToForest + -- compactFs = tracePrt "#compactForests" (prt . length) $ + -- tracePrt "compactForests" (prtBefore "\n") $ + -- compactForests forests + trees = tracePrt "Parsing.GFC - nr. trees" (prt . length) $ + nubsort $ filteredForests >>= forest2trees + -- compactFs >>= forest2trees + return $ map (tree2term abs) trees + -- parsing via MCFG -selectParser "m" strategy pinfo startCat inTokens - = do let startCats = tracePrt "Parsing.GFC - starting MCF categories" prt $ +parse "m" strategy pinfo abs startCat inString + = do let inTokens = tracePrt "Parsing.GFC - input tokens" prt $ + inputMany (map wordsCFTok inString) + let startCats = tracePrt "Parsing.GFC - starting MCF categories" prt $ filter isStart $ PM.grammarCats mcfpi isStart cat = mcat2scat cat == cfCat2Ident startCat mcfpi = mcfPInfo pinfo @@ -116,20 +117,28 @@ selectParser "m" strategy pinfo startCat inTokens finalEdges = tracePrt "Parsing.GFC - final chart edges" prt $ [ PM.makeFinalEdge cat lbl (inputBounds inTokens) | cat@(MCat _ [lbl]) <- startCats ] - return $ chart2forests chart (const False) finalEdges + forests = chart2forests chart (const False) finalEdges + traceM "Parsing.GFC - nr. unfiltered forests" (prt (length forests)) + traceM "Parsing.GFC - nr. unfiltered trees" (prt (length (forests >>= forest2trees))) + let filteredForests = tracePrt "Parsing.GFC - nr. forests" (prt . length) $ + forests >>= applyProfileToForest + -- compactFs = tracePrt "#compactForests" (prt . length) $ + -- tracePrt "compactForests" (prtBefore "\n") $ + -- compactForests forests + trees = tracePrt "Parsing.GFC - nr. trees" (prt . length) $ + nubsort $ filteredForests >>= forest2trees + -- compactFs >>= forest2trees + return $ map (tree2term abs) trees + -- parsing via FCFG -selectParser "f" strategy pinfo startCat inTokens - = do let startCats = filter isStart $ PF.grammarCats fcfpi - isStart cat = cat' == cfCat2Ident startCat - where AbsGFCC.CId x = fcat2cid cat - cat' = Ident.IC x - fcfpi = fcfPInfo pinfo - fcfParser <- PF.parseFCF strategy - let chart = fcfParser fcfpi startCats inTokens - (i,j) = inputBounds inTokens - finalEdges = [PF.makeFinalEdge cat i j | cat <- startCats] - return $ map cnv_forests $ chart2forests chart (const False) finalEdges +parse "f" strategy pinfo abs startCat inString = + let Ident.IC x = cfCat2Ident startCat + cat' = AbsGFCC.CId x + in case PF.parseFCF strategy (fcfPInfo pinfo) cat' (map prCFTok inString) of + ErrM.Ok es -> Ok (map (exp2term abs) es) + ErrM.Bad msg -> Bad msg + -- error parser: selectParser prs strategy _ _ _ = Bad $ "Parser '" ++ prs ++ "' not defined with strategy: " ++ strategy @@ -159,6 +168,15 @@ tree2term abs (TInt n) = Macros.int2term n tree2term abs (TFloat f) = Macros.float2term f tree2term abs (TMeta) = Macros.mkMeta 0 +exp2term :: Ident.Ident -> AbsGFCC.Exp -> Grammar.Term +exp2term abs (AbsGFCC.Tr a es) = Macros.mkApp (atom2term abs a) (map (exp2term abs) es) + +atom2term :: Ident.Ident -> AbsGFCC.Atom -> Grammar.Term +atom2term abs (AbsGFCC.AC (AbsGFCC.CId f)) = Macros.qq (abs,Ident.IC f) +atom2term abs (AbsGFCC.AS s) = Macros.string2term s +atom2term abs (AbsGFCC.AI n) = Macros.int2term n +atom2term abs (AbsGFCC.AF f) = Macros.float2term f +atom2term abs AbsGFCC.AM = Macros.mkMeta 0 ---------------------------------------------------------------------- -- conversion and unification of forests