GF/src is now for 2.9, and the new sources are in src-3.0 - keep it this way until the release of GF 3

1 files changed, 157 insertions, 0 deletions

diff --git a/src-3.0/GF/Conversion/GFC.hs b/src-3.0/GF/Conversion/GFC.hs
new file mode 100644
index 000000000..354bdea65
--- /dev/null
+++ b/src-3.0/GF/Conversion/GFC.hs
@@ -0,0 +1,157 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/09/01 09:53:18 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.14 $
+--
+-- All conversions from GFC 
+-----------------------------------------------------------------------------
+
+module GF.Conversion.GFC
+    (module GF.Conversion.GFC,
+     SGrammar, EGrammar, MGrammar, CGrammar) where
+
+import GF.Infra.Option
+import GF.Canon.GFC (CanonGrammar)
+import GF.Infra.Ident (Ident, identC)
+import qualified GF.Infra.Modules as M
+
+import GF.Formalism.GCFG (Rule(..), Abstract(..))
+import GF.Formalism.SimpleGFC (decl2cat)
+import GF.Formalism.CFG (CFRule(..))
+import GF.Formalism.Utilities (symbol, name2fun)
+import GF.Conversion.Types
+
+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.RemoveEpsilon as RemEps
+import qualified GF.Conversion.SimpleToMCFG as S2M
+import qualified GF.Conversion.MCFGtoCFG as M2C
+
+import GF.Infra.Print
+
+import GF.System.Tracing
+
+----------------------------------------------------------------------
+-- * GFC -> MCFG & CFG, using options to decide which conversion is used
+
+convertGFC :: Options -> (CanonGrammar, Ident)
+           -> (SGrammar, (EGrammar, (MGrammar, CGrammar)))
+convertGFC opts = \g -> let s = g2s g
+                            e = s2e s 
+                            m = e2m e
+                        in trace2 "Options" (show opts) (s, (e, (m, e2c e)))
+    where e2c = M2C.convertGrammar
+	  e2m = case getOptVal opts firstCat of
+		  Just cat -> flip erasing [identC cat]
+		  Nothing  -> flip erasing []
+	  s2e = case getOptVal opts gfcConversion of
+		  Just "strict"            -> strict
+		  Just "finite-strict"     -> strict
+		  Just "epsilon"           -> epsilon . nondet
+		  _                        -> nondet
+	  g2s = case getOptVal opts gfcConversion of
+		  Just "finite"            -> finite . simple
+		  Just "finite2"           -> finite . finite . simple
+		  Just "finite3"           -> finite . finite . finite . simple
+		  Just "singletons"        -> single . simple
+		  Just "finite-singletons" -> single . finite . simple
+		  Just "finite-strict"     -> finite . simple
+		  _                        -> simple
+
+          simple  = G2S.convertGrammar
+          strict  = S2M.convertGrammarStrict
+          nondet  = S2M.convertGrammarNondet
+          epsilon = RemEps.convertGrammar
+          finite  = S2Fin.convertGrammar
+          single  = RemSing.convertGrammar
+          erasing = RemEra.convertGrammar
+
+gfc2simple :: Options -> (CanonGrammar, Ident) -> SGrammar
+gfc2simple opts = fst . convertGFC opts 
+
+gfc2mcfg :: Options -> (CanonGrammar, Ident) -> MGrammar
+gfc2mcfg opts g = mcfg
+  where
+    (mcfg, _) = snd (snd (convertGFC opts g))
+
+gfc2cfg :: Options -> (CanonGrammar, Ident) -> CGrammar
+gfc2cfg opts g = cfg
+  where
+    (_, cfg) = snd (snd (convertGFC opts g))
+
+
+----------------------------------------------------------------------
+-- * single step conversions
+
+{-
+gfc2simple :: (CanonGrammar, Ident) -> SGrammar
+gfc2simple = G2S.convertGrammar
+
+simple2finite :: SGrammar -> SGrammar
+simple2finite = S2Fin.convertGrammar
+
+removeSingletons :: SGrammar -> SGrammar
+removeSingletons = RemSing.convertGrammar
+
+simple2mcfg_nondet :: SGrammar -> EGrammar
+simple2mcfg_nondet = 
+
+simple2mcfg_strict :: SGrammar -> EGrammar
+simple2mcfg_strict = S2M.convertGrammarStrict
+
+mcfg2cfg :: EGrammar -> CGrammar
+mcfg2cfg = M2C.convertGrammar
+
+removeErasing :: EGrammar -> [SCat] -> MGrammar
+removeErasing = RemEra.convertGrammar 
+
+removeEpsilon :: EGrammar -> EGrammar
+removeEpsilon = RemEps.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) _ <- G2S.convertGrammar gr ]
+
+abstract2skvatt :: [Abstract SCat Fun] -> String
+abstract2skvatt 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"
+
+cfg2skvatt :: CGrammar -> String
+cfg2skvatt 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 ++ "'"
+
+
+
+