"Committed_by_peb"

src/GF/CF/ChartParser.hs

@@ -5,16 +5,15 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/03/29 13:26:34 $ 
+-- > CVS $Date: 2005/04/16 05:40:50 $ 
--- > CVS $Author: aarne $
+-- > CVS $Author: peb $
--- > CVS $Revision: 1.8 $
+-- > CVS $Revision: 1.9 $
 --
 -- Bottom-up Kilbury chart parser from "Pure Functional Parsing", chapter 5.
 -- OBSOLETE -- should use new MCFG parsers instead 
 -----------------------------------------------------------------------------
 
-module ChartParser {- # DEPRECATED "Use ParseCF instead" #-} 
+module ChartParser (chartParser) where
-    (chartParser) where
 
 -- import Tracing
 -- import PrintParser

src/GF/CFGM/PrintCFGrammar.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/15 09:45:32 $ 
+-- > CVS $Date: 2005/04/16 05:40:50 $ 
--- > CVS $Author: bringert $
+-- > CVS $Author: peb $
--- > CVS $Revision: 1.15 $
+-- > CVS $Revision: 1.16 $
 --
 -- Handles printing a CFGrammar in CFGM format.
 -----------------------------------------------------------------------------
@@ -33,6 +33,8 @@ import qualified Option
 import List (intersperse)
 import Maybe (listToMaybe, maybe)
 
+-- | FIXME: should add an Options argument,
+-- to be able to decide which CFG conversion one wants to use
 prCanonAsCFGM :: CanonGrammar -> String
 prCanonAsCFGM gr = unlines $ map (uncurry (prLangAsCFGM gr)) xs 
     where 
@@ -46,12 +48,15 @@ prCanonAsCFGM gr = unlines $ map (uncurry (prLangAsCFGM gr)) xs
 getFlag :: [Flag] -> String -> Maybe String
 getFlag fs x = listToMaybe [v | Flg (IC k) (IC v) <- fs, k == x]
 
--- | OBS! Should use 'ShellState.statePInfo' or 'ShellState.pInfos'
+-- | FIXME: (1) Should use 'ShellState.stateCFG'
--- instead of 'Cnv.pInfo' (which recalculates the grammar every time)
+-- instead of 'Cnv.gfc2cfg' (which recalculates the grammar every time)
+--
+-- FIXME: (2) Should use the state options, when calculating the CFG
+-- (this is solved automatically if one solves (1) above)
 prLangAsCFGM :: CanonGrammar -> Ident -> Maybe String -> String
-prLangAsCFGM gr i start = prCFGrammarAsCFGM (Cnv.gfc2cfg (gr, i)) i start
+prLangAsCFGM gr i start = prCFGrammarAsCFGM (Cnv.gfc2cfg opts (gr, i)) i start
 -- prLangAsCFGM gr i start = prCFGrammarAsCFGM (Cnv.cfg (Cnv.pInfo opts gr i)) i start
---     where opts = Option.Opts [Option.gfcConversion "nondet"]
+     where opts = Option.Opts [Option.gfcConversion "nondet"]
 
 prCFGrammarAsCFGM :: GT.CGrammar -> Ident -> Maybe String -> String
 prCFGrammarAsCFGM gr i start = PrintCFG.printTree $ cfGrammarToCFGM gr i start

src/GF/Compile/ShellState.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/14 11:42:05 $ 
+-- > CVS $Date: 2005/04/16 05:40:50 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.42 $
+-- > CVS $Revision: 1.43 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------
@@ -189,21 +189,9 @@ updateShellState opts mcnc sh ((_,sgr,gr),rts) = do
 
   let pinfosOld = map (CnvOld.pInfo opts cgr) concrs  -- peb 18/6 (OBSOLETE)
 
-  let g2s  = Cnv.gfc2simple
+  let fromGFC       = Cnv.gfc2mcfg2cfg opts
-      fin  = Cnv.removeSingletons . Cnv.simple2finite
+      (mcfgs, cfgs) = unzip $ map (curry fromGFC cgr) concrs 
-      s2mN = Cnv.simple2mcfg_nondet
+      pInfos        = zipWith Prs.buildPInfo mcfgs cfgs
-      s2mS = Cnv.simple2mcfg_strict
-      --                     ____ kan man ha flera '-conversion=X -conversion=Y'?
-      (simpleCnv, mcfgCnv) = case getOptVal opts gfcConversion of
-			       Just "strict" -> (g2s, s2mS)
-			       Just "finite" -> (fin . g2s, s2mN)
-			       Just "finite-strict" -> (fin . g2s, s2mS)
-			       _             -> (g2s, s2mN)
-      cfgCnv  = Cnv.mcfg2cfg
-
-  let simples = map (curry simpleCnv cgr) concrs 
-      mcfgs   = map mcfgCnv simples
-      cfgs    = map cfgCnv mcfgs
 
   let funs = funRulesOf cgr
   let cats = allCatsOf cgr
@@ -225,7 +213,7 @@ updateShellState opts mcnc sh ((_,sgr,gr),rts) = do
     pInfosOld  = zip concrs pinfosOld, -- peb 8/6 (OBSOLETE)
     mcfgs      = zip concrs mcfgs,
     cfgs       = zip concrs cfgs,
-    pInfos     = zip concrs $ zipWith Prs.buildPInfo mcfgs cfgs,
+    pInfos     = zip concrs pInfos,
     morphos    = zip concrs (map (mkMorpho cgr) concrs),
     gloptions  = gloptions sh, --- opts, -- this would be command-line options
     readFiles  = [ft | ft@(f,_) <- readFiles sh, notInrts f] ++ rts,

src/GF/Conversion/GFC.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/14 18:38:36 $ 
+-- > CVS $Date: 2005/04/16 05:40:49 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.4 $
+-- > CVS $Revision: 1.5 $
 --
 -- All conversions from GFC 
 -----------------------------------------------------------------------------
@@ -15,16 +15,36 @@ module GF.Conversion.GFC
     (module GF.Conversion.GFC,
      SGrammar, MGrammar, CGrammar) where
 
+import Option
 import GFC (CanonGrammar)
 import Ident (Ident)
-import GF.Conversion.Types (CGrammar, MGrammar, SGrammar)
+import GF.Conversion.Types (CGrammar, MGrammar, NGrammar, SGrammar)
 
 import qualified GF.Conversion.GFCtoSimple as G2S
 import qualified GF.Conversion.SimpleToFinite as S2Fin
 import qualified GF.Conversion.RemoveSingletons as RemSing
+import qualified GF.Conversion.RemoveErasing as RemEra
 import qualified GF.Conversion.SimpleToMCFG as S2M
 import qualified GF.Conversion.MCFGtoCFG as M2C
 
+----------------------------------------------------------------------
+-- * GFC -> MCFG & CFG, using options to decide which conversion is used
+
+gfc2mcfg2cfg :: Options -> (CanonGrammar, Ident) -> (MGrammar, CGrammar)
+gfc2mcfg2cfg opts = \g -> let m = g2m g in (m, m2c m)
+    where m2c = mcfg2cfg
+	  g2m = case getOptVal opts gfcConversion of
+		  Just "strict" -> simple2mcfg_strict . gfc2simple
+		  Just "finite" -> simple2mcfg_nondet . gfc2finite
+		  Just "finite-strict" -> simple2mcfg_strict . gfc2finite
+		  _ -> simple2mcfg_nondet . gfc2simple
+
+gfc2mcfg :: Options -> (CanonGrammar, Ident) -> MGrammar
+gfc2mcfg opts = fst . gfc2mcfg2cfg opts
+
+gfc2cfg :: Options -> (CanonGrammar, Ident) -> CGrammar
+gfc2cfg opts = snd . gfc2mcfg2cfg opts
+
 ----------------------------------------------------------------------
 -- * single step conversions
 
@@ -37,6 +57,9 @@ simple2finite = S2Fin.convertGrammar
 removeSingletons :: SGrammar -> SGrammar
 removeSingletons = RemSing.convertGrammar
 
+gfc2finite :: (CanonGrammar, Ident) -> SGrammar
+gfc2finite = removeSingletons . simple2finite . gfc2simple
+
 simple2mcfg_nondet :: SGrammar -> MGrammar
 simple2mcfg_nondet = S2M.convertGrammarNondet
 
@@ -46,21 +69,15 @@ simple2mcfg_strict = S2M.convertGrammarStrict
 mcfg2cfg :: MGrammar -> CGrammar
 mcfg2cfg = M2C.convertGrammar
 
-----------------------------------------------------------------------
+removeErasing :: MGrammar -> NGrammar
--- * GFC -> MCFG
+removeErasing = RemEra.convertGrammar
 
--- | default conversion: 
+-- | this function is unnecessary, because of the following equivalence:
 --
---  - instantiating finite dependencies ('removeSingletons . simple2finite')
+-- >    mcfg2cfg == ne_mcfg2cfg . removeErasing
---  - nondeterministic MCFG conversion ('simple2mcfg_nondet')
+--
-gfc2mcfg :: (CanonGrammar, Ident) -> MGrammar
+ne_mcfg2cfg :: NGrammar -> CGrammar
-gfc2mcfg = simple2mcfg_nondet . removeSingletons . simple2finite . gfc2simple
+ne_mcfg2cfg = M2C.convertNEGrammar
-
+
-----------------------------------------------------------------------
--- * GFC -> CFG
-
--- | default conversion = default mcfg conversion + trivial cfg conversion
-gfc2cfg :: (CanonGrammar, Ident) -> CGrammar
-gfc2cfg = mcfg2cfg . gfc2mcfg
 
 

src/GF/Conversion/MCFGtoCFG.hs

@@ -4,16 +4,16 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/12 10:49:44 $ 
+-- > CVS $Date: 2005/04/16 05:40:49 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.2 $
+-- > CVS $Revision: 1.3 $
 --
 -- Converting MCFG grammars to (possibly overgenerating) CFG
 -----------------------------------------------------------------------------
 
 
 module GF.Conversion.MCFGtoCFG
-    (convertGrammar) where
+    (convertGrammar, convertNEGrammar) where
 
 import GF.System.Tracing
 import GF.Infra.Print
@@ -25,9 +25,12 @@ import GF.Formalism.MCFG
 import GF.Formalism.CFG
 import GF.Conversion.Types
 
+----------------------------------------------------------------------
+-- * converting (possibly erasing) MCFG grammars
+
 convertGrammar :: MGrammar -> CGrammar
 convertGrammar gram = tracePrt "#context-free rules" (prt.length) $
-		      concatMap convertRule gram
+		       concatMap convertRule gram
 
 convertRule :: MRule -> [CRule]
 convertRule (Rule (Abs cat args (Name fun mprofile)) (Cnc _ _ record)) 
@@ -45,6 +48,27 @@ argPlaces :: [Symbol (cat, lbl, Int) tok] -> Int -> [Int]
 argPlaces lin nr  = [ place | (nr', place) <- zip linArgs [0..], nr == nr' ]
     where linArgs = [ nr' | (_, _, nr') <- filterCats lin ]
 
+----------------------------------------------------------------------
+-- * converting nonerasing MCFG grammars
+
+convertNEGrammar :: NGrammar -> CGrammar
+convertNEGrammar gram = tracePrt "#context-free rules" (prt.length) $
+			concatMap convertNERule gram
+
+convertNERule :: NRule -> [CRule]
+convertNERule (Rule (Abs ncat args (Name fun mprofile)) (Cnc _ _ record)) 
+    = [ CFRule (CCat (ncat2mcat ncat) lbl) rhs (Name fun profile) |
+	Lin lbl lin <- record,
+	let rhs = map (mapSymbol convertNEArg id) lin,
+	let cprofile = map (Unify . argPlaces lin) [0 .. length args-1],
+	let profile = mprofile `composeProfiles` cprofile
+      ]
+
+convertNEArg :: (NCat, NLabel, Int) -> CCat
+convertNEArg (ncat, lbl, _) = CCat (ncat2mcat ncat) lbl
+
+----------------------------------------------------------------------
+
 
 
 

src/GF/Conversion/Types.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/14 11:42:05 $ 
+-- > CVS $Date: 2005/04/16 05:40:49 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.3 $
+-- > CVS $Revision: 1.4 $
 --
 -- All possible instantiations of different grammar formats used in conversion from GFC
 -----------------------------------------------------------------------------
@@ -44,6 +44,8 @@ data Name = Name Fun [Profile (SyntaxForest Fun)]
 name2fun :: Name -> Fun
 name2fun (Name fun _) = fun
 
+-- * profiles
+
 -- | A profile is a simple representation of a function on a number of arguments.
 -- We only use lists of profiles
 data Profile a = Unify [Int] -- ^ The Int's are the argument positions.
@@ -116,7 +118,7 @@ type SLinType = LinType SCat Token
 type SDecl    = Decl    SCat
 
 ----------------------------------------------------------------------
--- * MCFG
+-- * erasing MCFG
 
 type MGrammar = MCFGrammar MCat Name MLabel Token
 type MRule    = MCFRule    MCat Name MLabel Token
@@ -143,6 +145,17 @@ isCoercion :: Name -> Bool
 isCoercion (Name fun [Unify [0]]) = Ident.isWildIdent fun
 isCoercion _ = False
 
+----------------------------------------------------------------------
+-- * nonerasing MCFG
+
+type NGrammar = MCFGrammar NCat Name NLabel Token
+type NRule    = MCFRule    NCat Name NLabel Token
+data NCat     = NCat MCat [MLabel] deriving (Eq, Ord, Show)
+type NLabel   = MLabel
+
+ncat2mcat :: NCat -> MCat
+ncat2mcat (NCat mcat _) = mcat
+
 ----------------------------------------------------------------------
 -- * CFG
 
@@ -160,6 +173,9 @@ instance Print MCat where
 			     concat [ prt path ++ "=" ++ prt term ++ ";" |
 				      (path, term) <- constrs ] ++ "}"
 
+instance Print NCat where
+    prt (NCat cat labels) = prt cat ++ prt labels
+
 instance Print CCat where
     prt (CCat cat label) = prt cat ++ prt label
 

src/GF/Formalism/SimpleGFC.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/14 11:42:05 $ 
+-- > CVS $Date: 2005/04/16 05:40:49 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.3 $
+-- > CVS $Revision: 1.4 $
 --
 -- Simplistic GFC format
 -----------------------------------------------------------------------------
@@ -52,7 +52,7 @@ decl2cat (Decl _ cat _) = cat
 varsInTTerm :: TTerm -> [Var]
 varsInTTerm tterm = vars tterm []
     where vars (TVar x)  = (x:)
-	  vars (_ :@ ts) = foldr (.) id $ map vars ts
+	  vars (_ :@ ts) = foldr (.) id $ map vars ts
 
 tterm2term :: TTerm -> Term c t
 tterm2term (con :@ terms) = con :^ map tterm2term terms
@@ -108,9 +108,9 @@ term +. lbl = term :. lbl
 Variants terms +! pat = variants $ map (+! pat) terms 
 term +! Variants pats = variants $ map (term +!) pats 
 term +! arg@(Arg _ _ _) = term :! arg
-Tbl table +! pat = maybe err id $ lookup pat table
-    where err = error $ "(+!): pattern not in table"
 Arg arg cat path +! pat = Arg arg cat (path ++! pat)
+-- cannot handle tables with pattern variales or wildcards (yet):
+term@(Tbl table) +! pat = maybe (term :! pat) id $ lookup pat table
 term +! pat = term :! pat
 
 (?++) :: Term c t -> Term c t -> Term c t
@@ -141,7 +141,7 @@ enumerateTerms arg (TblT ptype ctype)
     where enumCase pat = liftM ((,) pat) $ enumerateTerms (fmap (+! pat) arg) ctype
 
 enumeratePatterns :: (Eq c, Eq t) => LinType c t -> [Term c t]
-enumeratePatterns = enumerateTerms Nothing
+enumeratePatterns t = enumerateTerms Nothing t
 
 ----------------------------------------------------------------------
 
@@ -198,7 +198,7 @@ instance Print TTerm where
     prt (TVar var)  = "?" ++ prt var
 
 instance (Print c, Print t) => Print (LinType c t) where
-    prt (RecT rec) = "{" ++ prtInterior ":" rec ++ "}"
+    prt (RecT rec) = "{" ++ prtPairList ":" "; " rec ++ "}"
     prt (TblT t1 t2) = "(" ++ prt t1 ++ " => " ++ prt t2 ++ ")"
     prt (ConT t ts) = prt t ++ "[" ++ prtSep "|" ts ++ "]"
     prt (StrT) = "Str"
@@ -207,8 +207,8 @@ instance (Print c, Print t) => Print (Term c t) where
     prt (Arg n c p) = prt c ++ prt n ++ prt p
     prt (c :^ [])  = prt c 
     prt (c :^ ts)  = "(" ++ prt c ++ prtBefore " " ts ++ ")"
-    prt (Rec rec)   = "{" ++ prtInterior "=" rec ++ "}"
+    prt (Rec rec)   = "{" ++ prtPairList "=" "; " rec ++ "}"
-    prt (Tbl tbl)   = "[" ++ prtInterior "=>" tbl ++ "]"
+    prt (Tbl tbl)   = "[" ++ prtPairList "=>" "; " tbl ++ "]"
     prt (Variants ts)  = "{| " ++ prtSep " | " ts ++ " |}"
     prt (t1 :++ t2) = prt t1 ++ "++" ++ prt t2
     prt (Token t)   = "'" ++ prt t ++ "'"
@@ -218,9 +218,6 @@ instance (Print c, Print t) => Print (Term c t) where
     prt (term :! sel) = prt term ++ "!" ++ prt sel
     prt (Var var) = "?" ++ prt var
 
-prtInterior sep xys = if null str then str else init (init str) 
-    where str = concat [ prt x ++ sep  ++ prt y ++ "; " | (x,y) <- xys ]
-
 instance (Print c, Print t) => Print (Path c t) where
     prt (Path path) = concatMap prtEither (reverse path)
 	where prtEither (Left  lbl)  = "." ++ prt lbl

src/GF/Formalism/Utilities.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/14 11:42:05 $ 
+-- > CVS $Date: 2005/04/16 05:40:49 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.2 $
+-- > CVS $Revision: 1.3 $
 --
 -- Basic type declarations and functions for grammar formalisms
 -----------------------------------------------------------------------------
@@ -150,7 +150,7 @@ compactForests :: Ord n => [SyntaxForest n] -> SList (SyntaxForest n)
 compactForests = map joinForests . groupBy eqNames . sortForests
     where eqNames f g    = forestName f == forestName g
 	  sortForests    = foldMerge mergeForests [] . map return 
-	  mergeForests [] gs = gs
+	  mergeForests [] gs = gs
 	  mergeForests fs [] = fs
 	  mergeForests fs@(f:fs') gs@(g:gs') 
 	      = case forestName f `compare` forestName g of
@@ -163,7 +163,7 @@ compactForests = map joinForests . groupBy eqNames . sortForests
 					  compactDaughters $
 					  concat [ fss | FNode _ fss <- fs ]
 	  compactDaughters fss = case head fss of
-				   []  -> [[]]
+				   []  -> [[]]
 				   [_] -> map return $ compactForests $ concat fss
 				   _   -> nubsort fss
 -}

