"Committed_by_peb"

src/GF/Conversion/GFC.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.5 $
+-- > CVS $Revision: 1.6 $
 --
 -- All conversions from GFC 
 -----------------------------------------------------------------------------
@@ -18,7 +18,7 @@ module GF.Conversion.GFC
 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)
+gfc2mcfg2cfg opts = \g -> let e = g2e g in (e2m e, e2c e)
-    where m2c = mcfg2cfg
+    where e2c = mcfg2cfg
-	  g2m = case getOptVal opts gfcConversion of
+	  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
 
 
 

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)) $
+convertGrammar gram = trace2 "GFCtoSimple - concrete language" (prt (snd gram)) $
-		      tracePrt "#simpleGFC rules" (show . length) $
+		      tracePrt "GFCtoSimple - nr. simpleGFC rules" (prt . length) $
 		      [ convertAbsFun gram fun typing |
 			A.Mod (A.MTAbs modname) _ _ _ defs <- modules,
 			A.AbsDFun fun typing _ <- defs ]

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 :: EGrammar -> CGrammar
-convertGrammar gram = tracePrt "#context-free rules" (prt.length) $
+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
-
-----------------------------------------------------------------------
-
 
 
 

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

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 ]
+
+
+
+
+
+
+

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

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

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
 

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 sameECatFst allHeadSet) 
-			(groupBy sameCat    allArgSet)
+			(groupBy sameECat    allArgSet)
-	  sameCatFst a b = sameCat (fst a) (fst b)
+	  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 ]
 
 

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 :: SGrammar -> EGrammar 
-convertGrammar rules = tracePrt "Nondet conversion: #MCFG rules" (prt . length) $
+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
+addToECat :: Constraint -> ECat -> CnvMonad ECat
-addToMCat cn (MCat cat cns) = liftM (MCat cat) $ addConstraint cn cns
+addToECat cn (ECat cat cns) = liftM (ECat cat) $ addConstraint cn cns
 
 addConstraint :: Constraint -> [Constraint] -> CnvMonad [Constraint]
 addConstraint cn0 (cn : cns)

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 :: SGrammar -> EGrammar 
-convertGrammar rules = tracePrt "Strict conversion: #MCFG rules" (prt . length) $
+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 :: [STerm] -> (Int, SCat, SLinType) -> CnvMonad ECat
-extractArg args (nr, cat, ctype) = extractMCat cat ctype (args !! nr)
+extractArg args (nr, cat, ctype) = extractECat cat ctype (args !! nr)
 
-extractMCat :: SCat -> SLinType -> STerm -> CnvMonad MCat
+extractECat :: SCat -> SLinType -> STerm -> CnvMonad ECat
-extractMCat cat ctype term = member $ map (MCat cat) $ parPaths ctype term
+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) = [[]]

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 EGrammar = MCFGrammar ECat Name ELabel Token
-type MRule    = MCFRule    MCat Name MLabel Token
+type ERule    = MCFRule    ECat Name ELabel Token
-data MCat     = MCat SCat [Constraint] deriving (Eq, Ord, Show)
+data ECat     = ECat SCat [Constraint]   deriving (Eq, Ord, Show)
-type MLabel   = SPath
+type ELabel   = SPath
 
 type Constraint = (SPath, STerm)
 
 -- ** type coercions etc
 
-initialMCat :: SCat -> MCat
+initialECat :: SCat -> ECat
-initialMCat cat = MCat cat []
+initialECat cat = ECat cat []
 
-mcat2scat :: MCat -> SCat
+ecat2scat :: ECat -> SCat
-mcat2scat (MCat cat _) = cat
+ecat2scat (ECat cat _) = cat
 
-sameCat :: MCat -> MCat -> Bool
+sameECat :: ECat -> ECat -> Bool
-sameCat mc1 mc2 = mcat2scat mc1 == mcat2scat mc2
+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 MGrammar = MCFGrammar MCat Name MLabel Token
-type NRule    = MCFRule    NCat Name NLabel Token
+type MRule    = MCFRule    MCat Name MLabel Token
-data NCat     = NCat MCat [MLabel] deriving (Eq, Ord, Show)
+data MCat     = MCat ECat [ELabel]   deriving (Eq, Ord, Show)
-type NLabel   = MLabel
+type MLabel   = ELabel
 
-ncat2mcat :: NCat -> MCat
+mcat2ecat :: MCat -> ECat
-ncat2mcat (NCat mcat _) = mcat
+mcat2ecat (MCat mcat _) = mcat
 
 ----------------------------------------------------------------------
 -- * CFG
 
 type CGrammar = CFGrammar CCat Name Token
 type CRule    = CFRule    CCat Name Token
-
+data CCat     = CCat      ECat ELabel  deriving (Eq, Ord, Show)
-data CCat     = CCat      MCat MLabel
-		deriving (Eq, Ord, Show)
 
 ----------------------------------------------------------------------
 -- * pretty-printing
 
-instance Print MCat where
+instance Print ECat where
-    prt (MCat cat constrs) = prt cat ++ "{" ++ 
+    prt (ECat cat constrs) = prt cat ++ "{" ++ 
 			     concat [ prt path ++ "=" ++ prt term ++ ";" |
 				      (path, term) <- constrs ] ++ "}"
 
