forked from GitHub/gf-core
"Committed_by_peb"
This commit is contained in:
peb
@@ -4,21 +4,21 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/16 05:40:49 $
|
||||
-- > CVS $Date: 2005/04/18 14:55:32 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.5 $
|
||||
-- > CVS $Revision: 1.6 $
|
||||
--
|
||||
-- All conversions from GFC
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module GF.Conversion.GFC
|
||||
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, NGrammar, SGrammar)
|
||||
import GF.Conversion.Types (CGrammar, MGrammar, EGrammar, SGrammar)
|
||||
|
||||
import qualified GF.Conversion.GFCtoSimple as G2S
|
||||
import qualified GF.Conversion.SimpleToFinite as S2Fin
|
||||
@@ -31,9 +31,10 @@ 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
|
||||
gfc2mcfg2cfg opts = \g -> let e = g2e g in (e2m e, e2c e)
|
||||
where e2c = mcfg2cfg
|
||||
e2m = removeErasing
|
||||
g2e = case getOptVal opts gfcConversion of
|
||||
Just "strict" -> simple2mcfg_strict . gfc2simple
|
||||
Just "finite" -> simple2mcfg_nondet . gfc2finite
|
||||
Just "finite-strict" -> simple2mcfg_strict . gfc2finite
|
||||
@@ -60,24 +61,18 @@ removeSingletons = RemSing.convertGrammar
|
||||
gfc2finite :: (CanonGrammar, Ident) -> SGrammar
|
||||
gfc2finite = removeSingletons . simple2finite . gfc2simple
|
||||
|
||||
simple2mcfg_nondet :: SGrammar -> MGrammar
|
||||
simple2mcfg_nondet :: SGrammar -> EGrammar
|
||||
simple2mcfg_nondet = S2M.convertGrammarNondet
|
||||
|
||||
simple2mcfg_strict :: SGrammar -> MGrammar
|
||||
simple2mcfg_strict :: SGrammar -> EGrammar
|
||||
simple2mcfg_strict = S2M.convertGrammarStrict
|
||||
|
||||
mcfg2cfg :: MGrammar -> CGrammar
|
||||
mcfg2cfg :: EGrammar -> CGrammar
|
||||
mcfg2cfg = M2C.convertGrammar
|
||||
|
||||
removeErasing :: MGrammar -> NGrammar
|
||||
removeErasing :: EGrammar -> MGrammar
|
||||
removeErasing = RemEra.convertGrammar
|
||||
|
||||
-- | this function is unnecessary, because of the following equivalence:
|
||||
--
|
||||
-- > mcfg2cfg == ne_mcfg2cfg . removeErasing
|
||||
--
|
||||
ne_mcfg2cfg :: NGrammar -> CGrammar
|
||||
ne_mcfg2cfg = M2C.convertNEGrammar
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/14 11:42:05 $
|
||||
-- > CVS $Date: 2005/04/18 14:55:32 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
-- > CVS $Revision: 1.4 $
|
||||
--
|
||||
-- Converting GFC to SimpleGFC
|
||||
--
|
||||
@@ -37,8 +37,8 @@ import GF.Infra.Print
|
||||
type Env = (CanonGrammar, I.Ident)
|
||||
|
||||
convertGrammar :: Env -> SGrammar
|
||||
convertGrammar gram = trace2 "converting language" (show (snd gram)) $
|
||||
tracePrt "#simpleGFC rules" (show . length) $
|
||||
convertGrammar gram = trace2 "GFCtoSimple - concrete language" (prt (snd gram)) $
|
||||
tracePrt "GFCtoSimple - nr. simpleGFC rules" (prt . length) $
|
||||
[ convertAbsFun gram fun typing |
|
||||
A.Mod (A.MTAbs modname) _ _ _ defs <- modules,
|
||||
A.AbsDFun fun typing _ <- defs ]
|
||||
|
||||
@@ -4,16 +4,16 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/16 05:40:49 $
|
||||
-- > CVS $Date: 2005/04/18 14:55:32 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
-- > CVS $Revision: 1.4 $
|
||||
--
|
||||
-- Converting MCFG grammars to (possibly overgenerating) CFG
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
module GF.Conversion.MCFGtoCFG
|
||||
(convertGrammar, convertNEGrammar) where
|
||||
(convertGrammar) where
|
||||
|
||||
import GF.System.Tracing
|
||||
import GF.Infra.Print
|
||||
@@ -28,11 +28,11 @@ import GF.Conversion.Types
|
||||
----------------------------------------------------------------------
|
||||
-- * converting (possibly erasing) MCFG grammars
|
||||
|
||||
convertGrammar :: MGrammar -> CGrammar
|
||||
convertGrammar gram = tracePrt "#context-free rules" (prt.length) $
|
||||
convertGrammar :: EGrammar -> CGrammar
|
||||
convertGrammar gram = tracePrt "MCFGtoCFG - nr. context-free rules" (prt.length) $
|
||||
concatMap convertRule gram
|
||||
|
||||
convertRule :: MRule -> [CRule]
|
||||
convertRule :: ERule -> [CRule]
|
||||
convertRule (Rule (Abs cat args (Name fun mprofile)) (Cnc _ _ record))
|
||||
= [ CFRule (CCat cat lbl) rhs (Name fun profile) |
|
||||
Lin lbl lin <- record,
|
||||
@@ -41,34 +41,13 @@ convertRule (Rule (Abs cat args (Name fun mprofile)) (Cnc _ _ record))
|
||||
let profile = mprofile `composeProfiles` cprofile
|
||||
]
|
||||
|
||||
convertArg :: (MCat, MLabel, Int) -> CCat
|
||||
convertArg :: (ECat, ELabel, Int) -> CCat
|
||||
convertArg (cat, lbl, _) = CCat cat lbl
|
||||
|
||||
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
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
36
src/GF/Conversion/RemoveEpsilon.hs
Normal file
36
src/GF/Conversion/RemoveEpsilon.hs
Normal file
@@ -0,0 +1,36 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Maintainer : PL
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/18 14:57:29 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.1 $
|
||||
--
|
||||
-- Removing epsilon linearizations from MCF grammars
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
module GF.Conversion.RemoveEpsilon where
|
||||
-- (convertGrammar) where
|
||||
|
||||
import GF.System.Tracing
|
||||
import GF.Infra.Print
|
||||
|
||||
import Monad
|
||||
import List (mapAccumL)
|
||||
import Maybe (mapMaybe)
|
||||
import GF.Formalism.Utilities
|
||||
import GF.Formalism.GCFG
|
||||
import GF.Formalism.MCFG
|
||||
import GF.Conversion.Types
|
||||
import GF.Data.Assoc
|
||||
import GF.Data.SortedList
|
||||
import GF.NewParsing.GeneralChart
|
||||
|
||||
convertGrammar :: EGrammar -> EGrammar
|
||||
convertGrammar grammar = undefined
|
||||
|
||||
|
||||
|
||||
92
src/GF/Conversion/RemoveErasing.hs
Normal file
92
src/GF/Conversion/RemoveErasing.hs
Normal file
@@ -0,0 +1,92 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Maintainer : PL
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/18 14:57:29 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.1 $
|
||||
--
|
||||
-- Removing erasingness from MCFG grammars (as in Ljunglöf 2004, sec 4.5.1)
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
module GF.Conversion.RemoveErasing
|
||||
(convertGrammar) where
|
||||
|
||||
import GF.System.Tracing
|
||||
import GF.Infra.Print
|
||||
|
||||
import Monad
|
||||
import List (mapAccumL)
|
||||
import Maybe (mapMaybe)
|
||||
import GF.Formalism.Utilities
|
||||
import GF.Formalism.GCFG
|
||||
import GF.Formalism.MCFG
|
||||
import GF.Conversion.Types
|
||||
import GF.Data.Assoc
|
||||
import GF.Data.SortedList
|
||||
import GF.NewParsing.GeneralChart
|
||||
|
||||
convertGrammar :: EGrammar -> MGrammar
|
||||
convertGrammar grammar
|
||||
= tracePrt "RemoveErasing - nr. nonerasing rules" (prt . length) $
|
||||
traceCalcFirst finalChart $
|
||||
trace2 "RemoveErasing - nr. nonerasing cats" (prt $ length $ chartLookup finalChart False) $
|
||||
trace2 "RemoveErasing - nr. initial ne-cats" (prt $ length initialCats) $
|
||||
trace2 "RemoveErasing - nr. erasing rules" (prt $ length grammar) $
|
||||
newGrammar
|
||||
where newGrammar = [ rule | NR rule <- chartLookup finalChart True ]
|
||||
finalChart = buildChart keyof [newRules rulesByCat] initialCats
|
||||
initialCats = initialCatsBU rulesByCat
|
||||
rulesByCat = accumAssoc id [ (cat, rule) | rule@(Rule (Abs cat _ _) _) <- grammar ]
|
||||
|
||||
data Item r c = NR r | NC c deriving (Eq, Ord, Show)
|
||||
|
||||
keyof (NR _) = True
|
||||
keyof (NC _) = False
|
||||
|
||||
newRules grammar chart (NR (Rule (Abs _ cats _) _))
|
||||
= [ NC cat | cat@(MCat _ lbls) <- cats, not (null lbls) ]
|
||||
newRules grammar chart (NC newCat@(MCat cat lbls))
|
||||
= do Rule (Abs _ args (Name fun profile)) (Cnc _ _ lins0) <- grammar ? cat
|
||||
|
||||
let lins = [ lin | lin@(Lin lbl _) <- lins0,
|
||||
lbl `elem` lbls ]
|
||||
argsInLin = listAssoc $
|
||||
map (\((n,c),l) -> (n, MCat c l)) $
|
||||
groupPairs $ nubsort $
|
||||
[ ((nr, cat), lbl) |
|
||||
Lin _ lin <- lins,
|
||||
Cat (cat, lbl, nr) <- lin ]
|
||||
|
||||
newArgs = mapMaybe (lookupAssoc argsInLin) [0 .. length args-1]
|
||||
argLbls = [ lbls | MCat _ lbls <- newArgs ]
|
||||
|
||||
newLins = [ Lin lbl newLin | Lin lbl lin <- lins,
|
||||
let newLin = map (mapSymbol cnvCat id) lin ]
|
||||
cnvCat (cat, lbl, nr) = (mcat, lbl, nr')
|
||||
where Just mcat = lookupAssoc argsInLin nr
|
||||
Unify [nr'] = newProfile !! nr
|
||||
nonEmptyCat (Cat (MCat _ [], _, _)) = False
|
||||
nonEmptyCat _ = True
|
||||
|
||||
newProfile = snd $ mapAccumL accumProf 0 $
|
||||
map (lookupAssoc argsInLin) [0 .. length args-1]
|
||||
accumProf nr = maybe (nr, Unify []) $ const (nr+1, Unify [nr])
|
||||
newName = Name fun (newProfile `composeProfiles` profile)
|
||||
|
||||
return $ NR (Rule (Abs newCat newArgs newName) (Cnc lbls argLbls newLins))
|
||||
|
||||
initialCatsBU grammar
|
||||
= [ NC (MCat cat [lbl]) | (cat, rules) <- aAssocs grammar,
|
||||
let Rule _ (Cnc lbls _ _) = head rules,
|
||||
lbl <- lbls ]
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/14 18:41:21 $
|
||||
-- > CVS $Date: 2005/04/18 14:55:32 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.1 $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
--
|
||||
-- Instantiating all types which only have one single element.
|
||||
--
|
||||
@@ -30,7 +30,7 @@ import List (mapAccumL)
|
||||
|
||||
convertGrammar :: SGrammar -> SGrammar
|
||||
convertGrammar grammar = if singles == emptyAssoc then grammar
|
||||
else tracePrt "#singleton-removed rules" (prt . length) $
|
||||
else tracePrt "RemoveSingletons - nr. non-singleton rules" (prt . length) $
|
||||
map (convertRule singles) grammar
|
||||
where singles = calcSingletons grammar
|
||||
|
||||
@@ -71,7 +71,7 @@ instantiateLin newArgs = inst
|
||||
|
||||
calcSingletons :: SGrammar -> Assoc SCat (SyntaxForest Fun, Maybe STerm)
|
||||
calcSingletons rules = listAssoc singleCats
|
||||
where singleCats = tracePrt "singleton cats" (prtSep " ") $
|
||||
where singleCats = tracePrt "RemoveSingletons - singleton cats" (prtSep " ") $
|
||||
[ (cat, (constantNameToForest name, lin)) |
|
||||
(cat, [([], name, lin)]) <- rulesByCat ]
|
||||
rulesByCat = groupPairs $ nubsort
|
||||
|
||||
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/14 11:42:05 $
|
||||
-- > CVS $Date: 2005/04/18 14:55:32 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
-- > CVS $Revision: 1.4 $
|
||||
--
|
||||
-- Calculating the finiteness of each type in a grammar
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -31,7 +31,7 @@ import Ident (Ident(..))
|
||||
type CnvMonad a = BacktrackM () a
|
||||
|
||||
convertGrammar :: SGrammar -> SGrammar
|
||||
convertGrammar rules = tracePrt "#finite simpleGFC rules" (prt . length) $
|
||||
convertGrammar rules = tracePrt "SimpleToFinie - nr. 'finite' rules" (prt . length) $
|
||||
solutions cnvMonad ()
|
||||
where split = calcSplitable rules
|
||||
cnvMonad = member rules >>= convertRule split
|
||||
@@ -101,7 +101,7 @@ calcSplitable rules = (listAssoc splitableCat2Funs, listAssoc splitableFun2Cat)
|
||||
|
||||
-- all cats that are splitable
|
||||
splitableCats = listSet $
|
||||
tracePrt "finite categories to split" prt $
|
||||
tracePrt "SimpleToFinite - finite categories to split" prt $
|
||||
(nondepCats <**> depCats) <\\> resultCats
|
||||
|
||||
-- all result cats for some pure function
|
||||
|
||||
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/12 10:49:44 $
|
||||
-- > CVS $Date: 2005/04/18 14:55:32 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
--
|
||||
-- All different conversions from SimpleGFC to MCFG
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -20,7 +20,7 @@ import qualified GF.Conversion.SimpleToMCFG.Strict as Strict
|
||||
import qualified GF.Conversion.SimpleToMCFG.Nondet as Nondet
|
||||
import qualified GF.Conversion.SimpleToMCFG.Coercions as Coerce
|
||||
|
||||
convertGrammarNondet, convertGrammarStrict :: SGrammar -> MGrammar
|
||||
convertGrammarNondet, convertGrammarStrict :: SGrammar -> EGrammar
|
||||
convertGrammarNondet = Coerce.addCoercions . Nondet.convertGrammar
|
||||
convertGrammarStrict = Strict.convertGrammar
|
||||
|
||||
|
||||
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/12 10:49:44 $
|
||||
-- > CVS $Date: 2005/04/18 14:55:32 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
--
|
||||
-- Adding coercion functions to a MCFG if necessary.
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -27,25 +27,26 @@ import List (groupBy)
|
||||
|
||||
----------------------------------------------------------------------
|
||||
|
||||
addCoercions :: MGrammar -> MGrammar
|
||||
addCoercions :: EGrammar -> EGrammar
|
||||
addCoercions rules = coercions ++ rules
|
||||
where (allHeads, allArgs) = unzip [ ((head, lbls), nubsort args) |
|
||||
Rule (Abs head args _) (Cnc lbls _ _) <- rules ]
|
||||
allHeadSet = nubsort allHeads
|
||||
allArgSet = union allArgs <\\> map fst allHeadSet
|
||||
coercions = tracePrt "#MCFG coercions" (prt . length) $
|
||||
coercions = tracePrt "SimpleToMCFG.Coercions - nr. MCFG coercions" (prt . length) $
|
||||
concat $
|
||||
tracePrt "#MCFG coercions per category" (prtList . map length) $
|
||||
tracePrt "SimpleToMCFG.Coerciions - nr. MCFG coercions per category"
|
||||
(prtList . map length) $
|
||||
combineCoercions
|
||||
(groupBy sameCatFst allHeadSet)
|
||||
(groupBy sameCat allArgSet)
|
||||
sameCatFst a b = sameCat (fst a) (fst b)
|
||||
(groupBy sameECatFst allHeadSet)
|
||||
(groupBy sameECat allArgSet)
|
||||
sameECatFst a b = sameECat (fst a) (fst b)
|
||||
|
||||
|
||||
combineCoercions [] _ = []
|
||||
combineCoercions _ [] = []
|
||||
combineCoercions allHeads'@(heads:allHeads) allArgs'@(args:allArgs)
|
||||
= case compare (mcat2scat $ fst $ head heads) (mcat2scat $ head args) of
|
||||
= case compare (ecat2scat $ fst $ head heads) (ecat2scat $ head args) of
|
||||
LT -> combineCoercions allHeads allArgs'
|
||||
GT -> combineCoercions allHeads' allArgs
|
||||
EQ -> makeCoercion heads args : combineCoercions allHeads allArgs
|
||||
@@ -53,9 +54,9 @@ combineCoercions allHeads'@(heads:allHeads) allArgs'@(args:allArgs)
|
||||
|
||||
makeCoercion heads args
|
||||
= [ Rule (Abs arg [head] coercionName) (Cnc lbls [lbls] lins) |
|
||||
(head@(MCat _ headCns), lbls) <- heads,
|
||||
(head@(ECat _ headCns), lbls) <- heads,
|
||||
let lins = [ Lin lbl [Cat (head, lbl, 0)] | lbl <- lbls ],
|
||||
arg@(MCat _ argCns) <- args,
|
||||
arg@(ECat _ argCns) <- args,
|
||||
argCns `subset` headCns ]
|
||||
|
||||
|
||||
|
||||
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/12 10:49:44 $
|
||||
-- > CVS $Date: 2005/04/18 14:55:32 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
--
|
||||
-- Converting SimpleGFC grammars to MCFG grammars, nondeterministically.
|
||||
-- Afterwards, the grammar has to be extended with coercion functions,
|
||||
@@ -40,22 +40,22 @@ import GF.Data.BacktrackM
|
||||
|
||||
type CnvMonad a = BacktrackM Env a
|
||||
|
||||
type Env = (MCat, [MCat], LinRec, [SLinType])
|
||||
type Env = (ECat, [ECat], LinRec, [SLinType])
|
||||
type LinRec = [Lin SCat MLabel Token]
|
||||
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- main conversion function
|
||||
|
||||
convertGrammar :: SGrammar -> MGrammar
|
||||
convertGrammar rules = tracePrt "Nondet conversion: #MCFG rules" (prt . length) $
|
||||
convertGrammar :: SGrammar -> EGrammar
|
||||
convertGrammar rules = tracePrt "SimpleToMCFG.Nondet - nr. MCFG rules" (prt . length) $
|
||||
solutions conversion undefined
|
||||
where conversion = member rules >>= convertRule
|
||||
|
||||
convertRule :: SRule -> CnvMonad MRule
|
||||
convertRule :: SRule -> CnvMonad ERule
|
||||
convertRule (Rule (Abs decl decls fun) (Cnc ctype ctypes (Just term)))
|
||||
= do let cat : args = map decl2cat (decl : decls)
|
||||
writeState (initialMCat cat, map initialMCat args, [], ctypes)
|
||||
writeState (initialECat cat, map initialECat args, [], ctypes)
|
||||
rterm <- simplifyTerm term
|
||||
reduceTerm ctype emptyPath rterm
|
||||
(newCat, newArgs, linRec, _) <- readState
|
||||
@@ -158,13 +158,13 @@ readArgCTypes = do (_, _, _, env) <- readState
|
||||
updateArg :: Int -> Constraint -> CnvMonad ()
|
||||
updateArg arg cn
|
||||
= do (head, args, lins, env) <- readState
|
||||
args' <- updateNth (addToMCat cn) arg args
|
||||
args' <- updateNth (addToECat cn) arg args
|
||||
writeState (head, args', lins, env)
|
||||
|
||||
updateHead :: Constraint -> CnvMonad ()
|
||||
updateHead cn
|
||||
= do (head, args, lins, env) <- readState
|
||||
head' <- addToMCat cn head
|
||||
head' <- addToECat cn head
|
||||
writeState (head', args, lins, env)
|
||||
|
||||
updateLin :: Constraint -> CnvMonad ()
|
||||
@@ -182,8 +182,8 @@ term2lins (Empty) = return []
|
||||
term2lins (Variants terms) = terms >>= term2lins
|
||||
term2lins term = error $ "term2lins: " ++ show term
|
||||
|
||||
addToMCat :: Constraint -> MCat -> CnvMonad MCat
|
||||
addToMCat cn (MCat cat cns) = liftM (MCat cat) $ addConstraint cn cns
|
||||
addToECat :: Constraint -> ECat -> CnvMonad ECat
|
||||
addToECat cn (ECat cat cns) = liftM (ECat cat) $ addConstraint cn cns
|
||||
|
||||
addConstraint :: Constraint -> [Constraint] -> CnvMonad [Constraint]
|
||||
addConstraint cn0 (cn : cns)
|
||||
|
||||
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/12 10:49:45 $
|
||||
-- > CVS $Date: 2005/04/18 14:55:33 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
--
|
||||
-- Converting SimpleGFC grammars to MCFG grammars, deterministic.
|
||||
--
|
||||
@@ -16,7 +16,8 @@
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
module GF.Conversion.SimpleToMCFG.Strict where -- (convertGrammar) where
|
||||
module GF.Conversion.SimpleToMCFG.Strict
|
||||
(convertGrammar) where
|
||||
|
||||
import GF.System.Tracing
|
||||
import GF.Infra.Print
|
||||
@@ -37,18 +38,18 @@ import GF.Data.SortedList
|
||||
|
||||
type CnvMonad a = BacktrackM () a
|
||||
|
||||
convertGrammar :: SGrammar -> MGrammar
|
||||
convertGrammar rules = tracePrt "Strict conversion: #MCFG rules" (prt . length) $
|
||||
convertGrammar :: SGrammar -> EGrammar
|
||||
convertGrammar rules = tracePrt "SimpleToMCFG.Strict - nr. MCFG rules" (prt . length) $
|
||||
solutions conversion undefined
|
||||
where conversion = member rules >>= convertRule
|
||||
|
||||
convertRule :: SRule -> CnvMonad MRule
|
||||
convertRule :: SRule -> CnvMonad ERule
|
||||
convertRule (Rule (Abs decl decls fun) (Cnc ctype ctypes (Just term)))
|
||||
= do let cat : args = map decl2cat (decl : decls)
|
||||
args_ctypes = zip3 [0..] args ctypes
|
||||
instArgs <- mapM enumerateArg args_ctypes
|
||||
let instTerm = substitutePaths instArgs term
|
||||
newCat <- extractMCat cat ctype instTerm
|
||||
newCat <- extractECat cat ctype instTerm
|
||||
newArgs <- mapM (extractArg instArgs) args_ctypes
|
||||
let linRec = strPaths ctype instTerm >>= extractLin newArgs
|
||||
let newLinRec = map (instantiateArgs newArgs) linRec
|
||||
@@ -59,11 +60,11 @@ convertRule _ = failure
|
||||
----------------------------------------------------------------------
|
||||
-- category extraction
|
||||
|
||||
extractArg :: [STerm] -> (Int, SCat, SLinType) -> CnvMonad MCat
|
||||
extractArg args (nr, cat, ctype) = extractMCat cat ctype (args !! nr)
|
||||
extractArg :: [STerm] -> (Int, SCat, SLinType) -> CnvMonad ECat
|
||||
extractArg args (nr, cat, ctype) = extractECat cat ctype (args !! nr)
|
||||
|
||||
extractMCat :: SCat -> SLinType -> STerm -> CnvMonad MCat
|
||||
extractMCat cat ctype term = member $ map (MCat cat) $ parPaths ctype term
|
||||
extractECat :: SCat -> SLinType -> STerm -> CnvMonad ECat
|
||||
extractECat cat ctype term = member $ map (ECat cat) $ parPaths ctype term
|
||||
|
||||
enumerateArg :: (Int, SCat, SLinType) -> CnvMonad STerm
|
||||
enumerateArg (nr, cat, ctype) = member $ enumerateTerms (Just (Arg nr cat emptyPath)) ctype
|
||||
@@ -117,7 +118,7 @@ strPaths ctype term = [ (path, variants values) | (path, values) <- groupPairs p
|
||||
----------------------------------------------------------------------
|
||||
-- linearization extraction
|
||||
|
||||
extractLin :: [MCat] -> (SPath, STerm) -> [Lin MCat MLabel Token]
|
||||
extractLin :: [ECat] -> (SPath, STerm) -> [Lin ECat MLabel Token]
|
||||
extractLin args (path, term) = map (Lin path) (convertLin term)
|
||||
where convertLin (t1 :++ t2) = liftM2 (++) (convertLin t1) (convertLin t2)
|
||||
convertLin (Empty) = [[]]
|
||||
|
||||
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/16 05:40:49 $
|
||||
-- > CVS $Date: 2005/04/18 14:55:32 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.4 $
|
||||
-- > CVS $Revision: 1.5 $
|
||||
--
|
||||
-- All possible instantiations of different grammar formats used in conversion from GFC
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -58,7 +58,8 @@ instance Functor Profile where
|
||||
fmap f (Constant a) = Constant (f a)
|
||||
fmap f (Unify xs) = Unify xs
|
||||
|
||||
-- | a function name where the profile does not contain
|
||||
-- | a function name where the profile does not contain arguments
|
||||
-- (i.e. denoting a constant, not a function)
|
||||
constantNameToForest :: Name -> SyntaxForest Fun
|
||||
constantNameToForest name@(Name fun profile) = FNode fun [map unConstant profile]
|
||||
where unConstant (Constant a) = a
|
||||
@@ -120,23 +121,23 @@ type SDecl = Decl SCat
|
||||
----------------------------------------------------------------------
|
||||
-- * erasing MCFG
|
||||
|
||||
type MGrammar = MCFGrammar MCat Name MLabel Token
|
||||
type MRule = MCFRule MCat Name MLabel Token
|
||||
data MCat = MCat SCat [Constraint] deriving (Eq, Ord, Show)
|
||||
type MLabel = SPath
|
||||
type EGrammar = MCFGrammar ECat Name ELabel Token
|
||||
type ERule = MCFRule ECat Name ELabel Token
|
||||
data ECat = ECat SCat [Constraint] deriving (Eq, Ord, Show)
|
||||
type ELabel = SPath
|
||||
|
||||
type Constraint = (SPath, STerm)
|
||||
|
||||
-- ** type coercions etc
|
||||
|
||||
initialMCat :: SCat -> MCat
|
||||
initialMCat cat = MCat cat []
|
||||
initialECat :: SCat -> ECat
|
||||
initialECat cat = ECat cat []
|
||||
|
||||
mcat2scat :: MCat -> SCat
|
||||
mcat2scat (MCat cat _) = cat
|
||||
ecat2scat :: ECat -> SCat
|
||||
ecat2scat (ECat cat _) = cat
|
||||
|
||||
sameCat :: MCat -> MCat -> Bool
|
||||
sameCat mc1 mc2 = mcat2scat mc1 == mcat2scat mc2
|
||||
sameECat :: ECat -> ECat -> Bool
|
||||
sameECat ec1 ec2 = ecat2scat ec1 == ecat2scat ec2
|
||||
|
||||
coercionName :: Name
|
||||
coercionName = Name Ident.wildIdent [Unify [0]]
|
||||
@@ -148,33 +149,31 @@ 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
|
||||
type MGrammar = MCFGrammar MCat Name MLabel Token
|
||||
type MRule = MCFRule MCat Name MLabel Token
|
||||
data MCat = MCat ECat [ELabel] deriving (Eq, Ord, Show)
|
||||
type MLabel = ELabel
|
||||
|
||||
ncat2mcat :: NCat -> MCat
|
||||
ncat2mcat (NCat mcat _) = mcat
|
||||
mcat2ecat :: MCat -> ECat
|
||||
mcat2ecat (MCat mcat _) = mcat
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- * CFG
|
||||
|
||||
type CGrammar = CFGrammar CCat Name Token
|
||||
type CRule = CFRule CCat Name Token
|
||||
|
||||
data CCat = CCat MCat MLabel
|
||||
deriving (Eq, Ord, Show)
|
||||
data CCat = CCat ECat ELabel deriving (Eq, Ord, Show)
|
||||
|
||||
----------------------------------------------------------------------
|
||||
-- * pretty-printing
|
||||
|
||||
instance Print MCat where
|
||||
prt (MCat cat constrs) = prt cat ++ "{" ++
|
||||
instance Print ECat where
|
||||
prt (ECat cat constrs) = prt cat ++ "{" ++
|
||||
concat [ prt path ++ "=" ++ prt term ++ ";" |
|
||||
(path, term) <- constrs ] ++ "}"
|
||||
|
||||
instance Print NCat where
|
||||
prt (NCat cat labels) = prt cat ++ prt labels
|
||||
instance Print MCat where
|
||||
prt (MCat cat labels) = prt cat ++ prt labels
|
||||
|
||||
instance Print CCat where
|
||||
prt (CCat cat label) = prt cat ++ prt label
|
||||
|
||||
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/14 18:41:22 $
|
||||
-- > CVS $Date: 2005/04/18 14:55:33 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.1 $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
--
|
||||
-- Chart parsing of grammars in CF format
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -32,19 +32,18 @@ parse :: String -> CF.CF -> Category -> CF.CFParser
|
||||
parse = buildParser . P.parseCF
|
||||
|
||||
buildParser :: P.CFParser Category Name Token -> CF.CF -> Category -> CF.CFParser
|
||||
buildParser parser cf start tokens = trace "ParseCF" $
|
||||
(parseResults, parseInformation)
|
||||
buildParser parser cf start tokens = (parseResults, parseInformation)
|
||||
where parseInformation = prtSep "\n" trees
|
||||
parseResults = [ (tree2cfTree t, []) | t <- trees ]
|
||||
theInput = input tokens
|
||||
edges = tracePrt "#edges" (prt.length) $
|
||||
edges = tracePrt "Parsing.CF - nr. edges" (prt.length) $
|
||||
parser pInf [start] theInput
|
||||
chart = tracePrt "#chart" (prt . map (length.snd) . aAssocs) $
|
||||
chart = tracePrt "Parsing.CF - size of chart" (prt . map (length.snd) . aAssocs) $
|
||||
grammar2chart $ map addCategory edges
|
||||
forests = tracePrt "#forests" (prt.length) $
|
||||
forests = tracePrt "Parsing.CF - nr. forests" (prt.length) $
|
||||
chart2forests chart (const False)
|
||||
[ uncurry Edge (inputBounds theInput) start ]
|
||||
trees = tracePrt "#trees" (prt.length) $
|
||||
trees = tracePrt "Parsing.CF - nr. trees" (prt.length) $
|
||||
concatMap forest2trees forests
|
||||
pInf = P.buildCFPInfo $ cf2grammar cf (nubsort tokens)
|
||||
|
||||
|
||||
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/16 05:40:49 $
|
||||
-- > CVS $Date: 2005/04/18 14:55:33 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
--
|
||||
-- CFG parsing with a general chart
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -26,7 +26,8 @@ import Monad
|
||||
|
||||
parse :: (Ord n, Ord c, Ord t) => Strategy -> CFParser c n t
|
||||
parse strategy grammar start = extract .
|
||||
tracePrt "#internal chart" (prt . length . chartList) .
|
||||
tracePrt "Parsing.CFG.General - size internal of chart"
|
||||
(prt . length . chartList) .
|
||||
process strategy grammar start
|
||||
|
||||
-- | parsing strategy: (isBottomup, isTopdown)
|
||||
@@ -54,8 +55,8 @@ process :: (Ord n, Ord c, Ord t) =>
|
||||
-> Input t -- ^ input string
|
||||
-> IChart n (Symbol c t)
|
||||
process (isBottomup, isTopdown) grammar start
|
||||
= trace2 "CFParserGeneral" ((if isBottomup then " BU" else "") ++
|
||||
(if isTopdown then " TD" else "")) $
|
||||
= trace2 "Parsing.CFG.General - strategy" ((if isBottomup then " BU" else "") ++
|
||||
(if isTopdown then " TD" else "")) $
|
||||
buildChart keyof [predict, combine] . axioms
|
||||
where axioms input = initial ++ scan input
|
||||
|
||||
|
||||
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/16 05:40:49 $
|
||||
-- > CVS $Date: 2005/04/18 14:55:33 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
--
|
||||
-- Incremental chart parsing for CFG
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -34,7 +34,8 @@ type Strategy = ((Bool, Bool), (Bool, Bool))
|
||||
|
||||
parse :: (Ord n, Ord c, Ord t) => Strategy -> CFParser c n t
|
||||
parse strategy grammar start = extract .
|
||||
tracePrt "#internal chart" (prt . length . flip chartList const) .
|
||||
tracePrt "Parsing.CFG.Incremental - size of internal chart"
|
||||
(prt . length . flip chartList const) .
|
||||
process strategy grammar start
|
||||
|
||||
extract :: (Ord n, Ord c, Ord t) =>
|
||||
@@ -54,10 +55,10 @@ extract finalChart = [ CFRule (Edge j k cat) daughters name |
|
||||
process :: (Ord n, Ord c, Ord t) =>
|
||||
Strategy -> CFPInfo c n t -> [c] -> Input t -> IChart c n t
|
||||
process ((isPredictBU, isPredictTD), (isFilterBU, isFilterTD)) grammar start input
|
||||
= trace2 "CFParserIncremental" ((if isPredictBU then "BU-predict " else "") ++
|
||||
(if isPredictTD then "TD-predict " else "") ++
|
||||
(if isFilterBU then "BU-filter " else "") ++
|
||||
(if isFilterTD then "TD-filter " else "")) $
|
||||
= trace2 "Parsing.CFG.Incremental - strategy" ((if isPredictBU then "BU-predict " else "") ++
|
||||
(if isPredictTD then "TD-predict " else "") ++
|
||||
(if isFilterBU then "BU-filter " else "") ++
|
||||
(if isFilterTD then "TD-filter " else "")) $
|
||||
finalChart
|
||||
where finalChart = buildChart keyof rules axioms $ inputBounds input
|
||||
|
||||
|
||||
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/16 05:40:49 $
|
||||
-- > CVS $Date: 2005/04/18 14:55:33 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
--
|
||||
-- CFG parsing, parser information
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -51,7 +51,7 @@ buildCFPInfo :: (Ord n, Ord c, Ord t) => CFGrammar c n t -> CFPInfo c n t
|
||||
|
||||
-- this is not permanent...
|
||||
buildCFPInfo grammar = traceCalcFirst grammar $
|
||||
tracePrt "cf parser info" (prt) $
|
||||
tracePrt "CFG.PInfo - parser info" (prt) $
|
||||
pInfo' (filter (not . isCyclic) grammar)
|
||||
|
||||
pInfo' grammar = CFPInfo grToks nmRules tdRules buRules elcRules emptyCats cyclicCats leftToks
|
||||
@@ -84,14 +84,14 @@ isCyclic _ = False
|
||||
----------------------------------------------------------------------
|
||||
|
||||
instance (Ord n, Ord c, Ord t) => Print (CFPInfo n c t) where
|
||||
prt pI = "[ tokens=" ++ sl grammarTokens ++
|
||||
"; names=" ++ sla nameRules ++
|
||||
"; tdCats=" ++ sla topdownRules ++
|
||||
"; buCats=" ++ sla bottomupRules ++
|
||||
"; elcCats=" ++ sla emptyLeftcornerRules ++
|
||||
"; eCats=" ++ sla emptyCategories ++
|
||||
"; cCats=" ++ sl cyclicCategories ++
|
||||
"; lctokCats=" ++ sla leftcornerTokens ++
|
||||
prt pI = "[ nr. tokens=" ++ sl grammarTokens ++
|
||||
"; nr. names=" ++ sla nameRules ++
|
||||
"; nr. tdCats=" ++ sla topdownRules ++
|
||||
"; nr. buCats=" ++ sla bottomupRules ++
|
||||
"; nr. elcCats=" ++ sla emptyLeftcornerRules ++
|
||||
"; nr. eCats=" ++ sla emptyCategories ++
|
||||
"; nr. cCats=" ++ sl cyclicCategories ++
|
||||
"; nr. lctokCats=" ++ sla leftcornerTokens ++
|
||||
" ]"
|
||||
where sla f = show $ length $ aElems $ f pI
|
||||
sl f = show $ length $ f pI
|
||||
|
||||
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/12 10:49:45 $
|
||||
-- > CVS $Date: 2005/04/18 14:55:33 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
--
|
||||
-- The main parsing module, parsing GFC grammars
|
||||
-- by translating to simpler formats, such as PMCFG and CFG
|
||||
@@ -67,9 +67,9 @@ parse (c:strategy) pinfo abs startCat
|
||||
| c=='c' || c=='C' = map (tree2term abs) .
|
||||
parseCFG strategy pinfo startCats .
|
||||
map prCFTok
|
||||
where startCats = tracePrt "startCats" prt $
|
||||
where startCats = tracePrt "Parsing.GFC - starting categories" prt $
|
||||
filter isStartCat $ map fst $ aAssocs $ PC.topdownRules $ cfPInfo pinfo
|
||||
isStartCat (CCat (MCat cat _) _) = cat == cfCat2Ident startCat
|
||||
isStartCat (CCat (ECat cat _) _) = cat == cfCat2Ident startCat
|
||||
|
||||
-- default parser
|
||||
parse strategy pinfo abs start = parse ('c':strategy) pinfo abs start
|
||||
@@ -78,9 +78,9 @@ parse strategy pinfo abs start = parse ('c':strategy) pinfo abs start
|
||||
----------------------------------------------------------------------
|
||||
|
||||
parseCFG :: String -> PInfo -> [CCat] -> [Token] -> [SyntaxTree Fun]
|
||||
parseCFG strategy pInfo startCats inString = trace2 "Parser" "CFG" $
|
||||
parseCFG strategy pInfo startCats inString = trace2 "Parsing.GFC - selected algorithm" "CFG" $
|
||||
trees
|
||||
where trees = tracePrt "#trees" (prt . length) $
|
||||
where trees = tracePrt "Parsing.GFC - nr. trees" (prt . length) $
|
||||
nubsort $ forests >>= forest2trees
|
||||
-- compactFs >>= forest2trees
|
||||
|
||||
@@ -88,19 +88,19 @@ parseCFG strategy pInfo startCats inString = trace2 "Parser" "CFG" $
|
||||
-- tracePrt "compactForests" (prtBefore "\n") $
|
||||
-- compactForests forests
|
||||
|
||||
forests = tracePrt "#forests" (prt . length) $
|
||||
forests = tracePrt "Parsing.GFC - nr. forests" (prt . length) $
|
||||
cfForests >>= convertFromCFForest
|
||||
cfForests= tracePrt "#cfForests" (prt . length) $
|
||||
cfForests= tracePrt "Parsing.GFC - nr. context-free forests" (prt . length) $
|
||||
chart2forests chart (const False) finalEdges
|
||||
|
||||
finalEdges = tracePrt "finalChartEdges" prt $
|
||||
finalEdges = tracePrt "Parsing.GFC - final chart edges" prt $
|
||||
map (uncurry Edge (inputBounds inTokens)) startCats
|
||||
chart = --tracePrt "finalChartEdges" (prt . (? finalEdge)) $
|
||||
tracePrt "#chart" (prt . map (length.snd) . aAssocs) $
|
||||
tracePrt "Parsing.GFC - size of chart" (prt . map (length.snd) . aAssocs) $
|
||||
C.grammar2chart cfChart
|
||||
cfChart = --tracePrt "finalEdges"
|
||||
--(prt . filter (\(Edge i j _) -> (i,j)==inputBounds inTokens)) $
|
||||
tracePrt "#cfChart" (prt . length) $
|
||||
tracePrt "Parsing.GFC - size of context-free chart" (prt . length) $
|
||||
PC.parseCF strategy (cfPInfo pInfo) startCats inTokens
|
||||
|
||||
inTokens = input inString
|
||||
|
||||
@@ -5,9 +5,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/04/16 05:40:50 $
|
||||
-- > CVS $Date: 2005/04/18 14:55:33 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.55 $
|
||||
-- > CVS $Revision: 1.56 $
|
||||
--
|
||||
-- A database for customizable GF shell commands.
|
||||
--
|
||||
@@ -65,26 +65,15 @@ import GrammarToHaskell
|
||||
-----import qualified GrammarToGFC as GFC
|
||||
|
||||
-- the cf parsing algorithms
|
||||
import ChartParser -- or some other CF Parser
|
||||
import ChartParser -- OBSOLETE
|
||||
import qualified GF.NewParsing.CF as PCF
|
||||
import qualified GF.OldParsing.ParseCF as PCFOld -- OBSOLETE
|
||||
--import qualified ParseGFCviaCFG as PGFC
|
||||
--import NewChartParser
|
||||
--import NewerChartParser
|
||||
|
||||
-- grammar conversions -- peb 19/4-04
|
||||
-- see also customGrammarPrinter
|
||||
import qualified GF.OldParsing.ConvertGrammar as CnvOld -- OBSOLETE
|
||||
import qualified GF.Printing.PrintParser as Prt
|
||||
--import qualified GF.Data.Assoc as Assoc
|
||||
--import qualified GF.OldParsing.ConvertFiniteGFC as Fin
|
||||
--import qualified GF.OldParsing.ConvertGFCtoSimple as Simp
|
||||
--import qualified GF.OldParsing.ConvertFiniteSimple as FinSimp
|
||||
--import qualified GF.OldParsing.ConvertSimpleToMCFG as MCFSimp
|
||||
--import qualified GF.Conversion.GFCtoSimple as G2S
|
||||
--import qualified GF.Conversion.SimpleToMCFG as S2M
|
||||
--import GF.Conversion.FromGFC
|
||||
import qualified GF.Infra.Print as Prt2
|
||||
import qualified GF.Printing.PrintParser as PrtOld -- OBSOLETE
|
||||
import qualified GF.Infra.Print as Prt
|
||||
import qualified GF.Conversion.GFC as Cnv
|
||||
|
||||
import GFC
|
||||
@@ -260,17 +249,15 @@ customGrammarPrinter =
|
||||
|
||||
-- add your own grammar printers here
|
||||
-- grammar conversions:
|
||||
,(strCI "mcfg", Prt2.prt . stateMCFG)
|
||||
,(strCI "cfg", Prt2.prt . stateCFG)
|
||||
,(strCI "mcfg", Prt.prt . stateMCFG)
|
||||
,(strCI "cfg", Prt.prt . stateCFG)
|
||||
-- obsolete, or only for testing:
|
||||
,(strCI "simple", Prt2.prt . Cnv.gfc2simple . stateGrammarLang)
|
||||
,(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)
|
||||
,(strCI "simple", Prt.prt . Cnv.gfc2simple . stateGrammarLang)
|
||||
,(strCI "finite", Prt.prt . Cnv.simple2finite . Cnv.gfc2simple . stateGrammarLang)
|
||||
,(strCI "single", Prt.prt . Cnv.removeSingletons . Cnv.simple2finite . Cnv.gfc2simple . stateGrammarLang)
|
||||
,(strCI "sg-sg", Prt.prt . Cnv.removeSingletons . Cnv.removeSingletons . Cnv.simple2finite . Cnv.gfc2simple . stateGrammarLang)
|
||||
,(strCI "mcfg-old", PrtOld.prt . CnvOld.mcfg . statePInfoOld)
|
||||
,(strCI "cfg-old", PrtOld.prt . CnvOld.cfg . statePInfoOld)
|
||||
]
|
||||
|
||||
customMultiGrammarPrinter =
|
||||
@@ -367,9 +354,6 @@ customParser =
|
||||
,(strCI "myparser", myParser)
|
||||
-- add your own parsers here
|
||||
]
|
||||
-- 31/5-04, peb: (DEPRECATED)
|
||||
-- ++ [ (strCI ("chart"++name), PCFOld.parse descr . stateCF) |
|
||||
-- (descr, names) <- PCFOld.alternatives, name <- names ]
|
||||
|
||||
customTokenizer =
|
||||
customData "Tokenizers, selected by option -lexer=x" $
|
||||
|
||||
@@ -35,7 +35,7 @@ GF/
|
||||
CFtoSRG
|
||||
CanonToCF
|
||||
ChartParser - obsolet.
|
||||
EBNF - ta bort parserkombinatorerna -- skapa en bncf-fil
|
||||
EBNF - ta bort parserkombinatorerna -- skapa en bnfc-fil
|
||||
PPrCF
|
||||
PrLBNF
|
||||
Profile
|
||||
@@ -95,6 +95,8 @@ GF/
|
||||
Zipper
|
||||
CheckM
|
||||
ErrM
|
||||
GenneralInduction
|
||||
IncrementalInduction
|
||||
|
||||
Fudgets/
|
||||
EventF
|
||||
@@ -159,6 +161,8 @@ GF/
|
||||
Str
|
||||
UseIO
|
||||
|
||||
Formalism/
|
||||
Conversion/
|
||||
Parsing/ dela upp i Grammar och Parsing?
|
||||
(då måste nuvarande Grammar byta namn)
|
||||
CFGrammar -> Grammar
|
||||
|
||||
Reference in New Issue
Block a user