Mini interpreter with State

assign.cabal

name:                assign
version:             0.1.0.0
build-type:          Simple
extra-source-files:  README.md
cabal-version:       >=1.10

executable assign
  build-depends:       
      base       >= 4.6 && <4.7
    , containers >= 0.5 && <0.6
    , mtl        >= 2.2
  default-language:    Haskell2010
  main-is:             Main.hs

  Build-depends:       base, array
  build-tools:         alex, happy
  other-modules:       
    Parser,
    Lexer

Eval.hs

module Eval (eval) where

import Syntax
import Control.Monad.State
import qualified Data.Map as Map

data Value
  = VInt Int
  | VUnit

instance Show Value where
  show (VInt x) = show x

type Eval = StateT Env IO
type Env = [(String, Value)]

eval1 :: Expr -> Eval Value
eval1 expr = case expr of
  Num a -> return (VInt a)
  Var a -> do
    env <- get
    case lookup a env of
      Just val -> return val
      Nothing -> error "Not in scope"
  Print a -> do
    a' <- eval1 a
    liftIO $ print a'
    return VUnit
  Assign ref val -> do
    modify $ \s -> (ref, VInt val) : s
    return VUnit

eval :: [Expr] -> IO ()
eval xs = evalStateT (mapM_ eval1 xs) []

Lexer.x

{
module Lexer (
  Token(..),
  scanTokens
) where

import Syntax
}

%wrapper "basic"

$digit = 0-9
$alpha = [a-zA-Z]
$eol   = [\n]

tokens :-

  -- Whitespace insensitive
  $eol                          ;
  $white+                       ;
  print                         { \s -> TokenPrint }
  $digit+                       { \s -> TokenNum (read s) }
  \=                            { \s -> TokenEq }
  $alpha [$alpha $digit \_ \']* { \s -> TokenSym s }

{

data Token 
  = TokenNum Int
  | TokenSym String
  | TokenPrint
  | TokenEq
  | TokenEOF
  deriving (Eq,Show)

scanTokens = alexScanTokens

}

Main.hs

import Eval (eval)
import Parser (parseExpr)
import System.Environment

process :: String -> IO ()
process input = do
  let ast = parseExpr input
  case ast of
    Right ast -> eval ast
    Left err -> do
      putStrLn "Parser Error:"
      print err

main :: IO ()
main = do
  args <- getArgs
  case args of
    []      -> putStrLn "Usage: assign <input file>"
    [fname] -> do
      contents <- readFile fname
      process contents

Parser.y

{
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Parser (
  parseExpr,
) where

import Lexer
import Syntax

import Control.Monad.Except
}

%name expr
%tokentype { Token }
%monad { Except String } { (>>=) } { return }
%error { parseError }

%token
    int   { TokenNum $$ }
    var   { TokenSym $$ }
    print { TokenPrint }
    '='   { TokenEq }

%%

terms 
    : term                   { [$1] }
    | term terms             { $1 : $2 }

term 
   : var                     { Var $1 }
   | var '=' int             { Assign $1 $3 }
   | print term              { Print $2 }

{

parseError :: [Token] -> Except String a
parseError (l:ls) = throwError (show l)
parseError [] = throwError "Unexpected end of Input"

parseExpr :: String -> Either String [Expr]
parseExpr input = 
  let tokenStream = scanTokens input in
  runExcept (expr tokenStream)
}

Syntax.hs

module Syntax where

data Expr
  = Var String
  | Num Int
  | Print Expr
  | Assign String Int
  deriving (Eq,Show)

test.input

x = 4
print x
y = 5
print y