1
0
forked from GitHub/gf-core

Get GF.Speech.SLF to compile in GF 3.

This commit is contained in:
bjorn
2008-06-22 11:51:53 +00:00
parent 0fb3221775
commit d617a05a36

View File

@@ -1,38 +1,26 @@
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
-- Module : PrSLF -- Module : GF.Speech.SLF
-- Maintainer : BB
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/11/10 16:43:44 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.12 $
-- --
-- This module converts a CFG to an SLF finite-state network -- This module converts a CFG to an SLF finite-state network
-- for use with the ATK recognizer. The SLF format is described -- for use with the ATK recognizer. The SLF format is described
-- in the HTK manual, and an example for use in ATK is shown -- in the HTK manual, and an example for use in ATK is shown
-- in the ATK manual. -- in the ATK manual.
-- --
-- FIXME: remove \/ warn \/ fail if there are int \/ string literal
-- categories in the grammar
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module GF.Speech.PrSLF (slfPrinter,slfGraphvizPrinter, module GF.Speech.SLF (slfPrinter,slfGraphvizPrinter,
slfSubPrinter,slfSubGraphvizPrinter) where slfSubPrinter,slfSubGraphvizPrinter) where
import GF.Data.Utilities import GF.Data.Utilities
import GF.Conversion.Types import GF.Speech.CFG
import GF.Formalism.CFG
import GF.Formalism.Utilities (Symbol(..),symbol,mapSymbol)
import GF.Infra.Ident
import GF.Infra.Option (Options)
import GF.Infra.Print
import GF.Speech.CFGToFiniteState
import GF.Speech.FiniteState import GF.Speech.FiniteState
import GF.Speech.TransformCFG import GF.Speech.CFG
import qualified GF.Visualization.Graphviz as Dot import GF.Speech.CFGToFA
import GF.Compile.ShellState (StateGrammar) import GF.Speech.PGFToCFG
import qualified GF.Speech.Graphviz as Dot
import PGF
import PGF.CId
import Control.Monad import Control.Monad
import qualified Control.Monad.State as STM import qualified Control.Monad.State as STM
@@ -52,19 +40,19 @@ type SLFWord = Maybe String
data SLFEdge = SLFEdge { eId :: Int, eStart :: Int, eEnd :: Int } data SLFEdge = SLFEdge { eId :: Int, eStart :: Int, eEnd :: Int }
type SLF_FA = FA State (Maybe (MFALabel String)) () type SLF_FA = FA State (Maybe CFSymbol) ()
mkFAs :: Options -> StateGrammar -> (SLF_FA, [(String,SLF_FA)]) mkFAs :: PGF -> CId -> (SLF_FA, [(String,SLF_FA)])
mkFAs opts s = (slfStyleFA main, [(c,slfStyleFA n) | (c,n) <- subs]) mkFAs pgf cnc = (slfStyleFA main, [(c,slfStyleFA n) | (c,n) <- subs])
where MFA start subs = {- renameSubs $ -} cfgToMFA opts s where MFA start subs = {- renameSubs $ -} cfgToMFA $ pgfToCFG pgf cnc
main = let (fa,s,f) = newFA_ in newTransition s f (Cat start) fa main = let (fa,s,f) = newFA_ in newTransition s f (NonTerminal start) fa
slfStyleFA :: Eq a => DFA a -> FA State (Maybe a) () slfStyleFA :: Eq a => DFA a -> FA State (Maybe a) ()
slfStyleFA = renameStates [0..] . removeTrivialEmptyNodes . oneFinalState Nothing () slfStyleFA = renameStates [0..] . removeTrivialEmptyNodes . oneFinalState Nothing ()
. moveLabelsToNodes . dfa2nfa . moveLabelsToNodes . dfa2nfa
-- | Give sequential names to subnetworks. -- | Give sequential names to subnetworks.
renameSubs :: MFA String -> MFA String renameSubs :: MFA -> MFA
renameSubs (MFA start subs) = MFA (newName start) subs' renameSubs (MFA start subs) = MFA (newName start) subs'
where newNames = zip (map fst subs) ["sub"++show n | n <- [0..]] where newNames = zip (map fst subs) ["sub"++show n | n <- [0..]]
newName s = lookup' s newNames newName s = lookup' s newNames
@@ -75,9 +63,9 @@ renameSubs (MFA start subs) = MFA (newName start) subs'
-- * SLF graphviz printing (without sub-networks) -- * SLF graphviz printing (without sub-networks)
-- --
slfGraphvizPrinter :: Options -> StateGrammar -> String slfGraphvizPrinter :: PGF -> CId -> String
slfGraphvizPrinter opts s slfGraphvizPrinter pgf cnc
= prFAGraphviz $ gvFA $ slfStyleFA $ cfgToFA' opts s = prFAGraphviz $ gvFA $ slfStyleFA $ cfgToFA' $ pgfToCFG pgf cnc
where where
gvFA = mapStates (fromMaybe "") . mapTransitions (const "") gvFA = mapStates (fromMaybe "") . mapTransitions (const "")
@@ -85,9 +73,9 @@ slfGraphvizPrinter opts s
-- * SLF graphviz printing (with sub-networks) -- * SLF graphviz printing (with sub-networks)
-- --
slfSubGraphvizPrinter :: Options -> StateGrammar -> String slfSubGraphvizPrinter :: PGF -> CId -> String
slfSubGraphvizPrinter opts s = Dot.prGraphviz g slfSubGraphvizPrinter pgf cnc = Dot.prGraphviz g
where (main, subs) = mkFAs opts s where (main, subs) = mkFAs pgf cnc
g = STM.evalState (liftM2 Dot.addSubGraphs ss m) [0..] g = STM.evalState (liftM2 Dot.addSubGraphs ss m) [0..]
ss = mapM (\ (c,f) -> gvSLFFA (Just c) f) subs ss = mapM (\ (c,f) -> gvSLFFA (Just c) f) subs
m = gvSLFFA Nothing main m = gvSLFFA Nothing main
@@ -111,19 +99,19 @@ gvSLFFA n fa =
-- * SLF printing (without sub-networks) -- * SLF printing (without sub-networks)
-- --
slfPrinter :: Options -> StateGrammar -> String slfPrinter :: PGF -> CId -> String
slfPrinter opts s slfPrinter pgf cnc
= prSLF $ automatonToSLF mkSLFNode $ slfStyleFA $ cfgToFA' opts s = prSLF $ automatonToSLF mkSLFNode $ slfStyleFA $ cfgToFA' $ pgfToCFG pgf cnc
-- --
-- * SLF printing (with sub-networks) -- * SLF printing (with sub-networks)
-- --
-- | Make a network with subnetworks in SLF -- | Make a network with subnetworks in SLF
slfSubPrinter :: Options -> StateGrammar -> String slfSubPrinter :: PGF -> CId -> String
slfSubPrinter opts s = prSLFs slfs slfSubPrinter pgf cnc = prSLFs slfs
where where
(main,subs) = mkFAs opts s (main,subs) = mkFAs pgf cnc
slfs = SLFs [(c, faToSLF fa) | (c,fa) <- subs] (faToSLF main) slfs = SLFs [(c, faToSLF fa) | (c,fa) <- subs] (faToSLF main)
faToSLF = automatonToSLF mfaNodeToSLFNode faToSLF = automatonToSLF mfaNodeToSLFNode
@@ -132,11 +120,11 @@ automatonToSLF mkNode fa = SLF { slfNodes = ns, slfEdges = es }
where ns = map (uncurry mkNode) (states fa) where ns = map (uncurry mkNode) (states fa)
es = zipWith (\i (f,t,()) -> mkSLFEdge i (f,t)) [0..] (transitions fa) es = zipWith (\i (f,t,()) -> mkSLFEdge i (f,t)) [0..] (transitions fa)
mfaNodeToSLFNode :: Int -> Maybe (MFALabel String) -> SLFNode mfaNodeToSLFNode :: Int -> Maybe CFSymbol -> SLFNode
mfaNodeToSLFNode i l = case l of mfaNodeToSLFNode i l = case l of
Nothing -> mkSLFNode i Nothing Nothing -> mkSLFNode i Nothing
Just (Tok x) -> mkSLFNode i (Just x) Just (Terminal x) -> mkSLFNode i (Just x)
Just (Cat s) -> mkSLFSubLat i s Just (NonTerminal s) -> mkSLFSubLat i s
mkSLFNode :: Int -> Maybe String -> SLFNode mkSLFNode :: Int -> Maybe String -> SLFNode
mkSLFNode i Nothing = SLFNode { nId = i, nWord = Nothing, nTag = Nothing } mkSLFNode i Nothing = SLFNode { nId = i, nWord = Nothing, nTag = Nothing }