src/GF/GFModes.hs

@@ -1,13 +1,12 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : Main
 -- Maintainer  : Aarne Ranta
 -- Stability   : (stability)
 -- Portability : (portability)
 --
--- > CVS $Date: 2005/02/04 10:10:28 $ 
+-- > CVS $Date: 2005/04/16 05:40:48 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.5 $
+-- > CVS $Revision: 1.6 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------

src/GF/Infra/Print.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/11 13:52:50 $ 
+-- > CVS $Date: 2005/04/16 05:40:49 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- Pretty-printing
 -----------------------------------------------------------------------------
@@ -14,7 +14,7 @@
 module GF.Infra.Print 
     (Print(..),
      prtBefore, prtAfter, prtSep, 
-     prtBeforeAfter,
+     prtBeforeAfter, prtPairList,
      prIO
     ) where
 
@@ -43,6 +43,9 @@ prtSep sep = concat . intersperse sep . map prt
 prtBeforeAfter :: Print a => String -> String -> [a] -> String
 prtBeforeAfter before after as = concat [ before ++ prt a ++ after | a <- as ]
 
+prtPairList :: (Print a, Print b) => String -> String -> [(a,b)] -> String
+prtPairList comma sep xys = prtSep sep [ prt x ++ comma ++ prt y | (x,y) <- xys ]
+
 prIO :: Print a => a -> IO ()
 prIO = putStr . prt
 

