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

implement time\! and sleep\!

This commit is contained in:
darkf 2015-02-13 03:12:36 -08:00
parent 6f3b2e15c2
commit 1ded14b348
1 changed files with 8 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
Interp.hs
View File

@ -10,9 +10,10 @@ import qualified Network.Socket as SO
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.IO as TIO import qualified Data.Text.IO as TIO
import Data.List (intercalate, foldl1') import Data.List (intercalate, foldl1')
import Data.Time.Clock.POSIX (getPOSIXTime)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Control.Exception (try, SomeException) import Control.Exception (try, SomeException)
import Control.Concurrent (forkIO) import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.STM (atomically) import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TVar (TVar, newTVarIO, readTVar, writeTVar) import Control.Concurrent.STM.TVar (TVar, newTVarIO, readTVar, writeTVar)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
@ -175,6 +176,10 @@ _readRef (RefV r) = liftIO $ atomically $ readTVar r
_setRef (TupleV [RefV r, v]) = _setRef (TupleV [RefV r, v]) =
liftIO (atomically $ writeTVar r v) >> return v liftIO (atomically $ writeTVar r v) >> return v
_time (TupleV []) = fmap IntV $ liftIO $ round <$> getPOSIXTime
_sleep (IntV milliseconds) = liftIO (threadDelay (fromInteger $ 1000 * milliseconds)) >> return unitv
_loop args@(TupleV [fn@(FnV _ _), arg]) = do _loop args@(TupleV [fn@(FnV _ _), arg]) = do
v <- apply fn arg v <- apply fn arg
if v /= BoolV False then if v /= BoolV False then
@ -250,6 +255,8 @@ initialState = [M.fromList $ map (\(k,v) -> (T.pack k, v)) $ [
("ref!", bif _ref), ("ref!", bif _ref),
("readRef!", bif _readRef), ("readRef!", bif _readRef),
("setRef!", bif _setRef), ("setRef!", bif _setRef),
("time!", bif _time),
("sleep!", bif _sleep),
("repr", bif _repr), ("repr", bif _repr),
("stdout", StreamV stdout), ("stdout", StreamV stdout),
("stdin", StreamV stdin), ("stdin", StreamV stdin),