diff --git a/src/GF/Speech/PrGSL.hs b/src/GF/Speech/PrGSL.hs index 14fb4c58e..8ddf0a521 100644 --- a/src/GF/Speech/PrGSL.hs +++ b/src/GF/Speech/PrGSL.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/04/21 16:23:31 $ +-- > CVS $Date: 2005/06/17 12:46:04 $ -- > CVS $Author: bringert $ --- > CVS $Revision: 1.18 $ +-- > CVS $Revision: 1.19 $ -- -- This module prints a CFG as a Nuance GSL 2.0 grammar. -- @@ -18,6 +18,7 @@ module GF.Speech.PrGSL (gslPrinter) where import GF.Speech.SRG +import GF.Speech.TransformCFG import GF.Infra.Ident import GF.Formalism.CFG @@ -31,7 +32,7 @@ import Data.Char (toUpper,toLower) gslPrinter :: Ident -- ^ Grammar name -> Options -> CGrammar -> String gslPrinter name opts cfg = prGSL srg "" - where srg = makeSRG name opts cfg + where srg = makeSRG name opts (makeNice cfg) prGSL :: SRG -> ShowS prGSL (SRG{grammarName=name,startCat=start,origStartCat=origStart,rules=rs}) diff --git a/src/GF/Speech/PrJSGF.hs b/src/GF/Speech/PrJSGF.hs index 58a33a324..8b73a080a 100644 --- a/src/GF/Speech/PrJSGF.hs +++ b/src/GF/Speech/PrJSGF.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/04/21 16:23:31 $ +-- > CVS $Date: 2005/06/17 12:46:05 $ -- > CVS $Author: bringert $ --- > CVS $Revision: 1.12 $ +-- > CVS $Revision: 1.13 $ -- -- This module prints a CFG as a JSGF grammar. -- @@ -20,6 +20,7 @@ module GF.Speech.PrJSGF (jsgfPrinter) where import GF.Speech.SRG +import GF.Speech.TransformCFG import GF.Infra.Ident import GF.Formalism.CFG import GF.Formalism.Utilities (Symbol(..)) @@ -30,7 +31,7 @@ import GF.Infra.Option jsgfPrinter :: Ident -- ^ Grammar name -> Options -> CGrammar -> String jsgfPrinter name opts cfg = prJSGF srg "" - where srg = makeSRG name opts cfg + where srg = makeSRG name opts (makeNice cfg) prJSGF :: SRG -> ShowS prJSGF (SRG{grammarName=name,startCat=start,origStartCat=origStart,rules=rs}) diff --git a/src/GF/Speech/PrSLF.hs b/src/GF/Speech/PrSLF.hs new file mode 100644 index 000000000..044a94ed0 --- /dev/null +++ b/src/GF/Speech/PrSLF.hs @@ -0,0 +1,69 @@ +---------------------------------------------------------------------- +-- | +-- Module : PrSLF +-- Maintainer : BB +-- Stability : (stable) +-- Portability : (portable) +-- +-- > CVS $Date: 2005/06/17 12:46:05 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.1 $ +-- +-- This module converts a CFG to an SLF finite-state network +-- 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 ATK manual. +-- +-- FIXME: remove \/ warn \/ fail if there are int \/ string literal +-- categories in the grammar +----------------------------------------------------------------------------- + +module GF.Speech.PrSLF (slfPrinter) where + +import GF.Speech.SRG +import GF.Speech.TransformCFG +import GF.Infra.Ident + +import GF.Formalism.CFG +import GF.Formalism.Utilities (Symbol(..)) +import GF.Conversion.Types +import GF.Infra.Print +import GF.Infra.Option + +import Data.Char (toUpper,toLower) + +data SLF = SLF [SLFNode] [SLFEdge] + +data SLFNode = SLFNode Int SLFWord + +type SLFWord = Maybe String + +data SLFEdge = SLFEdge Int Int Int + + +slfPrinter :: Ident -- ^ Grammar name + -> Options -> CGrammar -> String +slfPrinter name opts cfg = prSLF slf "" + where gr = makeNice cfg + gr' = makeRegular gr + srg = makeSRG name opts gr' + slf = srg2slf srg + +srg2slf :: SRG -> SLF +srg2slf = undefined + +prSLF :: SLF -> ShowS +prSLF (SLF ns es) = header . unlinesS (map prNode ns) . unlinesS (map prEdge es) + where + header = showString "VERSION=1.0" . nl + . prFields [("N",show (length ns)),("L", show (length es))] . nl + prNode (SLFNode i w) = prFields [("I",show i),("W",showWord w)] + prEdge (SLFEdge i s e) = prFields [("J",show i),("S",show s),("E",show e)] + + +showWord :: SLFWord -> String +showWord Nothing = "!NULL" +showWord (Just w) = w -- FIXME: convert words to upper case + +prFields :: [(String,String)] -> ShowS +prFields fs = unwordsS [ showString l . showChar '=' . showString v | (l,v) <- fs ] diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs index d59a391a1..2594e0a3e 100644 --- a/src/GF/Speech/SRG.hs +++ b/src/GF/Speech/SRG.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/04/21 16:23:32 $ +-- > CVS $Date: 2005/06/17 12:46:05 $ -- > CVS $Author: bringert $ --- > CVS $Revision: 1.13 $ +-- > CVS $Revision: 1.14 $ -- -- Representation of, conversion to, and utilities for -- printing of a general Speech Recognition Grammar. @@ -53,7 +53,7 @@ type CatNames = FiniteMap String String makeSRG :: Ident -- ^ Grammar name -> Options -- ^ Grammar options - -> CGrammar -- ^ A context-free grammar + -> [CFRule_] -- ^ A context-free grammar -> SRG makeSRG i opts gr = SRG { grammarName = name, startCat = start, @@ -63,9 +63,8 @@ makeSRG i opts gr = SRG { grammarName = name, name = prIdent i origStart = fromMaybe "S" (getOptVal opts gStartCat) ++ "{}.s" start = lookupFM_ names origStart - gr' = makeNice gr - names = mkCatNames name (nub $ map ruleCat gr') - rs = map (cfgRulesToSRGRule names) (sortAndGroupBy ruleCat gr') + names = mkCatNames name (nub $ map ruleCat gr) + rs = map (cfgRulesToSRGRule names) (sortAndGroupBy ruleCat gr) cfgRulesToSRGRule :: FiniteMap String String -> [CFRule_] -> SRGRule cfgRulesToSRGRule names rs@(r:_) = SRGRule cat origCat rhs diff --git a/src/GF/Speech/TransformCFG.hs b/src/GF/Speech/TransformCFG.hs index 71b3ca296..db9b009a6 100644 --- a/src/GF/Speech/TransformCFG.hs +++ b/src/GF/Speech/TransformCFG.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/04/21 16:23:33 $ +-- > CVS $Date: 2005/06/17 12:46:05 $ -- > CVS $Author: bringert $ --- > CVS $Revision: 1.12 $ +-- > CVS $Revision: 1.13 $ -- -- This module does some useful transformations on CFGs. -- @@ -16,7 +16,7 @@ -- peb thinks: most of this module should be moved to GF.Conversion... ----------------------------------------------------------------------------- -module GF.Speech.TransformCFG (makeNice, CFRule_) where +module GF.Speech.TransformCFG (makeNice, CFRule_, makeRegular) where import GF.Infra.Ident import GF.Formalism.CFG @@ -37,6 +37,8 @@ type Cat_ = String type CFRules = FiniteMap Cat_ [CFRule_] +-- | Remove left-recursion and categories with no productions +-- from a context-free grammar. makeNice :: CGrammar -> [CFRule_] makeNice = concat . eltsFM . makeNice' . groupProds . cfgToCFRules where makeNice' = removeLeftRecursion . removeEmptyCats @@ -94,6 +96,27 @@ isDirectLeftRecursive (CFRule c (Cat c':_) _) = c == c' isDirectLeftRecursive _ = False +-- Use the transformation algorithm from \"Regular Approximation of Context-free +-- Grammars through Approximation\", Mohri and Nederhof, 2000 +-- to create an over-generating regular frammar for a context-free +-- grammar +makeRegular :: [CFRule_] -> [CFRule_] +makeRegular = undefined + +{- +isRightLinear :: [Cat_] -- ^ The categories to consider + -> CFRule_ + -> Bool +isRightLinear _ (CFRule _ ss _) | all isTerminal ss = True +isRightLinear cs +-} + +-- Use the strongly regular grammar to finite automaton +-- compilation algorithm from \"Regular Approximation of Context-free +-- Grammars through Approximation\", Mohri and Nederhof, 2000 +-- compileAutomaton :: + + fix :: Eq a => (a -> a) -> a -> a fix f x = let x' = f x in if x' == x then x else fix f x' diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs index 08136fad8..e158a19c4 100644 --- a/src/GF/UseGrammar/Custom.hs +++ b/src/GF/UseGrammar/Custom.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/05/17 11:20:25 $ --- > CVS $Author: peb $ --- > CVS $Revision: 1.63 $ +-- > CVS $Date: 2005/06/17 12:46:05 $ +-- > CVS $Author: bringert $ +-- > CVS $Revision: 1.64 $ -- -- A database for customizable GF shell commands. -- @@ -56,6 +56,7 @@ import GF.Canon.MkGFC import GF.CF.CFtoSRG import GF.Speech.PrGSL (gslPrinter) import GF.Speech.PrJSGF (jsgfPrinter) +import GF.Speech.PrSLF (slfPrinter) import GF.Data.Zipper @@ -233,6 +234,9 @@ customGrammarPrinter = ,(strCI "jsgf", \s -> let opts = stateOptions s name = cncId s in jsgfPrinter name opts $ stateCFG s) + ,(strCI "slf", \s -> let opts = stateOptions s + name = cncId s + in slfPrinter name opts $ stateCFG s) ,(strCI "plbnf", prLBNF True) ,(strCI "lbnf", prLBNF False) ,(strCI "bnf", prBNF False)