From 54a1e0f879be657863cdcaed37fa609241369e8f Mon Sep 17 00:00:00 2001 From: peb Date: Wed, 11 May 2005 09:28:16 +0000 Subject: [PATCH] "Committed_by_peb" --- src/GF/Conversion/RemoveSingletons.hs | 6 ++-- src/GF/Infra/Option.hs | 10 +++--- src/GF/Parsing/CFG.hs | 15 ++++---- src/GF/Parsing/GFC.hs | 29 ++++++++------- src/GF/Parsing/MCFG.hs | 51 +++++++++++++++------------ src/GF/Shell/ShellCommands.hs | 11 +++--- src/GF/UseGrammar/Custom.hs | 18 +++++----- src/GF/UseGrammar/Parsing.hs | 40 +++++++++++---------- src/Makefile | 16 ++++----- 9 files changed, 105 insertions(+), 91 deletions(-) diff --git a/src/GF/Conversion/RemoveSingletons.hs b/src/GF/Conversion/RemoveSingletons.hs index 6c3a6e7c7..4b9992a4d 100644 --- a/src/GF/Conversion/RemoveSingletons.hs +++ b/src/GF/Conversion/RemoveSingletons.hs @@ -4,9 +4,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/05/09 09:28:44 $ +-- > CVS $Date: 2005/05/11 10:28:16 $ -- > CVS $Author: peb $ --- > CVS $Revision: 1.4 $ +-- > CVS $Revision: 1.5 $ -- -- Instantiating all types which only have one single element. -- @@ -57,7 +57,7 @@ instantiateLin newArgs = inst = case newArgs !! nr of Unify [nr'] -> Arg nr' cat path Constant (Just term) -> termFollowPath path term - Constant Nothing -> error "instantiateLin: argument has no linearization" + Constant Nothing -> error "RemoveSingletons.instantiateLin: This should not happen (argument has no linearization)" inst (cn :^ terms) = cn :^ map inst terms inst (Rec rec) = Rec [ (lbl, inst term) | (lbl, term) <- rec ] inst (term :. lbl) = inst term +. lbl diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs index 649534986..779fa96f0 100644 --- a/src/GF/Infra/Option.hs +++ b/src/GF/Infra/Option.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/04/21 16:22:37 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.26 $ +-- > CVS $Date: 2005/05/11 10:28:16 $ +-- > CVS $Author: peb $ +-- > CVS $Revision: 1.27 $ -- -- Options and flags used in GF shell commands and files. -- @@ -146,9 +146,11 @@ rawParse = iOpt "raw" firstParse = iOpt "1" dontParse = iOpt "read" -newParser, newerParser :: Option +newParser, newerParser, newCParser, newMParser :: Option newParser = iOpt "new" newerParser = iOpt "newer" +newCParser = iOpt "cfg" +newMParser = iOpt "mcfg" {- useParserMCFG, useParserMCFGviaCFG, useParserCFG, useParserCF :: Option diff --git a/src/GF/Parsing/CFG.hs b/src/GF/Parsing/CFG.hs index 34b1619a4..f64ce55f1 100644 --- a/src/GF/Parsing/CFG.hs +++ b/src/GF/Parsing/CFG.hs @@ -4,9 +4,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/04/21 16:23:05 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.4 $ +-- > CVS $Date: 2005/05/11 10:28:16 $ +-- > CVS $Author: peb $ +-- > CVS $Revision: 1.5 $ -- -- CFG parsing ----------------------------------------------------------------------------- @@ -27,6 +27,10 @@ import qualified GF.Parsing.CFG.General as Gen -- parsing parseCF :: (Ord n, Ord c, Ord t) => String -> Err (CFParser c n t) + +parseCF "bottomup" = Ok $ Gen.parse bottomup +parseCF "topdown" = Ok $ Gen.parse topdown + parseCF "gb" = Ok $ Gen.parse bottomup parseCF "gt" = Ok $ Gen.parse topdown parseCF "ib" = Ok $ Inc.parse (bottomup, noFilter) @@ -35,10 +39,9 @@ parseCF "ibFT" = Ok $ Inc.parse (bottomup, topdown) parseCF "ibFB" = Ok $ Inc.parse (bottomup, bottomup) parseCF "ibFTB" = Ok $ Inc.parse (bottomup, bothFilters) parseCF "itF" = Ok $ Inc.parse (topdown, bottomup) --- default parser: -parseCF "" = parseCF "gb" + -- error parser: -parseCF prs = Bad $ "Parser not defined: " ++ prs +parseCF prs = Bad $ "CFG parsing strategy not defined: " ++ prs bottomup = (True, False) topdown = (False, True) diff --git a/src/GF/Parsing/GFC.hs b/src/GF/Parsing/GFC.hs index 5476b8e8b..ec2409515 100644 --- a/src/GF/Parsing/GFC.hs +++ b/src/GF/Parsing/GFC.hs @@ -4,9 +4,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/05/09 09:28:45 $ +-- > CVS $Date: 2005/05/11 10:28:16 $ -- > CVS $Author: peb $ --- > CVS $Revision: 1.7 $ +-- > CVS $Revision: 1.8 $ -- -- The main parsing module, parsing GFC grammars -- by translating to simpler formats, such as PMCFG and CFG @@ -58,14 +58,15 @@ instance Print PInfo where ---------------------------------------------------------------------- -- main parsing function -parse :: String -- ^ parsing strategy +parse :: String -- ^ parsing algorithm (mcfg/cfg) + -> String -- ^ parsing strategy -> PInfo -- ^ compiled grammars (mcfg and cfg) -> Ident.Ident -- ^ abstract module name -> CFCat -- ^ starting category -> [CFTok] -- ^ input tokens -> Err [Grammar.Term] -- ^ resulting GF terms -parse (prs:strategy) pinfo abs startCat inString = +parse prs strategy pinfo abs startCat inString = do let inTokens = tracePrt "Parsing.GFC - input tokens" prt $ inputMany (map wordsCFTok inString) forests <- selectParser prs strategy pinfo startCat inTokens @@ -81,34 +82,32 @@ parse (prs:strategy) pinfo abs startCat inString = -- compactFs >>= forest2trees return $ map (tree2term abs) trees --- default parser = CFG (for now) -parse "" pinfo abs startCat inString = parse "c" pinfo abs startCat inString - -- parsing via CFG -selectParser prs strategy pinfo startCat inTokens | prs=='c' +selectParser "c" strategy pinfo startCat inTokens = do let startCats = tracePrt "Parsing.GFC - starting CF categories" prt $ filter isStart $ map fst $ aAssocs $ PC.topdownRules cfpi isStart cat = ccat2scat cat == cfCat2Ident startCat cfpi = cfPInfo pinfo cfParser <- PC.parseCF strategy - let cfChart = tracePrt "Parsing.GFC - sz. CF chart" (prt . length) $ + let cfChart = tracePrt "Parsing.GFC - CF chart" (prt . length) $ cfParser cfpi startCats inTokens - chart = tracePrt "Parsing.GFC - sz. chart" (prt . map (length.snd) . aAssocs) $ + chart = tracePrt "Parsing.GFC - chart" (prt . map (length.snd) . aAssocs) $ C.grammar2chart cfChart finalEdges = tracePrt "Parsing.GFC - final chart edges" prt $ map (uncurry Edge (inputBounds inTokens)) startCats return $ chart2forests chart (const False) finalEdges -- parsing via MCFG -selectParser prs strategy pinfo startCat inTokens | prs=='m' +selectParser "m" strategy pinfo startCat inTokens = do let startCats = tracePrt "Parsing.GFC - starting MCF categories" prt $ filter isStart $ PM.grammarCats mcfpi isStart cat = mcat2scat cat == cfCat2Ident startCat mcfpi = mcfPInfo pinfo - mcfChart <- PM.parseMCF strategy mcfpi startCats inTokens - traceM "Parsing.GFC - sz. MCF chart" (prt (length mcfChart)) - let chart = tracePrt "Parsing.GFC - sz. chart" (prt . length . concat . map snd . aAssocs) $ + mcfParser <- PM.parseMCF strategy + let mcfChart = tracePrt "Parsing.GFC - MCF chart" (prt . length) $ + mcfParser mcfpi startCats inTokens + chart = tracePrt "Parsing.GFC - chart" (prt . length . concat . map snd . aAssocs) $ G.abstract2chart mcfChart finalEdges = tracePrt "Parsing.GFC - final chart edges" prt $ [ PM.makeFinalEdge cat lbl (inputBounds inTokens) | @@ -116,7 +115,7 @@ selectParser prs strategy pinfo startCat inTokens | prs=='m' return $ chart2forests chart (const False) finalEdges -- error parser: -selectParser prs strategy _ _ _ = Bad $ "Parser not defined: " ++ (prs:strategy) +selectParser prs strategy _ _ _ = Bad $ "Parser '" ++ prs ++ "' not defined with strategy: " ++ strategy ---------------------------------------------------------------------- diff --git a/src/GF/Parsing/MCFG.hs b/src/GF/Parsing/MCFG.hs index 4cfc6e2ec..6aec811de 100644 --- a/src/GF/Parsing/MCFG.hs +++ b/src/GF/Parsing/MCFG.hs @@ -4,9 +4,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/05/09 09:28:45 $ +-- > CVS $Date: 2005/05/11 10:28:16 $ -- > CVS $Author: peb $ --- > CVS $Revision: 1.4 $ +-- > CVS $Revision: 1.5 $ -- -- MCFG parsing ----------------------------------------------------------------------------- @@ -30,30 +30,35 @@ import qualified GF.Parsing.MCFG.Incremental2 as Incremental2 ---------------------------------------------------------------------- -- parsing --- parseMCF :: (Ord c, Ord n, Ord l, Ord t) => String -> Err (MCFParser c n l t) +parseMCF :: (Ord c, Ord n, Ord l, Ord t) => String -> Err (MCFParser c n l t) +parseMCF prs | prs `elem` strategies = Ok $ parseMCF' prs + | otherwise = Bad $ "MCFG parsing strategy not defined: " ++ prs -parseMCF "n" pinfo starts toks = Ok $ Naive.parse pinfo starts toks -parseMCF "an" pinfo starts toks = Ok $ Active.parse "n" pinfo starts toks -parseMCF "ab" pinfo starts toks = Ok $ Active.parse "b" pinfo starts toks -parseMCF "at" pinfo starts toks = Ok $ Active.parse "t" pinfo starts toks -parseMCF "i" pinfo starts toks = Ok $ Incremental.parse pinfo starts toks -parseMCF "an2" pinfo starts toks = Ok $ Active2.parse "n" pinfo starts toks -parseMCF "ab2" pinfo starts toks = Ok $ Active2.parse "b" pinfo starts toks -parseMCF "at2" pinfo starts toks = Ok $ Active2.parse "t" pinfo starts toks -parseMCF "i2" pinfo starts toks = Ok $ Incremental2.parse pinfo starts toks +strategies = words "bottomup topdown n an ab at i an2 ab2 at2 i2 rn ran rab rat ri" -parseMCF "rn" pinfo starts toks = Ok $ Naive.parseR (rrP pinfo toks) starts -parseMCF "ran" pinfo starts toks = Ok $ Active.parseR "n" (rrP pinfo toks) starts -parseMCF "rab" pinfo starts toks = Ok $ Active.parseR "b" (rrP pinfo toks) starts -parseMCF "rat" pinfo starts toks = Ok $ Active.parseR "t" (rrP pinfo toks) starts -parseMCF "ri" pinfo starts toks = Ok $ Incremental.parseR (rrP pinfo toks) starts ntoks + +parseMCF' :: (Ord c, Ord n, Ord l, Ord t) => String -> MCFParser c n l t + +parseMCF' "bottomup" pinfo starts toks = Active.parse "b" pinfo starts toks +parseMCF' "topdown" pinfo starts toks = Active.parse "t" pinfo starts toks + +parseMCF' "n" pinfo starts toks = Naive.parse pinfo starts toks +parseMCF' "an" pinfo starts toks = Active.parse "n" pinfo starts toks +parseMCF' "ab" pinfo starts toks = Active.parse "b" pinfo starts toks +parseMCF' "at" pinfo starts toks = Active.parse "t" pinfo starts toks +parseMCF' "i" pinfo starts toks = Incremental.parse pinfo starts toks + +parseMCF' "an2" pinfo starts toks = Active2.parse "n" pinfo starts toks +parseMCF' "ab2" pinfo starts toks = Active2.parse "b" pinfo starts toks +parseMCF' "at2" pinfo starts toks = Active2.parse "t" pinfo starts toks +parseMCF' "i2" pinfo starts toks = Incremental2.parse pinfo starts toks + +parseMCF' "rn" pinfo starts toks = Naive.parseR (rrP pinfo toks) starts +parseMCF' "ran" pinfo starts toks = Active.parseR "n" (rrP pinfo toks) starts +parseMCF' "rab" pinfo starts toks = Active.parseR "b" (rrP pinfo toks) starts +parseMCF' "rat" pinfo starts toks = Active.parseR "t" (rrP pinfo toks) starts +parseMCF' "ri" pinfo starts toks = Incremental.parseR (rrP pinfo toks) starts ntoks where ntoks = snd (inputBounds toks) --- default parsers: -parseMCF "" pinfo starts toks = parseMCF "n" pinfo starts toks --- error parser: -parseMCF prs pinfo starts toks = Bad $ "Parser not defined: " ++ prs - - rrP pi = rangeRestrictPInfo pi diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs index ccadf4b2d..542b940ab 100644 --- a/src/GF/Shell/ShellCommands.hs +++ b/src/GF/Shell/ShellCommands.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/05/09 09:28:46 $ +-- > CVS $Date: 2005/05/11 10:28:16 $ -- > CVS $Author: peb $ --- > CVS $Revision: 1.31 $ +-- > CVS $Revision: 1.32 $ -- -- The datatype of shell commands and the list of their options. ----------------------------------------------------------------------------- @@ -130,8 +130,9 @@ testValidFlag st co f x = case f of "depth" -> testN "rawtrees"-> testN "parser" -> testInc customParser - -- hack for the -newer parsers: (to be changed) - `mplus` if not(null x) && head x `elem` "mc" then return () else Bad "" + -- hack for the -newer parsers: (to be changed in the future) + -- `mplus` testIn (words "mcfg mcfg-bottomup mcfg-topdown cfg cfg-bottomup cfg-topdown bottomup topdown") + -- if not(null x) && head x `elem` "mc" then return () else Bad "" "alts" -> testN "transform" -> testInc customTermCommand "filter" -> testInc customStringCommand @@ -167,7 +168,7 @@ optionsOfCommand co = case co of CTransformGrammar _ -> flags "printer" CConvertLatex _ -> none CLinearize _ -> both "utf8 table struct record all multi" "lang number unlexer" - CParse -> both "new newer n ign raw v lines all" "cat lang lexer parser number rawtrees" + CParse -> both "new newer cfg mcfg n ign raw v lines all" "cat lang lexer parser number rawtrees" CTranslate _ _ -> opts "cat lexer parser" CGenerateRandom -> flags "cat lang number depth" CGenerateTrees -> both "metas" "depth alts cat lang number" diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs index d6d310d36..2384ff736 100644 --- a/src/GF/UseGrammar/Custom.hs +++ b/src/GF/UseGrammar/Custom.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/05/09 09:28:46 $ +-- > CVS $Date: 2005/05/11 10:28:16 $ -- > CVS $Author: peb $ --- > CVS $Revision: 1.59 $ +-- > CVS $Revision: 1.60 $ -- -- A database for customizable GF shell commands. -- @@ -349,13 +349,13 @@ customStringCommand = customParser = customData "Parsers, selected by option -parser=x" $ [ - (strCI "chart", PCFOld.parse "ibn" . stateCF) -- DEPRECATED - ,(strCI "general", PCF.parse "gb" . stateCF) - ,(strCI "general-bottomup", PCF.parse "gt" . stateCF) - ,(strCI "general-topdown", PCF.parse "gt" . stateCF) - ,(strCI "incremental", PCF.parse "ib" . stateCF) - ,(strCI "incremental-bottomup", PCF.parse "ib" . stateCF) - ,(strCI "incremental-topdown", PCF.parse "it" . stateCF) + (strCI "bottomup", PCF.parse "gb" . stateCF) + ,(strCI "topdown", PCF.parse "gt" . stateCF) +-- commented for now, since there's a bug in the incremental algorithm: +-- ,(strCI "incremental", PCF.parse "ib" . stateCF) +-- ,(strCI "incremental-bottomup", PCF.parse "ib" . stateCF) +-- ,(strCI "incremental-topdown", PCF.parse "it" . stateCF) + ,(strCI "chart", PCFOld.parse "ibn" . stateCF) -- DEPRECATED ,(strCI "old", chartParser . stateCF) -- DEPRECATED ,(strCI "myparser", myParser) -- add your own parsers here diff --git a/src/GF/UseGrammar/Parsing.hs b/src/GF/UseGrammar/Parsing.hs index 82e9297a6..bdf179987 100644 --- a/src/GF/UseGrammar/Parsing.hs +++ b/src/GF/UseGrammar/Parsing.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/05/10 14:16:59 $ --- > CVS $Author: aarne $ --- > CVS $Revision: 1.22 $ +-- > CVS $Date: 2005/05/11 10:28:16 $ +-- > CVS $Author: peb $ +-- > CVS $Revision: 1.23 $ -- -- (Description of the module) ----------------------------------------------------------------------------- @@ -35,7 +35,7 @@ import GF.UseGrammar.Custom import GF.Compile.ShellState import GF.CF.PPrCF (prCFTree) -import qualified GF.OldParsing.ParseGFC as NewOld -- OBSOLETE +-- import qualified GF.OldParsing.ParseGFC as NewOld -- OBSOLETE import qualified GF.Parsing.GFC as New import GF.Data.Operations @@ -54,26 +54,30 @@ parseStringMsg os sg cat s = do return (ts,unlines ss) parseStringC :: Options -> StateGrammar -> CFCat -> String -> Check [Tree] -parseStringC opts0 sg cat s ---- to test peb's new parser 6/10/2003 ----- (to be obsoleted by "newer" below) - | oElem newParser opts0 = do - let pm = maybe "" id $ getOptVal opts0 useParser -- -parser=pm - ct = cfCat2Cat cat - ts <- checkErr $ NewOld.newParser pm sg ct s - mapM (checkErr . annotate (stateGrammarST sg) . refreshMetas []) ts +---- (obsoleted by "newer" below) +-- parseStringC opts0 sg cat s +-- | oElem newParser opts0 = do +-- let pm = maybe "" id $ getOptVal opts0 useParser -- -parser=pm +-- ct = cfCat2Cat cat +-- ts <- checkErr $ NewOld.newParser pm sg ct s +-- mapM (checkErr . annotate (stateGrammarST sg) . refreshMetas []) ts ----- to test peb's newer parser 7/4-05 - | oElem newerParser opts0 = do - let opts = unionOptions opts0 $ stateOptions sg - pm = maybe "" id $ getOptVal opts0 useParser -- -parser=pm - tok = customOrDefault opts useTokenizer customTokenizer sg - ts <- checkErr $ New.parse pm (pInfo sg) (absId sg) cat (tok s) +-- to use peb's newer parser 7/4-05 +parseStringC opts0 sg cat s + | oElem newCParser opts0 || oElem newMParser opts0 || oElem newParser opts0 || oElem newerParser opts0 = do + let opts = unionOptions opts0 $ stateOptions sg + algorithm | oElem newCParser opts0 = "c" + | oElem newMParser opts0 = "m" + | otherwise = "c" -- default algorithm + strategy = maybe "bottomup" id $ getOptVal opts useParser -- -parser=bottomup/topdown + tokenizer = customOrDefault opts useTokenizer customTokenizer sg + ts <- checkErr $ New.parse algorithm strategy (pInfo sg) (absId sg) cat (tokenizer s) ts' <- mapM (checkErr . annotate (stateGrammarST sg) . refreshMetas []) ts return $ optIntOrAll opts flagNumber ts' - | otherwise = do +parseStringC opts0 sg cat s = do let opts = unionOptions opts0 $ stateOptions sg cf = stateCF sg gr = stateGrammarST sg diff --git a/src/Makefile b/src/Makefile index 2c1e38d22..33d2f4bc7 100644 --- a/src/Makefile +++ b/src/Makefile @@ -19,6 +19,8 @@ BIN_DIST_DIR=$(DIST_DIR)-$(host) SNAPSHOT_DIR=GF-$(shell date +%Y%m%d) +# use the temporary binary file name 'gf-bin' name to not clash with directory 'GF' +# on case insensitive file systems (such as MacOSX) GF_EXE=gf$(EXEEXT) GF_EXE_TMP=gf-bin$(EXEEXT) GF_DOC_EXE=gfdoc$(EXEEXT) @@ -39,16 +41,14 @@ endif all: unix gfdoc $(BUILD_JAR) -unix: today touch-files opt +unix: today opt windows: unix -temp: today touch-files noopt +temp: today noopt -# use gf-bin name to not clash with GF/ dir on -# case insensitive file systems build: $(GHMAKE) $(GHCFLAGS) GF.hs -o $(GF_EXE_TMP) strip $(GF_EXE_TMP) @@ -59,7 +59,7 @@ opt: build noopt: build -ghci: touch-files ghci-nofud +ghci: ghci-nofud fud: $(GHCXMAKE) $(GHCFLAGS) $(GHCFUDFLAG) GF.hs -o fgf @@ -111,9 +111,9 @@ tracing: temp ghci-trace: GHCFLAGS += -DTRACING ghci-trace: ghci -touch-files: - rm -f GF/System/Tracing.{hi,o} - touch GF/System/Tracing.hs +#touch-files: +# rm -f GF/System/Tracing.{hi,o} +# touch GF/System/Tracing.hs # profiling prof: GHCOPTFLAGS += -prof -auto-all -auto-dicts