*** empty log message ***

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

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

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

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
 

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
 

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 = 

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

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: 

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"