summaryrefslogtreecommitdiff
path: root/src/GF/Conversion
diff options
context:
space:
mode:
authorpeb <unknown>2005-04-18 13:55:32 +0000
committerpeb <unknown>2005-04-18 13:55:32 +0000
commitc1592825c71867711a63293b588fcbc97e52bfc4 (patch)
tree5b042471de94431e15f8fda2c6ff9a85bce99cef /src/GF/Conversion
parent1323b7406376c72f40b1e561e079f8824f79aabf (diff)
"Committed_by_peb"
Diffstat (limited to 'src/GF/Conversion')
-rw-r--r--src/GF/Conversion/GFC.hs29
-rw-r--r--src/GF/Conversion/GFCtoSimple.hs8
-rw-r--r--src/GF/Conversion/MCFGtoCFG.hs35
-rw-r--r--src/GF/Conversion/RemoveEpsilon.hs36
-rw-r--r--src/GF/Conversion/RemoveErasing.hs92
-rw-r--r--src/GF/Conversion/RemoveSingletons.hs8
-rw-r--r--src/GF/Conversion/SimpleToFinite.hs8
-rw-r--r--src/GF/Conversion/SimpleToMCFG.hs6
-rw-r--r--src/GF/Conversion/SimpleToMCFG/Coercions.hs23
-rw-r--r--src/GF/Conversion/SimpleToMCFG/Nondet.hs22
-rw-r--r--src/GF/Conversion/SimpleToMCFG/Strict.hs25
-rw-r--r--src/GF/Conversion/Types.hs51
12 files changed, 223 insertions, 120 deletions
diff --git a/src/GF/Conversion/GFC.hs b/src/GF/Conversion/GFC.hs
index 3f52ec88d..f2261ea3c 100644
--- a/src/GF/Conversion/GFC.hs
+++ b/src/GF/Conversion/GFC.hs
@@ -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
diff --git a/src/GF/Conversion/GFCtoSimple.hs b/src/GF/Conversion/GFCtoSimple.hs
index a93652866..82cc143db 100644
--- a/src/GF/Conversion/GFCtoSimple.hs
+++ b/src/GF/Conversion/GFCtoSimple.hs
@@ -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 ]
diff --git a/src/GF/Conversion/MCFGtoCFG.hs b/src/GF/Conversion/MCFGtoCFG.hs
index 236a90aca..add87c9d3 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/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
-
-----------------------------------------------------------------------
-
diff --git a/src/GF/Conversion/RemoveEpsilon.hs b/src/GF/Conversion/RemoveEpsilon.hs
new file mode 100644
index 000000000..f6e30e16d
--- /dev/null
+++ b/src/GF/Conversion/RemoveEpsilon.hs
@@ -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
+
+
+
diff --git a/src/GF/Conversion/RemoveErasing.hs b/src/GF/Conversion/RemoveErasing.hs
new file mode 100644
index 000000000..a7ff2c6df
--- /dev/null
+++ b/src/GF/Conversion/RemoveErasing.hs
@@ -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 ]
+
+
+
+
+
+
+
diff --git a/src/GF/Conversion/RemoveSingletons.hs b/src/GF/Conversion/RemoveSingletons.hs
index 9c5ff274e..53f39dede 100644
--- a/src/GF/Conversion/RemoveSingletons.hs
+++ b/src/GF/Conversion/RemoveSingletons.hs
@@ -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
diff --git a/src/GF/Conversion/SimpleToFinite.hs b/src/GF/Conversion/SimpleToFinite.hs
index f462ddf01..3480a2a23 100644
--- a/src/GF/Conversion/SimpleToFinite.hs
+++ b/src/GF/Conversion/SimpleToFinite.hs
@@ -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
diff --git a/src/GF/Conversion/SimpleToMCFG.hs b/src/GF/Conversion/SimpleToMCFG.hs
index 2b829a52e..8f23c905d 100644
--- a/src/GF/Conversion/SimpleToMCFG.hs
+++ b/src/GF/Conversion/SimpleToMCFG.hs
@@ -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
diff --git a/src/GF/Conversion/SimpleToMCFG/Coercions.hs b/src/GF/Conversion/SimpleToMCFG/Coercions.hs
index a57953061..98dfd3e7e 100644
--- a/src/GF/Conversion/SimpleToMCFG/Coercions.hs
+++ b/src/GF/Conversion/SimpleToMCFG/Coercions.hs
@@ -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 ]
diff --git a/src/GF/Conversion/SimpleToMCFG/Nondet.hs b/src/GF/Conversion/SimpleToMCFG/Nondet.hs
index 83e5fec96..46e89c09a 100644
--- a/src/GF/Conversion/SimpleToMCFG/Nondet.hs
+++ b/src/GF/Conversion/SimpleToMCFG/Nondet.hs
@@ -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)
diff --git a/src/GF/Conversion/SimpleToMCFG/Strict.hs b/src/GF/Conversion/SimpleToMCFG/Strict.hs
index e1fd3ecfa..9e14c9dc5 100644
--- a/src/GF/Conversion/SimpleToMCFG/Strict.hs
+++ b/src/GF/Conversion/SimpleToMCFG/Strict.hs
@@ -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) = [[]]
diff --git a/src/GF/Conversion/Types.hs b/src/GF/Conversion/Types.hs
index 26203f73c..a8dc20393 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/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