diff --git a/src/GF/CF/ChartParser.hs b/src/GF/CF/ChartParser.hs index f17cfdf69..fb7f91ec0 100644 --- a/src/GF/CF/ChartParser.hs +++ b/src/GF/CF/ChartParser.hs @@ -5,16 +5,15 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/03/29 13:26:34 $ --- > CVS $Author: aarne $ --- > CVS $Revision: 1.8 $ +-- > CVS $Date: 2005/04/16 05:40:50 $ +-- > CVS $Author: peb $ +-- > 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" #-} - (chartParser) where +module ChartParser (chartParser) where -- import Tracing -- import PrintParser diff --git a/src/GF/CFGM/PrintCFGrammar.hs b/src/GF/CFGM/PrintCFGrammar.hs index a0bc4ea9c..005da1404 100644 --- a/src/GF/CFGM/PrintCFGrammar.hs +++ b/src/GF/CFGM/PrintCFGrammar.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/04/15 09:45:32 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.15 $ +-- > CVS $Date: 2005/04/16 05:40:50 $ +-- > CVS $Author: peb $ +-- > 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' --- instead of 'Cnv.pInfo' (which recalculates the grammar every time) +-- | FIXME: (1) Should use 'ShellState.stateCFG' +-- 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 diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs index 6e6f00176..ce2a8d378 100644 --- a/src/GF/Compile/ShellState.hs +++ b/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 - fin = Cnv.removeSingletons . Cnv.simple2finite - s2mN = Cnv.simple2mcfg_nondet - 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 fromGFC = Cnv.gfc2mcfg2cfg opts + (mcfgs, cfgs) = unzip $ map (curry fromGFC cgr) concrs + pInfos = zipWith Prs.buildPInfo mcfgs cfgs 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, diff --git a/src/GF/Conversion/GFC.hs b/src/GF/Conversion/GFC.hs index 765fb10e0..3f52ec88d 100644 --- a/src/GF/Conversion/GFC.hs +++ b/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 ----------------------------------------------------------------------- --- * GFC -> MCFG +removeErasing :: MGrammar -> NGrammar +removeErasing = RemEra.convertGrammar --- | default conversion: +-- | this function is unnecessary, because of the following equivalence: -- --- - instantiating finite dependencies ('removeSingletons . simple2finite') --- - nondeterministic MCFG conversion ('simple2mcfg_nondet') -gfc2mcfg :: (CanonGrammar, Ident) -> MGrammar -gfc2mcfg = simple2mcfg_nondet . removeSingletons . simple2finite . gfc2simple - ----------------------------------------------------------------------- --- * GFC -> CFG - --- | default conversion = default mcfg conversion + trivial cfg conversion -gfc2cfg :: (CanonGrammar, Ident) -> CGrammar -gfc2cfg = mcfg2cfg . gfc2mcfg +-- > mcfg2cfg == ne_mcfg2cfg . removeErasing +-- +ne_mcfg2cfg :: NGrammar -> CGrammar +ne_mcfg2cfg = M2C.convertNEGrammar + diff --git a/src/GF/Conversion/MCFGtoCFG.hs b/src/GF/Conversion/MCFGtoCFG.hs index 2b86b633a..236a90aca 100644 --- a/src/GF/Conversion/MCFGtoCFG.hs +++ b/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 + +---------------------------------------------------------------------- + diff --git a/src/GF/Conversion/Types.hs b/src/GF/Conversion/Types.hs index d193f6d67..26203f73c 100644 --- a/src/GF/Conversion/Types.hs +++ b/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 diff --git a/src/GF/Formalism/SimpleGFC.hs b/src/GF/Formalism/SimpleGFC.hs index dfddc212d..537f4f568 100644 --- a/src/GF/Formalism/SimpleGFC.hs +++ b/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 (Tbl tbl) = "[" ++ prtInterior "=>" tbl ++ "]" + prt (Rec rec) = "{" ++ prtPairList "=" "; " rec ++ "}" + 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 diff --git a/src/GF/Formalism/Utilities.hs b/src/GF/Formalism/Utilities.hs index a03464e04..f4a6e8e2c 100644 --- a/src/GF/Formalism/Utilities.hs +++ b/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 -} diff --git a/src/GF/GFModes.hs b/src/GF/GFModes.hs index 54e0d6165..b0d1d797b 100644 --- a/src/GF/GFModes.hs +++ b/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) ----------------------------------------------------------------------------- diff --git a/src/GF/Infra/Print.hs b/src/GF/Infra/Print.hs index 8feeae3a0..75fa52a17 100644 --- a/src/GF/Infra/Print.hs +++ b/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 diff --git a/src/GF/OldParsing/ConvertSimpleToMCFG/Coercions.hs b/src/GF/OldParsing/ConvertSimpleToMCFG/Coercions.hs index 58a39b7f4..1c107356b 100644 --- a/src/GF/OldParsing/ConvertSimpleToMCFG/Coercions.hs +++ b/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 diff --git a/src/GF/Parsing/CFG/General.hs b/src/GF/Parsing/CFG/General.hs index ea67ec94f..33e0b9232 100644 --- a/src/GF/Parsing/CFG/General.hs +++ b/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 diff --git a/src/GF/Parsing/CFG/Incremental.hs b/src/GF/Parsing/CFG/Incremental.hs index af0f79bf0..e934b48c5 100644 --- a/src/GF/Parsing/CFG/Incremental.hs +++ b/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 . diff --git a/src/GF/Parsing/CFG/PInfo.hs b/src/GF/Parsing/CFG/PInfo.hs index eff0767c1..63c506e19 100644 --- a/src/GF/Parsing/CFG/PInfo.hs +++ b/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 - -> Input t -- ^ the input tokens + -> [c] + -> 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 $ diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs index 9f9743cf1..b61f8e3e7 100644 --- a/src/GF/Shell/ShellCommands.hs +++ b/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 = diff --git a/src/GF/System/Tracing.hs b/src/GF/System/Tracing.hs index 179ed986d..e90a37648 100644 --- a/src/GF/System/Tracing.hs +++ b/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. diff --git a/src/GF/Translate/GFT.hs b/src/GF/Translate/GFT.hs index b36e44cd2..8a9796bf9 100644 --- a/src/GF/Translate/GFT.hs +++ b/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) ----------------------------------------------------------------------------- diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs index 1bd44851f..b3ed0156c 100644 --- a/src/GF/UseGrammar/Custom.hs +++ b/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) ] diff --git a/src/haddock/haddock-check.perl b/src/haddock/haddock-check.perl index fa1dae941..a16eac9ef 100644 --- a/src/haddock/haddock-check.perl +++ b/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 "", ; 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 " - unless $reported++; - print " $function"; + $reported++; + $untyped .= " $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; } diff --git a/src/tools/AlphaConvGF.hs b/src/tools/AlphaConvGF.hs index ef00aba11..0e87bdb7a 100644 --- a/src/tools/AlphaConvGF.hs +++ b/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) ----------------------------------------------------------------------------- diff --git a/src/tools/GFDoc.hs b/src/tools/GFDoc.hs index 2193a4bf8..d84594c10 100644 --- a/src/tools/GFDoc.hs +++ b/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 -- diff --git a/src/tools/Htmls.hs b/src/tools/Htmls.hs index 2a343adab..dcca7dea6 100644 --- a/src/tools/Htmls.hs +++ b/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,... diff --git a/src/tools/MkHelpFile.hs b/src/tools/MkHelpFile.hs index 7a3f3965a..ab88e6c7f 100644 --- a/src/tools/MkHelpFile.hs +++ b/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.", diff --git a/src/tools/WriteF.hs b/src/tools/WriteF.hs index 03dc47666..2e5b299dc 100644 --- a/src/tools/WriteF.hs +++ b/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) -----------------------------------------------------------------------------