PGF is now real synchronous PMCFG

1 files changed, 46 insertions, 11 deletions

diff --git a/src/runtime/haskell/PGF/Data.hs b/src/runtime/haskell/PGF/Data.hs
index dcdf38dcb..7b3f3435f 100644
--- a/src/runtime/haskell/PGF/Data.hs
+++ b/src/runtime/haskell/PGF/Data.hs
@@ -1,15 +1,17 @@
-module PGF.Data (module PGF.Data, module PGF.Expr, module PGF.Type, module PGF.PMCFG) where
+module PGF.Data (module PGF.Data, module PGF.Expr, module PGF.Type) where
 
 import PGF.CId
 import PGF.Expr hiding (Value, Env, Tree)
 import PGF.Type
-import PGF.PMCFG
 
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.IntMap as IntMap
+import Data.Array.IArray
+import Data.Array.Unboxed
 import Data.List
 
+
 -- internal datatypes for PGF
 
 -- | An abstract data type representing multilingual grammar
@@ -30,16 +32,40 @@ data Abstr = Abstr {
   }
 
 data Concr = Concr {
-  cflags  :: Map.Map CId String,    -- value of a flag
-  lins    :: Map.Map CId Term,      -- lin of a fun
-  opers   :: Map.Map CId Term,      -- oper generated by subex elim
-  lincats :: Map.Map CId Term,      -- lin type of a cat
-  lindefs :: Map.Map CId Term,      -- lin default of a cat
-  printnames :: Map.Map CId String, -- printname of a cat or a fun
-  paramlincats :: Map.Map CId Term, -- lin type of cat, with printable param names
-  parser  :: Maybe ParserInfo       -- parser
+  cflags       :: Map.Map CId String,                                -- value of a flag
+  printnames   :: Map.Map CId String,                                -- printname of a cat or a fun
+  functions    :: Array FunId FFun,
+  sequences    :: Array SeqId FSeq,
+  productions  :: IntMap.IntMap (Set.Set Production),                -- the original productions loaded from the PGF file
+  pproductions :: IntMap.IntMap (Set.Set Production),                -- productions needed for parsing
+  lproductions :: Map.Map CId (IntMap.IntMap (Set.Set Production)),  -- productions needed for linearization
+  startCats    :: Map.Map CId (FCat,FCat,Array FIndex String),       -- for every category - start/end FCat and a list of label names
+  totalCats    :: {-# UNPACK #-} !FCat
   }
 
+type FCat      = Int
+type FIndex    = Int
+type FPointPos = Int
+data FSymbol
+  = FSymCat {-# UNPACK #-} !Int {-# UNPACK #-} !FIndex
+  | FSymLit {-# UNPACK #-} !Int {-# UNPACK #-} !FIndex
+  | FSymKS [String]
+  | FSymKP [String] [Alternative]
+  deriving (Eq,Ord,Show)
+data Production
+  = FApply  {-# UNPACK #-} !FunId [FCat]
+  | FCoerce {-# UNPACK #-} !FCat
+  | FConst  Expr [String]
+  deriving (Eq,Ord,Show)
+data FFun  = FFun CId {-# UNPACK #-} !(UArray FIndex SeqId) deriving (Eq,Ord,Show)
+type FSeq  = Array FPointPos FSymbol
+type FunId = Int
+type SeqId = Int
+
+data Alternative =
+   Alt [String] [String]
+  deriving (Eq,Ord,Show)
+
 data Term =
    R [Term]
  | P Term Term
@@ -59,7 +85,7 @@ data Tokn =
   deriving (Eq,Ord,Show)
 
 
--- merge two GFCCs; fails is differens absnames; priority to second arg
+-- merge two PGFs; fails is differens absnames; priority to second arg
 
 unionPGF :: PGF -> PGF -> PGF
 unionPGF one two = case absname one of
@@ -93,3 +119,12 @@ readLanguage = readCId
 
 showLanguage :: Language -> String
 showLanguage = showCId
+
+fcatString, fcatInt, fcatFloat, fcatVar :: Int
+fcatString = (-1)
+fcatInt    = (-2)
+fcatFloat  = (-3)
+fcatVar    = (-4)
+
+isLiteralFCat :: FCat -> Bool
+isLiteralFCat = (`elem` [fcatString, fcatInt, fcatFloat, fcatVar])