summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/GF/Speech/CFGToFiniteState.hs6
-rw-r--r--src/GF/Speech/FiniteState.hs33
-rw-r--r--src/GF/Speech/Graph.hs17
-rw-r--r--src/GF/Speech/PrFA.hs15
-rw-r--r--src/GF/Speech/PrSLF.hs8
-rw-r--r--src/GF/UseGrammar/Custom.hs9
6 files changed, 55 insertions, 33 deletions
diff --git a/src/GF/Speech/CFGToFiniteState.hs b/src/GF/Speech/CFGToFiniteState.hs
index 590fd1c6d..5a72f548a 100644
--- a/src/GF/Speech/CFGToFiniteState.hs
+++ b/src/GF/Speech/CFGToFiniteState.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/10/26 17:13:13 $
+-- > CVS $Date: 2005/11/10 16:43:44 $
-- > CVS $Author: bringert $
--- > CVS $Revision: 1.5 $
+-- > CVS $Revision: 1.6 $
--
-- Approximates CFGs with finite state networks.
-----------------------------------------------------------------------------
@@ -28,7 +28,7 @@ import GF.Speech.Relation
import GF.Speech.TransformCFG
cfgToFA :: Ident -- ^ Grammar name
- -> Options -> CGrammar -> NFA String
+ -> Options -> CGrammar -> DFA String
cfgToFA name opts = minimize . compileAutomaton start . makeSimpleRegular
where start = getStartCat opts
diff --git a/src/GF/Speech/FiniteState.hs b/src/GF/Speech/FiniteState.hs
index 51cacb1e1..cfcc6e096 100644
--- a/src/GF/Speech/FiniteState.hs
+++ b/src/GF/Speech/FiniteState.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/10/27 09:16:30 $
+-- > CVS $Date: 2005/11/10 16:43:44 $
-- > CVS $Author: bringert $
--- > CVS $Revision: 1.15 $
+-- > CVS $Revision: 1.16 $
--
-- A simple finite state network module.
-----------------------------------------------------------------------------
@@ -19,6 +19,7 @@ module GF.Speech.FiniteState (FA, State, NFA, DFA,
newState, newTransition,
mapStates, mapTransitions,
moveLabelsToNodes, minimize,
+ dfa2nfa,
prFAGraphviz) where
import Data.List
@@ -36,7 +37,7 @@ data FA n a b = FA (Graph n a b) n [n]
type NFA a = FA State () (Maybe a)
-type DFA a = FA [State] () a
+type DFA a = FA State () a
startState :: FA n a b -> n
@@ -72,8 +73,8 @@ mapStates f = onGraph (nmap f)
mapTransitions :: (b -> c) -> FA n a b -> FA n a c
mapTransitions f = onGraph (emap f)
-minimize :: Ord a => NFA a -> NFA a
-minimize = dfa2nfa . determinize . reverseNFA . dfa2nfa . determinize . reverseNFA
+minimize :: Ord a => NFA a -> DFA a
+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
@@ -114,11 +115,11 @@ alphabet = nub . catMaybes . map getLabel . edges
determinize :: Ord a => NFA a -> DFA a
determinize (FA g s f) = let (ns,es) = h [start] [] []
final = filter (not . null . (f `intersect`)) ns
- in FA (Graph (freshDFANodes g) [(n,()) | n <- ns] es) start final
+ fa = FA (Graph undefined [(n,()) | n <- ns] es) start final
+ in numberStates fa
where out = outgoing g
start = closure out [s]
isDFAFinal n = not (null (f `intersect` n))
- freshDFANodes (Graph ns _ _) = map (:[]) ns
-- Get the new DFA states and edges produced by a set of DFA states.
new ns = unzip [ (s, (n,s,c)) | n <- ns, (c,s) <- reachable out n]
h currentStates oldStates oldEdges
@@ -128,6 +129,14 @@ determinize (FA g s f) = let (ns,es) = h [start] [] []
allOldStates = currentStates ++ oldStates
newStates' = nub newStates \\ allOldStates
+numberStates :: (Ord x,Enum y) => FA x a b -> FA y a b
+numberStates (FA g s fs) = FA (renameNodes newName rest g) s' fs'
+ where (ns,rest) = splitAt (length (nodes g)) $ [toEnum 0 .. ]
+ newNodes = zip (map fst (nodes g)) ns
+ newName n = lookup' n newNodes
+ s' = newName s
+ fs' = map newName fs
+
-- | Get all the nodes reachable from a set of nodes by only empty edges.
closure :: Eq n => Outgoing n a (Maybe b) -> [n] -> [n]
closure out = fix closure_
@@ -146,15 +155,7 @@ reverseNFA (FA g s fs) = FA g''' s' [s]
g''' = newEdges [(s',f,Nothing) | f <- fs] g''
dfa2nfa :: DFA a -> NFA a
-dfa2nfa (FA (Graph _ ns es) s fs) = FA (Graph c ns' es') s' fs'
- where newNodes = zip (map fst ns) [0..]
- newNode n = lookup' n newNodes
- c = [length ns..]
- ns' = [ (n,()) | (_,n) <- newNodes ]
- es' = [ (newNode f, newNode t,Just l) | (f,t,l) <- es]
- s' = newNode s
- fs' = map newNode fs
-
+dfa2nfa = mapTransitions Just
--
-- * Visualization
diff --git a/src/GF/Speech/Graph.hs b/src/GF/Speech/Graph.hs
index 64b73a70a..2f80ef0ca 100644
--- a/src/GF/Speech/Graph.hs
+++ b/src/GF/Speech/Graph.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/10/26 17:13:13 $
+-- > CVS $Date: 2005/11/10 16:43:44 $
-- > CVS $Author: bringert $
--- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
--
-- A simple graph module.
-----------------------------------------------------------------------------
@@ -16,7 +16,7 @@ module GF.Speech.Graph ( Graph(..), Node, Edge, Incoming, Outgoing
, nmap, emap, newNode, newEdge, newEdges
, incoming, outgoing, getOutgoing
, getFrom, getTo, getLabel
- , reverseGraph
+ , reverseGraph, renameNodes
) where
import GF.Data.Utilities
@@ -41,9 +41,11 @@ nodes (Graph _ ns _) = ns
edges :: Graph n a b -> [Edge n b]
edges (Graph _ _ es) = es
+-- | Map a function over the node label.s
nmap :: (a -> c) -> Graph n a b -> Graph n c b
nmap f (Graph c ns es) = Graph c [(n,f l) | (n,l) <- ns] es
+-- | Map a function over the edge labels.
emap :: (b -> c) -> Graph n a b -> Graph n a c
emap f (Graph c ns es) = Graph c ns [(x,y,f l) | (x,y,l) <- es]
@@ -86,3 +88,12 @@ getLabel (_,_,l) = l
reverseGraph :: Graph n a b -> Graph n a b
reverseGraph (Graph c ns es) = Graph c ns [ (t,f,l) | (f,t,l) <- es ]
+
+-- | Re-name the nodes in the graph.
+renameNodes :: (n -> m) -- ^ renaming function
+ -> [m] -- ^ infinite supply of fresh node names, to
+ -- use when adding nodes in the future.
+ -> Graph n a b -> Graph m a b
+renameNodes newName c (Graph _ ns es) = Graph c ns' es'
+ where ns' = [ (newName n,x) | (n,x) <- ns ]
+ es' = [ (newName f, newName t, l) | (f,t,l) <- es]
diff --git a/src/GF/Speech/PrFA.hs b/src/GF/Speech/PrFA.hs
index 28745066f..79a9356db 100644
--- a/src/GF/Speech/PrFA.hs
+++ b/src/GF/Speech/PrFA.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/11/10 14:19:33 $
+-- > CVS $Date: 2005/11/10 16:43:44 $
-- > CVS $Author: bringert $
--- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
--
-- This module prints finite automata and regular grammars
-- for a context-free grammar.
@@ -16,7 +16,7 @@
-- categories in the grammar
-----------------------------------------------------------------------------
-module GF.Speech.PrFA (faGraphvizPrinter,regularPrinter) where
+module GF.Speech.PrFA (faGraphvizPrinter,regularPrinter,faCPrinter) where
import GF.Data.Utilities
import GF.Conversion.Types
@@ -37,7 +37,7 @@ import Data.Maybe (fromMaybe)
faGraphvizPrinter :: Ident -- ^ Grammar name
-> Options -> CGrammar -> String
faGraphvizPrinter name opts cfg =
- prFAGraphviz (mapStates (const "") $ mapTransitions (fromMaybe "") $ cfgToFA name opts cfg)
+ prFAGraphviz $ mapStates (const "") $ cfgToFA name opts cfg
-- | Convert the grammar to a regular grammar and print it in BNF
@@ -48,3 +48,10 @@ regularPrinter = prCFRules . makeSimpleRegular
prCFRules g = unlines [ c ++ " ::= " ++ join " | " (map (showRhs . ruleRhs) rs) | (c,rs) <- g]
join g = concat . intersperse g
showRhs = unwords . map (symbol id show)
+
+faCPrinter :: Ident -- ^ Grammar name
+ -> Options -> CGrammar -> String
+faCPrinter name opts cfg = fa2c $ cfgToFA name opts cfg
+
+fa2c :: DFA String -> String
+fa2c fa = undefined \ No newline at end of file
diff --git a/src/GF/Speech/PrSLF.hs b/src/GF/Speech/PrSLF.hs
index 7a328dd1d..bd6eba5bb 100644
--- a/src/GF/Speech/PrSLF.hs
+++ b/src/GF/Speech/PrSLF.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/11/10 14:19:33 $
+-- > CVS $Date: 2005/11/10 16:43:44 $
-- > CVS $Author: bringert $
--- > CVS $Revision: 1.11 $
+-- > CVS $Revision: 1.12 $
--
-- This module converts a CFG to an SLF finite-state network
-- for use with the ATK recognizer. The SLF format is described
@@ -48,12 +48,12 @@ data SLFEdge = SLFEdge { eId :: Int, eStart :: Int, eEnd :: Int }
slfPrinter :: Ident -- ^ Grammar name
-> Options -> CGrammar -> String
-slfPrinter name opts cfg = prSLF (automatonToSLF $ moveLabelsToNodes $ cfgToFA name opts cfg) ""
+slfPrinter name opts cfg = prSLF (automatonToSLF $ moveLabelsToNodes $ dfa2nfa $ cfgToFA name opts cfg) ""
slfGraphvizPrinter :: Ident -- ^ Grammar name
-> Options -> CGrammar -> String
slfGraphvizPrinter name opts cfg =
- prFAGraphviz (mapStates (fromMaybe "") $ mapTransitions (const "") $ moveLabelsToNodes $ cfgToFA name opts cfg)
+ prFAGraphviz $ mapStates (fromMaybe "") $ mapTransitions (const "") $ moveLabelsToNodes $ dfa2nfa $ cfgToFA name opts cfg
automatonToSLF :: FA State (Maybe String) () -> SLF
automatonToSLF fa =
diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs
index 9a4ce997d..1db93bff3 100644
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/11/10 14:19:33 $
+-- > CVS $Date: 2005/11/10 16:43:45 $
-- > CVS $Author: bringert $
--- > CVS $Revision: 1.83 $
+-- > CVS $Revision: 1.84 $
--
-- A database for customizable GF shell commands.
--
@@ -59,7 +59,7 @@ import GF.Speech.PrGSL (gslPrinter)
import GF.Speech.PrJSGF (jsgfPrinter)
import GF.Speech.PrSRGS (srgsXmlPrinter)
import GF.Speech.PrSLF (slfPrinter,slfGraphvizPrinter)
-import GF.Speech.PrFA (faGraphvizPrinter,regularPrinter)
+import GF.Speech.PrFA (faGraphvizPrinter,regularPrinter,faCPrinter)
import GF.Data.Zipper
@@ -261,6 +261,9 @@ customGrammarPrinter =
,(strCI "fa_graphviz", \s -> let opts = stateOptions s
name = cncId s
in faGraphvizPrinter name opts $ stateCFG s)
+ ,(strCI "fa_c", \s -> let opts = stateOptions s
+ name = cncId s
+ in faCPrinter name opts $ stateCFG s)
,(strCI "regular", regularPrinter . stateCFG)
,(strCI "plbnf", prLBNF True)
,(strCI "lbnf", prLBNF False)
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 15:35:15 +0000