From 7cc1ecbbcf68fb358d186bc094262c0279897763 Mon Sep 17 00:00:00 2001 From: peb Date: Thu, 10 Jun 2004 14:37:43 +0000 Subject: [PATCH] *** empty log message *** --- src/GF/CF/CanonToCF.hs | 4 +++- src/GF/Compile/ShellState.hs | 32 +++++++++++--------------------- src/GF/Data/Operations.hs | 11 +++++++++++ src/GF/UseGrammar/Custom.hs | 14 +++++++------- src/GF/UseGrammar/Parsing.hs | 4 ++-- 5 files changed, 34 insertions(+), 31 deletions(-) diff --git a/src/GF/CF/CanonToCF.hs b/src/GF/CF/CanonToCF.hs index 430ccbbac..d2e247360 100644 --- a/src/GF/CF/CanonToCF.hs +++ b/src/GF/CF/CanonToCF.hs @@ -1,5 +1,7 @@ module CanonToCF where +import Tracing -- peb 8/6-04 + import Operations import Option import Ident @@ -23,7 +25,7 @@ import Monad -- the abstract module name a that m is of. canon2cf :: Options -> CanonGrammar -> Ident -> Err CF -canon2cf opts gr c = do +canon2cf opts gr c = tracePrt "#size of CF" (err id (show.length.rulesOfCF)) $ do -- peb 8/6-04 let ms = M.allExtends gr c a <- M.abstractOfConcrete gr c let cncs = [m | (n, M.ModMod m) <- M.modules gr, elem n ms] diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs index c6a6a0a20..bc5bc1d33 100644 --- a/src/GF/Compile/ShellState.hs +++ b/src/GF/Compile/ShellState.hs @@ -36,9 +36,7 @@ data ShellState = ShSt { canModules :: CanonGrammar , -- compiled abstracts and concretes srcModules :: G.SourceGrammar , -- saved resource modules cfs :: [(Ident,CF)] , -- context-free grammars --- peb 25/5-04: --- cfParserInfos :: [(Ident, CFParserInfo)], -- parser information - cfParserInfos :: Cnv.CFParserInfo, -- peb 27/5-04 + pInfos :: Cnv.PInfo, -- peb 8/6 morphos :: [(Ident,Morpho)], -- morphologies gloptions :: Options, -- global options readFiles :: [(FilePath,ModTime)],-- files read @@ -61,8 +59,7 @@ emptyShellState = ShSt { canModules = M.emptyMGrammar, srcModules = M.emptyMGrammar, cfs = [], --- cfParserInfos = [], -- peb 25/5-04 - cfParserInfos = Cnv.emptyParserInfo, -- peb 27/5-04 + pInfos = Cnv.pInfo M.emptyMGrammar, -- peb 8/6 morphos = [], gloptions = noOptions, readFiles = [], @@ -81,8 +78,7 @@ data StateGrammar = StGr { cncId :: Ident, grammar :: CanonGrammar, cf :: CF, --- cfParserInfo :: CFParserInfo, -- peb 25/5-04 - cfParserInfo :: Cnv.CFParserInfo, -- peb 27/5-04 + pInfo :: Cnv.PInfo, -- peb 8/6 morpho :: Morpho, loptions :: Options } @@ -92,8 +88,7 @@ emptyStateGrammar = StGr { cncId = identC "#EMPTY", --- grammar = M.emptyMGrammar, cf = emptyCF, --- cfParserInfo = emptyParserInfo, -- peb 25/5-04 - cfParserInfo = Cnv.emptyParserInfo, -- peb 27/5-04 + pInfo = Cnv.pInfo M.emptyMGrammar, -- peb 8/6 morpho = emptyMorpho, loptions = noOptions } @@ -101,8 +96,7 @@ emptyStateGrammar = StGr { -- analysing shell grammar into parts stateGrammarST = grammar stateCF = cf ---stateParserInfo= cfParserInfo -stateParserInfo= cfParserInfo +statePInfo = pInfo stateMorpho = morpho stateOptions = loptions stateGrammarWords = allMorphoWords . stateMorpho @@ -133,8 +127,8 @@ updateShellState opts sh (gr,(sgr,rts)) = do concr0 = ifNull Nothing (return . last) concrs notInrts f = notElem f $ map fst rts cfs <- mapM (canon2cf opts cgr) concrs --- would not need to update all... --- let parserInfos = map cf2parserInfo cfs -- peb 25/5-04 - let parserInfos = Cnv.convertCanonToCFParserInfo gr -- peb 27/5-04 + + let pinfos = Cnv.pInfo gr -- peb 8/6 let funs = funRulesOf cgr let cats = allCatsOf cgr @@ -153,8 +147,7 @@ updateShellState opts sh (gr,(sgr,rts)) = do canModules = cgr, srcModules = src, cfs = zip concrs cfs, --- cfParserInfos = zip concrs parserInfos, -- peb 25/5-04 - cfParserInfos = parserInfos, -- peb 27/5-04 + pInfos = pinfos, -- peb 8/6 morphos = zip concrs (map (mkMorpho cgr) concrs), gloptions = opts, readFiles = [ft | ft@(f,_) <- readFiles sh, notInrts f] ++ rts, @@ -199,8 +192,7 @@ purgeShellState sh = ShSt { canModules = M.MGrammar $ purge $ M.modules $ canModules sh, srcModules = M.emptyMGrammar, cfs = cfs sh, --- cfParserInfos = cfParserInfos sh, -- peb 25/5-04 - cfParserInfos = cfParserInfos sh, -- peb 27/5-04 + pInfos = pInfos sh, morphos = morphos sh, gloptions = gloptions sh, readFiles = [], @@ -257,8 +249,7 @@ stateGrammarOfLang st l = StGr { cncId = l, grammar = can, cf = maybe emptyCF id (lookup l (cfs st)), --- cfParserInfo = maybe emptyParserInfo id (lookup l (cfParserInfos st)), -- peb 25/5-04 - cfParserInfo = cfParserInfos st, -- peb 27/5-04 + pInfo = pInfos st, -- peb 8/6 morpho = maybe emptyMorpho id (lookup l (morphos st)), loptions = errVal noOptions $ lookupOptionsCan can } @@ -288,8 +279,7 @@ stateAbstractGrammar st = StGr { cncId = identC "#Cnc", --- grammar = canModules st, ---- only abstarct ones cf = emptyCF, --- cfParserInfo = emptyParserInfo, -- peb 25/5-04 - cfParserInfo = Cnv.emptyParserInfo, -- peb 27/5-04 + pInfo = Cnv.pInfo (canModules st), -- peb 8/6 morpho = emptyMorpho, loptions = gloptions st ---- } diff --git a/src/GF/Data/Operations.hs b/src/GF/Data/Operations.hs index f348b768f..9c374fe83 100644 --- a/src/GF/Data/Operations.hs +++ b/src/GF/Data/Operations.hs @@ -111,6 +111,17 @@ mapErr f xs = Ok (ys, unlines ss) (ys,ss) = ([y | Ok y <- fxs], [s | Bad s <- fxs]) fxs = map f xs +-- alternative variant, peb 9/6-04 +mapErrN :: Int -> (a -> Err b) -> [a] -> Err ([b], String) +mapErrN maxN f xs = Ok (ys, unlines (errHdr : ss2)) + where + (ys, ss) = ([y | Ok y <- fxs], [s | Bad s <- fxs]) + errHdr = show nss ++ " errors occured" ++ + if nss > maxN then ", showing the first " ++ show maxN else "" + ss2 = map ("* "++) $ take maxN ss + nss = length ss + fxs = map f xs + -- !! with the error monad (!?) :: [a] -> Int -> Err a xs !? i = foldr (const . return) (Bad "too few elements in list") $ drop i xs diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs index 23bd55afe..daaa7c997 100644 --- a/src/GF/UseGrammar/Custom.hs +++ b/src/GF/UseGrammar/Custom.hs @@ -37,7 +37,7 @@ import GrammarToHaskell -- the cf parsing algorithms import ChartParser -- or some other CF Parser -import qualified ParseCFviaCFG as PCF +import qualified ParseCF as PCF --import qualified ParseGFCviaCFG as PGFC --import NewChartParser --import NewerChartParser @@ -177,12 +177,12 @@ customGrammarPrinter = -- add your own grammar printers here -- grammar conversions, (peb) ,(strCI "gfc_show", show . grammar2canon . stateGrammarST) - -- ,(strCI "tnf", prCanon . Cnv.convertCanonToTNF . stateGrammarST) - ,(strCI "emcfg", Prt.prt . Cnv.convertCanonToEMCFG . stateGrammarST) - ,(strCI "emcfg_cf", Prt.prt . Cnv.convertCanonViaEMCFGtoCFG . stateGrammarST) - ,(strCI "mcfg", Prt.prt . Cnv.convertCanonToMCFG . stateGrammarST) - ,(strCI "mcfg_cf", Prt.prt . Cnv.convertCanonToCFG . stateGrammarST) - ,(strCI "mcfg_show", show . Cnv.convertCanonToMCFG . stateGrammarST) + ,(strCI "emcfg", Prt.prt . Cnv.emcfg . statePInfo) + ,(strCI "mcfg", Prt.prt . Cnv.mcfg . statePInfo) + ,(strCI "cfg", Prt.prt . Cnv.cfg . statePInfo) + ,(strCI "emcfg_show", show . Cnv.emcfg . statePInfo) + ,(strCI "mcfg_show", show . Cnv.mcfg . statePInfo) + ,(strCI "cfg_show", show . Cnv.cfg . statePInfo) --- also include printing via grammar2syntax! ] ++ moreCustomGrammarPrinter diff --git a/src/GF/UseGrammar/Parsing.hs b/src/GF/UseGrammar/Parsing.hs index 6e6356081..380b58ae7 100644 --- a/src/GF/UseGrammar/Parsing.hs +++ b/src/GF/UseGrammar/Parsing.hs @@ -20,7 +20,7 @@ import Option import Custom import ShellState -import qualified ParseGFCviaCFG as N +import qualified ParseGFC as N import Operations @@ -71,7 +71,7 @@ trees2trms opts sg cn as ts0 info = do ts1 <- return (map cf2trm0 ts0) ----- should not need annot mapM (checkErr . (annotate gr) . trExp) ts1 ---- complicated; often fails _ -> do - (ts1,ss) <- checkErr $ mapErr postParse ts0 + (ts1,ss) <- checkErr $ mapErrN 10 postParse ts0 if null ts1 then raise ss else return () ts2 <- mapM (checkErr . annotate gr . refreshMetas [] . trExp) ts1 ---- if forgive then return ts2 else do