diff --git a/src/GF/Speech/FiniteState.hs b/src/GF/Speech/FiniteState.hs
index cfcc6e096..dfd5d941d 100644
--- a/src/GF/Speech/FiniteState.hs
+++ b/src/GF/Speech/FiniteState.hs
@@ -18,6 +18,7 @@ module GF.Speech.FiniteState (FA, State, NFA, DFA,
 			      addFinalState,
 			      newState, newTransition,
 			      mapStates, mapTransitions,
+                              oneFinalState,
 			      moveLabelsToNodes, minimize,
                               dfa2nfa,
 			      prFAGraphviz) where
@@ -79,6 +80,18 @@ minimize = determinize . reverseNFA . dfa2nfa . determinize . reverseNFA
 onGraph :: (Graph n a b -> Graph n c d) -> FA n a b -> FA n c d
 onGraph f (FA g s ss) = FA (f g) s ss
 
+-- | Make the finite automaton have a single final state
+--   by adding a new final state and adding an edge
+--   from the old final states to the new state.
+oneFinalState :: a        -- ^ Label to give the new node
+              -> b        -- ^ Label to give the new edges
+              -> FA n a b -- ^ The old network
+              -> FA n a b -- ^ The new network
+oneFinalState nl el fa =
+    let (FA g s fs,nf) = newState nl fa
+        es = [ (f,nf,el) | f <- fs ]
+     in FA (newEdges es g) s [nf]
+
 -- | Transform a standard finite automaton with labelled edges
 --   to one where the labels are on the nodes instead. This can add
 --   up to one extra node per edge.
diff --git a/src/GF/Speech/PrSLF.hs b/src/GF/Speech/PrSLF.hs
index eba50a7e8..1e614d140 100644
--- a/src/GF/Speech/PrSLF.hs
+++ b/src/GF/Speech/PrSLF.hs
@@ -48,12 +48,16 @@ data SLFEdge = SLFEdge { eId :: Int, eStart :: Int, eEnd :: Int }
 
 slfPrinter :: Ident -- ^ Grammar name
 	   -> Options -> CGrammar -> String
-slfPrinter name opts cfg = prSLF (automatonToSLF $ moveLabelsToNodes $ dfa2nfa $ cfgToFA name opts cfg) ""
+slfPrinter name opts cfg = prSLF (automatonToSLF $ mkSLFFA name opts cfg) ""
 
 slfGraphvizPrinter :: Ident -- ^ Grammar name
 		   -> Options -> CGrammar -> String
 slfGraphvizPrinter name opts cfg = 
-    prFAGraphviz $ mapStates (fromMaybe "") $ mapTransitions (const "") $ moveLabelsToNodes $ dfa2nfa $ cfgToFA name opts cfg
+    prFAGraphviz $ mapStates (fromMaybe "") $ mapTransitions (const "") $ mkSLFFA name opts cfg
+
+mkSLFFA :: Ident -- ^ Grammar name
+	-> Options -> CGrammar -> FA State (Maybe String) ()
+mkSLFFA name opts cfg = oneFinalState Nothing () $ moveLabelsToNodes $ dfa2nfa $ cfgToFA name opts cfg
 
 automatonToSLF :: FA State (Maybe String) () -> SLF
 automatonToSLF fa =