"Committed_by_peb"

src/GF/Conversion/GFC.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/14 18:38:36 $ 
+-- > CVS $Date: 2005/04/16 05:40:49 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.4 $
+-- > CVS $Revision: 1.5 $
 --
 -- All conversions from GFC 
 -----------------------------------------------------------------------------
@@ -15,16 +15,36 @@ module GF.Conversion.GFC
     (module GF.Conversion.GFC,
      SGrammar, MGrammar, CGrammar) where
 
+import Option
 import GFC (CanonGrammar)
 import Ident (Ident)
-import GF.Conversion.Types (CGrammar, MGrammar, SGrammar)
+import GF.Conversion.Types (CGrammar, MGrammar, NGrammar, SGrammar)
 
 import qualified GF.Conversion.GFCtoSimple as G2S
 import qualified GF.Conversion.SimpleToFinite as S2Fin
 import qualified GF.Conversion.RemoveSingletons as RemSing
+import qualified GF.Conversion.RemoveErasing as RemEra
 import qualified GF.Conversion.SimpleToMCFG as S2M
 import qualified GF.Conversion.MCFGtoCFG as M2C
 
+----------------------------------------------------------------------
+-- * GFC -> MCFG & CFG, using options to decide which conversion is used
+
+gfc2mcfg2cfg :: Options -> (CanonGrammar, Ident) -> (MGrammar, CGrammar)
+gfc2mcfg2cfg opts = \g -> let m = g2m g in (m, m2c m)
+    where m2c = mcfg2cfg
+	  g2m = case getOptVal opts gfcConversion of
+		  Just "strict" -> simple2mcfg_strict . gfc2simple
+		  Just "finite" -> simple2mcfg_nondet . gfc2finite
+		  Just "finite-strict" -> simple2mcfg_strict . gfc2finite
+		  _ -> simple2mcfg_nondet . gfc2simple
+
+gfc2mcfg :: Options -> (CanonGrammar, Ident) -> MGrammar
+gfc2mcfg opts = fst . gfc2mcfg2cfg opts
+
+gfc2cfg :: Options -> (CanonGrammar, Ident) -> CGrammar
+gfc2cfg opts = snd . gfc2mcfg2cfg opts
+
 ----------------------------------------------------------------------
 -- * single step conversions
 
@@ -37,6 +57,9 @@ simple2finite = S2Fin.convertGrammar
 removeSingletons :: SGrammar -> SGrammar
 removeSingletons = RemSing.convertGrammar
 
+gfc2finite :: (CanonGrammar, Ident) -> SGrammar
+gfc2finite = removeSingletons . simple2finite . gfc2simple
+
 simple2mcfg_nondet :: SGrammar -> MGrammar
 simple2mcfg_nondet = S2M.convertGrammarNondet
 
@@ -46,21 +69,15 @@ simple2mcfg_strict = S2M.convertGrammarStrict
 mcfg2cfg :: MGrammar -> CGrammar
 mcfg2cfg = M2C.convertGrammar
 
-----------------------------------------------------------------------
--- * GFC -> MCFG
+removeErasing :: MGrammar -> NGrammar
+removeErasing = RemEra.convertGrammar
 
--- | default conversion: 
+-- | this function is unnecessary, because of the following equivalence:
 --
---  - instantiating finite dependencies ('removeSingletons . simple2finite')
---  - nondeterministic MCFG conversion ('simple2mcfg_nondet')
-gfc2mcfg :: (CanonGrammar, Ident) -> MGrammar
-gfc2mcfg = simple2mcfg_nondet . removeSingletons . simple2finite . gfc2simple
-
-----------------------------------------------------------------------
--- * GFC -> CFG
-
--- | default conversion = default mcfg conversion + trivial cfg conversion
-gfc2cfg :: (CanonGrammar, Ident) -> CGrammar
-gfc2cfg = mcfg2cfg . gfc2mcfg
+-- >    mcfg2cfg == ne_mcfg2cfg . removeErasing
+--
+ne_mcfg2cfg :: NGrammar -> CGrammar
+ne_mcfg2cfg = M2C.convertNEGrammar
+
 
 

src/GF/Conversion/MCFGtoCFG.hs

@@ -4,16 +4,16 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/12 10:49:44 $ 
+-- > CVS $Date: 2005/04/16 05:40:49 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.2 $
+-- > CVS $Revision: 1.3 $
 --
 -- Converting MCFG grammars to (possibly overgenerating) CFG
 -----------------------------------------------------------------------------
 
 
 module GF.Conversion.MCFGtoCFG
