GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

refactor BracketedString

Browse Source
This commit is contained in:
krasimir
2010-05-01 21:02:32 +00:00
parent 029fbec8f3
commit 4e85f8ada3
4 changed files with 14 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/runtime/haskell/PGF/Forest.hs
View File

@@ -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

4
src/runtime/haskell/PGF/Linearize.hs
View File

@@ -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

10
src/runtime/haskell/PGF/Macros.hs
View File

@@ -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]

10
src/runtime/haskell/PGF/VisualizeTree.hs
View File

@@ -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 "\"] ;" $$