From e3e0da73ac68efd2748c321bf0796dc8faa3aba9 Mon Sep 17 00:00:00 2001 From: peb Date: Wed, 26 May 2004 18:44:40 +0000 Subject: [PATCH] *** empty log message *** --- src/GF/CF/CFIdent.hs | 3 ++- src/GF/CF/ChartParser.hs | 48 +++++++++++++++++++++++++++++++----- src/GF/Compile/ShellState.hs | 27 ++++++++++++++------ src/GF/Data/OrdMap2.hs | 17 +++++++------ src/GF/Data/OrdSet.hs | 17 +++++++------ src/GF/UseGrammar/Custom.hs | 22 +++++++++-------- src/GF/UseGrammar/Parsing.hs | 4 ++- src/Makefile | 8 ++++-- src/Today.hs | 2 +- 9 files changed, 106 insertions(+), 42 deletions(-) diff --git a/src/GF/CF/CFIdent.hs b/src/GF/CF/CFIdent.hs index 28903e5d7..8e45902cb 100644 --- a/src/GF/CF/CFIdent.hs +++ b/src/GF/CF/CFIdent.hs @@ -46,7 +46,8 @@ prCFTok t = case t of TM i m -> m --- "?" --- m -- to build trees: the Atom contains a GF function, Cn | Meta | Vr | Literal -newtype CFFun = CFFun (Atom, Profile) deriving (Eq,Show) +newtype CFFun = CFFun (Atom, Profile) deriving (Eq,Ord,Show) +-- - - - - - - - - - - - - - - - - - - - - ^^^ added by peb, 21/5-04 type Profile = [([[Int]],[Int])] diff --git a/src/GF/CF/ChartParser.hs b/src/GF/CF/ChartParser.hs index 09d538244..a66155662 100644 --- a/src/GF/CF/ChartParser.hs +++ b/src/GF/CF/ChartParser.hs @@ -1,6 +1,22 @@ +{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + Filename: ChartParser.hs + Author: Peter Ljunglöf + Time-stamp: <2004-05-25 02:20:01 peb> + + Description: Bottom-up Kilbury chart parser from + "Pure Functional Parsing", chapter 5 + + DESIRED CHANGES: - The modules OrdSet and OrdMap2 are obsolete + and should be changed to newer versions + - Also, should use the CFG parsers in parsing/ + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} module ChartParser (chartParser) where +import Tracing +import PrintParser +import PrintSimplifiedTerm + import Operations import CF import CFIdent @@ -20,6 +36,10 @@ type Terminal = Token -> [(Category, Maybe Name)] type GParser = Grammar -> Category -> [Token] -> ([ParseTree],String) data ParseTree = Node Name Category [ParseTree] | Leaf Token +maxTake :: Int +-- maxTake = 1000 +maxTake = maxBound + -------------------------------------------------- -- converting between GF parsing and CFG parsing @@ -28,7 +48,7 @@ buildParser gparser cf = parse where parse = \start input -> let parse2 = parse' (CFNonterm start) input in - ([(parse2tree t, []) | t <- fst parse2], snd parse2) + (take maxTake [(parse2tree t, []) | t <- fst parse2], snd parse2) parse' = gparser (cf2grammar cf) cf2grammar :: CF -> Grammar @@ -95,8 +115,12 @@ chartParser0 (productions, terminal) = cparse | otherwise = [cats] cparse :: Category -> [Token] -> ([ParseTree], String) - cparse start input = case lookup (0, length input, start) edgeTrees of - Just trees -> (trees, "Chart:" ++++ prChart passiveEdges) + cparse start input = trace "ChartParser" $ + case lookup (0, length input, start) $ + tracePrt "#edgeTrees" (prt . map (length.snd)) $ + edgeTrees of + Just trees -> tracePrt "#trees" (prt . length . fst) $ + (trees, "Chart:" ++++ prChart passiveEdges) Nothing -> ([], "Chart:" ++++ prChart passiveEdges) where finalChart :: Chart @@ -110,7 +134,8 @@ chartParser0 (productions, terminal) = cparse (i, b, a:bs) <- elems state ] initialChart :: Chart - initialChart = emptySet : map initialState (zip [0..] input) + initialChart = tracePrt "#initialChart" (prt . map (length.elems)) $ + emptySet : map initialState (zip [0..] input) where initialState (j, sym) = makeSet [ (j, cat, []) | (cat, _) <- terminal sym ] @@ -124,8 +149,13 @@ chartParser0 (productions, terminal) = cparse a `elemSet` emptyCats ] passiveEdges :: [Passive] - passiveEdges = [ (i, j, cat) | - (j, state) <- zip [0..] finalChart, + passiveEdges = tracePrt "#passiveEdges" (prt . length) $ + [ (i, j, cat) | + (j, state) <- zip [0..] $ + tracePrt "#passiveChart" + (prt . map (length.filter (\(_,_,x)->null x).elems)) $ + tracePrt "#activeChart" (prt . map (length.elems)) $ + finalChart, (i, cat, []) <- elems state ] ++ [ (i, i, cat) | @@ -158,9 +188,15 @@ chartParser0 (productions, terminal) = cparse tree <- trees ] +instance Print ParseTree where + prt (Node name cat trees) = prt name++"."++prt cat++"^{"++prtSep "," trees++"}" + prt (Leaf token) = prt token + -- AR 10/12/2002 prChart :: [Passive] -> String prChart = unlines . map (unwords . map prOne) . positions where prOne (i,j,it) = show i ++ "-" ++ show j ++ "-" ++ prCFItem it positions = groupBy (\ (i,_,_) (j,_,_) -> i == j) + + diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs index 9bfc4a048..a9cc3bf7a 100644 --- a/src/GF/Compile/ShellState.hs +++ b/src/GF/Compile/ShellState.hs @@ -20,6 +20,9 @@ import Option import Ident import Arch (ModTime) +-- peb 25/5-04 +import CFtoCFG + import List (nub,nubBy) -- AR 11/11/2001 -- 17/6/2003 (for modules) ---- unfinished @@ -32,6 +35,8 @@ 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 morphos :: [(Ident,Morpho)], -- morphologies gloptions :: Options, -- global options readFiles :: [(FilePath,ModTime)],-- files read @@ -54,6 +59,7 @@ emptyShellState = ShSt { canModules = M.emptyMGrammar, srcModules = M.emptyMGrammar, cfs = [], + cfParserInfos = [], -- peb 25/5-04 morphos = [], gloptions = noOptions, readFiles = [], @@ -72,7 +78,7 @@ data StateGrammar = StGr { cncId :: Ident, grammar :: CanonGrammar, cf :: CF, ----- parser :: StaticParserInfo, + cfParserInfo :: CFParserInfo, -- peb 25/5-04 morpho :: Morpho, loptions :: Options } @@ -82,6 +88,7 @@ emptyStateGrammar = StGr { cncId = identC "#EMPTY", --- grammar = M.emptyMGrammar, cf = emptyCF, + cfParserInfo = emptyParserInfo, -- peb 25/5-04 morpho = emptyMorpho, loptions = noOptions } @@ -89,6 +96,7 @@ emptyStateGrammar = StGr { -- analysing shell grammar into parts stateGrammarST = grammar stateCF = cf +stateParserInfo= cfParserInfo stateMorpho = morpho stateOptions = loptions stateGrammarWords = allMorphoWords . stateMorpho @@ -119,6 +127,7 @@ 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 funs = funRulesOf cgr let cats = allCatsOf cgr @@ -137,6 +146,7 @@ updateShellState opts sh (gr,(sgr,rts)) = do canModules = cgr, srcModules = src, cfs = zip concrs cfs, + cfParserInfos = zip concrs parserInfos, -- peb 25/5-04 morphos = zip concrs (map (mkMorpho cgr) concrs), gloptions = opts, readFiles = [ft | ft@(f,_) <- readFiles sh, notInrts f] ++ rts, @@ -181,6 +191,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 morphos = morphos sh, gloptions = gloptions sh, readFiles = [], @@ -237,6 +248,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 morpho = maybe emptyMorpho id (lookup l (morphos st)), loptions = errVal noOptions $ lookupOptionsCan can } @@ -266,6 +278,7 @@ stateAbstractGrammar st = StGr { cncId = identC "#Cnc", --- grammar = canModules st, ---- only abstarct ones cf = emptyCF, + cfParserInfo = emptyParserInfo, morpho = emptyMorpho, loptions = gloptions st ---- } @@ -387,8 +400,8 @@ languageOn = languageOnOff True languageOff = languageOnOff False languageOnOff :: Bool -> Language -> ShellStateOper -languageOnOff b lang (ShSt a c cs cg sg cfs ms os fs cats sts) = - ShSt a c cs' cg sg cfs ms os fs cats sts where +languageOnOff b lang (ShSt a c cs cg sg cfs pinfs ms os fs cats sts) = + ShSt a c cs' cg sg cfs pinfs ms os fs cats sts where cs' = [if lang==l then ((l,c),b) else i | i@((l,c),_) <- cs] {- @@ -405,12 +418,12 @@ removeLanguage :: Language -> ShellStateOper removeLanguage lang (ShSt (ab,gs,os)) = ShSt (ab,removeAssoc lang gs, os) -} changeOptions :: (Options -> Options) -> ShellStateOper -changeOptions f (ShSt a c cs can src cfs ms os ff ts ss) = - ShSt a c cs can src cfs ms (f os) ff ts ss +changeOptions f (ShSt a c cs can src cfs pinfs ms os ff ts ss) = + ShSt a c cs can src cfs pinfs ms (f os) ff ts ss changeModTimes :: [(FilePath,ModTime)] -> ShellStateOper -changeModTimes mfs (ShSt a c cs can src cfs ms os ff ts ss) = - ShSt a c cs can src cfs ms os ff' ts ss +changeModTimes mfs (ShSt a c cs can src cfs pinfs ms os ff ts ss) = + ShSt a c cs can src cfs pinfs ms os ff' ts ss where ff' = mfs ++ [mf | mf@(f,_) <- ff, notElem f (map fst mfs)] diff --git a/src/GF/Data/OrdMap2.hs b/src/GF/Data/OrdMap2.hs index f41d33139..b4f9245fb 100644 --- a/src/GF/Data/OrdMap2.hs +++ b/src/GF/Data/OrdMap2.hs @@ -1,12 +1,15 @@ +{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + Filename: OrdMap2.hs + Author: Peter Ljunglöf + Time-stamp: <2004-05-07 14:16:03 peb> + Description: The class of finite maps, as described in + "Pure Functional Parsing", section 2.2.2 + and an example implementation, + derived from appendix A.2 --------------------------------------------------- --- The class of ordered finite maps --- as described in section 2.2.2 - --- and an example implementation, --- derived from the implementation in appendix A.2 - + OBSOLETE! this is only used in cf/ChartParser.hs + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} module OrdMap2 (OrdMap(..), Map) where diff --git a/src/GF/Data/OrdSet.hs b/src/GF/Data/OrdSet.hs index 84169a699..8761b2176 100644 --- a/src/GF/Data/OrdSet.hs +++ b/src/GF/Data/OrdSet.hs @@ -1,12 +1,15 @@ +{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + Filename: OrdSet.hs + Author: Peter Ljunglöf + Time-stamp: <2004-05-07 14:16:12 peb> + Description: The class of ordered sets, as described in + "Pure Functional Parsing", section 2.2.1, + and an example implementation + derived from appendix A.1 --------------------------------------------------- --- The class of ordered sets --- as described in section 2.2.1 - --- and an example implementation, --- derived from the implementation in appendix A.1 - + OBSOLETE! this is only used in cf/ChartParser.hs + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -} module OrdSet (OrdSet(..), Set) where diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs index d7cf99fa0..e5e59fc05 100644 --- a/src/GF/UseGrammar/Custom.hs +++ b/src/GF/UseGrammar/Custom.hs @@ -37,11 +37,12 @@ import GrammarToHaskell -- the cf parsing algorithms import ChartParser -- or some other CF Parser +import NewChartParser +import NewerChartParser -- grammar conversions -- peb 19/4-04 -- see also customGrammarPrinter -import qualified ConvertGrammar as CG -import TestConversions (prRaw) +import qualified ConvertGrammar as Cnv import MoreCustom -- either small/ or big/. The one in Small is empty. @@ -170,15 +171,11 @@ customGrammarPrinter = -} -- add your own grammar printers here -- grammar conversions, (peb) -{- ,(strCI "gfc_show", show . grammar2canon . stateGrammarST) - ,(strCI "gfc_raw", prRaw . stateGrammarST) - ,(strCI "tnf", prCanon . CG.convertCanonToTNF . stateGrammarST) - ,(strCI "mcfg", CG.prMCFG . CG.convertCanonToMCFG . stateGrammarST) - ,(strCI "mcfg_cf", prCF . CG.convertCanonToCFG . stateGrammarST) - ,(strCI "mcfg_canon", prCanon . CG.convertCanonToMCFG . stateGrammarST) - ,(strCI "mcfg_raw", prRaw . CG.convertCanonToMCFG . stateGrammarST) --} + ,(strCI "tnf", prCanon . Cnv.convertCanonToTNF . stateGrammarST) + ,(strCI "mcfg", Cnv.prMCFG . Cnv.convertCanonToMCFG . stateGrammarST) + ,(strCI "mcfg_cf", Cnv.prCFG . Cnv.convertCanonToCFG . stateGrammarST) + ,(strCI "mcfg_show", show . Cnv.convertCanonToMCFG . stateGrammarST) --- also include printing via grammar2syntax! ] ++ moreCustomGrammarPrinter @@ -262,6 +259,11 @@ customParser = (strCI "chart", chartParser . stateCF) -- add your own parsers here ] + -- 21/5-04, peb: + ++ [ (strCI ("new"++name), newChartParser descr . stateCF) | + (descr, names) <- newChartParserAlternatives, name <- names ] + ++ [ (strCI ("newer"++name), newerChartParser descr . stateParserInfo) | + (descr, names) <- newerChartParserAlternatives, name <- names ] ++ moreCustomParser customTokenizer = diff --git a/src/GF/UseGrammar/Parsing.hs b/src/GF/UseGrammar/Parsing.hs index 5d601bc58..91e811f22 100644 --- a/src/GF/UseGrammar/Parsing.hs +++ b/src/GF/UseGrammar/Parsing.hs @@ -60,7 +60,9 @@ parseStringC opts0 sg cat s tokens2trms :: Options ->StateGrammar ->Ident -> CFParser -> [CFTok] -> Check [Tree] tokens2trms opts sg cn parser as = do let res@(trees,info) = parser as - ts0 <- return $ nub (cfParseResults res) + ts0 <- return $ cfParseResults res -- removed nub, peb 25/5-04 + -- ts0 <- return $ nub (cfParseResults res) -- nub gives quadratic behaviour! + -- SortedList.nubsort is O(n log n) ts <- case () of _ | null ts0 -> checkWarn "No success in cf parsing" >> return [] _ | raw -> do diff --git a/src/Makefile b/src/Makefile index d083ecaf3..c6837d538 100644 --- a/src/Makefile +++ b/src/Makefile @@ -5,8 +5,9 @@ GHCFLAGS=-package lang -package util -fglasgow-exts GHCOPTFLAGS=-O -package lang -package util -fglasgow-exts GHCFUDFLAG=-package Fudgets -HUGSINCLUDE =.:for-hugs:api:source:canonical:cf:grammar:infra:shell:useGrammar:compile:parsing:conversions: -BASICINCLUDE =-iapi -icompile -igrammar -iinfra -ishell -isource -icanonical -iuseGrammar -icf -iparsing -iparsers -iconversions +HUGSTRACE = trace +HUGSINCLUDE =.:for-hugs:api:source:canonical:cf:grammar:infra:shell:useGrammar:compile:parsing:conversions:$(HUGSTRACE): +BASICINCLUDE =-iapi -icompile -igrammar -iinfra -ishell -isource -icanonical -iuseGrammar -icf -iparsing -iparsers -iconversions -inotrace GHCINCLUDE =-ifor-ghc $(BASICINCLUDE) GHCINCLUDENOFUD=-ifor-ghc-nofud $(BASICINCLUDE) GHCINCLUDEGFT =-ifor-gft $(BASICINCLUDE) @@ -37,6 +38,9 @@ justwindows: $(GHMAKE) $(GHCOPTFLAGS) $(WINDOWSINCLUDE) --make GF.hs -o gf2.exe ; strip gf2.exe ; mv gf2.exe ../bin/ nofud-links: cd for-ghc-nofud ; rm -f *.hs ; ln -s ../for-ghc/Arch.hs ; ln -s ../for-hugs/ArchEdit.hs ; cd .. +tracing: + make today ; $(GHMAKE) $(GHCFLAGS) -itrace $(GHCINCLUDENOFUD) --make GF.hs -o gf2 ; strip gf2 ; mv gf2 ../bin/ + batch: $(GHMAKE) $(GHCFLAGS) $(GHCINCLUDE) --make GF2.hs -o gf2 ; strip gf2 api: diff --git a/src/Today.hs b/src/Today.hs index c8d548625..06d208779 100644 --- a/src/Today.hs +++ b/src/Today.hs @@ -1 +1 @@ -module Today where today = "Wed May 26 10:26:30 CEST 2004" +module Today where today = "Wed May 26 21:43:58 CEST 2004"