summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/GF/CF/CFIdent.hs3
-rw-r--r--src/GF/CF/ChartParser.hs48
-rw-r--r--src/GF/Compile/ShellState.hs27
-rw-r--r--src/GF/Data/OrdMap2.hs21
-rw-r--r--src/GF/Data/OrdSet.hs21
-rw-r--r--src/GF/UseGrammar/Custom.hs22
-rw-r--r--src/GF/UseGrammar/Parsing.hs4
-rw-r--r--src/Makefile8
-rw-r--r--src/Today.hs2
9 files changed, 110 insertions, 46 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 @@
-
-
---------------------------------------------------
--- 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
-
+{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ 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
+
+ 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 @@
-
-
---------------------------------------------------
--- The class of ordered sets
--- as described in section 2.2.1
-
--- and an example implementation,
--- derived from the implementation in appendix A.1
-
+{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ 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
+
+ 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"
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 07:02:43 +0000