diff options
| author | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:43:48 +0000 |
|---|---|---|
| committer | aarne <aarne@cs.chalmers.se> | 2008-06-25 16:43:48 +0000 |
| commit | b96b36f43de3e2f8b58d5f539daa6f6d47f25870 (patch) | |
| tree | 0992334be13cec6538a1dea22fbbf26ad6bdf224 /src/GF/OldParsing/ParseGFC.hs | |
| parent | fe367412e0aeb4ad5c02de68e6eca382e0f96984 (diff) | |
removed src for 2.9
Diffstat (limited to 'src/GF/OldParsing/ParseGFC.hs')
| -rw-r--r-- | src/GF/OldParsing/ParseGFC.hs | 177 |
1 files changed, 0 insertions, 177 deletions
diff --git a/src/GF/OldParsing/ParseGFC.hs b/src/GF/OldParsing/ParseGFC.hs deleted file mode 100644 index fbc6cff5a..000000000 --- a/src/GF/OldParsing/ParseGFC.hs +++ /dev/null @@ -1,177 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : ParseGFC --- Maintainer : PL --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/04/21 16:22:50 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.2 $ --- --- The main parsing module, parsing GFC grammars --- by translating to simpler formats, such as PMCFG and CFG ----------------------------------------------------------------------- - -module GF.OldParsing.ParseGFC (newParser) where - -import GF.System.Tracing -import GF.Printing.PrintParser -import qualified GF.Grammar.PrGrammar as PrGrammar - --- Haskell modules -import Control.Monad --- import Ratio ((%)) --- GF modules -import qualified GF.Grammar.Grammar as GF -import GF.Grammar.Values -import qualified GF.Grammar.Macros as Macros -import qualified GF.Infra.Modules as Mods -import qualified GF.Canon.AbsGFC as AbsGFC -import qualified GF.Infra.Ident as Ident -import qualified GF.Compile.ShellState as SS -import GF.Data.Operations -import GF.Data.SortedList --- Conversion and parser modules -import GF.Data.Assoc -import GF.OldParsing.Utilities --- import ConvertGrammar -import GF.OldParsing.GrammarTypes -import qualified GF.OldParsing.MCFGrammar as M -import qualified GF.OldParsing.CFGrammar as C -import qualified GF.OldParsing.ParseMCFG as PM -import qualified GF.OldParsing.ParseCFG as PC ---import MCFRange - -newParser :: String -> SS.StateGrammar -> GF.Cat -> String -> Err [GF.Term] - --- parsing via MCFG -newParser (m:strategy) gr (_, startCat) inString - | m=='m' || m=='M' = trace2 "Parser" "MCFG" $ Ok terms - where terms = map (ptree2term abstract) trees - trees = --tracePrt "trees" (prtBefore "\n") $ - tracePrt "#trees" (prt . length) $ - concatMap forest2trees forests - forests = --tracePrt "forests" (prtBefore "\n") $ - tracePrt "#forests" (prt . length) $ - concatMap (chart2forests chart isMeta) finalEdges - isMeta = null . snd - finalEdges = tracePrt "finalEdges" (prtBefore "\n") $ - filter isFinalEdge $ aElems chart --- nubsort [ (cat, [(lbl, E.makeRange [(i,j)])]) | --- let (i, j) = inputBounds inTokens, --- E.Rule cat _ [E.Lin lbl _] _ <- pInf, --- isStartCat cat ] - isFinalEdge (cat, rows) - = isStartCat cat && - inputBounds inTokens `elem` concat [ rho | (_, M.Rng rho) <- rows ] - chart = --tracePrt "chart" (prtBefore "\n" . aAssocs) $ - tracePrt "#chart" (prt . map (length.snd) . aAssocs) $ - PM.parse strategy pInf starters inTokens - inTokens = input $ map AbsGFC.KS $ words inString - pInf = -- tracePrt "avg rec" (\gr -> show (sum [ length rec | E.Rule _ _ rec _ <- gr ] % length gr)) $ - mcfPInfo $ SS.statePInfoOld gr - starters = tracePrt "startCats" prt $ - filter isStartCat $ nubsort [ cat | M.Rule cat _ _ _ <- pInf ] - isStartCat (MCFCat cat _) = cat == startCat - abstract = tracePrt "abstract module" PrGrammar.prt $ - SS.absId gr - --- parsing via CFG -newParser (c:strategy) gr (_, startCat) inString - | c=='c' || c=='C' = trace2 "Parser" "CFG" $ Ok terms - where terms = -- tracePrt "terms" (unlines . map PrGrammar.prt) $ - map (ptree2term abstract) trees - trees = tracePrt "#trees" (prt . length) $ - --tracePrt "trees" (prtSep "\n") $ - concatMap forest2trees forests - forests = tracePrt "$cfForests" (prt) $ -- . length) $ - tracePrt "forests" (unlines . map prt) $ - concatMap convertFromCFForest cfForests - cfForests= tracePrt "cfForests" (unlines . map prt) $ - concatMap (chart2forests chart (const False)) finalEdges - finalEdges = tracePrt "finalChartEdges" prt $ - map (uncurry Edge (inputBounds inTokens)) starters - chart = --tracePrt "finalChartEdges" (prt . (? finalEdge)) $ - tracePrt "#chart" (prt . map (length.snd) . aAssocs) $ - C.edges2chart inTokens edges - edges = --tracePrt "finalEdges" - --(prt . filter (\(Edge i j _) -> (i,j)==inputBounds inTokens)) $ - tracePrt "#edges" (prt . length) $ - PC.parse strategy pInf starters inTokens - inTokens = input $ map AbsGFC.KS $ words inString - pInf = cfPInfo $ SS.statePInfoOld gr - starters = tracePrt "startCats" prt $ - filter isStartCat $ map fst $ aAssocs $ C.topdownRules pInf - isStartCat (CFCat (MCFCat cat _) _) = cat == startCat - abstract = tracePrt "abstract module" PrGrammar.prt $ - SS.absId gr - --ifNull (Ident.identC "ABS") last $ - --[i | (i, Mods.ModMod m) <- Mods.modules (SS.grammar gr), Mods.isModAbs m] - -newParser "" gr start inString = newParser "c" gr start inString - -newParser opt gr (_,cat) _ = - Bad ("new-parser '" ++ opt ++ "' not defined yet") - -ptree2term :: Ident.Ident -> ParseTree Name -> GF.Term -ptree2term a (TNode f ts) = Macros.mkApp (Macros.qq (a,f)) (map (ptree2term a) ts) -ptree2term a (TMeta) = GF.Meta (GF.MetaSymb 0) - ----------------------------------------------------------------------- --- conversion and unification of forests - -convertFromCFForest :: ParseForest CFName -> [ParseForest Name] -convertFromCFForest (FNode (CFName name profile) children) - | isCoercion name = concat chForests - | otherwise = [ FNode name chForests | not (null chForests) ] - where chForests = concat [ mapM (checkProfile forests) profile | - forests0 <- children, - forests <- mapM convertFromCFForest forests0 ] - checkProfile forests = unifyManyForests . map (forests !!) - -- foldM unifyForests FMeta . map (forests !!) - -isCoercion Ident.IW = True -isCoercion _ = False - -unifyManyForests :: Eq n => [ParseForest n] -> [ParseForest n] -unifyManyForests [] = [FMeta] -unifyManyForests [f] = [f] -unifyManyForests (f:g:fs) = do h <- unifyForests f g - unifyManyForests (h:fs) - -unifyForests :: Eq n => ParseForest n -> ParseForest n -> [ParseForest n] -unifyForests FMeta forest = [forest] -unifyForests forest FMeta = [forest] -unifyForests (FNode name1 children1) (FNode name2 children2) - = [ FNode name1 children | name1 == name2, not (null children) ] - where children = [ forests | forests1 <- children1, forests2 <- children2, - forests <- zipWithM unifyForests forests1 forests2 ] - - - -{- ----------------------------------------------------------------------- --- conversion and unification for parse trees instead of forests - -convertFromCFTree :: ParseTree CFName -> [ParseTree Name] -convertFromCFTree (TNode (CFName name profile) children0) - = [ TNode name children | - children1 <- mapM convertFromCFTree children0, - children <- mapM (checkProfile children1) profile ] - where checkProfile trees = unifyManyTrees . map (trees !!) - -unifyManyTrees :: Eq n => [ParseTree n] -> [ParseTree n] -unifyManyTrees [] = [TMeta] -unifyManyTrees [f] = [f] -unifyManyTrees (f:g:fs) = do h <- unifyTrees f g - unifyManyTrees (h:fs) - -unifyTrees TMeta tree = [tree] -unifyTrees tree TMeta = [tree] -unifyTrees (TNode name1 children1) (TNode name2 children2) - = [ TNode name1 children | name1 == name2, - children <- zipWithM unifyTrees children1 children2 ] - --} - |
