summaryrefslogtreecommitdiff
path: root/src/GF/OldParsing/ParseGFC.hs
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
committeraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
commitb96b36f43de3e2f8b58d5f539daa6f6d47f25870 (patch)
tree0992334be13cec6538a1dea22fbbf26ad6bdf224 /src/GF/OldParsing/ParseGFC.hs
parentfe367412e0aeb4ad5c02de68e6eca382e0f96984 (diff)
removed src for 2.9
Diffstat (limited to 'src/GF/OldParsing/ParseGFC.hs')
-rw-r--r--src/GF/OldParsing/ParseGFC.hs177
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 ]
-
--}
-