diff --git a/src/GF/CFGM/PrintCFGrammar.hs b/src/GF/CFGM/PrintCFGrammar.hs index a80fa1930..cc61fcfab 100644 --- a/src/GF/CFGM/PrintCFGrammar.hs +++ b/src/GF/CFGM/PrintCFGrammar.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/02/24 11:46:34 $ +-- > CVS $Date: 2005/03/18 10:17:10 $ -- > CVS $Author: peb $ --- > CVS $Revision: 1.7 $ +-- > CVS $Revision: 1.8 $ -- -- Handles printing a CFGrammar in CFGM format. ----------------------------------------------------------------------------- @@ -27,6 +27,7 @@ import qualified AbsCFG import qualified Parser import qualified PrintParser import ErrM +import qualified Option import List (intersperse) import Maybe (listToMaybe, maybe) @@ -45,8 +46,11 @@ prCanonAsCFGM gr = unlines $ map (uncurry (prLangAsCFGM gr)) xs getFlag :: [Flag] -> String -> Maybe String 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 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 @@ -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 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)) = AbsCFG.Rule fun' n' p' c' rhs' where @@ -75,6 +90,7 @@ ruleToCFGMRule (CFGrammar.Rule c rhs (GT.CFName (GT.MCFName fun cat args) lbl pr p' = profileToCFGMProfile profile c' = catToCFGMCat c rhs' = map symbolToGFCMSymbol rhs +-} profileToCFGMProfile :: GT.CFProfile -> AbsCFG.Profile profileToCFGMProfile = AbsCFG.Profile . map (AbsCFG.Ints . map fromIntegral) @@ -91,7 +107,7 @@ catToCFGMCat = strToCFGMCat . Prt.prt strToCFGMName :: String -> AbsCFG.Name 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.Tok t) = AbsCFG.TermS (Prt.prt t) diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs index 4069e01ed..b5975af8d 100644 --- a/src/GF/Compile/ShellState.hs +++ b/src/GF/Compile/ShellState.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/03/02 14:22:53 $ +-- > CVS $Date: 2005/03/18 10:17:10 $ -- > CVS $Author: peb $ --- > CVS $Revision: 1.37 $ +-- > CVS $Revision: 1.38 $ -- -- (Description of the module) ----------------------------------------------------------------------------- @@ -166,7 +166,7 @@ updateShellState opts mcnc sh ((_,sgr,gr),rts) = do notInrts f = notElem f $ map fst rts 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 cats = allCatsOf cgr diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs index a1a4e3468..401e02cab 100644 --- a/src/GF/Infra/Option.hs +++ b/src/GF/Infra/Option.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/03/08 15:31:22 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.22 $ +-- > CVS $Date: 2005/03/18 10:17:10 $ +-- > CVS $Author: peb $ +-- > CVS $Revision: 1.23 $ -- -- Options and flags used in GF shell commands and files. -- @@ -284,6 +284,10 @@ extractGr = aOpt "extract" pathList = aOpt "path" uniCoding = aOpt "coding" +-- peb 16/3-05: +gfcConversion :: String -> Option +gfcConversion = aOpt "conversion" + useName, useAbsName, useCncName, useResName, useFile, useOptimizer :: String -> Option diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs index d60849e90..06cfbf57a 100644 --- a/src/GF/Shell/ShellCommands.hs +++ b/src/GF/Shell/ShellCommands.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/03/08 15:31:22 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.25 $ +-- > CVS $Date: 2005/03/18 10:17:10 $ +-- > CVS $Author: peb $ +-- > CVS $Revision: 1.26 $ -- -- 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 co = case co of 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 CEmptyState -> none CStripState -> none diff --git a/src/GF/Speech/PrGSL.hs b/src/GF/Speech/PrGSL.hs index 3c2d5b479..ce55960ee 100644 --- a/src/GF/Speech/PrGSL.hs +++ b/src/GF/Speech/PrGSL.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/02/18 19:21:21 $ +-- > CVS $Date: 2005/03/18 10:17:10 $ -- > CVS $Author: peb $ --- > CVS $Revision: 1.10 $ +-- > CVS $Revision: 1.11 $ -- -- This module prints a CFG as a Nuance GSL 2.0 grammar. -- @@ -55,13 +55,13 @@ firstToUpper :: String -> String firstToUpper [] = [] firstToUpper (x:xs) = toUpper x : xs -rmPunct :: [Symbol String Token] -> [Symbol String Token] +rmPunct :: [Symbol String Tokn] -> [Symbol String Tokn] rmPunct [] = [] rmPunct (Tok t:ss) | all isPunct (prt t) = rmPunct ss rmPunct (s:ss) = s : rmPunct ss -- Nuance does not like upper case characters in tokens -showToken :: Token -> String +showToken :: Tokn -> String showToken t = map toLower (prt t) isPunct :: Char -> Bool diff --git a/src/GF/Speech/PrJSGF.hs b/src/GF/Speech/PrJSGF.hs index 6f2b51988..a5b81cfea 100644 --- a/src/GF/Speech/PrJSGF.hs +++ b/src/GF/Speech/PrJSGF.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/02/22 13:35:19 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.4 $ +-- > CVS $Date: 2005/03/18 10:17:11 $ +-- > CVS $Author: peb $ +-- > CVS $Revision: 1.5 $ -- -- 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) "\"" prCat c = showChar '<' . showString c . showChar '>' -rmPunct :: [Symbol String Token] -> [Symbol String Token] +rmPunct :: [Symbol String Tokn] -> [Symbol String Tokn] rmPunct [] = [] rmPunct (Tok t:ss) | all isPunct (prt t) = rmPunct ss rmPunct (s:ss) = s : rmPunct ss diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs index 40240651e..cf474f6a1 100644 --- a/src/GF/Speech/SRG.hs +++ b/src/GF/Speech/SRG.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/02/24 11:46:38 $ +-- > CVS $Date: 2005/03/18 10:17:11 $ -- > CVS $Author: peb $ --- > CVS $Revision: 1.6 $ +-- > CVS $Revision: 1.7 $ -- -- Representation of, conversion to, and utilities for -- 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 -- and productions -type SRGAlt = [Symbol String Token] +type SRGAlt = [Symbol String Tokn] -- | SRG category name and original name type CatName = (String,String) diff --git a/src/GF/Speech/TransformCFG.hs b/src/GF/Speech/TransformCFG.hs index 870325b9e..560687faf 100644 --- a/src/GF/Speech/TransformCFG.hs +++ b/src/GF/Speech/TransformCFG.hs @@ -5,9 +5,9 @@ -- Stability : (stable) -- Portability : (portable) -- --- > CVS $Date: 2005/02/22 13:35:19 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.4 $ +-- > CVS $Date: 2005/03/18 10:17:11 $ +-- > CVS $Author: peb $ +-- > CVS $Revision: 1.5 $ -- -- 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 -type CFRule_ = Rule CFName String Token +type CFRule_ = Rule CFName String Tokn type CFRules = FiniteMap String [CFRule_]