uplime/lamb
uplime
/
lamb
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Interp: lift -> liftIO

This commit is contained in:
darkf 2013-12-17 01:42:21 -08:00
parent 5097c855ce
commit cf2723d01f
1 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
Interp.hs
View File

@ -9,7 +9,7 @@ import qualified Data.ByteString.Char8 as BSC
import qualified Network.Socket as SO import qualified Network.Socket as SO
import Data.List (intercalate) import Data.List (intercalate)
import Control.Exception (try, SomeException) import Control.Exception (try, SomeException)
import Control.Monad.Trans (lift) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.State (StateT, runStateT, evalStateT, get, put) import Control.Monad.Trans.State (StateT, runStateT, evalStateT, get, put)
import System.IO (Handle, hPutStr, hGetLine, hClose, hIsEOF, hSetBuffering, import System.IO (Handle, hPutStr, hGetLine, hClose, hIsEOF, hSetBuffering,
hSetBinaryMode, openBinaryFile, IOMode(..), BufferMode(NoBuffering), stdout, stdin) hSetBinaryMode, openBinaryFile, IOMode(..), BufferMode(NoBuffering), stdout, stdin)
@ -116,19 +116,19 @@ fromDict m =
_fputbytes (TupleV [StreamV h, StrV str]) = do _fputbytes (TupleV [StreamV h, StrV str]) = do
(handles,_) <- get (handles,_) <- get
let handle = handles !! h let handle = handles !! h
io <- lift $ hPutStr handle str io <- liftIO $ hPutStr handle str
return unitv return unitv
_fputstr (TupleV [StreamV h, StrV str]) = do _fputstr (TupleV [StreamV h, StrV str]) = do
(handles,_) <- get (handles,_) <- get
let handle = handles !! h let handle = handles !! h
io <- lift $ hPutStr handle str io <- liftIO $ hPutStr handle str
return unitv return unitv
_fgetline (StreamV h) = do _fgetline (StreamV h) = do
(handles,_) <- get (handles,_) <- get
let handle = handles !! h let handle = handles !! h
str <- lift $ hGetLine handle str <- liftIO $ hGetLine handle
if last str == '\r' then -- remove trailing CR if last str == '\r' then -- remove trailing CR
return . StrV $ init str return . StrV $ init str
else return $ StrV str else return $ StrV str
@ -136,7 +136,7 @@ _fgetline (StreamV h) = do
_freadbytes (TupleV [StreamV h, IntV n]) = do _freadbytes (TupleV [StreamV h, IntV n]) = do
(handles,_) <- get (handles,_) <- get
let handle = handles !! h let handle = handles !! h
str <- lift $ BSC.hGet handle (fromIntegral n :: Int) str <- liftIO $ BSC.hGet handle (fromIntegral n :: Int)
return . StrV $ BSC.unpack str return . StrV $ BSC.unpack str
_fopen (TupleV [StrV path, StrV mode]) = do _fopen (TupleV [StrV path, StrV mode]) = do
@ -145,25 +145,25 @@ _fopen (TupleV [StrV path, StrV mode]) = do
"r" -> ReadMode "r" -> ReadMode
"w" -> WriteMode "w" -> WriteMode
"rw" -> ReadWriteMode "rw" -> ReadWriteMode
handle <- lift $ openBinaryFile path mode' handle <- liftIO $ openBinaryFile path mode'
put (handles ++ [handle], env) put (handles ++ [handle], env)
return . StreamV $ length handles return . StreamV $ length handles
_feof (StreamV h) = do _feof (StreamV h) = do
(handles,_) <- get (handles,_) <- get
let handle = handles !! h let handle = handles !! h
isEof <- lift $ hIsEOF handle isEof <- liftIO $ hIsEOF handle
return $ BoolV isEof return $ BoolV isEof
_fclose handle@(StreamV h) = do _fclose handle@(StreamV h) = do
(handles,_) <- get (handles,_) <- get
let handle = handles !! h let handle = handles !! h
lift $ hClose handle liftIO $ hClose handle
return unitv return unitv
_sockopen (TupleV [StrV host, IntV port]) = do _sockopen (TupleV [StrV host, IntV port]) = do
(handles,env) <- get (handles,env) <- get
handle <- lift $ SO.withSocketsDo $ do handle <- liftIO $ SO.withSocketsDo $ do
addr:_ <- SO.getAddrInfo Nothing (Just host) (Just $ show port) addr:_ <- SO.getAddrInfo Nothing (Just host) (Just $ show port)
sock <- SO.socket (SO.addrFamily addr) SO.Stream SO.defaultProtocol sock <- SO.socket (SO.addrFamily addr) SO.Stream SO.defaultProtocol
SO.connect sock (SO.addrAddress addr) SO.connect sock (SO.addrAddress addr)
@ -193,7 +193,7 @@ _eval (TupleV [StrV code, DictV env]) = do
let trySome :: IO a -> IO (Either SomeException a) let trySome :: IO a -> IO (Either SomeException a)
trySome = try trySome = try
state = ([stdout, stdin], [fromDict env]) state = ([stdout, stdin], [fromDict env])
ret <- lift . trySome $ evalStateT (evalString code) state ret <- liftIO. trySome $ evalStateT (evalString code) state
case ret of case ret of
Left err -> return $ TupleV [StrV "err", StrV (show err)] Left err -> return $ TupleV [StrV "err", StrV (show err)]
Right v -> return v Right v -> return v
@ -220,7 +220,7 @@ _locals (TupleV []) = do
_Import (StrV modname) = do _Import (StrV modname) = do
(h,env) <- get -- save current state (h,env) <- get -- save current state
put initialState put initialState
(path,modname) <- lift $ findModule modname -- find the module file (path,modname) <- liftIO $ findModule modname -- find the module file
evalFile path -- evaluate the module file evalFile path -- evaluate the module file
(_,[modenv]) <- get -- get the module env (_,[modenv]) <- get -- get the module env
let (_, [initialEnv]) = initialState let (_, [initialEnv]) = initialState
@ -478,7 +478,7 @@ parseLiterate lns = [drop 4 line | line <- lns, take 4 line == " "]
evalFile :: FilePath -> InterpState Value evalFile :: FilePath -> InterpState Value
evalFile path = do evalFile path = do
contents <- lift $ if path == "-" then getContents else readFile path contents <- liftIO $ if path == "-" then getContents else readFile path
if isLiterate path then if isLiterate path then
evalString . unlines . parseLiterate . lines $ contents evalString . unlines . parseLiterate . lines $ contents
else evalString contents else evalString contents