summaryrefslogtreecommitdiff
path: root/src/GF
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF')
-rw-r--r--src/GF/Conversion/RemoveSingletons.hs6
-rw-r--r--src/GF/Infra/Option.hs10
-rw-r--r--src/GF/Parsing/CFG.hs15
-rw-r--r--src/GF/Parsing/GFC.hs29
-rw-r--r--src/GF/Parsing/MCFG.hs49
-rw-r--r--src/GF/Shell/ShellCommands.hs11
-rw-r--r--src/GF/UseGrammar/Custom.hs18
-rw-r--r--src/GF/UseGrammar/Parsing.hs42
8 files changed, 97 insertions, 83 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
- 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
+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)
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
-
----- 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)
+---- (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 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
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 20:34:18 +0000