diff --git a/.ghci b/.ghci index 5da296450..041c7d773 100644 --- a/.ghci +++ b/.ghci @@ -1,2 +1,2 @@ -:set -isrc/compiler -isrc/binary -isrc/runtime/haskell -isrc/server -isrc/example-based -isrc/server/transfer -idist/build/autogen -idist/build/gf/gf-tmp +:set -isrc/compiler -isrc/binary -isrc/runtime/haskell -isrc/server -isrc/example-based -isrc/server/transfer -idist/build/autogen -idist/build :set -fwarn-unused-imports -optP-DSERVER_MODE -optP-DUSE_INTERRUPT -optP-DCC_LAZY -optP-include -optPdist/build/autogen/cabal_macros.h -odir dist/build/gf/gf-tmp -hidir dist/build/gf/gf-tmp -stubdir dist/build/gf/gf-tmp diff --git a/src/compiler/GF/Grammar/Macros.hs b/src/compiler/GF/Grammar/Macros.hs index 011e5be9d..00b5dbb20 100644 --- a/src/compiler/GF/Grammar/Macros.hs +++ b/src/compiler/GF/Grammar/Macros.hs @@ -551,7 +551,7 @@ strsFromTerm t = case t of d0 <- strsFromTerm d v0 <- mapM (strsFromTerm . fst) vs c0 <- mapM (strsFromTerm . snd) vs - let vs' = zip v0 c0 + --let vs' = zip v0 c0 return [strTok (str2strings def) vars | def <- d0, vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] | diff --git a/src/compiler/GF/Infra/SIO.hs b/src/compiler/GF/Infra/SIO.hs index 3b6a4c3c1..75c57601b 100644 --- a/src/compiler/GF/Infra/SIO.hs +++ b/src/compiler/GF/Infra/SIO.hs @@ -9,7 +9,7 @@ module GF.Infra.SIO( -- * Unrestricted, safe operations -- ** From the standard libraries getCPUTime,getCurrentDirectory,getLibraryDirectory, - newStdGen,print,putStrLn, + newStdGen,print,putStr,putStrLn, -- ** Specific to GF importGrammar,importSource, #ifdef C_RUNTIME @@ -22,11 +22,11 @@ module GF.Infra.SIO( -- Output to stdout will /not/ be captured or redirected. restricted,restrictedSystem ) where -import Prelude hiding (putStrLn,print) +import Prelude hiding (putStr,putStrLn,print) import Control.Applicative(Applicative(..)) import Control.Monad(liftM,ap) import Control.Monad.Trans(MonadTrans(..)) -import System.IO(hPutStrLn,hFlush,stdout) +import System.IO(hPutStr,hFlush,stdout) import GF.System.Catch(try) import System.Process(system) import System.Environment(getEnv) @@ -45,8 +45,8 @@ import qualified PGF2 -- * The SIO monad -type PutStrLn = String -> IO () -newtype SIO a = SIO {unS::PutStrLn->IO a} +type PutStr = String -> IO () +newtype SIO a = SIO {unS::PutStr->IO a} instance Functor SIO where fmap = liftM @@ -62,9 +62,11 @@ instance Output SIO where ePutStr = lift0 . ePutStr ePutStrLn = lift0 . ePutStrLn putStrLnE = putStrLnFlush ---putStrE = --- !!! + putStrE = putStr -class MonadSIO m where liftSIO :: SIO a -> m a +class {- Monad m => -} MonadSIO m where liftSIO :: SIO a -> m a +-- ^ If the Monad m superclass is included, then the generic instance +-- for monad transformers below would require UndecidableInstances instance MonadSIO SIO where liftSIO = id @@ -77,16 +79,17 @@ instance (MonadTrans t,Monad m,MonadSIO m) => MonadSIO (t m) where runSIO = hRunSIO stdout -- | Redirect 'stdout' to the given handle -hRunSIO h sio = unS sio (\s->hPutStrLn h s>>hFlush h) +hRunSIO h sio = unS sio (\s->hPutStr h s>>hFlush h) -- | Capture 'stdout' +captureSIO :: SIO a -> IO (String,a) captureSIO sio = do ch <- newChan result <- unS sio (writeChan ch . Just) writeChan ch Nothing output <- fmap takeJust (getChanContents ch) return (output,result) where - takeJust (Just xs:ys) = xs++'\n':takeJust ys + takeJust (Just xs:ys) = xs++takeJust ys takeJust _ = [] -- * Restricted accesss to arbitrary (potentially unsafe) IO operations @@ -105,8 +108,10 @@ restrictedIO io = lift0 io = SIO $ const io lift1 f io = SIO $ f . unS io +putStr = putStrFlush +putStrFlush s = SIO ($ s) putStrLn = putStrLnFlush -putStrLnFlush s = SIO ($ s) +putStrLnFlush s = putStr s >> putStrFlush "\n" print x = putStrLn (show x) getCPUTime = lift0 IO.getCPUTime diff --git a/src/runtime/haskell/PGF/Parse.hs b/src/runtime/haskell/PGF/Parse.hs index 2cfd91ca5..0b435fc28 100644 --- a/src/runtime/haskell/PGF/Parse.hs +++ b/src/runtime/haskell/PGF/Parse.hs @@ -517,7 +517,7 @@ type Continuation = TrieMap.TrieMap Token ActiveSet getContinuationInfo :: ParseState -> Map.Map [Token] [(FunId, CId, String)] getContinuationInfo pstate = Map.map (map f . Set.toList) contMap where - PState abstr concr chart cont = pstate + PState _abstr concr _chart cont = pstate contMap = Map.fromList (TrieMap.toList cont) -- always get [([], _::ActiveSet)] f :: Active -> (FunId,CId,String) f (Active int dotpos funid seqid pargs ak) = (funid, cid, seq)