From 26dabeab9b692ee14cbee7ae41ed7a09d6072637 Mon Sep 17 00:00:00 2001 From: Krasimir Angelov Date: Thu, 20 Dec 2018 10:52:45 +0100 Subject: [PATCH] save the original concrete category in BracketedString --- src/runtime/c/pgf/parser.c | 2 +- src/runtime/haskell/PGF/Forest.hs | 4 ++-- src/runtime/haskell/PGF/Macros.hs | 24 ++++++++++++------------ src/runtime/haskell/PGF/VisualizeTree.hs | 14 +++++++------- 4 files changed, 22 insertions(+), 22 deletions(-) diff --git a/src/runtime/c/pgf/parser.c b/src/runtime/c/pgf/parser.c index cb59b2a55..20deba9da 100644 --- a/src/runtime/c/pgf/parser.c +++ b/src/runtime/c/pgf/parser.c @@ -10,7 +10,7 @@ #include #include -//#define PGF_PARSER_DEBUG +#define PGF_PARSER_DEBUG //#define PGF_COUNTS_DEBUG //#define PGF_RESULT_DEBUG diff --git a/src/runtime/haskell/PGF/Forest.hs b/src/runtime/haskell/PGF/Forest.hs index d487f43d6..ee15e2cf9 100644 --- a/src/runtime/haskell/PGF/Forest.hs +++ b/src/runtime/haskell/PGF/Forest.hs @@ -58,8 +58,8 @@ bracketedTokn :: Maybe Int -> Forest -> BracketedTokn bracketedTokn dp f@(Forest abs cnc forest root) = case [computeSeq isTrusted seq (map (render forest) args) | (seq,args) <- root] of ([bs@(Bracket_{})]:_) -> bs - (bss:_) -> Bracket_ wildCId 0 0 wildCId [] bss - [] -> Bracket_ wildCId 0 0 wildCId [] [] + (bss:_) -> Bracket_ wildCId 0 0 0 wildCId [] bss + [] -> Bracket_ wildCId 0 0 0 wildCId [] [] where isTrusted (_,fid) = IntSet.member fid trusted diff --git a/src/runtime/haskell/PGF/Macros.hs b/src/runtime/haskell/PGF/Macros.hs index 3fc7a5804..c294a0ce1 100644 --- a/src/runtime/haskell/PGF/Macros.hs +++ b/src/runtime/haskell/PGF/Macros.hs @@ -138,7 +138,7 @@ cidVar = mkCId "__gfVar" -- mark the beginning and the end of each constituent. data BracketedString = Leaf Token -- ^ this is the leaf i.e. a single token - | Bracket CId {-# UNPACK #-} !FId {-# UNPACK #-} !LIndex CId [Expr] [BracketedString] + | Bracket CId {-# UNPACK #-} !FId {-# UNPACK #-} !FId {-# UNPACK #-} !LIndex CId [Expr] [BracketedString] -- ^ this is a bracket. The 'CId' is the category of -- the phrase. The 'FId' is an unique identifier for -- every phrase in the sentence. For context-free grammars @@ -152,7 +152,7 @@ data BracketedString -- that represents the same constituent. data BracketedTokn - = Bracket_ CId {-# UNPACK #-} !FId {-# UNPACK #-} !LIndex CId [Expr] [BracketedTokn] -- Invariant: the list is not empty + = Bracket_ CId {-# UNPACK #-} !FId {-# UNPACK #-} !FId {-# UNPACK #-} !LIndex CId [Expr] [BracketedTokn] -- Invariant: the list is not empty | LeafKS Token | LeafNE | LeafBIND @@ -170,12 +170,12 @@ showBracketedString :: BracketedString -> String showBracketedString = render . ppBracketedString ppBracketedString (Leaf t) = text t -ppBracketedString (Bracket cat fid index _ _ bss) = parens (ppCId cat <> colon <> int fid <+> hsep (map ppBracketedString bss)) +ppBracketedString (Bracket cat fid fid' index _ _ bss) = parens (ppCId cat <> colon <> int fid' <+> hsep (map ppBracketedString bss)) -- | The length of the bracketed string in number of tokens. lengthBracketedString :: BracketedString -> Int -lengthBracketedString (Leaf _) = 1 -lengthBracketedString (Bracket _ _ _ _ _ bss) = sum (map lengthBracketedString bss) +lengthBracketedString (Leaf _) = 1 +lengthBracketedString (Bracket _ _ _ _ _ _ bss) = sum (map lengthBracketedString bss) untokn :: Maybe String -> [BracketedTokn] -> (Maybe String,[BracketedString]) untokn nw bss = @@ -184,10 +184,10 @@ untokn nw bss = Just bss -> (nw,concat bss) Nothing -> (nw,[]) where - untokn nw (Bracket_ cat fid index fun es bss) = + untokn nw (Bracket_ cat fid fid' index fun es bss) = let (nw',bss') = mapAccumR untokn nw bss in case sequence bss' of - Just bss -> (nw',Just [Bracket cat fid index fun es (concat bss)]) + Just bss -> (nw',Just [Bracket cat fid fid' index fun es (concat bss)]) Nothing -> (Nothing, Nothing) untokn nw (LeafKS t) | null t = (nw,Just []) @@ -228,16 +228,16 @@ computeSeq filter seq args = concatMap compute seq getArg d r | not (null arg_lin) && - filter ct = [Bracket_ cat fid r fun es arg_lin] + filter ct = [Bracket_ cat fid fid' r fun es arg_lin] | otherwise = arg_lin where - arg_lin = lin ! r - (ct@(cat,fid),_,fun,es,(_xs,lin)) = args !! d + arg_lin = lin ! r + (ct@(cat,fid),fid',fun,es,(_xs,lin)) = args !! d getVar d r = [LeafKS (showCId (xs !! r))] where (_ct,_,_fun,_es,(xs,_lin)) = args !! d flattenBracketedString :: BracketedString -> [String] -flattenBracketedString (Leaf w) = [w] -flattenBracketedString (Bracket _ _ _ _ _ bss) = concatMap flattenBracketedString bss +flattenBracketedString (Leaf w) = [w] +flattenBracketedString (Bracket _ _ _ _ _ _ bss) = concatMap flattenBracketedString bss diff --git a/src/runtime/haskell/PGF/VisualizeTree.hs b/src/runtime/haskell/PGF/VisualizeTree.hs index ee691fc7a..bbe4887ec 100644 --- a/src/runtime/haskell/PGF/VisualizeTree.hs +++ b/src/runtime/haskell/PGF/VisualizeTree.hs @@ -182,8 +182,8 @@ graphvizDependencyTree format debug mlab mclab pgf lang t = getLeaves parent bs = case bs of - Leaf w -> [(parent,w)] - Bracket cat fid lind fun _ bss -> concatMap (getLeaves (cat,fid,fun,lind)) bss + Leaf w -> [(parent,w)] + Bracket cat fid _ lind fun _ bss -> concatMap (getLeaves (cat,fid,fun,lind)) bss mkNode ((_,p,_,_),i,w) = tag p <+> brackets (text "label = " <> doubleQuotes (int i <> char '.' <+> text w)) <+> semi @@ -301,13 +301,13 @@ graphvizBracketedString opts mbl tree bss = render graphviz_code getInternals [] = [] getInternals nodes = nub [(parent, fid, mkNode fun cat) | - (parent, Bracket cat fid _ fun _ _) <- nodes] + (parent, Bracket cat fid _ _ fun _ _) <- nodes] : getInternals [(fid, child) | - (_, Bracket _ fid _ _ _ children) <- nodes, + (_, Bracket _ fid _ _ _ _ children) <- nodes, child <- children] getLeaves cat parent (Leaf word) = [(parent, (cat, word))] -- the lowest cat before the word - getLeaves _ parent (Bracket cat fid i _ _ children) + getLeaves _ parent (Bracket cat fid _ i _ _ children) = concatMap (getLeaves cat fid) children mkLevel nodes @@ -411,8 +411,8 @@ genPreAlignment pgf langs = lin2align . linsBracketed getLeaves parent bs = case bs of - Leaf w -> [(parent,w)] - Bracket _ fid _ _ _ bss -> concatMap (getLeaves fid) bss + Leaf w -> [(parent,w)] + Bracket _ fid _ _ _ _ bss -> concatMap (getLeaves fid) bss mkLayers (cs:css:rest) = let (lrest, rrest) = mkLayers (css:rest) in ((fields cs) : lrest, (map (mkLinks css) cs) : rrest)