-instance Print NCat where
+instance Print MCat where
-    prt (NCat cat labels) = prt cat ++ prt labels
+    prt (MCat cat labels) = prt cat ++ prt labels
 
 instance Print CCat where
     prt (CCat cat label) = prt cat ++ prt label

src/GF/Parsing/CF.hs

@@ -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" $
+buildParser parser cf start tokens = (parseResults, parseInformation)
-				     (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)
 	  

src/GF/Parsing/CFG/General.hs

@@ -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 "") ++ 
+    = trace2 "Parsing.CFG.General - strategy" ((if isBottomup then " BU" else "") ++ 
-				(if isTopdown  then " TD" else "")) $
+					       (if isTopdown  then " TD" else "")) $
       buildChart keyof [predict, combine] . axioms 
     where axioms input = initial ++ scan input
 

src/GF/Parsing/CFG/Incremental.hs

@@ -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 "") ++
+    = trace2 "Parsing.CFG.Incremental - strategy" ((if isPredictBU then "BU-predict " else "") ++
-				    (if isPredictTD then "TD-predict " else "") ++
+						   (if isPredictTD then "TD-predict " else "") ++
-				    (if isFilterBU  then "BU-filter " else "") ++
+						   (if isFilterBU  then "BU-filter " else "") ++
-				    (if isFilterTD  then "TD-filter " else "")) $
+						   (if isFilterTD  then "TD-filter " else "")) $
       finalChart
     where finalChart = buildChart keyof rules axioms $ inputBounds input
 

src/GF/Parsing/CFG/PInfo.hs

@@ -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 ++
+    prt pI = "[ nr. tokens=" ++ sl grammarTokens ++
-	     "; names=" ++ sla nameRules ++ 
+	     "; nr. names=" ++ sla nameRules ++ 
-	     "; tdCats=" ++ sla topdownRules ++
+	     "; nr. tdCats=" ++ sla topdownRules ++
-	     "; buCats=" ++ sla bottomupRules ++ 
+	     "; nr. buCats=" ++ sla bottomupRules ++ 
-	     "; elcCats=" ++ sla emptyLeftcornerRules ++
+	     "; nr. elcCats=" ++ sla emptyLeftcornerRules ++
-	     "; eCats=" ++ sla emptyCategories ++
+	     "; nr. eCats=" ++ sla emptyCategories ++
-	     "; cCats=" ++ sl cyclicCategories ++
+	     "; nr. cCats=" ++ sl cyclicCategories ++
-	     "; lctokCats=" ++ sla leftcornerTokens ++ 
+	     "; nr. lctokCats=" ++ sla leftcornerTokens ++ 
 	     " ]"
 	where sla f = show $ length $ aElems $ f pI
 	      sl  f = show $ length $ f pI

src/GF/Parsing/GFC.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 $
 --
 -- 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

src/GF/UseGrammar/Custom.hs

@@ -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.Printing.PrintParser as PrtOld -- OBSOLETE
---import qualified GF.Data.Assoc as Assoc
+import qualified GF.Infra.Print as Prt
---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.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 "mcfg",     Prt.prt . stateMCFG)
-  ,(strCI "cfg",      Prt2.prt . stateCFG)
+  ,(strCI "cfg",      Prt.prt . stateCFG)
 -- obsolete, or only for testing:
-  ,(strCI "simple",   Prt2.prt . Cnv.gfc2simple . stateGrammarLang)
+  ,(strCI "simple",   Prt.prt . Cnv.gfc2simple . stateGrammarLang)
-  ,(strCI "finite",   Prt2.prt . Cnv.simple2finite . Cnv.gfc2simple . stateGrammarLang)
+  ,(strCI "finite",   Prt.prt . Cnv.simple2finite . Cnv.gfc2simple . stateGrammarLang)
-  ,(strCI "single",   Prt2.prt . Cnv.removeSingletons . Cnv.simple2finite . Cnv.gfc2simple . stateGrammarLang)
+  ,(strCI "single",   Prt.prt . Cnv.removeSingletons . Cnv.simple2finite . Cnv.gfc2simple . stateGrammarLang)
-  ,(strCI "sg-sg",    Prt2.prt . Cnv.removeSingletons . Cnv.removeSingletons . Cnv.simple2finite . Cnv.gfc2simple . stateGrammarLang)
+  ,(strCI "sg-sg",    Prt.prt . Cnv.removeSingletons . Cnv.removeSingletons . Cnv.simple2finite . Cnv.gfc2simple . stateGrammarLang)
-  ,(strCI "mcfg-ne", Prt2.prt . Cnv.removeErasing . stateMCFG)
+  ,(strCI "mcfg-old", PrtOld.prt . CnvOld.mcfg . statePInfoOld)
-  ,(strCI "cfg-ne", Prt2.prt . Cnv.ne_mcfg2cfg . Cnv.removeErasing . stateMCFG)
+  ,(strCI "cfg-old",  PrtOld.prt . CnvOld.cfg . statePInfoOld)
-  ,(strCI "mcfg-old", Prt.prt . CnvOld.mcfg . statePInfoOld)
-  ,(strCI "cfg-old",  Prt.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" $

src/module-structure.txt

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