Skip to content

Instantly share code, notes, and snippets.

@soupi
Last active January 21, 2022 16:23
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save soupi/c3257a6752e0414c16af124ccca9d86f to your computer and use it in GitHub Desktop.
Save soupi/c3257a6752e0414c16af124ccca9d86f to your computer and use it in GitHub Desktop.
How to use Reader and IORef for static scope and mutation
{-# options_ghc -Wall #-}
{-# language LambdaCase #-}
-- | Run repl with:
--
-- > cabal repl --build-depends containers --build-depends mtl
--
-- or
--
-- > stack exec --package containers --package mtl -- ghci
--
-- and then run with
--
-- > :load eval_with_reader.hs
-- > :main
import Data.Functor ((<&>))
import Data.Maybe (fromMaybe)
import qualified Data.Map as M
import Data.IORef
import Control.Monad.Reader
-- * Run
main :: IO ()
main = do
runEval print_1_1_2_1
putStrLn ""
runEval print_1_1_2_3_2
runEval :: [Stmt] -> IO ()
runEval = flip runReaderT mempty . eval
-- * Example programs
print_1_1_2_1 :: [Stmt]
print_1_1_2_1 =
[ Define "x" (Val 1)
, Print $ Var "x" -- 1
, Define "y" (Var "x")
, Print $ Var "y" -- 1
, Set "x" (Val 2)
, Print $ Var "x" -- 2
, Print $ Var "y" -- 1
]
print_1_1_2_3_2 :: [Stmt]
print_1_1_2_3_2 =
[ Define "x" (Val 1)
, Print $ Var "x" -- 1
, Define "y" $ Let "x" (Val 2) (Var "x")
, Print $ Var "x" -- 1
, Print $ Var "y" -- 2
, Set "x" (Val 3)
, Print $ Var "x" -- 3
, Print $ Var "y" -- 1
]
-- * Types
data Stmt
= Define Var Expr
| Set Var Expr
| Print Expr
type Var = String
data Expr
= Var Var
| Val Val
| Let Var Expr Expr
type Val = Int
type Env = M.Map Var (IORef Val)
-- * Eval
eval :: [Stmt] -> ReaderT Env IO ()
eval = \case
[] -> pure ()
Print var : stmts -> do
val <- evalExpr var
liftIO $ print val
eval stmts
Define var expr : stmts -> do
val <- evalExpr expr
ref <- liftIO $ newIORef val
local (M.insert var ref) $
eval stmts
Set var expr : stmts -> do
val <- evalExpr expr
ref <- lookupRef var
liftIO $ writeIORef ref val
eval stmts
evalExpr :: Expr -> ReaderT Env IO Val
evalExpr = \case
Val val ->
pure val
Var var -> do
ref <- lookupRef var
val <- liftIO $ readIORef ref
pure val
Let var bind body -> do
val <- evalExpr bind
ref <- liftIO $ newIORef val
local (M.insert var ref) $
evalExpr body
lookupRef :: Var -> ReaderT Env IO (IORef Val)
lookupRef var = asks (M.lookup var)
<&> fromMaybe (error "Not in env")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment