add helper lookup function
This commit is contained in:
parent
1723239d9b
commit
314458e445
12
interp.hs
12
interp.hs
|
@ -1,4 +1,5 @@
|
||||||
module Interp where
|
module Interp where
|
||||||
|
import Prelude hiding (lookup)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Control.Monad.State (State, runState, evalState, get, put)
|
import Control.Monad.State (State, runState, evalState, get, put)
|
||||||
import System.IO (Handle, hPutStr, hGetLine, hFlush, stdout, stdin)
|
import System.IO (Handle, hPutStr, hGetLine, hFlush, stdout, stdin)
|
||||||
|
@ -23,6 +24,9 @@ data Value = IntV Integer
|
||||||
type Env = M.Map String Value -- an environment
|
type Env = M.Map String Value -- an environment
|
||||||
type InterpState = State ([Handle], Env) -- interpreter state (open handles, global env)
|
type InterpState = State ([Handle], Env) -- interpreter state (open handles, global env)
|
||||||
|
|
||||||
|
lookup :: Env -> String -> Maybe Value
|
||||||
|
lookup env name = M.lookup name env
|
||||||
|
|
||||||
(IntV l) +$ (IntV r) = IntV (l + r)
|
(IntV l) +$ (IntV r) = IntV (l + r)
|
||||||
(StrV l) +$ (StrV r) = StrV (l ++ r)
|
(StrV l) +$ (StrV r) = StrV (l ++ r)
|
||||||
l +$ r = error $ "cannot + " ++ show l ++ " and " ++ show r
|
l +$ r = error $ "cannot + " ++ show l ++ " and " ++ show r
|
||||||
|
@ -70,8 +74,8 @@ eval (ListConst v) =
|
||||||
mapM eval v >>= \xs ->
|
mapM eval v >>= \xs ->
|
||||||
return $ ListV xs
|
return $ ListV xs
|
||||||
|
|
||||||
eval (Var var) = get >>= \(_,m) ->
|
eval (Var var) = get >>= \(_,env) ->
|
||||||
case M.lookup var m of
|
case lookup env var of
|
||||||
Just v -> return v
|
Just v -> return v
|
||||||
Nothing -> error $ "unbound variable " ++ var
|
Nothing -> error $ "unbound variable " ++ var
|
||||||
|
|
||||||
|
@ -89,8 +93,8 @@ eval (Add l r) = do
|
||||||
r <- eval r
|
r <- eval r
|
||||||
return $ l +$ r
|
return $ l +$ r
|
||||||
|
|
||||||
eval (Call name args) = get >>= \(_,m) ->
|
eval (Call name args) = get >>= \(_,env) ->
|
||||||
case M.lookup name m of
|
case lookup env name of
|
||||||
Just fn@(FnV _) ->
|
Just fn@(FnV _) ->
|
||||||
do
|
do
|
||||||
xargs <- mapM eval args
|
xargs <- mapM eval args
|
||||||
|
|
Loading…
Reference in New Issue