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

add mutable refs

This commit is contained in:
darkf 2014-02-12 02:11:36 -08:00
parent d180116931
commit 5bae5645ec
1 changed files with 45 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
Interp.hs
View File

@ -13,6 +13,7 @@ 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)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import System.Directory (doesFileExist) import System.Directory (doesFileExist)
import System.FilePath (FilePath, splitExtension, takeBaseName, takeDirectory, (</>)) import System.FilePath (FilePath, splitExtension, takeBaseName, takeDirectory, (</>))
import System.Environment (getExecutablePath) import System.Environment (getExecutablePath)
@ -32,6 +33,7 @@ data Value = IntV Integer
| TupleV [Value] | TupleV [Value]
| ListV [Value] | ListV [Value]
| DictV (M.Map Value Value) | DictV (M.Map Value Value)
| RefV (IORef Value)
| Builtin BIF | Builtin BIF
| FnV Env [(Pattern, AST)] -- closure pattern->body bindings | FnV Env [(Pattern, AST)] -- closure pattern->body bindings
deriving (Eq) deriving (Eq)
@ -74,6 +76,7 @@ instance Show Value where
show (FnV _ _) = "<fn>" show (FnV _ _) = "<fn>"
show (StreamV _) = "<stream>" show (StreamV _) = "<stream>"
show (Builtin _) = "<built-in>" show (Builtin _) = "<built-in>"
show (RefV _) = "<ref>"
-- value operators -- value operators
(IntV l) +$ (IntV r) = IntV (l + r) (IntV l) +$ (IntV r) = IntV (l + r)
@ -164,6 +167,18 @@ _repr v = return . StrV $ show v
_itos (IntV i) = return $ StrV $ show i _itos (IntV i) = return $ StrV $ show i
_itos v = error $ "itos: not an int: " ++ show v _itos v = error $ "itos: not an int: " ++ show v
_ref v = do
value <- liftIO $ newIORef v
return $ RefV value
_readRef (RefV r) = do
value <- liftIO $ readIORef r
return value
_setRef (TupleV [RefV r, v]) = do
liftIO $ writeIORef r v
return v
_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
@ -224,30 +239,35 @@ _Import (StrV modname) = do
if exists then return (path, takeBaseName path) if exists then return (path, takeBaseName path)
else findModuleIn xs else findModuleIn xs
initialState = ( [M.fromList [("id", FnV emptyEnv [(VarP "x", Var "x")]), bif = Builtin . BIF
("loop", Builtin $ BIF _loop), initialState = [M.fromList [
("repr", Builtin $ BIF _repr), ("id", FnV emptyEnv [(VarP "x", Var "x")]),
("loop", bif _loop),
("ref!", bif _ref),
("readRef!", bif _readRef),
("setRef!", bif _setRef),
("repr", bif _repr),
("stdout", StreamV stdout), ("stdout", StreamV stdout),
("stdin", StreamV stdin), ("stdin", StreamV stdin),
("print", Builtin $ BIF _print), ("print", bif _print),
("putstr", Builtin $ BIF _putstr), ("putstr", bif _putstr),
("putstrln", Builtin $ BIF (\x -> _putstr $ x +$ StrV "\n")), ("putstrln", bif (\x -> _putstr $ x +$ StrV "\n")),
("getline", Builtin $ BIF _getline), ("getline", bif _getline),
("fgetline", Builtin $ BIF _fgetline), ("fgetline", bif _fgetline),
("putbytes", Builtin $ BIF _putbytes), ("putbytes", bif _putbytes),
("fputbytes", Builtin $ BIF _fputbytes), ("fputbytes", bif _fputbytes),
("fputstr", Builtin $ BIF _fputstr), ("fputstr", bif _fputstr),
("freadbytes", Builtin $ BIF _freadbytes), ("freadbytes", bif _freadbytes),
("feof", Builtin $ BIF _feof), ("feof", bif _feof),
("fclose", Builtin $ BIF _fclose), ("fclose", bif _fclose),
("fopen", Builtin $ BIF _fopen), ("fopen", bif _fopen),
("sockopen", Builtin $ BIF _sockopen), ("sockopen", bif _sockopen),
("itos", Builtin $ BIF _itos), ("itos", bif _itos),
("globals", Builtin $ BIF _globals), ("globals", bif _globals),
("locals", Builtin $ BIF _locals), ("locals", bif _locals),
("newStdEnv", Builtin $ BIF _newStdEnv), ("newStdEnv", bif _newStdEnv),
("eval", Builtin $ BIF _eval), ("eval", bif _eval),
("import", Builtin $ BIF _Import)]]) ("import", bif _Import)]]
eval :: AST -> InterpState Value eval :: AST -> InterpState Value
@ -463,4 +483,4 @@ evalFile path = do
else evalString contents else evalString contents
evalFileV :: FilePath -> IO Value evalFileV :: FilePath -> IO Value
evalFileV path = interpret $ evalFile path evalFileV = interpret . evalFile