import Control.Monad.State
import Data.Map

-- the types SExp, Value of S-expressions and values

data SExp v = Lit v | Sym String | Form [SExp v]
data Value = Int Int | String String | Fn ([Value] -> Interp Value)

instance Show Value where
    show (Int i) = "Int "++show i
    show (String s) = "String "++show s
    show (Fn _) = "<function>"

-- the monad Interp

newtype Interp a = Interp { unInterp :: State (Map String Value) a }
instance Monad Interp where
    return x = Interp $ return x
    m >>= f = Interp $ do x <- unInterp m
                          unInterp $ f x
getTable :: String -> Interp Value
getTable s = Interp $ do table <- get
                         return (table ! s)
putTable :: String -> Value -> Interp ()
putTable s v = Interp $ do table <- get
                           put $ insert s v table
runInterp :: Map String Value -> Interp a -> a
runInterp table m = evalState (unInterp m) table

-- the interpreter

eval :: SExp Value -> Interp Value
eval (Lit x) = return x
eval (Sym s) = getTable s
eval (Form (head:args)) = do h <- eval head
                             a <- mapM eval args
                             case h of
                               Fn f -> f a

prelude :: Map String Value
prelude = insert "+" (Fn $ \[Int a, Int b] -> return $ Int $ a + b)
          empty  -- it's a start..

run :: SExp Value -> Value
run e = runInterp prelude $ eval e

-- it works!
-- > run $ Form [Sym "+", Lit (Int 3), Lit (Int 5)]
-- Int 8