msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

"Committed_by_peb"

Browse Source
This commit is contained in:
peb
2005-05-11 09:28:16 +00:00
parent 2c9e0c6148
commit 4bdb527770
9 changed files with 105 additions and 91 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
src/GF/Conversion/RemoveSingletons.hs
View File

@@ -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

10
src/GF/Infra/Option.hs
View File

@@ -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

15
src/GF/Parsing/CFG.hs
View File

@@ -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)

29
src/GF/Parsing/GFC.hs
View File

@@ -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
----------------------------------------------------------------------

51
src/GF/Parsing/MCFG.hs
View File

@@ -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

11
src/GF/Shell/ShellCommands.hs
View File

@@ -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"

18
src/GF/UseGrammar/Custom.hs
View File

@@ -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

40
src/GF/UseGrammar/Parsing.hs
View File

@@ -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

16
src/Makefile
View File

@@ -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