add mutable refs
This commit is contained in:
parent
d180116931
commit
5bae5645ec
70
Interp.hs
70
Interp.hs
|
@ -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")]),
|
||||||
("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
|
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
|
Loading…
Reference in New Issue