added the file GF.Conversion.MCFGtoFCFG

1 files changed, 51 insertions, 0 deletions

diff --git a/src/GF/Conversion/MCFGtoFCFG.hs b/src/GF/Conversion/MCFGtoFCFG.hs
new file mode 100644
index 000000000..70aa4644d
--- /dev/null
+++ b/src/GF/Conversion/MCFGtoFCFG.hs
@@ -0,0 +1,51 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/09 09:28:43 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.6 $
+--
+-- Converting MCFG grammars to equivalent optimized FCFG
+-----------------------------------------------------------------------------
+
+
+module GF.Conversion.MCFGtoFCFG
+    (convertGrammar) where
+
+import Control.Monad
+import List (elemIndex)
+import Array
+
+import GF.Formalism.Utilities
+import GF.Formalism.GCFG
+import GF.Formalism.MCFG
+import GF.Formalism.FCFG
+import GF.Conversion.Types
+import GF.Data.SortedList (nubsort)
+
+import GF.Infra.Print
+
+----------------------------------------------------------------------
+-- * converting MCFG to optimized FCFG
+
+convertGrammar :: MGrammar -> FGrammar
+convertGrammar gram = [ FRule (Abs (fcat cat) (map fcat cats) name) (fcnc cnc) |
+                        Rule (Abs cat cats name) cnc <- gram ]
+    where mcats = nubsort [ mc | Rule (Abs mcat mcats _) _ <- gram, mc <- mcat:mcats ]
+
+          fcat mcat@(MCat (ECat scat ecns) mlbls) 
+              = case elemIndex mcat mcats of
+                  Just catid -> FCat catid scat mlbls ecns
+                  Nothing -> error ("MCFGtoFCFG.fcat " ++ prt mcat)
+
+          fcnc (Cnc  _ arglbls lins) = listArray (0, length lins-1) (map flin lins)
+              where flin (Lin _ syms) = listArray (0, length syms-1) (map fsym syms)
+                    fsym (Tok tok) = FSymTok tok
+                    fsym (Cat (cat,lbl,arg)) = FSymCat (fcat cat) (flbl arg lbl) arg
+                    flbl arg lbl = case elemIndex lbl (arglbls !! arg) of
+                                     Just lblid -> lblid
+                                     Nothing -> error ("MCFGtoFCFG.flbl " ++ prt arg ++ " " ++ prt lbl)
+