summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorpeb <unknown>2004-06-10 14:37:43 +0000
committerpeb <unknown>2004-06-10 14:37:43 +0000
commit652618742aa1dd10b1a53bb132a476a91f1dc3ba (patch)
tree602c1ab0e7f8ba9f1797e90a9a768c19e35d677a /src
parent3522b2a3cd8d01ef1b908c1a717b0592332a5737 (diff)
*** empty log message ***
Diffstat (limited to 'src')
-rw-r--r--src/GF/CF/CanonToCF.hs4
-rw-r--r--src/GF/Compile/ShellState.hs32
-rw-r--r--src/GF/Data/Operations.hs11
-rw-r--r--src/GF/UseGrammar/Custom.hs14
-rw-r--r--src/GF/UseGrammar/Parsing.hs4
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