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.ByteCode
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 PGF.TrieMap as TMap
import Data.Array.IArray
import Data.Array.Unboxed
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],[[Instr]]),Double),
cats :: Map.Map CId ([Hypo],[(Double, CId)],Double)
}
data Concr = Concr {
cflags :: Map.Map CId Literal,
printnames :: Map.Map CId String,
cncfuns :: Array FunId CncFun,
lindefs :: IntMap.IntMap [FunId],
linrefs :: 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 [Symbol] [([Symbol],[String])]
| SymBIND
| SymNE
| SymSOFT_BIND
| SymSOFT_SPACE
| SymCAPIT
| SymALL_CAPIT
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
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])