"Committed_by_peb"

src/GF/Conversion/GFC.hs

@@ -4,9 +4,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:21:49 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.7 $
+-- > CVS $Date: 2005/05/09 09:28:43 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.8 $
 --
 -- All conversions from GFC 
 -----------------------------------------------------------------------------
@@ -17,8 +17,13 @@ module GF.Conversion.GFC
 
 import GF.Infra.Option
 import GF.Canon.GFC (CanonGrammar)
-import GF.Infra.Ident (Ident)
-import GF.Conversion.Types (CGrammar, MGrammar, EGrammar, SGrammar)
+import GF.Infra.Ident (Ident, identC)
+
+import GF.Formalism.GCFG (Rule(..), Abstract(..))
+import GF.Formalism.SimpleGFC (decl2cat)
+import GF.Formalism.CFG (CFRule(..))
+import GF.Formalism.Utilities (symbol)
+import GF.Conversion.Types
 
 import qualified GF.Conversion.GFCtoSimple as G2S
 import qualified GF.Conversion.SimpleToFinite as S2Fin
@@ -27,13 +32,17 @@ import qualified GF.Conversion.RemoveErasing as RemEra
 import qualified GF.Conversion.SimpleToMCFG as S2M
 import qualified GF.Conversion.MCFGtoCFG as M2C
 
+import GF.Infra.Print
+
 ----------------------------------------------------------------------
 -- * GFC -> MCFG & CFG, using options to decide which conversion is used
 
 gfc2mcfg2cfg :: Options -> (CanonGrammar, Ident) -> (MGrammar, CGrammar)
 gfc2mcfg2cfg opts = \g -> let e = g2e g in (e2m e, e2c e)
     where e2c = mcfg2cfg
-	  e2m = removeErasing
+	  e2m = case getOptVal opts firstCat of
+		  Just cat -> flip removeErasing [identC cat]
+		  Nothing  -> flip removeErasing []
 	  g2e = case getOptVal opts gfcConversion of
 		  Just "strict" -> simple2mcfg_strict . gfc2simple
 		  Just "finite" -> simple2mcfg_nondet . gfc2finite
@@ -70,8 +79,44 @@ simple2mcfg_strict = S2M.convertGrammarStrict
 mcfg2cfg :: EGrammar -> CGrammar
 mcfg2cfg = M2C.convertGrammar
 
-removeErasing :: EGrammar -> MGrammar
-removeErasing = RemEra.convertGrammar
+removeErasing :: EGrammar -> [SCat] -> MGrammar
+removeErasing = RemEra.convertGrammar 
+
+----------------------------------------------------------------------
+-- * converting to some obscure formats
+
+gfc2abstract :: (CanonGrammar, Ident) -> [Abstract SCat Fun]
+gfc2abstract gr = [ Abs (decl2cat decl) (map decl2cat decls) (name2fun name) |
+		    Rule (Abs decl decls name) _ <- gfc2simple gr ]
+
+abstract2prolog :: [Abstract SCat Fun] -> String
+abstract2prolog gr = skvatt_hdr ++ concatMap abs2pl gr
+    where abs2pl (Abs cat [] fun) = prtQuoted cat ++ " ---> " ++ 
+				    "\"" ++ prt fun ++ "\".\n"
+	  abs2pl (Abs cat cats fun) =
+	      prtQuoted cat ++ " ---> " ++
+	      "\"(" ++ prt fun ++ "\"" ++
+	      prtBefore ", \" \", " (map prtQuoted cats) ++ ", \")\".\n"
+
+cfg2prolog :: CGrammar -> String
+cfg2prolog gr = skvatt_hdr ++ concatMap cfg2pl gr
+    where cfg2pl (CFRule cat syms _name) =
+	      prtQuoted cat ++ " ---> " ++
+	      if null syms then "\"\".\n" else
+	      prtSep ", " (map (symbol prtQuoted prTok) syms) ++ ".\n"
+	  prTok tok = "\"" ++ tok ++ " \""
+
+skvatt_hdr = ":- use_module(library(skvatt)).\n" ++ 
+	     ":- use_module(library(utils), [repeat/1]).\n" ++
+	     "corpus(File, StartCat, Depth, Size) :- \n" ++
+	     "        set_flag(gendepth, Depth),\n" ++ 
+	     "        tell(File), repeat(Size),\n" ++
+	     "        generate_words(StartCat, String), format('~s~n~n', [String]),\n" ++
+	     "        write(user_error, '.'),\n" ++ 
+	     "        fail ; told.\n\n"
+
+prtQuoted :: Print a => a -> String
+prtQuoted a = "'" ++ prt a ++ "'"