Toy Forth interpreter

I've been reading too many papers and writing too little code. These are my first 300 lines of Haskell:

```
{-# LANGUAGE NoMonomorphismRestriction, TemplateHaskell #-}

module Forth where

import qualified Data.Map.Lazy as Map

import Control.Monad.State
import Control.Monad.Error

import Text.Read (readMaybe)

import Text.Parsec
import Control.Applicative hiding ((), optional, many)

import Control.Lens
import Control.Lens.Operators

import Safe

data Forth = Forth {
_stack :: [Integer],
_loopStack :: [Integer],
_heap :: Map.Map String [Exp]} deriving (Show)

data Exp = Cmt String | Dump | Num Integer | Plus | Min | Mul | Div | Mod | Dup | Swap | Drop | PP
| LoopIndex Int | In | Out String | CR | Eq | Lt | Gt
| Word String [Exp] | Call String | If [Exp] [Exp] | DoLoop [Exp] Bool | Leave
deriving (Show)

makeLenses ''Forth

type ForthS a = ErrorT String (StateT Forth IO) a

emptyForth :: Forth
emptyForth = Forth [] [] Map.empty

pushStack :: Integer -> ForthS ()
pushStack n = stack %= (n:)

popStack :: ForthS Integer
popStack = do
s throwError "Empty stack. Can't pop!"
(n:ns) -> do
stack .= ns
return n

dumpStack :: ForthS [Integer]
dumpStack = zoom stack get
--

pushLoopStack :: Integer -> ForthS ()
pushLoopStack n = loopStack %= (n:)

popLoopStack :: ForthS Integer
popLoopStack = do
s throwError "Empty loop stack. Can't pop!"
(n:ns) -> do
loopStack .= ns
return n

--(.?) :: MonadState s m => Getting s1 s s1 -> Getting (f a) s1 a -> m (Maybe a)
(.?) a b = do
v ForthS Integer
peekLoopStack i = do
--a return n
Nothing -> throwError $ "Loop stack is empty."

--
setWord :: String -> [Exp] -> ForthS ()
setWord word val = heap %= (Map.insert word val)

getWord :: String -> ForthS [

I think popStack might look a little nicer using the LambdaCase extension:

popStack :: ForthS Integer
popStack = use stack >>= \case
  []     -> throwError "Empty stack. Can't pop!"
  (n:ns) -> stack .= ns >> return n

The same transformation can occur with popLoopStack. It also applies to peekLoopStack, but in that case, you might even use maybe rather than a language extension:

peekLoopStack :: Int -> ForthS Integer
peekLoopStack = maybe (throwError "Loop stack is empty.") return
              . zoom loopStack . gets . flip atMay

You could also use maybe to eliminate the do in getWord.

You have a lot of binary operators. Each one is implemented like this:

eval (Plus) = do
  a <- popStack
  b <- popStack
  pushStack (b+a)

I think that’s a little repetitive. I might define a little helper function:

binop :: (Integer -> Integer -> Integer) -> Eval
binop f = do
  a <- popStack
  b <- popStack
  pushStack (f b a)

Then you can define your operators like this:

eval Plus = binop (+)
eval Min  = binop (-)
eval Mul  = binop (*)
-- ...

This leaves less room for error.

In a similar vein to the first suggestion, you might try to eliminate the do from Call:

eval (Call key) = getWord key >>= mapM_ eval

xor is /=. There is no need to define xor when you could just use /=.

forthExp

comments >>= pure . Cmt can be replaced with fmap Cmt comments or Cmt comments. Similarly for integer, stringLike, and calls.

char '-' *> pure Min can be replaced with Min <$ char '-'. Similarly for the others.

The outer structure, too, can probably be changed. Rather than using

foldl1 () $ map (\e-> e  eof))

I think this would be clearer:

choice $ map (( eof)) . try)

I would avoid the name ifThenElse, as that is used by GHC’s RebindableSyntax extension should you ever want to use it in the future.

Transformer stack

Your transformer stack looks okay, but I might consider replacing the underlying IO with a free monad providing only the operations (input, output) you need, and then provide an interpreter to use IO. This makes it trivial to test, as you can make it pure by just inspecting the resulting structure rather than using the IO interpreter. See this blog post for more details.

StackExchange Code Review Q#33483, answer score: 5