"Committed_by_peb"

This commit is contained in:
peb
2005-03-18 09:17:10 +00:00
parent af6cb59fe8
commit 24c666fbe5
8 changed files with 49 additions and 29 deletions

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/02/24 11:46:34 $ -- > CVS $Date: 2005/03/18 10:17:10 $
-- > CVS $Author: peb $ -- > CVS $Author: peb $
-- > CVS $Revision: 1.7 $ -- > CVS $Revision: 1.8 $
-- --
-- Handles printing a CFGrammar in CFGM format. -- Handles printing a CFGrammar in CFGM format.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -27,6 +27,7 @@ import qualified AbsCFG
import qualified Parser import qualified Parser
import qualified PrintParser import qualified PrintParser
import ErrM import ErrM
import qualified Option
import List (intersperse) import List (intersperse)
import Maybe (listToMaybe, maybe) import Maybe (listToMaybe, maybe)
@@ -45,8 +46,11 @@ prCanonAsCFGM gr = unlines $ map (uncurry (prLangAsCFGM gr)) xs
getFlag :: [Flag] -> String -> Maybe String getFlag :: [Flag] -> String -> Maybe String
getFlag fs x = listToMaybe [v | Flg (IC k) (IC v) <- fs, k == x] getFlag fs x = listToMaybe [v | Flg (IC k) (IC v) <- fs, k == x]
-- | OBS! Should use 'ShellState.statePInfo' or 'ShellState.pInfos'
-- instead of 'Cnv.pInfo' (which recalculates the grammar every time)
prLangAsCFGM :: CanonGrammar -> Ident -> Maybe String -> String prLangAsCFGM :: CanonGrammar -> Ident -> Maybe String -> String
prLangAsCFGM gr i start = prCFGrammarAsCFGM (Cnv.cfg (Cnv.pInfo gr i)) i start prLangAsCFGM gr i start = prCFGrammarAsCFGM (Cnv.cfg (Cnv.pInfo opts gr i)) i start
where opts = Option.noOptions
{- {-
prCFGrammarAsCFGM :: GT.CFGrammar -> Ident -> Maybe String -> String prCFGrammarAsCFGM :: GT.CFGrammar -> Ident -> Maybe String -> String
@@ -67,6 +71,17 @@ cfGrammarToCFGM gr i start = AbsCFG.Grammar (identToCFGMIdent i) flags (map rule
where flags = maybe [] (\c -> [AbsCFG.StartCat $ strToCFGMCat (c++"{}.s")]) start where flags = maybe [] (\c -> [AbsCFG.StartCat $ strToCFGMCat (c++"{}.s")]) start
ruleToCFGMRule :: GT.CFRule -> AbsCFG.Rule ruleToCFGMRule :: GT.CFRule -> AbsCFG.Rule
-- new version, without the MCFName constructor:
ruleToCFGMRule (CFGrammar.Rule c rhs (GT.CFName ({-GT.MCFName-} fun {-cat args-}) {-lbl-} profile))
= AbsCFG.Rule fun' n' p' c' rhs'
where
fun' = identToCFGMIdent fun
n' = strToCFGMName "this_should_disappear"
p' = profileToCFGMProfile profile
c' = catToCFGMCat c
rhs' = map symbolToGFCMSymbol rhs
{- old version, with the MCFName constructor:
ruleToCFGMRule (CFGrammar.Rule c rhs (GT.CFName (GT.MCFName fun cat args) lbl profile)) ruleToCFGMRule (CFGrammar.Rule c rhs (GT.CFName (GT.MCFName fun cat args) lbl profile))
= AbsCFG.Rule fun' n' p' c' rhs' = AbsCFG.Rule fun' n' p' c' rhs'
where where
@@ -75,6 +90,7 @@ ruleToCFGMRule (CFGrammar.Rule c rhs (GT.CFName (GT.MCFName fun cat args) lbl pr
p' = profileToCFGMProfile profile p' = profileToCFGMProfile profile
c' = catToCFGMCat c c' = catToCFGMCat c
rhs' = map symbolToGFCMSymbol rhs rhs' = map symbolToGFCMSymbol rhs
-}
profileToCFGMProfile :: GT.CFProfile -> AbsCFG.Profile profileToCFGMProfile :: GT.CFProfile -> AbsCFG.Profile
profileToCFGMProfile = AbsCFG.Profile . map (AbsCFG.Ints . map fromIntegral) profileToCFGMProfile = AbsCFG.Profile . map (AbsCFG.Ints . map fromIntegral)
@@ -91,7 +107,7 @@ catToCFGMCat = strToCFGMCat . Prt.prt
strToCFGMName :: String -> AbsCFG.Name strToCFGMName :: String -> AbsCFG.Name
strToCFGMName = AbsCFG.Name . AbsCFG.SingleQuoteString . quoteSingle strToCFGMName = AbsCFG.Name . AbsCFG.SingleQuoteString . quoteSingle
symbolToGFCMSymbol :: Parser.Symbol GT.CFCat GT.Token -> AbsCFG.Symbol symbolToGFCMSymbol :: Parser.Symbol GT.CFCat GT.Tokn -> AbsCFG.Symbol
symbolToGFCMSymbol (Parser.Cat c) = AbsCFG.CatS (catToCFGMCat c) symbolToGFCMSymbol (Parser.Cat c) = AbsCFG.CatS (catToCFGMCat c)
symbolToGFCMSymbol (Parser.Tok t) = AbsCFG.TermS (Prt.prt t) symbolToGFCMSymbol (Parser.Tok t) = AbsCFG.TermS (Prt.prt t)

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/03/02 14:22:53 $ -- > CVS $Date: 2005/03/18 10:17:10 $
-- > CVS $Author: peb $ -- > CVS $Author: peb $
-- > CVS $Revision: 1.37 $ -- > CVS $Revision: 1.38 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -166,7 +166,7 @@ updateShellState opts mcnc sh ((_,sgr,gr),rts) = do
notInrts f = notElem f $ map fst rts notInrts f = notElem f $ map fst rts
cfs <- mapM (canon2cf opts cgr) concrs --- would not need to update all... cfs <- mapM (canon2cf opts cgr) concrs --- would not need to update all...
let pinfos = map (Cnv.pInfo cgr) concrs -- peb 18/6 let pinfos = map (Cnv.pInfo opts cgr) concrs -- peb 18/6
let funs = funRulesOf cgr let funs = funRulesOf cgr
let cats = allCatsOf cgr let cats = allCatsOf cgr

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/03/08 15:31:22 $ -- > CVS $Date: 2005/03/18 10:17:10 $
-- > CVS $Author: bringert $ -- > CVS $Author: peb $
-- > CVS $Revision: 1.22 $ -- > CVS $Revision: 1.23 $
-- --
-- Options and flags used in GF shell commands and files. -- Options and flags used in GF shell commands and files.
-- --
@@ -284,6 +284,10 @@ extractGr = aOpt "extract"
pathList = aOpt "path" pathList = aOpt "path"
uniCoding = aOpt "coding" uniCoding = aOpt "coding"
-- peb 16/3-05:
gfcConversion :: String -> Option
gfcConversion = aOpt "conversion"
useName, useAbsName, useCncName, useResName, useName, useAbsName, useCncName, useResName,
useFile, useOptimizer :: String -> Option useFile, useOptimizer :: String -> Option

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/03/08 15:31:22 $ -- > CVS $Date: 2005/03/18 10:17:10 $
-- > CVS $Author: bringert $ -- > CVS $Author: peb $
-- > CVS $Revision: 1.25 $ -- > CVS $Revision: 1.26 $
-- --
-- The datatype of shell commands and the list of their options. -- The datatype of shell commands and the list of their options.
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -151,7 +151,7 @@ testValidFlag st co f x = case f of
optionsOfCommand :: Command -> ([String],[String]) optionsOfCommand :: Command -> ([String],[String])
optionsOfCommand co = case co of optionsOfCommand co = case co of
CImport _ -> both "old v s src retain nocf nocheckcirc cflexer noemit o" CImport _ -> both "old v s src retain nocf nocheckcirc cflexer noemit o"
"abs cnc res path optimize" "abs cnc res path optimize conversion"
CRemoveLanguage _ -> none CRemoveLanguage _ -> none
CEmptyState -> none CEmptyState -> none
CStripState -> none CStripState -> none

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/02/18 19:21:21 $ -- > CVS $Date: 2005/03/18 10:17:10 $
-- > CVS $Author: peb $ -- > CVS $Author: peb $
-- > CVS $Revision: 1.10 $ -- > CVS $Revision: 1.11 $
-- --
-- This module prints a CFG as a Nuance GSL 2.0 grammar. -- This module prints a CFG as a Nuance GSL 2.0 grammar.
-- --
@@ -55,13 +55,13 @@ firstToUpper :: String -> String
firstToUpper [] = [] firstToUpper [] = []
firstToUpper (x:xs) = toUpper x : xs firstToUpper (x:xs) = toUpper x : xs
rmPunct :: [Symbol String Token] -> [Symbol String Token] rmPunct :: [Symbol String Tokn] -> [Symbol String Tokn]
rmPunct [] = [] rmPunct [] = []
rmPunct (Tok t:ss) | all isPunct (prt t) = rmPunct ss rmPunct (Tok t:ss) | all isPunct (prt t) = rmPunct ss
rmPunct (s:ss) = s : rmPunct ss rmPunct (s:ss) = s : rmPunct ss
-- Nuance does not like upper case characters in tokens -- Nuance does not like upper case characters in tokens
showToken :: Token -> String showToken :: Tokn -> String
showToken t = map toLower (prt t) showToken t = map toLower (prt t)
isPunct :: Char -> Bool isPunct :: Char -> Bool

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/02/22 13:35:19 $ -- > CVS $Date: 2005/03/18 10:17:11 $
-- > CVS $Author: bringert $ -- > CVS $Author: peb $
-- > CVS $Revision: 1.4 $ -- > CVS $Revision: 1.5 $
-- --
-- This module prints a CFG as a JSGF grammar. -- This module prints a CFG as a JSGF grammar.
-- --
@@ -53,7 +53,7 @@ prJSGF (SRG{grammarName=name,startCat=start,origStartCat=origStart,rules=rs})
prSymbol (Tok t) = wrap "\"" (prtS t) "\"" prSymbol (Tok t) = wrap "\"" (prtS t) "\""
prCat c = showChar '<' . showString c . showChar '>' prCat c = showChar '<' . showString c . showChar '>'
rmPunct :: [Symbol String Token] -> [Symbol String Token] rmPunct :: [Symbol String Tokn] -> [Symbol String Tokn]
rmPunct [] = [] rmPunct [] = []
rmPunct (Tok t:ss) | all isPunct (prt t) = rmPunct ss rmPunct (Tok t:ss) | all isPunct (prt t) = rmPunct ss
rmPunct (s:ss) = s : rmPunct ss rmPunct (s:ss) = s : rmPunct ss

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/02/24 11:46:38 $ -- > CVS $Date: 2005/03/18 10:17:11 $
-- > CVS $Author: peb $ -- > CVS $Author: peb $
-- > CVS $Revision: 1.6 $ -- > CVS $Revision: 1.7 $
-- --
-- Representation of, conversion to, and utilities for -- Representation of, conversion to, and utilities for
-- printing of a general Speech Recognition Grammar. -- printing of a general Speech Recognition Grammar.
@@ -40,7 +40,7 @@ data SRG = SRG { grammarName :: String -- ^ grammar name
} }
data SRGRule = SRGRule String String [SRGAlt] -- ^ SRG category name, original category name data SRGRule = SRGRule String String [SRGAlt] -- ^ SRG category name, original category name
-- and productions -- and productions
type SRGAlt = [Symbol String Token] type SRGAlt = [Symbol String Tokn]
-- | SRG category name and original name -- | SRG category name and original name
type CatName = (String,String) type CatName = (String,String)

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/02/22 13:35:19 $ -- > CVS $Date: 2005/03/18 10:17:11 $
-- > CVS $Author: bringert $ -- > CVS $Author: peb $
-- > CVS $Revision: 1.4 $ -- > CVS $Revision: 1.5 $
-- --
-- This module does some useful transformations on CFGs. -- This module does some useful transformations on CFGs.
-- --
@@ -30,7 +30,7 @@ import Debug.Trace
-- | not very nice to get replace the structured CFCat type with a simple string -- | not very nice to get replace the structured CFCat type with a simple string
type CFRule_ = Rule CFName String Token type CFRule_ = Rule CFName String Tokn
type CFRules = FiniteMap String [CFRule_] type CFRules = FiniteMap String [CFRule_]