diff --git a/src/GF/Speech/FiniteState.hs b/src/GF/Speech/FiniteState.hs
index bdbd21b67..671efb3d7 100644
--- a/src/GF/Speech/FiniteState.hs
+++ b/src/GF/Speech/FiniteState.hs
@@ -1,6 +1,8 @@
 module GF.Speech.FiniteState (FA, State,
 			      startState, finalStates,
 			      states, transitions,
+			      newFA, addFinalState,
+			      newState, newTrans,
 			      moveLabelsToNodes) where
 
 import Data.Graph.Inductive
@@ -25,15 +27,29 @@ states (FA g _ _) = labNodes g
 transitions :: FA a b -> [(State,State,b)]
 transitions (FA g _ _) = labEdges g
 
-onGraph :: (Gr a b -> Gr c d) -> FA a b -> FA c d
-onGraph f (FA g s ss) = FA (f g) s ss
+newFA :: a -- ^ Start node label
+      -> FA a b
+newFA l = FA g' s []
+    where g = empty
+	  s = freshNode g
+	  g' = insNode (s,l) g
+
+addFinalState :: Node -> FA a b -> FA a b
+addFinalState f (FA g s ss) = FA g s (f:ss)
 
 newState :: a -> FA a b -> (FA a b, State)
 newState x (FA g s ss) = (FA g' s ss, n)
     where (g',n) = addNode x g
 
-newEdge :: Node -> Node -> b -> FA a b -> FA a b
-newEdge f t l = onGraph (insEdge (f,t,l))
+newTrans :: Node -> Node -> b -> FA a b -> FA a b
+newTrans f t l = onGraph (insEdge (f,t,l))
+
+--
+-- * Graph functions
+--
+
+onGraph :: (Gr a b -> Gr c d) -> FA a b -> FA c d
+onGraph f (FA g s ss) = FA (f g) s ss
 
 addNode :: DynGraph gr => a -> gr a b -> (gr a b, Node)
 addNode x g = let s = freshNode g in (insNode (s,x) g, s)
diff --git a/src/GF/Speech/TransformCFG.hs b/src/GF/Speech/TransformCFG.hs
index 9c3ed2c06..0b4b680f8 100644
--- a/src/GF/Speech/TransformCFG.hs
+++ b/src/GF/Speech/TransformCFG.hs
@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/09/07 14:21:31 $ 
+-- > CVS $Date: 2005/09/08 15:39:12 $ 
 -- > CVS $Author: bringert $
--- > CVS $Revision: 1.16 $
+-- > CVS $Revision: 1.17 $
 --
 --  This module does some useful transformations on CFGs.
 --
@@ -134,9 +134,22 @@ mutRecCats g = equivalenceClasses $ symmetricSubrelation $ transitiveClosure $ r
 
 -- Convert a strongly regular grammar to a finite automaton.
 compileAutomaton :: Cat_ -- ^ Start category
-		    -> CFRules
-		    -> FA () (Maybe Token)
-compileAutomaton s g = undefined
+		 -> CFRules
+		 -> FA () (Maybe Token)
+compileAutomaton start g = make_fa s [Cat start] f g fa''
+  where fa = newFA ()
+	s = startState fa
+	(fa',f) = newState () fa
+	fa'' = addFinalState f fa'
+
+-- | The make_fa algorithm from \"Regular approximation of CFLs: a grammatical view\",
+--   Mark-Jan Nederhof. International Workshop on Parsing Technologies, 1997.
+make_fa :: State -> [Symbol Cat_ Token] -> State 
+	-> CFRules -> FA () (Maybe Token) -> FA () (Maybe Token)
+make_fa q0 a q1 g fa = 
+    case a of
+	   [] -> newTrans q0 Nothing q1 fa
+	   [Tok t] -> newTrans q0 (Just t) q1 fa
 
 --
 -- * CFG rule utilities