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

src-3.0/GF/Formalism/FCFG.hs

@@ -0,0 +1,106 @@
+----------------------------------------------------------------------
+-- |
+-- Maintainer  : Krasimir Angelov
+-- Stability   : (stable)
+-- Portability : (portable)
+--
+-- Definitions of fast multiple context-free grammars
+-----------------------------------------------------------------------------
+
+module GF.Formalism.FCFG
+         ( 
+         -- * Token
+           FToken
+
+         -- * Category
+         , FPath
+         , FCat
+
+         , fcatString, fcatInt, fcatFloat, fcatVar
+
+         -- * Symbol
+         , FIndex
+         , FSymbol(..)
+
+         -- * Name
+         , FName
+         , isCoercionF
+
+         -- * Grammar
+         , FPointPos
+         , FGrammar
+         , FRule(..)
+         ) where
+
+import Control.Monad (liftM)
+import Data.List (groupBy)
+import Data.Array
+import qualified Data.Map as Map
+
+import GF.Formalism.Utilities
+import qualified GF.GFCC.CId as AbsGFCC
+import GF.Infra.PrintClass
+
+
+------------------------------------------------------------
+-- Token
+type FToken    = String
+
+
+------------------------------------------------------------
+-- Category
+type FPath     = [FIndex]
+type FCat      = Int
+
+fcatString, fcatInt, fcatFloat, fcatVar :: Int
+fcatString = (-1)
+fcatInt    = (-2)
+fcatFloat  = (-3)
+fcatVar    = (-4)
+
+
+------------------------------------------------------------
+-- Symbol
+type FIndex    = Int
+data FSymbol
+  = FSymCat {-# UNPACK #-} !FCat {-# UNPACK #-} !FIndex {-# UNPACK #-} !Int 
+  | FSymTok FToken
+
+
+------------------------------------------------------------
+-- Name
+type FName     = NameProfile AbsGFCC.CId
+
+isCoercionF :: FName -> Bool
+isCoercionF (Name fun [Unify [0]]) = fun == AbsGFCC.CId "_"
+isCoercionF _ = False
+
+
+------------------------------------------------------------
+-- Grammar
+
+type FPointPos = Int
+type FGrammar  = ([FRule], Map.Map AbsGFCC.CId [FCat])
+data FRule     = FRule FName [FCat] FCat (Array FIndex (Array FPointPos FSymbol))
+
+------------------------------------------------------------
+-- pretty-printing
+
+instance Print AbsGFCC.CId where
+  prt (AbsGFCC.CId s) = s
+
+instance Print FSymbol where
+    prt (FSymCat c l n) = "($" ++ 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 FRule where
+    prt (FRule name args res lins) = prt name ++ " : " ++ (if null args then "" else prtSep " " args ++ " -> ") ++ prt res ++
+                                     " =\n   [" ++ prtSep "\n    " ["("++prtSep " " [prt sym | (_,sym) <- assocs syms]++")" | (_,syms) <- assocs lins]++"]"
+    prtList = prtSep "\n"