summaryrefslogtreecommitdiff
path: root/src/runtime
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2010-05-01 21:02:32 +0000
committerkrasimir <krasimir@chalmers.se>2010-05-01 21:02:32 +0000
commit4e85f8ada33b2b7fb5f06750ef5f1d9ac81130b2 (patch)
tree472ae693f4032b9d9dcb9361fd9235754907be2b /src/runtime
parent029fbec8f361d0978fd595707c393fb51d289ecb (diff)
refactor BracketedString
Diffstat (limited to 'src/runtime')
-rw-r--r--src/runtime/haskell/PGF/Forest.hs4
-rw-r--r--src/runtime/haskell/PGF/Linearize.hs4
-rw-r--r--src/runtime/haskell/PGF/Macros.hs10
-rw-r--r--src/runtime/haskell/PGF/VisualizeTree.hs10
4 files changed, 14 insertions, 14 deletions
diff --git a/src/runtime/haskell/PGF/Forest.hs b/src/runtime/haskell/PGF/Forest.hs
index 3dd996aa6..428ee276a 100644
--- a/src/runtime/haskell/PGF/Forest.hs
+++ b/src/runtime/haskell/PGF/Forest.hs
@@ -51,7 +51,7 @@ linearizeWithBrackets = head . snd . untokn "" . bracketedTokn
bracketedTokn :: Forest -> BracketedTokn
bracketedTokn (Forest abs cnc forest root label) =
let (fid,cat,lin) = render IntMap.empty root
- in Bracket_ fid label cat (lin ! label)
+ in Bracket_ cat fid label (lin ! label)
where
trusted = trustedSpots IntSet.empty root
@@ -94,7 +94,7 @@ bracketedTokn (Forest abs cnc forest root label) =
getArg d r
| not (null arg_lin) &&
IntSet.member fid trusted
- = [Bracket_ fid r cat arg_lin]
+ = [Bracket_ cat fid r arg_lin]
| otherwise = arg_lin
where
arg_lin = lin ! r
diff --git a/src/runtime/haskell/PGF/Linearize.hs b/src/runtime/haskell/PGF/Linearize.hs
index e126bc552..503b98d7b 100644
--- a/src/runtime/haskell/PGF/Linearize.hs
+++ b/src/runtime/haskell/PGF/Linearize.hs
@@ -63,7 +63,7 @@ type CncType = (CId, FId) -- concrete type is the abstract type (the category
linTree :: PGF -> Language -> Expr -> [Array LIndex BracketedTokn]
linTree pgf lang e =
- [amapWithIndex (\label -> Bracket_ fid label cat) lin | (_,((cat,fid),lin)) <- lin0 [] [] Nothing 0 e]
+ [amapWithIndex (\label -> Bracket_ cat fid label) lin | (_,((cat,fid),lin)) <- lin0 [] [] Nothing 0 e]
where
cnc = lookMap (error "no lang") lang (concretes pgf)
lp = lproductions cnc
@@ -127,7 +127,7 @@ linTree pgf lang e =
compute (SymKP ts alts) = [LeafKP ts alts]
getArg d r
- | not (null arg_lin) = [Bracket_ fid r cat arg_lin]
+ | not (null arg_lin) = [Bracket_ cat fid r arg_lin]
| otherwise = arg_lin
where
arg_lin = lin ! r
diff --git a/src/runtime/haskell/PGF/Macros.hs b/src/runtime/haskell/PGF/Macros.hs
index 1b563fc48..0670a0d20 100644
--- a/src/runtime/haskell/PGF/Macros.hs
+++ b/src/runtime/haskell/PGF/Macros.hs
@@ -212,7 +212,7 @@ updateProductionIndices pgf = pgf{ concretes = fmap updateConcrete (concretes pg
-- mark the beginning and the end of each constituent.
data BracketedString
= Leaf String -- ^ this is the leaf i.e. a single token
- | Bracket {-# UNPACK #-} !FId {-# UNPACK #-} !LIndex CId [BracketedString] -- ^ this is a bracket. The 'CId' is the category of
+ | Bracket CId {-# UNPACK #-} !FId {-# UNPACK #-} !LIndex [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
-- i.e. without discontinuous constituents this identifier
@@ -227,7 +227,7 @@ data BracketedString
data BracketedTokn
= LeafKS [String]
| LeafKP [String] [Alternative]
- | Bracket_ {-# UNPACK #-} !FId {-# UNPACK #-} !LIndex CId [BracketedTokn] -- Invariant: the list is not empty
+ | Bracket_ CId {-# UNPACK #-} !FId {-# UNPACK #-} !LIndex [BracketedTokn] -- Invariant: the list is not empty
type LinTable = Array.Array LIndex [BracketedTokn]
@@ -238,7 +238,7 @@ showBracketedString :: BracketedString -> String
showBracketedString = render . ppBracketedString
ppBracketedString (Leaf t) = text t
-ppBracketedString (Bracket fcat index cat bss) = parens (ppCId cat <+> hsep (map ppBracketedString bss))
+ppBracketedString (Bracket cat fcat index bss) = parens (ppCId cat <+> hsep (map ppBracketedString bss))
untokn :: String -> BracketedTokn -> (String,[BracketedString])
untokn nw (LeafKS ts) = (head ts,map Leaf ts)
@@ -249,9 +249,9 @@ untokn nw (LeafKP d vs) = let ts = sel d vs nw
case [v | Alt v cs <- vs, any (\c -> isPrefixOf c nw) cs] of
v:_ -> v
_ -> d
-untokn nw (Bracket_ fid index cat bss) =
+untokn nw (Bracket_ cat fid index bss) =
let (nw',bss') = mapAccumR untokn nw bss
- in (nw',[Bracket fid index cat (concat bss')])
+ in (nw',[Bracket cat fid index (concat bss')])
flattenBracketedString :: BracketedString -> [String]
flattenBracketedString (Leaf w) = [w]
diff --git a/src/runtime/haskell/PGF/VisualizeTree.hs b/src/runtime/haskell/PGF/VisualizeTree.hs
index 3075e7a86..098d6a07f 100644
--- a/src/runtime/haskell/PGF/VisualizeTree.hs
+++ b/src/runtime/haskell/PGF/VisualizeTree.hs
@@ -123,7 +123,7 @@ graphvizDependencyTree format debug mlab ms pgf lang t = render $
getLeaves parent bs =
case bs of
Leaf w -> [(parent,w)]
- Bracket fid _ _ bss -> concatMap (getLeaves fid) bss
+ Bracket _ fid _ bss -> concatMap (getLeaves fid) bss
mkNode (p,i,w) =
tag p <> text " [label = " <> doubleQuotes (int i <> char '.' <+> text w) <> text "] ;"
@@ -235,12 +235,12 @@ graphvizBracketedString = render . lin2tree
getLeaves level parent bs =
case bs of
Leaf w -> [(level-1,parent,w)]
- Bracket fid i _ bss -> concatMap (getLeaves (level+1) fid) bss
+ Bracket _ fid i bss -> concatMap (getLeaves (level+1) fid) bss
getInterns level [] = []
getInterns level nodes =
- nub [(level-1,parent,fid,showCId cat) | (parent,Bracket fid _ cat _) <- nodes] :
- getInterns (level+1) [(fid,child) | (_,Bracket fid _ _ children) <- nodes, child <- children]
+ nub [(level-1,parent,fid,showCId cat) | (parent,Bracket cat fid _ _) <- nodes] :
+ getInterns (level+1) [(fid,child) | (_,Bracket _ fid _ children) <- nodes, child <- children]
mkStruct l cs = struct l <> text "[label = \"" <> fields cs <> text "\"] ;" $$
vcat [link pl pid l id | (pl,pid,id,_) <- cs]
@@ -291,7 +291,7 @@ graphvizAlignment pgf langs = render . lin2graph . linsBracketed
getLeaves parent bs =
case bs of
Leaf w -> [(parent,w)]
- Bracket fid _ _ bss -> concatMap (getLeaves fid) bss
+ Bracket _ fid _ bss -> concatMap (getLeaves fid) bss
mkLayers l [] = empty
mkLayers l (cs:css) = struct l <> text "[label = \"" <> fields cs <> text "\"] ;" $$