An AST interpreter example for language with scoped variables and addition, subtraction, logical and/or.

interpreter.hs

import Control.Monad.State.Lazy
import Data.Map.Strict qualified as Map
import Data.Maybe

-- Operator token in AST
data Op = Plus | Minus | And | Or deriving (Show)

-- Variable name in AST
newtype VarName = VarName String deriving (Show, Ord, Eq)

-- Node of AST
data Expr
  = Var VarName -- Named variable
  | Num Int -- Integer constant
  | BinOp (Expr, Op, Expr) -- Binary operator and two operands
  | If (Expr, Expr, Expr) -- If expression with condition, branch of yes and branch of no
  | Let (VarName, Expr, Expr) -- Variable assignment with new value, and then evaluate with it
  | WhilePos (VarName, VarName, Expr, Expr) -- Loop evaluating and assignment two expression while the first is positive
  deriving (Show)

-- Result of evaluation
data Result = Bool Bool | Int Int | RuntimeError deriving (Show)

-- Evaluation context with evaluated result bound by variable name
type Env = Map.Map VarName Result

-- Interpreter for AST, using variables context
type Interpreter = State Env Result

-- Adds two results, or fails they are not integers
add :: Result -> Result -> Result
add (Int l) (Int r) = Int (l + r)
add _ _ = RuntimeError

-- Subtracts the second from the first, or fails they are not integers
sub :: Result -> Result -> Result
sub (Int l) (Int r) = Int (l - r)
sub _ _ = RuntimeError

-- logical-and two results, or fails they are not booleans
logicalAnd :: Result -> Result -> Result
logicalAnd (Bool l) (Bool r) = Bool (l && r)
logicalAnd _ _ = RuntimeError

-- logical-or two results, or fails they are not booleans
logicalOr :: Result -> Result -> Result
logicalOr (Bool l) (Bool r) = Bool (l || r)
logicalOr _ _ = RuntimeError

-- returns whether the given is less than or equal to zero.
isNonPositive :: Result -> Bool
isNonPositive (Int n) = n <= 0
isNonPositive _ = False

-- Evaluates an AST Node with evaluation context
eval :: Expr -> Interpreter
eval (Var name) = do
  fromMaybe RuntimeError . Map.lookup name <$> get
eval (Num n) = do
  return $ Int n
eval (BinOp (lhs, Plus, rhs)) = do
  l <- eval lhs
  r <- eval rhs
  return $ add l r
eval (BinOp (lhs, Minus, rhs)) = do
  l <- eval lhs
  r <- eval rhs
  return $ sub l r
eval (BinOp (lhs, And, rhs)) = do
  l <- eval lhs
  r <- eval rhs
  return $ logicalAnd l r
eval (BinOp (lhs, Or, rhs)) = do
  l <- eval lhs
  r <- eval rhs
  return $ logicalOr l r
eval (If (cond, yes, no)) = do
  c <- eval cond
  case c of
    Bool True -> eval yes
    Bool False -> eval no
    _ -> return RuntimeError
eval (Let (name, value, body)) = do
  old_value <- gets $ Map.lookup name
  new_value <- eval value
  modify $ Map.insert name new_value
  ret <- eval body
  maybe (return ()) (modify . Map.insert name) old_value
  return ret
eval (WhilePos (cond_name, acc_name, cond_next, body)) = do
  cond_next_value <- eval cond_next
  body_value <- eval body
  case cond_next_value of
    Int n | n <= 0 -> return body_value
    _ -> do
      modify $ Map.insert cond_name cond_next_value
      modify $ Map.insert acc_name body_value
      ret <- eval (WhilePos (cond_name, acc_name, cond_next, body))
      modify $ Map.delete cond_name
      modify $ Map.delete acc_name
      return ret

interpreter_example.hs

example :: Expr
example =
  Let
    ( VarName "x"
    , Num 3
    , Let
        ( VarName "y"
        , Num 4
        , Let
            ( VarName "z"
            , Num 0
            , WhilePos
                ( VarName "x"
                , VarName "z"
                , BinOp (Var (VarName "x"), Minus, Num 1)
                , BinOp (Var (VarName "y"), Plus, Var (VarName "z"))
                )
            )
        )
    )

main :: IO ()
main = print $ evalState (eval example) Map.empty