add mutable refs

Interp.hs

@@ -13,6 +13,7 @@ import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.State (StateT, runStateT, evalStateT, get, put)
 import System.IO (Handle, hPutStr, hGetLine, hClose, hIsEOF, hSetBuffering,
 		hSetBinaryMode, openBinaryFile, IOMode(..), BufferMode(NoBuffering), stdout, stdin)
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import System.Directory (doesFileExist)
 import System.FilePath (FilePath, splitExtension, takeBaseName, takeDirectory, (</>))
 import System.Environment (getExecutablePath)
@@ -32,6 +33,7 @@ data Value = IntV Integer
 		   | TupleV [Value]
 		   | ListV [Value]
 		   | DictV (M.Map Value Value)
+		   | RefV (IORef Value)
 		   | Builtin BIF
 		   | FnV Env [(Pattern, AST)] -- closure pattern->body bindings
 		   deriving (Eq)
@@ -74,6 +76,7 @@ instance Show Value where
 	show (FnV _ _) = "<fn>"
 	show (StreamV _) = "<stream>"
 	show (Builtin _) = "<built-in>"
+	show (RefV _) = "<ref>"
 
 -- value operators
 (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 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
 	v <- apply fn arg
 	if v /= BoolV False then
@@ -224,30 +239,35 @@ _Import (StrV modname) = do
 					if exists then return (path, takeBaseName path)
 					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")]),
-						   		("stdout", StreamV stdout),
+                            ("loop", bif _loop),
-						   		("stdin", StreamV stdin),
+                            ("ref!", bif _ref),
-						   		("print", Builtin $ BIF _print),
+                            ("readRef!", bif _readRef),
-						   		("putstr", Builtin $ BIF _putstr),
+                            ("setRef!", bif _setRef),
-						   		("putstrln", Builtin $ BIF (\x -> _putstr $ x +$ StrV "\n")),
+                            ("repr", bif _repr),
-						   		("getline", Builtin $ BIF _getline),
+                            ("stdout", StreamV stdout),
-						   		("fgetline", Builtin $ BIF _fgetline),
+                            ("stdin", StreamV stdin),
-						   		("putbytes", Builtin $ BIF _putbytes),
+                            ("print", bif _print),
-						   		("fputbytes", Builtin $ BIF _fputbytes),
+                            ("putstr", bif _putstr),
-						   		("fputstr", Builtin $ BIF _fputstr),
+                            ("putstrln", bif (\x -> _putstr $ x +$ StrV "\n")),
-						   		("freadbytes", Builtin $ BIF _freadbytes),
+                            ("getline", bif _getline),
-						   		("feof", Builtin $ BIF _feof),
+                            ("fgetline", bif _fgetline),
-						   		("fclose", Builtin $ BIF _fclose),
+                            ("putbytes", bif _putbytes),
-						   		("fopen", Builtin $ BIF _fopen),
+                            ("fputbytes", bif _fputbytes),
-						   		("sockopen", Builtin $ BIF _sockopen),
+                            ("fputstr", bif _fputstr),
-						   		("itos", Builtin $ BIF _itos),
+                            ("freadbytes", bif _freadbytes),
-						   		("globals", Builtin $ BIF _globals),
+                            ("feof", bif _feof),
-						   		("locals", Builtin $ BIF _locals),
+                            ("fclose", bif _fclose),
-						   		("newStdEnv", Builtin $ BIF _newStdEnv),
+                            ("fopen", bif _fopen),
-						   		("eval", Builtin $ BIF _eval),
+                            ("sockopen", bif _sockopen),
-						   		("import", Builtin $ BIF _Import)]])
+                            ("itos", bif _itos),
+                            ("globals", bif _globals),
+                            ("locals", bif _locals),
+                            ("newStdEnv", bif _newStdEnv),
+                            ("eval", bif _eval),
+                            ("import", bif _Import)]]
 
 eval :: AST -> InterpState Value
 
@@ -463,4 +483,4 @@ evalFile path = do
 	else evalString contents
 
 evalFileV :: FilePath -> IO Value
-evalFileV path = interpret $ evalFile path
+evalFileV = interpret . evalFile