GF.Infra.SIO: The SIO monad now supports putStr in addition to putStrLn

Also included some unrelated minor changes.

3 files changed, 17 insertions, 12 deletions

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)