diff options
| author | kr.angelov <kr.angelov@chalmers.se> | 2008-05-22 11:59:31 +0000 |
|---|---|---|
| committer | kr.angelov <kr.angelov@chalmers.se> | 2008-05-22 11:59:31 +0000 |
| commit | df0c4f81fa9c620d7c63af79c0b183a6beccf0bd (patch) | |
| tree | 0cdc80b29f8f5df0ad280f17be0ba9d46fbd948c /src-3.0/GF/System | |
| parent | 6394f3ccfbb9d14017393b433a38a3921f1083e5 (diff) | |
remove all files that aren't used in GF-3.0
Diffstat (limited to 'src-3.0/GF/System')
| -rw-r--r-- | src-3.0/GF/System/ATKSpeechInput.hs | 137 | ||||
| -rw-r--r-- | src-3.0/GF/System/Arch.hs | 90 | ||||
| -rw-r--r-- | src-3.0/GF/System/ArchEdit.hs | 30 | ||||
| -rw-r--r-- | src-3.0/GF/System/NoReadline.hs | 27 | ||||
| -rw-r--r-- | src-3.0/GF/System/NoSignal.hs | 29 | ||||
| -rw-r--r-- | src-3.0/GF/System/NoSpeechInput.hs | 28 | ||||
| -rw-r--r-- | src-3.0/GF/System/Readline.hs | 27 | ||||
| -rw-r--r-- | src-3.0/GF/System/Signal.hs | 27 | ||||
| -rw-r--r-- | src-3.0/GF/System/SpeechInput.hs | 27 | ||||
| -rw-r--r-- | src-3.0/GF/System/Tracing.hs | 73 | ||||
| -rw-r--r-- | src-3.0/GF/System/UseReadline.hs | 25 | ||||
| -rw-r--r-- | src-3.0/GF/System/UseSignal.hs | 58 |
12 files changed, 0 insertions, 578 deletions
diff --git a/src-3.0/GF/System/ATKSpeechInput.hs b/src-3.0/GF/System/ATKSpeechInput.hs deleted file mode 100644 index 4b50293af..000000000 --- a/src-3.0/GF/System/ATKSpeechInput.hs +++ /dev/null @@ -1,137 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : GF.System.ATKSpeechInput --- Maintainer : BB --- Stability : (stable) --- Portability : (non-portable) --- --- > CVS $Date: 2005/05/10 15:04:01 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.2 $ --- --- Use ATK and Speech.ATKRec for speech input. ------------------------------------------------------------------------------ - -module GF.System.ATKSpeechInput (recognizeSpeech) where - -import GF.Infra.Ident (Ident, prIdent) -import GF.Infra.Option -import GF.Conversion.Types (CGrammar) -import GF.Speech.PrSLF - -import Speech.ATKRec - -import Control.Monad -import Data.Maybe -import Data.IORef -import System.Environment -import System.IO -import System.IO.Unsafe - -data ATKLang = ATKLang { - hmmlist :: FilePath, - mmf0 :: FilePath, - mmf1 :: FilePath, - dict :: FilePath, - opts :: [(String,String)] - } - -atk_home_error = "The environment variable ATK_HOME is not set. " - ++ "It should contain the path to your copy of ATK." - -gf_atk_cfg_error = "The environment variable GF_ATK_CFG is not set. " - ++ "It should contain the path to your GF ATK configuration" - ++ " file. A default version of this file can be found" - ++ " in GF/src/gf_atk.cfg" - -getLanguage :: String -> IO ATKLang -getLanguage l = - case l of - "en_UK" -> do - atk_home <- getEnv_ "ATK_HOME" atk_home_error - let res = atk_home ++ "/Resources" - return $ ATKLang { - hmmlist = res ++ "/UK_SI_ZMFCC/hmmlistbg", - mmf0 = res ++ "/UK_SI_ZMFCC/WI4", - mmf1 = res ++ "/UK_SI_ZMFCC/BGHMM2", - dict = res ++ "/beep.dct", - opts = [("TARGETKIND", "MFCC_0_D_A_Z"), - ("HPARM:CMNDEFAULT", res ++ "/UK_SI_ZMFCC/cepmean")] - } - "sv_SE" -> do - let res = "/home/bjorn/projects/atkswe/numerals-swe/final" - return $ ATKLang { - hmmlist = res ++ "/hmm_tri/hmmlist", - mmf0 = res ++ "/hmm_tri/macros", - mmf1 = res ++ "/hmm_tri/hmmdefs", - dict = res ++ "/NumeralsSwe.dct", - opts = [("TARGETKIND", "MFCC_0_D_A")] - } - _ -> fail $ "ATKSpeechInput: language " ++ l ++ " not supported" - --- | Current language for which we have loaded the HMM --- and dictionary. -{-# NOINLINE currentLang #-} -currentLang :: IORef (Maybe String) -currentLang = unsafePerformIO $ newIORef Nothing - --- | Initializes the ATK, loading the given language. --- ATK must not be initialized when calling this function. -loadLang :: String -> IO () -loadLang lang = - do - l <- getLanguage lang - config <- getEnv_ "GF_ATK_CFG" gf_atk_cfg_error - hPutStrLn stderr $ "Initializing ATK..." - initialize (Just config) (opts l) - let hmmName = "hmm_" ++ lang - dictName = "dict_" ++ lang - hPutStrLn stderr $ "Initializing ATK (" ++ lang ++ ")..." - loadHMMSet hmmName (hmmlist l) (mmf0 l) (mmf1 l) - loadDict dictName (dict l) - writeIORef currentLang (Just lang) - -initATK :: String -> IO () -initATK lang = - do - ml <- readIORef currentLang - case ml of - Nothing -> loadLang lang - Just l | l == lang -> return () - | otherwise -> do - deinitialize - loadLang lang - -recognizeSpeech :: Ident -- ^ Grammar name - -> String -- ^ Language, e.g. en_UK - -> CGrammar -- ^ Context-free grammar for input - -> String -- ^ Start category name - -> Int -- ^ Number of utterances - -> IO [String] -recognizeSpeech name language cfg start number = - do - let slf = slfPrinter name start cfg - n = prIdent name - hmmName = "hmm_" ++ language - dictName = "dict_" ++ language - slfName = "gram_" ++ n - recName = "rec_" ++ language ++ "_" ++ n - writeFile "debug.net" slf - initATK language - hPutStrLn stderr $ "Loading grammar " ++ n ++ " ..." - loadGrammarString slfName slf - createRecognizer recName hmmName dictName slfName - hPutStrLn stderr $ "Listening in category " ++ start ++ "..." - s <- replicateM number (recognize recName) - return s - - -getEnv_ :: String -- ^ Name of environment variable - -> String -- ^ Message to fail with if the variable is not set. - -> IO String -getEnv_ e err = - do - env <- getEnvironment - case lookup e env of - Just v -> return v - Nothing -> fail err diff --git a/src-3.0/GF/System/Arch.hs b/src-3.0/GF/System/Arch.hs deleted file mode 100644 index c0dac3644..000000000 --- a/src-3.0/GF/System/Arch.hs +++ /dev/null @@ -1,90 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : Arch --- Maintainer : AR --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/05/10 14:55:01 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.8 $ --- --- architecture\/compiler dependent definitions for unix\/hbc ------------------------------------------------------------------------------ - -module GF.System.Arch ( - myStdGen, prCPU, selectLater, modifiedFiles, ModTime, getModTime,getNowTime, - welcomeArch, fetchCommand, laterModTime) where - -import System.Time -import System.Random -import System.CPUTime -import Control.Monad (filterM) -import System.Directory - -import GF.System.Readline (fetchCommand) - ----- import qualified UnicodeF as U --(fudlogueWrite) - --- architecture/compiler dependent definitions for unix/hbc - -myStdGen :: Int -> IO StdGen --- ---- myStdGen _ = newStdGen --- gives always the same result -myStdGen int0 = do - t0 <- getClockTime - cal <- toCalendarTime t0 - let int = int0 + ctSec cal + fromInteger (div (ctPicosec cal) 10000000) - return $ mkStdGen int - -prCPU :: Integer -> IO Integer -prCPU cpu = do - cpu' <- getCPUTime - putStrLn (show ((cpu' - cpu) `div` 1000000000) ++ " msec") - return cpu' - -welcomeArch :: String -welcomeArch = "This is the system compiled with ghc." - --- | selects the one with the later modification time of two -selectLater :: FilePath -> FilePath -> IO FilePath -selectLater x y = do - ex <- doesFileExist x - if not ex - then return y --- which may not exist - else do - ey <- doesFileExist y - if not ey - then return x - else do - tx <- getModificationTime x - ty <- getModificationTime y - return $ if tx < ty then y else x - --- | a file is considered modified also if it has not been read yet --- --- new 23\/2\/2004: the environment ofs has just module names -modifiedFiles :: [(FilePath,ModTime)] -> [FilePath] -> IO [FilePath] -modifiedFiles ofs fs = do - filterM isModified fs - where - isModified file = case lookup (justModName file) ofs of - Just to -> do - t <- getModificationTime file - return $ to < t - _ -> return True - - justModName = - reverse . takeWhile (/='/') . tail . dropWhile (/='.') . reverse - -type ModTime = ClockTime - -laterModTime :: ModTime -> ModTime -> Bool -laterModTime = (>) - -getModTime :: FilePath -> IO (Maybe ModTime) -getModTime f = do - b <- doesFileExist f - if b then (getModificationTime f >>= return . Just) else return Nothing - -getNowTime :: IO ModTime -getNowTime = getClockTime diff --git a/src-3.0/GF/System/ArchEdit.hs b/src-3.0/GF/System/ArchEdit.hs deleted file mode 100644 index 39b558cef..000000000 --- a/src-3.0/GF/System/ArchEdit.hs +++ /dev/null @@ -1,30 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : ArchEdit --- Maintainer : AR --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/04/21 16:46:15 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.2 $ --- --- (Description of the module) ------------------------------------------------------------------------------ - -module GF.System.ArchEdit ( - fudlogueEdit, fudlogueWrite, fudlogueWriteUni - ) where - -fudlogueEdit :: a -> b -> IO () -fudlogueEdit _ _ = do - putStrLn "sorry no fudgets available in Hugs" - return () - -fudlogueWrite :: a -> b -> IO () -fudlogueWrite _ _ = do - putStrLn "sorry no fudgets available in Hugs" - -fudlogueWriteUni :: a -> b -> IO () -fudlogueWriteUni _ _ = do - putStrLn "sorry no fudgets available in Hugs" diff --git a/src-3.0/GF/System/NoReadline.hs b/src-3.0/GF/System/NoReadline.hs deleted file mode 100644 index 138ba4e28..000000000 --- a/src-3.0/GF/System/NoReadline.hs +++ /dev/null @@ -1,27 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : GF.System.NoReadline --- Maintainer : BB --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/05/10 15:04:01 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.1 $ --- --- Do not use readline. ------------------------------------------------------------------------------ - -module GF.System.NoReadline (fetchCommand) where - -import System.IO.Error (try) -import System.IO (stdout,hFlush) - -fetchCommand :: String -> IO (String) -fetchCommand s = do - putStr s - hFlush stdout - res <- try getLine - case res of - Left e -> return "q" - Right l -> return l diff --git a/src-3.0/GF/System/NoSignal.hs b/src-3.0/GF/System/NoSignal.hs deleted file mode 100644 index 5d82a431e..000000000 --- a/src-3.0/GF/System/NoSignal.hs +++ /dev/null @@ -1,29 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : GF.System.NoSignal --- Maintainer : Bjorn Bringert --- Stability : (stability) --- Portability : (portability) --- --- > CVS $Date: 2005/11/11 11:12:50 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.1 $ --- --- Dummy implementation of signal handling. ------------------------------------------------------------------------------ - -module GF.System.NoSignal where - -import Control.Exception (Exception,catch) -import Prelude hiding (catch) - -{-# NOINLINE runInterruptibly #-} -runInterruptibly :: IO a -> IO (Either Exception a) ---runInterruptibly = fmap Right -runInterruptibly a = - p `catch` h - where p = a >>= \x -> return $! Right $! x - h e = return $ Left e - -blockInterrupt :: IO a -> IO a -blockInterrupt = id diff --git a/src-3.0/GF/System/NoSpeechInput.hs b/src-3.0/GF/System/NoSpeechInput.hs deleted file mode 100644 index 04197ce92..000000000 --- a/src-3.0/GF/System/NoSpeechInput.hs +++ /dev/null @@ -1,28 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : GF.System.NoSpeechInput --- Maintainer : BB --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/05/10 15:04:01 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.2 $ --- --- Dummy speech input. ------------------------------------------------------------------------------ - -module GF.System.NoSpeechInput (recognizeSpeech) where - -import GF.Infra.Ident (Ident) -import GF.Infra.Option (Options) -import GF.Conversion.Types (CGrammar) - - -recognizeSpeech :: Ident -- ^ Grammar name - -> String -- ^ Language, e.g. en_UK - -> CGrammar -- ^ Context-free grammar for input - -> String -- ^ Start category name - -> Int -- ^ Number of utterances - -> IO [String] -recognizeSpeech _ _ _ _ _ = fail "No speech input available" diff --git a/src-3.0/GF/System/Readline.hs b/src-3.0/GF/System/Readline.hs deleted file mode 100644 index c12493f98..000000000 --- a/src-3.0/GF/System/Readline.hs +++ /dev/null @@ -1,27 +0,0 @@ -{-# OPTIONS -cpp #-} - ----------------------------------------------------------------------- --- | --- Module : GF.System.Readline --- Maintainer : BB --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/05/10 15:04:01 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.2 $ --- --- Uses the right readline library to read user input. ------------------------------------------------------------------------------ - -module GF.System.Readline (fetchCommand) where - -#ifdef USE_READLINE - -import GF.System.UseReadline (fetchCommand) - -#else - -import GF.System.NoReadline (fetchCommand) - -#endif diff --git a/src-3.0/GF/System/Signal.hs b/src-3.0/GF/System/Signal.hs deleted file mode 100644 index fe8a12483..000000000 --- a/src-3.0/GF/System/Signal.hs +++ /dev/null @@ -1,27 +0,0 @@ -{-# OPTIONS -cpp #-} - ----------------------------------------------------------------------- --- | --- Module : GF.System.Signal --- Maintainer : Bjorn Bringert --- Stability : (stability) --- Portability : (portability) --- --- > CVS $Date: 2005/11/11 11:12:50 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.3 $ --- --- Import the right singal handling module. ------------------------------------------------------------------------------ - -module GF.System.Signal (runInterruptibly,blockInterrupt) where - -#ifdef USE_INTERRUPT - -import GF.System.UseSignal (runInterruptibly,blockInterrupt) - -#else - -import GF.System.NoSignal (runInterruptibly,blockInterrupt) - -#endif diff --git a/src-3.0/GF/System/SpeechInput.hs b/src-3.0/GF/System/SpeechInput.hs deleted file mode 100644 index 6c2374473..000000000 --- a/src-3.0/GF/System/SpeechInput.hs +++ /dev/null @@ -1,27 +0,0 @@ -{-# OPTIONS -cpp #-} - ----------------------------------------------------------------------- --- | --- Module : GF.System.SpeechInput --- Maintainer : BB --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/05/10 15:04:01 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.2 $ --- --- Uses the right speech recognition library for speech input. ------------------------------------------------------------------------------ - -module GF.System.SpeechInput (recognizeSpeech) where - -#ifdef USE_ATK - -import GF.System.ATKSpeechInput (recognizeSpeech) - -#else - -import GF.System.NoSpeechInput (recognizeSpeech) - -#endif diff --git a/src-3.0/GF/System/Tracing.hs b/src-3.0/GF/System/Tracing.hs deleted file mode 100644 index 71bacfb75..000000000 --- a/src-3.0/GF/System/Tracing.hs +++ /dev/null @@ -1,73 +0,0 @@ -{-# OPTIONS -cpp #-} - ----------------------------------------------------------------------- --- | --- Maintainer : PL --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/04/26 09:54:11 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.4 $ --- --- Tracing utilities for debugging purposes. --- If the CPP symbol TRACING is set, then the debugging output is shown. ------------------------------------------------------------------------------ - - -module GF.System.Tracing - (trace, trace2, traceM, traceCall, tracePrt, traceCalcFirst) where - -import qualified Debug.Trace as Trace - --- | emit a string inside braces, before(?) calculating the value: --- @{str}@ -trace :: String -> a -> a - --- | emit function name and debugging output: --- @{fun: out}@ -trace2 :: String -> String -> a -> a - --- | monadic version of 'trace2' -traceM :: Monad m => String -> String -> m () - --- | show when a value is starting to be calculated (with a '+'), --- and when it is finished (with a '-') -traceCall :: String -> String -> (a -> String) -> a -> a - --- | showing the resulting value (filtered through a printing function): --- @{fun: value}@ -tracePrt :: String -> (a -> String) -> a -> a - --- | this is equivalent to 'seq' when tracing, but --- just skips the first argument otherwise -traceCalcFirst :: a -> b -> b - -#if TRACING -trace str a = Trace.trace (bold ++ "{" ++ normal ++ str ++ bold ++ "}" ++ normal) a -trace2 fun str a = trace (bold ++ fgcol 1 ++ fun ++ ": " ++ normal ++ str) a -traceM fun str = trace2 fun str (return ()) -traceCall fun start prt val - = trace2 ("+" ++ fun) start $ - val `seq` trace2 ("-" ++ fun) (prt val) val -tracePrt mod prt val = val `seq` trace2 mod (prt val) val -traceCalcFirst = seq - -#else -trace _ = id -trace2 _ _ = id -traceM _ _ = return () -traceCall _ _ _ = id -tracePrt _ _ = id -traceCalcFirst _ = id - -#endif - - -escape = "\ESC" -highlight = escape ++ "[7m" -bold = escape ++ "[1m" -underline = escape ++ "[4m" -normal = escape ++ "[0m" -fgcol col = escape ++ "[0" ++ show (30+col) ++ "m" -bgcol col = escape ++ "[0" ++ show (40+col) ++ "m" diff --git a/src-3.0/GF/System/UseReadline.hs b/src-3.0/GF/System/UseReadline.hs deleted file mode 100644 index c84b9d7f4..000000000 --- a/src-3.0/GF/System/UseReadline.hs +++ /dev/null @@ -1,25 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : GF.System.UseReadline --- Maintainer : BB --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/05/10 15:04:01 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.1 $ --- --- Use GNU readline ------------------------------------------------------------------------------ - -module GF.System.UseReadline (fetchCommand) where - -import System.Console.Readline (readline, addHistory) - -fetchCommand :: String -> IO (String) -fetchCommand s = do - res <- readline s - case res of - Nothing -> return "q" - Just s -> do addHistory s - return s diff --git a/src-3.0/GF/System/UseSignal.hs b/src-3.0/GF/System/UseSignal.hs deleted file mode 100644 index 5e6d81237..000000000 --- a/src-3.0/GF/System/UseSignal.hs +++ /dev/null @@ -1,58 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : GF.System.UseSignal --- Maintainer : Bjorn Bringert --- Stability : (stability) --- Portability : (portability) --- --- > CVS $Date: 2005/11/11 11:12:50 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.1 $ --- --- Allows SIGINT (Ctrl-C) to interrupt computations. ------------------------------------------------------------------------------ - -module GF.System.UseSignal where - -import Control.Concurrent (myThreadId, killThread) -import Control.Exception (Exception,catch) -import Prelude hiding (catch) -import System.IO -import System.Posix.Signals - -{-# NOINLINE runInterruptibly #-} - --- | Run an IO action, and allow it to be interrupted --- by a SIGINT to the current process. Returns --- an exception if the process did not complete --- normally. --- NOTES: --- * This will replace any existing SIGINT --- handler during the action. After the computation --- has completed the existing handler will be restored. --- * If the IO action is lazy (e.g. using readFile, --- unsafeInterleaveIO etc.) the lazy computation will --- not be interruptible, as it will be performed --- after the signal handler has been removed. -runInterruptibly :: IO a -> IO (Either Exception a) -runInterruptibly a = - do t <- myThreadId - oldH <- installHandler sigINT (Catch (killThread t)) Nothing - x <- p `catch` h - installHandler sigINT oldH Nothing - return x - where p = a >>= \x -> return $! Right $! x - h e = return $ Left e - --- | Like 'runInterruptibly', but always returns (), whether --- the computation fails or not. -runInterruptibly_ :: IO () -> IO () -runInterruptibly_ = fmap (either (const ()) id) . runInterruptibly - --- | Run an action with SIGINT blocked. -blockInterrupt :: IO a -> IO a -blockInterrupt a = - do oldH <- installHandler sigINT Ignore Nothing - x <- a - installHandler sigINT oldH Nothing - return x |
