GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

"Committed_by_peb"

Browse Source
This commit is contained in:
peb
2005-04-16 04:40:48 +00:00
parent 1ef891adaf
commit 1c79bb67ae
24 changed files with 189 additions and 137 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
src/GF/CF/ChartParser.hs
View File

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

19
src/GF/CFGM/PrintCFGrammar.hs
View File

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

24
src/GF/Compile/ShellState.hs
View File

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

51
src/GF/Conversion/GFC.hs
View File

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

32
src/GF/Conversion/MCFGtoCFG.hs
View File

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

22
src/GF/Conversion/Types.hs
View File

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

21
src/GF/Formalism/SimpleGFC.hs
View File

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

8
src/GF/Formalism/Utilities.hs
View File

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

5
src/GF/GFModes.hs
View File

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

9
src/GF/Infra/Print.hs
View File

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

10
src/GF/OldParsing/ConvertSimpleToMCFG/Coercions.hs
View File

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

9
src/GF/Parsing/CFG/General.hs
View File

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

7
src/GF/Parsing/CFG/Incremental.hs
View File

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

14
src/GF/Parsing/CFG/PInfo.hs
View File

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

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

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

5
src/GF/System/Tracing.hs
View File

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

5
src/GF/Translate/GFT.hs
View File

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

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

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

35
src/haddock/haddock-check.perl
View File

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

5
src/tools/AlphaConvGF.hs
View File

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

5
src/tools/GFDoc.hs
View File

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

5
src/tools/Htmls.hs
View File

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

9
src/tools/MkHelpFile.hs
View File

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

5
src/tools/WriteF.hs
View File

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