forked from GitHub/gf-core
*** empty log message ***
This commit is contained in:
@@ -1,5 +1,7 @@
|
|||||||
module CanonToCF where
|
module CanonToCF where
|
||||||
|
|
||||||
|
import Tracing -- peb 8/6-04
|
||||||
|
|
||||||
import Operations
|
import Operations
|
||||||
import Option
|
import Option
|
||||||
import Ident
|
import Ident
|
||||||
@@ -23,7 +25,7 @@ import Monad
|
|||||||
-- the abstract module name a that m is of.
|
-- the abstract module name a that m is of.
|
||||||
|
|
||||||
canon2cf :: Options -> CanonGrammar -> Ident -> Err CF
|
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
|
let ms = M.allExtends gr c
|
||||||
a <- M.abstractOfConcrete gr c
|
a <- M.abstractOfConcrete gr c
|
||||||
let cncs = [m | (n, M.ModMod m) <- M.modules gr, elem n ms]
|
let cncs = [m | (n, M.ModMod m) <- M.modules gr, elem n ms]
|
||||||
|
|||||||
@@ -36,9 +36,7 @@ data ShellState = ShSt {
|
|||||||
canModules :: CanonGrammar , -- compiled abstracts and concretes
|
canModules :: CanonGrammar , -- compiled abstracts and concretes
|
||||||
srcModules :: G.SourceGrammar , -- saved resource modules
|
srcModules :: G.SourceGrammar , -- saved resource modules
|
||||||
cfs :: [(Ident,CF)] , -- context-free grammars
|
cfs :: [(Ident,CF)] , -- context-free grammars
|
||||||
-- peb 25/5-04:
|
pInfos :: Cnv.PInfo, -- peb 8/6
|
||||||
-- cfParserInfos :: [(Ident, CFParserInfo)], -- parser information
|
|
||||||
cfParserInfos :: Cnv.CFParserInfo, -- peb 27/5-04
|
|
||||||
morphos :: [(Ident,Morpho)], -- morphologies
|
morphos :: [(Ident,Morpho)], -- morphologies
|
||||||
gloptions :: Options, -- global options
|
gloptions :: Options, -- global options
|
||||||
readFiles :: [(FilePath,ModTime)],-- files read
|
readFiles :: [(FilePath,ModTime)],-- files read
|
||||||
@@ -61,8 +59,7 @@ emptyShellState = ShSt {
|
|||||||
canModules = M.emptyMGrammar,
|
canModules = M.emptyMGrammar,
|
||||||
srcModules = M.emptyMGrammar,
|
srcModules = M.emptyMGrammar,
|
||||||
cfs = [],
|
cfs = [],
|
||||||
-- cfParserInfos = [], -- peb 25/5-04
|
pInfos = Cnv.pInfo M.emptyMGrammar, -- peb 8/6
|
||||||
cfParserInfos = Cnv.emptyParserInfo, -- peb 27/5-04
|
|
||||||
morphos = [],
|
morphos = [],
|
||||||
gloptions = noOptions,
|
gloptions = noOptions,
|
||||||
readFiles = [],
|
readFiles = [],
|
||||||
@@ -81,8 +78,7 @@ data StateGrammar = StGr {
|
|||||||
cncId :: Ident,
|
cncId :: Ident,
|
||||||
grammar :: CanonGrammar,
|
grammar :: CanonGrammar,
|
||||||
cf :: CF,
|
cf :: CF,
|
||||||
-- cfParserInfo :: CFParserInfo, -- peb 25/5-04
|
pInfo :: Cnv.PInfo, -- peb 8/6
|
||||||
cfParserInfo :: Cnv.CFParserInfo, -- peb 27/5-04
|
|
||||||
morpho :: Morpho,
|
morpho :: Morpho,
|
||||||
loptions :: Options
|
loptions :: Options
|
||||||
}
|
}
|
||||||
@@ -92,8 +88,7 @@ emptyStateGrammar = StGr {
|
|||||||
cncId = identC "#EMPTY", ---
|
cncId = identC "#EMPTY", ---
|
||||||
grammar = M.emptyMGrammar,
|
grammar = M.emptyMGrammar,
|
||||||
cf = emptyCF,
|
cf = emptyCF,
|
||||||
-- cfParserInfo = emptyParserInfo, -- peb 25/5-04
|
pInfo = Cnv.pInfo M.emptyMGrammar, -- peb 8/6
|
||||||
cfParserInfo = Cnv.emptyParserInfo, -- peb 27/5-04
|
|
||||||
morpho = emptyMorpho,
|
morpho = emptyMorpho,
|
||||||
loptions = noOptions
|
loptions = noOptions
|
||||||
}
|
}
|
||||||
@@ -101,8 +96,7 @@ emptyStateGrammar = StGr {
|
|||||||
-- analysing shell grammar into parts
|
-- analysing shell grammar into parts
|
||||||
stateGrammarST = grammar
|
stateGrammarST = grammar
|
||||||
stateCF = cf
|
stateCF = cf
|
||||||
--stateParserInfo= cfParserInfo
|
statePInfo = pInfo
|
||||||
stateParserInfo= cfParserInfo
|
|
||||||
stateMorpho = morpho
|
stateMorpho = morpho
|
||||||
stateOptions = loptions
|
stateOptions = loptions
|
||||||
stateGrammarWords = allMorphoWords . stateMorpho
|
stateGrammarWords = allMorphoWords . stateMorpho
|
||||||
@@ -133,8 +127,8 @@ updateShellState opts sh (gr,(sgr,rts)) = do
|
|||||||
concr0 = ifNull Nothing (return . last) concrs
|
concr0 = ifNull Nothing (return . last) concrs
|
||||||
notInrts f = notElem f $ map fst rts
|
notInrts f = notElem f $ map fst rts
|
||||||
cfs <- mapM (canon2cf opts cgr) concrs --- would not need to update all...
|
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 funs = funRulesOf cgr
|
||||||
let cats = allCatsOf cgr
|
let cats = allCatsOf cgr
|
||||||
@@ -153,8 +147,7 @@ updateShellState opts sh (gr,(sgr,rts)) = do
|
|||||||
canModules = cgr,
|
canModules = cgr,
|
||||||
srcModules = src,
|
srcModules = src,
|
||||||
cfs = zip concrs cfs,
|
cfs = zip concrs cfs,
|
||||||
-- cfParserInfos = zip concrs parserInfos, -- peb 25/5-04
|
pInfos = pinfos, -- peb 8/6
|
||||||
cfParserInfos = parserInfos, -- peb 27/5-04
|
|
||||||
morphos = zip concrs (map (mkMorpho cgr) concrs),
|
morphos = zip concrs (map (mkMorpho cgr) concrs),
|
||||||
gloptions = opts,
|
gloptions = opts,
|
||||||
readFiles = [ft | ft@(f,_) <- readFiles sh, notInrts f] ++ rts,
|
readFiles = [ft | ft@(f,_) <- readFiles sh, notInrts f] ++ rts,
|
||||||
@@ -199,8 +192,7 @@ purgeShellState sh = ShSt {
|
|||||||
canModules = M.MGrammar $ purge $ M.modules $ canModules sh,
|
canModules = M.MGrammar $ purge $ M.modules $ canModules sh,
|
||||||
srcModules = M.emptyMGrammar,
|
srcModules = M.emptyMGrammar,
|
||||||
cfs = cfs sh,
|
cfs = cfs sh,
|
||||||
-- cfParserInfos = cfParserInfos sh, -- peb 25/5-04
|
pInfos = pInfos sh,
|
||||||
cfParserInfos = cfParserInfos sh, -- peb 27/5-04
|
|
||||||
morphos = morphos sh,
|
morphos = morphos sh,
|
||||||
gloptions = gloptions sh,
|
gloptions = gloptions sh,
|
||||||
readFiles = [],
|
readFiles = [],
|
||||||
@@ -257,8 +249,7 @@ stateGrammarOfLang st l = StGr {
|
|||||||
cncId = l,
|
cncId = l,
|
||||||
grammar = can,
|
grammar = can,
|
||||||
cf = maybe emptyCF id (lookup l (cfs st)),
|
cf = maybe emptyCF id (lookup l (cfs st)),
|
||||||
-- cfParserInfo = maybe emptyParserInfo id (lookup l (cfParserInfos st)), -- peb 25/5-04
|
pInfo = pInfos st, -- peb 8/6
|
||||||
cfParserInfo = cfParserInfos st, -- peb 27/5-04
|
|
||||||
morpho = maybe emptyMorpho id (lookup l (morphos st)),
|
morpho = maybe emptyMorpho id (lookup l (morphos st)),
|
||||||
loptions = errVal noOptions $ lookupOptionsCan can
|
loptions = errVal noOptions $ lookupOptionsCan can
|
||||||
}
|
}
|
||||||
@@ -288,8 +279,7 @@ stateAbstractGrammar st = StGr {
|
|||||||
cncId = identC "#Cnc", ---
|
cncId = identC "#Cnc", ---
|
||||||
grammar = canModules st, ---- only abstarct ones
|
grammar = canModules st, ---- only abstarct ones
|
||||||
cf = emptyCF,
|
cf = emptyCF,
|
||||||
-- cfParserInfo = emptyParserInfo, -- peb 25/5-04
|
pInfo = Cnv.pInfo (canModules st), -- peb 8/6
|
||||||
cfParserInfo = Cnv.emptyParserInfo, -- peb 27/5-04
|
|
||||||
morpho = emptyMorpho,
|
morpho = emptyMorpho,
|
||||||
loptions = gloptions st ----
|
loptions = gloptions st ----
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -111,6 +111,17 @@ mapErr f xs = Ok (ys, unlines ss)
|
|||||||
(ys,ss) = ([y | Ok y <- fxs], [s | Bad s <- fxs])
|
(ys,ss) = ([y | Ok y <- fxs], [s | Bad s <- fxs])
|
||||||
fxs = map f xs
|
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
|
-- !! with the error monad
|
||||||
(!?) :: [a] -> Int -> Err a
|
(!?) :: [a] -> Int -> Err a
|
||||||
xs !? i = foldr (const . return) (Bad "too few elements in list") $ drop i xs
|
xs !? i = foldr (const . return) (Bad "too few elements in list") $ drop i xs
|
||||||
|
|||||||
@@ -37,7 +37,7 @@ import GrammarToHaskell
|
|||||||
|
|
||||||
-- the cf parsing algorithms
|
-- the cf parsing algorithms
|
||||||
import ChartParser -- or some other CF Parser
|
import ChartParser -- or some other CF Parser
|
||||||
import qualified ParseCFviaCFG as PCF
|
import qualified ParseCF as PCF
|
||||||
--import qualified ParseGFCviaCFG as PGFC
|
--import qualified ParseGFCviaCFG as PGFC
|
||||||
--import NewChartParser
|
--import NewChartParser
|
||||||
--import NewerChartParser
|
--import NewerChartParser
|
||||||
@@ -177,12 +177,12 @@ customGrammarPrinter =
|
|||||||
-- add your own grammar printers here
|
-- add your own grammar printers here
|
||||||
-- grammar conversions, (peb)
|
-- grammar conversions, (peb)
|
||||||
,(strCI "gfc_show", show . grammar2canon . stateGrammarST)
|
,(strCI "gfc_show", show . grammar2canon . stateGrammarST)
|
||||||
-- ,(strCI "tnf", prCanon . Cnv.convertCanonToTNF . stateGrammarST)
|
,(strCI "emcfg", Prt.prt . Cnv.emcfg . statePInfo)
|
||||||
,(strCI "emcfg", Prt.prt . Cnv.convertCanonToEMCFG . stateGrammarST)
|
,(strCI "mcfg", Prt.prt . Cnv.mcfg . statePInfo)
|
||||||
,(strCI "emcfg_cf", Prt.prt . Cnv.convertCanonViaEMCFGtoCFG . stateGrammarST)
|
,(strCI "cfg", Prt.prt . Cnv.cfg . statePInfo)
|
||||||
,(strCI "mcfg", Prt.prt . Cnv.convertCanonToMCFG . stateGrammarST)
|
,(strCI "emcfg_show", show . Cnv.emcfg . statePInfo)
|
||||||
,(strCI "mcfg_cf", Prt.prt . Cnv.convertCanonToCFG . stateGrammarST)
|
,(strCI "mcfg_show", show . Cnv.mcfg . statePInfo)
|
||||||
,(strCI "mcfg_show", show . Cnv.convertCanonToMCFG . stateGrammarST)
|
,(strCI "cfg_show", show . Cnv.cfg . statePInfo)
|
||||||
--- also include printing via grammar2syntax!
|
--- also include printing via grammar2syntax!
|
||||||
]
|
]
|
||||||
++ moreCustomGrammarPrinter
|
++ moreCustomGrammarPrinter
|
||||||
|
|||||||
@@ -20,7 +20,7 @@ import Option
|
|||||||
import Custom
|
import Custom
|
||||||
import ShellState
|
import ShellState
|
||||||
|
|
||||||
import qualified ParseGFCviaCFG as N
|
import qualified ParseGFC as N
|
||||||
|
|
||||||
import Operations
|
import Operations
|
||||||
|
|
||||||
@@ -71,7 +71,7 @@ trees2trms opts sg cn as ts0 info = do
|
|||||||
ts1 <- return (map cf2trm0 ts0) ----- should not need annot
|
ts1 <- return (map cf2trm0 ts0) ----- should not need annot
|
||||||
mapM (checkErr . (annotate gr) . trExp) ts1 ---- complicated; often fails
|
mapM (checkErr . (annotate gr) . trExp) ts1 ---- complicated; often fails
|
||||||
_ -> do
|
_ -> do
|
||||||
(ts1,ss) <- checkErr $ mapErr postParse ts0
|
(ts1,ss) <- checkErr $ mapErrN 10 postParse ts0
|
||||||
if null ts1 then raise ss else return ()
|
if null ts1 then raise ss else return ()
|
||||||
ts2 <- mapM (checkErr . annotate gr . refreshMetas [] . trExp) ts1 ----
|
ts2 <- mapM (checkErr . annotate gr . refreshMetas [] . trExp) ts1 ----
|
||||||
if forgive then return ts2 else do
|
if forgive then return ts2 else do
|
||||||
|
|||||||
Reference in New Issue
Block a user