module PGF.Data (module PGF.Data, module PGF.Expr, module PGF.Type) where
import PGF.CId
import PGF.Expr hiding (Value, Sig, Env, Tree, eval, apply, applyValue, value2expr)
import PGF.Type
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified GF.Data.TrieMap as TMap
import qualified Data.ByteString as BS
import Data.Array.IArray
import Data.Array.Unboxed
import Data.List
data PGF = PGF {
gflags :: Map.Map CId Literal,
absname :: CId ,
abstract :: Abstr ,
concretes :: Map.Map CId Concr
}
data Abstr = Abstr {
aflags :: Map.Map CId Literal,
funs :: Map.Map CId (Type,Int,Maybe [Equation],Double,BCAddr),
cats :: Map.Map CId ([Hypo],[(Double, CId)],BCAddr),
code :: BS.ByteString
}
data Concr = Concr {
cflags :: Map.Map CId Literal,
printnames :: Map.Map CId String,
cncfuns :: Array FunId CncFun,
lindefs :: IntMap.IntMap [FunId],
sequences :: Array SeqId Sequence,
productions :: IntMap.IntMap (Set.Set Production),
pproductions :: IntMap.IntMap (Set.Set Production),
lproductions :: Map.Map CId (IntMap.IntMap (Set.Set Production)),
cnccats :: Map.Map CId CncCat,
lexicon :: IntMap.IntMap (IntMap.IntMap (TMap.TrieMap Token IntSet.IntSet)),
totalCats :: !FId
}
type Token = String
type FId = Int
type LIndex = Int
type DotPos = Int
data Symbol
= SymCat !Int !LIndex
| SymLit !Int !LIndex
| SymVar !Int !Int
| SymKS [Token]
| SymKP [Token] [Alternative]
deriving (Eq,Ord,Show)
data Production
= PApply !FunId [PArg]
| PCoerce !FId
| PConst CId Expr [Token]
deriving (Eq,Ord,Show)
data PArg = PArg [(FId,FId)] !FId deriving (Eq,Ord,Show)
data CncCat = CncCat !FId !FId !(Array LIndex String)
data CncFun = CncFun CId !(UArray LIndex SeqId) deriving (Eq,Ord,Show)
type Sequence = Array DotPos Symbol
type FunId = Int
type SeqId = Int
type BCAddr = Int
data Alternative =
Alt [Token] [String]
deriving (Eq,Ord,Show)
unionPGF :: PGF -> PGF -> PGF
unionPGF one two = fst $ msgUnionPGF one two
msgUnionPGF :: PGF -> PGF -> (PGF, Maybe String)
msgUnionPGF one two = case absname one of
n | n == wildCId -> (two, Nothing)
| n == absname two && haveSameFunsPGF one two -> (one {
concretes = Map.union (concretes two) (concretes one)
}, Nothing)
_ -> (two,
Just "Abstract changed, previous concretes discarded.")
emptyPGF :: PGF
emptyPGF = PGF {
gflags = Map.empty,
absname = wildCId,
abstract = error "empty grammar, no abstract",
concretes = Map.empty
}
haveSameFunsPGF :: PGF -> PGF -> Bool
haveSameFunsPGF one two =
let
fsone = [(f,t) | (f,(t,_,_,_,_)) <- Map.toList (funs (abstract one))]
fstwo = [(f,t) | (f,(t,_,_,_,_)) <- Map.toList (funs (abstract two))]
in fsone == fstwo
type Language = CId
readLanguage :: String -> Maybe Language
readLanguage = readCId
showLanguage :: Language -> String
showLanguage = showCId
fidString, fidInt, fidFloat, fidVar :: FId
fidString = (1)
fidInt = (2)
fidFloat = (3)
fidVar = (4)
isPredefFId :: FId -> Bool
isPredefFId = (`elem` [fidString, fidInt, fidFloat, fidVar])