src/GF/OldParsing/ConvertSimpleToMCFG/Coercions.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/11 13:52:56 $ 
+-- > CVS $Date: 2005/04/16 05:40:50 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- Adding coercion functions to a MCFG if necessary.
 -----------------------------------------------------------------------------
@@ -55,15 +55,15 @@ combineCoercions allHeads'@(heads:allHeads) allArgs'@(args:allArgs)
 
 
 makeCoercion heads args = [ Rule arg [head] lins coercionName |
-			    (head@({-MCFCat-}(_, headCns), lbls) <- heads, 
+			    head@((_, headCns), lbls) <- heads, 
 			    let lins = [ Lin lbl [Cat (head, lbl, 0)] | lbl <- lbls ],
-			    arg@({-MCFCat-} (_, argCns) <- args,
+			    arg@(_, argCns) <- args,
 			    argCns `subset` headCns ]
 
 
 coercionName = Ident.IW
 
-mainCat ({-MCFCat-} (c, _) = c
+mainCat (c, _) = c
 
 sameCat mc1 mc2 = mainCat mc1 == mainCat mc2
 

src/GF/Parsing/CFG/General.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/11 13:52:51 $ 
+-- > CVS $Date: 2005/04/16 05:40:49 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- CFG parsing with a general chart
 -----------------------------------------------------------------------------
@@ -24,12 +24,13 @@ import GF.NewParsing.GeneralChart
 import GF.Data.Assoc
 import Monad
 
---parse :: (Ord n, Ord c, Ord t) => Strategy -> CFParser c n t
+parse :: (Ord n, Ord c, Ord t) => Strategy -> CFParser c n t
 parse strategy grammar start = extract .
 			       tracePrt "#internal chart" (prt . length . chartList) .
       			       process strategy grammar start 
 
-type Strategy = (Bool, Bool) -- ^ (isBottomup, isTopdown)
+-- | parsing strategy: (isBottomup, isTopdown)
+type Strategy = (Bool, Bool)
 
 extract :: (Ord n, Ord c, Ord t) =>
 	   IChart n (Symbol c t) -> CFChart c n t

src/GF/Parsing/CFG/Incremental.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/11 13:52:51 $ 
+-- > CVS $Date: 2005/04/16 05:40:49 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- Incremental chart parsing for CFG
 -----------------------------------------------------------------------------
@@ -29,7 +29,8 @@ import GF.NewParsing.CFG.PInfo
 import GF.NewParsing.IncrementalChart
 
 
-type Strategy = ((Bool, Bool), (Bool, Bool)) -- ^ (predict:(BU, TD), filter:(BU, TD))
+-- | parsing strategy: (predict:(BU, TD), filter:(BU, TD))
+type Strategy = ((Bool, Bool), (Bool, Bool))
 
 parse :: (Ord n, Ord c, Ord t) => Strategy -> CFParser c n t
 parse strategy grammar start = extract . 

src/GF/Parsing/CFG/PInfo.hs

@@ -4,14 +4,15 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/11 13:52:52 $ 
+-- > CVS $Date: 2005/04/16 05:40:49 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- CFG parsing, parser information
 -----------------------------------------------------------------------------
 
-module GF.NewParsing.CFG.PInfo where
+module GF.NewParsing.CFG.PInfo
+    (CFParser, CFPInfo(..), buildCFPInfo) where
 
 import GF.System.Tracing
 import GF.Infra.Print
@@ -24,9 +25,10 @@ import GF.Data.Assoc
 ----------------------------------------------------------------------
 -- type declarations
 
+-- | the list of categories = possible starting categories
 type CFParser c n t = CFPInfo c n t 
-		    -> [c]             -- ^ possible starting categories
+		    -> [c]
-		    -> Input t         -- ^ the input tokens
+		    -> Input t
 		    -> CFChart c n t
 
 ------------------------------------------------------------
@@ -45,7 +47,7 @@ data CFPInfo c n t
 		-- ^ DOES NOT WORK WITH EMPTY RULES!!!
 	      }
 
---buildCFPInfo :: (Ord n, Ord c, Ord t) => CFGrammar c n t -> CFPInfo c n t
+buildCFPInfo :: (Ord n, Ord c, Ord t) => CFGrammar c n t -> CFPInfo c n t
 
 -- this is not permanent...
 buildCFPInfo grammar = traceCalcFirst grammar $

src/GF/Shell/ShellCommands.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/11 13:53:38 $ 
+-- > CVS $Date: 2005/04/16 05:40:50 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.28 $
+-- > CVS $Revision: 1.29 $
 --
 -- The datatype of shell commands and the list of their options.
 -----------------------------------------------------------------------------
@@ -135,7 +135,7 @@ testValidFlag st co f x = case f of
   "filter"  -> testInc customStringCommand
   "length"  -> testN
   "optimize"-> testIn $ words "parametrize values all share none"
-  "conversion" -> testIn $ words "strict nondet"
+  "conversion" -> testIn $ words "strict nondet finite finite-strict"
   _ -> return ()
  where
    testInc ci = 

src/GF/System/Tracing.hs

@@ -1,13 +1,14 @@
 {-# OPTIONS -cpp #-}
+
 ----------------------------------------------------------------------
 -- |
 -- Maintainer  : PL
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/11 13:52:57 $ 
+-- > CVS $Date: 2005/04/16 05:40:50 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.2 $
+-- > CVS $Revision: 1.3 $
 --
 -- Tracing utilities for debugging purposes.
 -- If the CPP symbol TRACING is set, then the debugging output is shown.

src/GF/Translate/GFT.hs

@@ -1,13 +1,12 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : GFT
 -- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:21 $ 
+-- > CVS $Date: 2005/04/16 05:40:50 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.5 $
+-- > CVS $Revision: 1.6 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------

src/GF/UseGrammar/Custom.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/14 18:38:36 $ 
+-- > CVS $Date: 2005/04/16 05:40:50 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.54 $
+-- > CVS $Revision: 1.55 $
 --
 -- A database for customizable GF shell commands. 
 --
@@ -267,6 +267,8 @@ customGrammarPrinter =
   ,(strCI "finite",   Prt2.prt . Cnv.simple2finite . Cnv.gfc2simple . stateGrammarLang)
   ,(strCI "single",   Prt2.prt . Cnv.removeSingletons . Cnv.simple2finite . Cnv.gfc2simple . stateGrammarLang)
   ,(strCI "sg-sg",    Prt2.prt . Cnv.removeSingletons . Cnv.removeSingletons . Cnv.simple2finite . Cnv.gfc2simple . stateGrammarLang)
+  ,(strCI "mcfg-ne", Prt2.prt . Cnv.removeErasing . stateMCFG)
+  ,(strCI "cfg-ne", Prt2.prt . Cnv.ne_mcfg2cfg . Cnv.removeErasing . stateMCFG)
   ,(strCI "mcfg-old", Prt.prt . CnvOld.mcfg . statePInfoOld)
   ,(strCI "cfg-old",  Prt.prt . CnvOld.cfg . statePInfoOld)
   ] 

src/haddock/haddock-check.perl

@@ -30,10 +30,11 @@ sub check_headerline {
   my ($title, $regexp) = @_;
   if (s/^-- \s $title \s* : \s+ (.+?) \s*\n//sx) {
     $name = $1;
-    print "   > Incorrect ".lcfirst $title.": $name\n" unless $name =~ $regexp;
+    push @ERR, "Incorrect ".lcfirst $title.": $name"
+      unless $name =~ $regexp;
     return $&;
   } else {
-    print "   > Header missing: ".lcfirst $title."\n";
+    push @ERR, "Header missing: ".lcfirst $title."";
   }
 }
 
@@ -43,7 +44,7 @@ if ($#ARGV >= 0) {
   @dirs = qw{. api canonical cf cfgm compile for-ghc-nofud
 	     grammar infra notrace parsers shell
 	     source speech translate useGrammar util visualization
-	     GF GF/* GF/*/*};
+	     GF GF/* GF/*/* GF/*/*/*};
   @FILES = grep(!/\/(Par|Lex)(GF|GFC|CFG)\.hs$/,
 		glob "{".join(",",@dirs)."}/*.hs");
 }
@@ -55,12 +56,12 @@ for $file (@FILES) {
   $_ = join "", <F>;
   close F;
 
-  print "-- $file\n";
+  @ERR = ();
 
   # substituting hard spaces for ordinary spaces
   $nchars = tr/\240/ /;
   if ($nchars > 0) {
-    print "!! > Substituted $nchars hard spaces\n";
+    push @ERR, "!! > Substituted $nchars hard spaces";
     open F, ">$file.hs";
     print F $_;
     close F;
@@ -71,17 +72,17 @@ for $file (@FILES) {
 
   s/^ (--+ \s* \n) +//sx;
   unless (s/^ -- \s \| \s* \n//sx) {
-    print "   > Incorrect module header\n";
+    push @ERR, "Incorrect module header";
   } else {
     $hdr_module = s/^-- \s Module \s* : \s+ (.+?) \s*\n//sx ? $1 : "";
     &check_headerline("Maintainer", qr/^ [\wåäöÅÄÖüÜ\s\@\.]+ $/x);
     &check_headerline("Stability", qr/.*/);
     &check_headerline("Portability", qr/.*/);
     s/^ (--+ \s* \n) +//sx;
-    print "   > Missing CVS information\n"
+    push @ERR, "Missing CVS information"
       unless s/^(-- \s+ \> \s+ CVS \s+ \$ .*? \$ \s* \n)+//sx;
     s/^ (--+ \s* \n) +//sx;
-    print "   > Missing module description\n"
+    push @ERR, "Missing module description"
       unless /^ -- \s+ [^\(]/x;
   }
 
@@ -105,7 +106,7 @@ for $file (@FILES) {
     $module = $1;
 
     # modules without export lists
-    print "   > No export list\n";
+    # push @ERR, "No export list";
 
     # function definitions
     while (/^ (.*? $nonOperCharColon) = (?! $operCharColon)/gmx) {
@@ -120,17 +121,17 @@ for $file (@FILES) {
       } elsif ($defn =~ /^($funSym)/x) {
 	$fn = $1;
       } else {
-	print "!! > Error in function defintion: $defn\n";
+	push @ERR, "!! > Error in function defintion: $defn";
 	next;
       }
 
       $exportlist .= " $fn ";
     }
   } else {
-    print "  > No module header found\n";
+    push @ERR, "No module header found";
   }
 
-  print "  > Module names not matching: $module != $hdr_module\n"
+  push @ERR, "Module names not matching: $module != $hdr_module"
     if $hdr_module && $module !~ /\Q$hdr_module\E$/;
 
   # fixing exportlist (double spaces as separator)
@@ -148,16 +149,18 @@ for $file (@FILES) {
 
   # reporting exported functions without type signatures
   $reported = 0;
+  $untyped = "";
   while ($exportlist =~ /\s ($funOrOper) \s/x) {
     $function = $1;
     $exportlist =~ s/\s \Q$function\E \s/ /gx;
-    print "   > No type signature for function(s):\n    "
+    $reported++;
-      unless $reported++;
+    $untyped .= " $function";
-    print " $function";
   }
-  print "\n     $reported function(s)\n"
+  push @ERR, "No type signature for $reported function(s):\n    " . $untyped
     if $reported;
 
+  print "-- $file\n   > " . join("\n   > ", @ERR) . "\n"
+    if @ERR;
 }
 
 

src/tools/AlphaConvGF.hs

@@ -1,13 +1,12 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : AlphaConvGF
 -- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:23 $ 
+-- > CVS $Date: 2005/04/16 05:40:50 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.3 $
+-- > CVS $Revision: 1.4 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------

src/tools/GFDoc.hs

@@ -1,13 +1,12 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : GFDoc
 -- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:23 $ 
+-- > CVS $Date: 2005/04/16 05:40:50 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.6 $
+-- > CVS $Revision: 1.7 $
 --
 -- produce a HTML document from a list of GF grammar files. AR 6\/10\/2002
 --

src/tools/Htmls.hs

@@ -1,13 +1,12 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : Htmls
 -- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:23 $ 
+-- > CVS $Date: 2005/04/16 05:40:50 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.4 $
+-- > CVS $Revision: 1.5 $
 --
 -- chop an HTML file into separate files, each linked to the next and previous.
 -- the names of the files are n-file, with n = 01,02,...

src/tools/MkHelpFile.hs

@@ -1,13 +1,12 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : MkHelpFile
 -- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:23 $ 
+-- > CVS $Date: 2005/04/16 05:40:51 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.6 $
+-- > CVS $Revision: 1.7 $
 --
 -- Compile @HelpFile.hs@ from the text file @HelpFile@.
 -----------------------------------------------------------------------------
@@ -49,9 +48,9 @@ helpHeader = unlines [
   "-- Stability   : (stable)",
   "-- Portability : (portable)",
   "--",
-  "-- > CVS $Date: 2005/02/18 19:21:23 $", 
+  "-- > CVS $Date: 2005/04/16 05:40:51 $", 
   "-- > CVS $Author: peb $",
-  "-- > CVS $Revision: 1.6 $",
+  "-- > CVS $Revision: 1.7 $",
   "--",
   "-- Help on shell commands. Generated from HelpFile by 'make help'.",
   "-- PLEASE DON'T EDIT THIS FILE.",

src/tools/WriteF.hs

@@ -1,13 +1,12 @@
 ----------------------------------------------------------------------
 -- |
--- Module      : WriteF
 -- Maintainer  : AR
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/02/18 19:21:23 $ 
+-- > CVS $Date: 2005/04/16 05:40:51 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.3 $
+-- > CVS $Revision: 1.4 $
 --
 -- (Description of the module)
 -----------------------------------------------------------------------------