add the FCFG parser

1 files changed, 55 insertions, 0 deletions

diff --git a/src/GF/Formalism/FCFG.hs b/src/GF/Formalism/FCFG.hs
new file mode 100644
index 000000000..9ef1f4000
--- /dev/null
+++ b/src/GF/Formalism/FCFG.hs
@@ -0,0 +1,55 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : PL
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- > CVS $Date: 2005/05/09 09:28:45 $ 
+-- > CVS $Author: peb $
+-- > CVS $Revision: 1.2 $
+--
+-- Definitions of multiple context-free grammars
+-----------------------------------------------------------------------------
+
+module GF.Formalism.FCFG where
+
+import Control.Monad (liftM)
+import Data.List (groupBy)
+import Data.Array
+
+import GF.Formalism.Utilities
+import GF.Formalism.GCFG
+
+import GF.Infra.Print
+
+
+------------------------------------------------------------
+-- grammar types
+
+type FLabel    = Int
+type FPointPos = Int
+
+data FSymbol cat tok 
+  = FSymCat cat {-# UNPACK #-} !FLabel {-# UNPACK #-} !Int 
+  | FSymTok tok
+
+type FCFGrammar cat name tok = [FCFRule cat name tok]
+data FCFRule    cat name tok = FRule (Abstract cat name) (Array FLabel (Array FPointPos (FSymbol cat tok)))
+
+------------------------------------------------------------
+-- pretty-printing
+
+instance (Print c, Print t) => Print (FSymbol c t) where
+    prt (FSymCat c l n) = prt c ++ "[" ++ prt n ++ "," ++ prt l ++ "]"
+    prt (FSymTok t)     = simpleShow (prt t)
+      where simpleShow str = "\"" ++ concatMap mkEsc str ++ "\""
+            mkEsc '\\' = "\\\\"
+            mkEsc '\"' = "\\\""
+            mkEsc '\n' = "\\n"
+            mkEsc '\t' = "\\t"
+            mkEsc chr  = [chr]
+    prtList = prtSep " "
+
+instance (Print c, Print n, Print t) => Print (FCFRule n c t) where
+    prt (FRule abs lins) = prt abs ++ " := \n" ++ prtSep "\n" ["  | "++prtSep " " [prt sym | (_,sym) <- assocs syms] | (_,syms) <- assocs lins]
+    prtList = prtSep "\n"