GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-26 03:08:55 -06:00
Code Issues Packages Projects Releases Wiki Activity

Defined compileAutomaton in terms of make_fa

Browse Source
This commit is contained in:
bringert
2005-09-08 14:39:12 +00:00
parent 982a522272
commit 9508120dd1
2 changed files with 38 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
src/GF/Speech/FiniteState.hs
View File

@@ -1,6 +1,8 @@
module GF.Speech.FiniteState (FA, State, module GF.Speech.FiniteState (FA, State,
startState, finalStates, startState, finalStates,
states, transitions, states, transitions,
newFA, addFinalState,
newState, newTrans,
moveLabelsToNodes) where moveLabelsToNodes) where
import Data.Graph.Inductive import Data.Graph.Inductive
@@ -25,15 +27,29 @@ states (FA g _ _) = labNodes g
transitions :: FA a b -> [(State,State,b)] transitions :: FA a b -> [(State,State,b)]
transitions (FA g _ _) = labEdges g transitions (FA g _ _) = labEdges g
onGraph :: (Gr a b -> Gr c d) -> FA a b -> FA c d newFA :: a -- ^ Start node label
onGraph f (FA g s ss) = FA (f g) s ss -> 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 :: a -> FA a b -> (FA a b, State)
newState x (FA g s ss) = (FA g' s ss, n) newState x (FA g s ss) = (FA g' s ss, n)
where (g',n) = addNode x g where (g',n) = addNode x g
newEdge :: Node -> Node -> b -> FA a b -> FA a b newTrans :: Node -> Node -> b -> FA a b -> FA a b
newEdge f t l = onGraph (insEdge (f,t,l)) 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 :: DynGraph gr => a -> gr a b -> (gr a b, Node)
addNode x g = let s = freshNode g in (insNode (s,x) g, s) addNode x g = let s = freshNode g in (insNode (s,x) g, s)

19
src/GF/Speech/TransformCFG.hs
View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/09/07 14:21:31 $ -- > CVS $Date: 2005/09/08 15:39:12 $
-- > CVS $Author: bringert $ -- > CVS $Author: bringert $
-- > CVS $Revision: 1.16 $ -- > CVS $Revision: 1.17 $
-- --
-- This module does some useful transformations on CFGs. -- This module does some useful transformations on CFGs.
-- --
@@ -136,7 +136,20 @@ mutRecCats g = equivalenceClasses $ symmetricSubrelation $ transitiveClosure $ r
compileAutomaton :: Cat_ -- ^ Start category compileAutomaton :: Cat_ -- ^ Start category
-> CFRules -> CFRules
-> FA () (Maybe Token) -> FA () (Maybe Token)
compileAutomaton s g = undefined 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 -- * CFG rule utilities