Added the prerequisits for automaton building.

This commit is contained in:
bringert
2005-09-07 13:21:30 +00:00
parent 6b00f22c12
commit a134b2b6f8
7 changed files with 191 additions and 75 deletions

View File

@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/09/02 15:47:46 $
-- > CVS $Date: 2005/09/07 14:21:30 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.2 $
-- > CVS $Revision: 1.3 $
--
-- This module converts a CFG to an SLF finite-state network
-- for use with the ATK recognizer. The SLF format is described
@@ -22,6 +22,7 @@ module GF.Speech.PrSLF (slfPrinter) where
import GF.Speech.SRG
import GF.Speech.TransformCFG
import GF.Speech.FiniteState
import GF.Infra.Ident
import GF.Formalism.CFG
@@ -31,24 +32,35 @@ import GF.Infra.Print
import GF.Infra.Option
import Data.Char (toUpper,toLower)
import Data.Maybe (fromMaybe)
data SLF = SLF { slfNodes :: [SLFNode], slfEdges :: [SLFEdge] }
data SLFNode = SLFNode { nId :: Int, nWord :: SLFWord }
-- | An SLF word is a word, or the empty string.
type SLFWord = String
type SLFWord = Maybe String
data SLFEdge = SLFEdge { eId :: Int, eStart :: Int, eEnd :: Int }
slfPrinter :: Ident -- ^ Grammar name
-> Options -> CGrammar -> String
slfPrinter name opts cfg = prSLF slf ""
where slf = srg2slf $ makeSRG name opts $ makeRegular $ makeNice cfg
slfPrinter name opts cfg = prSLF (regularToSLF start rgr) ""
where start = getStartCat opts
rgr = makeRegular $ removeEmptyCats $ cfgToCFRules cfg
regularToSLF :: String -> CFRules -> SLF
regularToSLF s rs = automatonToSLF $ compileAutomaton s rs
automatonToSLF :: FA () (Maybe String) -> SLF
automatonToSLF fa =
SLF { slfNodes = map mkSLFNode (states fa'),
slfEdges = zipWith mkSLFEdge [0..] (transitions fa') }
where fa' = moveLabelsToNodes fa
mkSLFNode (i,w) = SLFNode { nId = i, nWord = w }
mkSLFEdge i (f,t,()) = SLFEdge { eId = i, eStart = f, eEnd = t }
srg2slf :: SRG -> SLF
srg2slf = undefined -- should use TransformCFG.compileAutomaton
prSLF :: SLF -> ShowS
prSLF (SLF { slfNodes = ns, slfEdges = es}) = header . unlinesS (map prNode ns) . unlinesS (map prEdge es)
@@ -60,8 +72,10 @@ prSLF (SLF { slfNodes = ns, slfEdges = es}) = header . unlinesS (map prNode ns)
showWord :: SLFWord -> String
showWord "" = "!NULL"
showWord w = w -- FIXME: convert words to upper case
showWord Nothing = "!NULL"
showWord (Just w) = w -- FIXME: convert words to upper case
-- FIXME: could this be the empty string? if so, print as !NULL
prFields :: [(String,String)] -> ShowS
prFields fs = unwordsS [ showString l . showChar '=' . showString v | (l,v) <- fs ]