summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/GF/Speech/FiniteState.hs8
-rw-r--r--src/GF/Speech/PrSLF.hs2
2 files changed, 7 insertions, 3 deletions
diff --git a/src/GF/Speech/FiniteState.hs b/src/GF/Speech/FiniteState.hs
index f58ca1312..832fb81d4 100644
--- a/src/GF/Speech/FiniteState.hs
+++ b/src/GF/Speech/FiniteState.hs
@@ -150,8 +150,9 @@ removeTrivialEmptyNodes = pruneUnusable . skipSimpleEmptyNodes
-- | Move edges to empty nodes with exactly one outgoing edge
-- or exactly one incoming edge to point to the next node(s).
+-- This is not done if the pointed-to node is a final node.
skipSimpleEmptyNodes :: (Eq a, Ord n) => FA n (Maybe a) () -> FA n (Maybe a) ()
-skipSimpleEmptyNodes = onGraph og
+skipSimpleEmptyNodes fa = onGraph og fa
where
og g@(Graph c ns es) = if es' == es then g else og (Graph c ns es')
where
@@ -160,13 +161,16 @@ skipSimpleEmptyNodes = onGraph og
changeEdge e@(f,t,())
| isNothing (getNodeLabel info t)
&& (inDegree info t == 1 || outDegree info t == 1)
+ && not (isFinal fa t)
= [ (f,t',()) | (_,t',()) <- getOutgoing info t]
| otherwise = [e]
-
isInternal :: Eq n => FA n a b -> n -> Bool
isInternal (FA _ start final) n = n /= start && n `notElem` final
+isFinal :: Eq n => FA n a b -> n -> Bool
+isFinal (FA _ _ final) n = n `elem` final
+
-- | Remove all internal nodes with no incoming edges
-- or no outgoing edges.
pruneUnusable :: Ord n => FA n (Maybe a) () -> FA n (Maybe a) ()
diff --git a/src/GF/Speech/PrSLF.hs b/src/GF/Speech/PrSLF.hs
index fbba89692..7f96bba5e 100644
--- a/src/GF/Speech/PrSLF.hs
+++ b/src/GF/Speech/PrSLF.hs
@@ -58,7 +58,7 @@ mkFAs start cfg = (slfStyleFA main, [(c,slfStyleFA n) | (c,n) <- subs])
where MFA main subs = {- renameSubs $ -} cfgToMFA start cfg
slfStyleFA :: Eq a => DFA a -> FA State (Maybe a) ()
-slfStyleFA = renameStates [0..] . removeTrivialEmptyNodes . oneFinalState Nothing ()
+slfStyleFA = renameStates [0..] . removeTrivialEmptyNodes . oneFinalState Nothing ()
. moveLabelsToNodes . dfa2nfa
-- | Give sequential names to subnetworks.