-    (convertGrammar) where
+    (convertGrammar, convertNEGrammar) where
 
 import GF.System.Tracing
 import GF.Infra.Print
@@ -25,9 +25,12 @@ import GF.Formalism.MCFG
 import GF.Formalism.CFG
 import GF.Conversion.Types
 
+----------------------------------------------------------------------
+-- * converting (possibly erasing) MCFG grammars
+
 convertGrammar :: MGrammar -> CGrammar
 convertGrammar gram = tracePrt "#context-free rules" (prt.length) $
-		      concatMap convertRule gram
+		       concatMap convertRule gram
 
 convertRule :: MRule -> [CRule]
 convertRule (Rule (Abs cat args (Name fun mprofile)) (Cnc _ _ record)) 
@@ -45,6 +48,27 @@ argPlaces :: [Symbol (cat, lbl, Int) tok] -> Int -> [Int]
 argPlaces lin nr  = [ place | (nr', place) <- zip linArgs [0..], nr == nr' ]
     where linArgs = [ nr' | (_, _, nr') <- filterCats lin ]
 
+----------------------------------------------------------------------
+-- * converting nonerasing MCFG grammars
+
+convertNEGrammar :: NGrammar -> CGrammar
+convertNEGrammar gram = tracePrt "#context-free rules" (prt.length) $
+			concatMap convertNERule gram
+
+convertNERule :: NRule -> [CRule]
+convertNERule (Rule (Abs ncat args (Name fun mprofile)) (Cnc _ _ record)) 
+    = [ CFRule (CCat (ncat2mcat ncat) lbl) rhs (Name fun profile) |
+	Lin lbl lin <- record,
+	let rhs = map (mapSymbol convertNEArg id) lin,
+	let cprofile = map (Unify . argPlaces lin) [0 .. length args-1],
+	let profile = mprofile `composeProfiles` cprofile
+      ]
+
+convertNEArg :: (NCat, NLabel, Int) -> CCat
+convertNEArg (ncat, lbl, _) = CCat (ncat2mcat ncat) lbl
+
+----------------------------------------------------------------------
+
 
 
 

src/GF/Conversion/Types.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/14 11:42:05 $ 
+-- > CVS $Date: 2005/04/16 05:40:49 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.3 $
+-- > CVS $Revision: 1.4 $
 --
 -- All possible instantiations of different grammar formats used in conversion from GFC
 -----------------------------------------------------------------------------
@@ -44,6 +44,8 @@ data Name = Name Fun [Profile (SyntaxForest Fun)]
 name2fun :: Name -> Fun
 name2fun (Name fun _) = fun
 
+-- * profiles
+
 -- | A profile is a simple representation of a function on a number of arguments.
 -- We only use lists of profiles
 data Profile a = Unify [Int] -- ^ The Int's are the argument positions.
@@ -116,7 +118,7 @@ type SLinType = LinType SCat Token
 type SDecl    = Decl    SCat
 
 ----------------------------------------------------------------------
--- * MCFG
+-- * erasing MCFG
 
 type MGrammar = MCFGrammar MCat Name MLabel Token
 type MRule    = MCFRule    MCat Name MLabel Token
@@ -143,6 +145,17 @@ isCoercion :: Name -> Bool
 isCoercion (Name fun [Unify [0]]) = Ident.isWildIdent fun
 isCoercion _ = False
 
+----------------------------------------------------------------------
+-- * nonerasing MCFG
+
+type NGrammar = MCFGrammar NCat Name NLabel Token
+type NRule    = MCFRule    NCat Name NLabel Token
+data NCat     = NCat MCat [MLabel] deriving (Eq, Ord, Show)
+type NLabel   = MLabel
+
+ncat2mcat :: NCat -> MCat
+ncat2mcat (NCat mcat _) = mcat
+
 ----------------------------------------------------------------------
 -- * CFG
 
@@ -160,6 +173,9 @@ instance Print MCat where
 			     concat [ prt path ++ "=" ++ prt term ++ ";" |
 				      (path, term) <- constrs ] ++ "}"
 
+instance Print NCat where
+    prt (NCat cat labels) = prt cat ++ prt labels
+
 instance Print CCat where
     prt (CCat cat label) = prt cat ++ prt label