summaryrefslogtreecommitdiff
path: root/src/runtime/haskell
diff options
context:
space:
mode:
Diffstat (limited to 'src/runtime/haskell')
-rw-r--r--src/runtime/haskell/PGF.hs9
-rw-r--r--src/runtime/haskell/PGF/Binary.hs7
-rw-r--r--src/runtime/haskell/PGF/Data.hs1
-rw-r--r--src/runtime/haskell/PGF/Printer.hs6
4 files changed, 18 insertions, 5 deletions
diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs
index 1d0d13f97..fdb834cad 100644
--- a/src/runtime/haskell/PGF.hs
+++ b/src/runtime/haskell/PGF.hs
@@ -32,7 +32,7 @@ module PGF(
showType, readType,
mkType, mkHypo, mkDepHypo, mkImplHypo,
unType,
- categories, startCat,
+ categories, categoryContext, startCat,
-- * Functions
functions, functionsByCat, functionType, missingLins,
@@ -221,6 +221,8 @@ abstractName :: PGF -> Language
-- with the \'cat\' keyword.
categories :: PGF -> [CId]
+categoryContext :: PGF -> CId -> Maybe [Hypo]
+
-- | The start category is defined in the grammar with
-- the \'startcat\' flag. This is usually the sentence category
-- but it is not necessary. Despite that there is a start category
@@ -279,6 +281,11 @@ languageCode pgf lang =
categories pgf = [c | (c,hs) <- Map.toList (cats (abstract pgf))]
+categoryContext pgf cat =
+ case Map.lookup cat (cats (abstract pgf)) of
+ Just (hypos,_,_) -> Just hypos
+ Nothing -> Nothing
+
startCat pgf = DTyp [] (lookStartCat pgf) []
functions pgf = Map.keys (funs (abstract pgf))
diff --git a/src/runtime/haskell/PGF/Binary.hs b/src/runtime/haskell/PGF/Binary.hs
index e293da99c..bf8fe2824 100644
--- a/src/runtime/haskell/PGF/Binary.hs
+++ b/src/runtime/haskell/PGF/Binary.hs
@@ -14,7 +14,7 @@ import qualified Data.Set as Set
import Control.Monad
pgfMajorVersion, pgfMinorVersion :: Word16
-(pgfMajorVersion, pgfMinorVersion) = (1,0)
+(pgfMajorVersion, pgfMinorVersion) = (2,0)
instance Binary PGF where
put pgf = do putWord16be pgfMajorVersion
@@ -56,6 +56,7 @@ instance Binary Concr where
putArray2 (sequences cnc)
putArray (cncfuns cnc)
put (lindefs cnc)
+ put (linrefs cnc)
put (productions cnc)
put (cnccats cnc)
put (totalCats cnc)
@@ -64,11 +65,13 @@ instance Binary Concr where
sequences <- getArray2
cncfuns <- getArray
lindefs <- get
+ linrefs <- get
productions <- get
cnccats <- get
totalCats <- get
return (Concr{ cflags=cflags, printnames=printnames
- , sequences=sequences, cncfuns=cncfuns, lindefs=lindefs
+ , sequences=sequences, cncfuns=cncfuns
+ , lindefs=lindefs, linrefs=linrefs
, productions=productions
, pproductions = IntMap.empty
, lproductions = Map.empty
diff --git a/src/runtime/haskell/PGF/Data.hs b/src/runtime/haskell/PGF/Data.hs
index 06ace4565..19df9d0ed 100644
--- a/src/runtime/haskell/PGF/Data.hs
+++ b/src/runtime/haskell/PGF/Data.hs
@@ -41,6 +41,7 @@ data Concr = Concr {
printnames :: Map.Map CId String, -- printname of a cat or a fun
cncfuns :: Array FunId CncFun,
lindefs :: IntMap.IntMap [FunId],
+ linrefs :: IntMap.IntMap [FunId],
sequences :: Array SeqId Sequence,
productions :: IntMap.IntMap (Set.Set Production), -- the original productions loaded from the PGF file
pproductions :: IntMap.IntMap (Set.Set Production), -- productions needed for parsing
diff --git a/src/runtime/haskell/PGF/Printer.hs b/src/runtime/haskell/PGF/Printer.hs
index 9385e81c4..5d85255d0 100644
--- a/src/runtime/haskell/PGF/Printer.hs
+++ b/src/runtime/haskell/PGF/Printer.hs
@@ -47,7 +47,9 @@ ppCnc name cnc =
text "productions" $$
nest 2 (vcat [ppProduction (fcat,prod) | (fcat,set) <- IntMap.toList (productions cnc), prod <- Set.toList set]) $$
text "lindefs" $$
- nest 2 (vcat (map ppLinDef (IntMap.toList (lindefs cnc)))) $$
+ nest 2 (vcat (map ppFunList (IntMap.toList (lindefs cnc)))) $$
+ text "linrefs" $$
+ nest 2 (vcat (map ppFunList (IntMap.toList (linrefs cnc)))) $$
text "lin" $$
nest 2 (vcat (map ppCncFun (assocs (cncfuns cnc)))) $$
text "sequences" $$
@@ -73,7 +75,7 @@ ppProduction (fid,PConst _ _ ss) =
ppCncFun (funid,CncFun fun arr) =
ppFunId funid <+> text ":=" <+> parens (hcat (punctuate comma (map ppSeqId (elems arr)))) <+> brackets (ppCId fun)
-ppLinDef (fid,funids) =
+ppFunList (fid,funids) =
ppFId fid <+> text "->" <+> hcat (punctuate comma (map ppFunId funids))
ppSeq (seqid,seq) =