Tukukkk

I have been studying Haskell by myself for about a little over a year. And I have been stuck at monad/monad transformers for quite a while until recently some examples I read online enlightened me. So I decided to try on the following problem with writing monadic Haskell code.

The problem is to evaluate a string that contains only 0-9, +, - and *, which represents addition, subtraction and multiplication separately. The string itself should represent a valid math expression and starts with a number always.

"3+5" -> 8

"3+25*4" -> 103

"1-2*2*2+7" -> 7

The goal of the exercise is not to write a perfect parsing engine to evaluate any math expression but to try to learn to use monad as a tool to write program that could be relatively straight forward in an imperative language such as C++, for example:

#include <stack>

#include <iostream>

#include <string>

#include <stdexcept>



using namespace std;



int calc(char c, int n1, int n2)

{

    // cout << c << "-->" << n1 << " and " << n2 << endl;

    if (c == '+') return n1+n2;

    else if (c == '-') return n1-n2;

    else if (c == '*') return n1*n2;

    else throw runtime_error("bad operator");

}



void update(stack<int>& numbers, stack<char>& operators)

{

    if (operators.size() + 1 != numbers.size()) throw runtime_error("bad");

    char op = operators.top();

    operators.pop();



    int n2 = numbers.top();

    numbers.pop();



    int n1 = numbers.top();

    numbers.pop();



    numbers.push(calc(op, n1, n2));

}



int processMath(const string& input) {

    int num = 0;



    stack<int> numbers;

    stack<char> operators;



    for (char c : input) {

        if (c == '+' || c == '-' || c == '*') {

            numbers.push(num);

            num = 0; // reset number

            if (c == '*' && !operators.empty() && operators.top() == '*') {

                update(numbers, operators);

            } else if (c == '+' || c == '-') { // c is + or -

                while (!operators.empty()) update(numbers, operators);

            }

            operators.push(c);

        } else {

            num = num*10+(c-'0');

            // cout << "num=" << num << endl;

        }

    }

    numbers.push(num);

    while (!operators.empty()) update(numbers, operators);

    return numbers.top();

}



// To execute C++, please define "int main()"

int main() {



    string exp1 = "13+15";

    string exp2 = "3+25*4";

    string exp3 = "1-2*2*2+7";



    cout << exp1 << endl << processMath(exp1) << endl << endl;

    cout << exp2 << endl << processMath(exp2) << endl << endl;

    cout << exp3 << endl << processMath(exp3) << endl << endl;



    return 0;

}

The following part is the haskell program I came up with, without using anything specific for parsing or math evaluation.

import Control.Monad.State

import Data.Char



data MathStacks = MathStacks { numbers :: [Int]

                             , operators :: [Char] 

                             , current :: Int }

                             deriving Show



data EvalErr = ParseErr { position :: Int, reason :: String } 

             | StackErr String 

             | OpErr String

             deriving Show



collapseOn :: MathStacks -> [Char] -> Either EvalErr MathStacks

collapseOn ms@(MathStacks ns ops _) permittedOps

    | null ops = return ms

    | length ns < 2 = Left $ StackErr ("numbers length < 2:" ++ show ns)

    | not $ op `elem` "+-*" = Left $ OpErr ("invalid op=" ++ [op])

    | not $ op `elem` permittedOps = return ms

    | otherwise = do

        n <- calc op n1 n2

        return $ ms { numbers=(n:nrest), operators=oprest }

    where (n2:n1:nrest) = ns

          (op:oprest) = ops



calc :: Char -> Int -> Int -> Either EvalErr Int

calc c n1 n2 

    | c == '+' = return $ n1 + n2

    | c == '-' = return $ n1 - n2

    | c == '*' = return $ n1 * n2

    | otherwise = Left $ OpErr ("invalid op=" ++ [c])



exec :: MathStacks -> Either EvalErr MathStacks

exec ms@(MathStacks ns ops curr)

    | nlen /= olen + 1 = Left $ StackErr ("inconsistent stacks")

    | olen == 0 = Right ms

    | otherwise = do 

        let (n2:n1:nrest) = ns 

            (op:oprest) = ops

        n <- calc op n1 n2

        return $ MathStacks (n:nrest) oprest curr

    where nlen = length ns

          olen = length ops



exec' :: MathStacks -> Either EvalErr MathStacks

exec' ms@(MathStacks ns ops _) 

    | null ops = return ms

    | otherwise = (exec ms) >>= exec'



eval :: MathStacks -> Either EvalErr Int

eval (MathStacks ns ops curr) 

    | nlen /= 1 || olen /= 0 = Left $ StackErr ("inconsistent stacks")

    | otherwise = Right $ head ns

    where nlen = length ns

          olen = length ops



horner :: Int -> Int -> Int

horner digit num = num * 10 + digit



updateCurr :: Int -> MathStacks -> MathStacks

updateCurr digit ms@(MathStacks _ _ curr) = ms { current=horner digit curr }



updateOps :: Char -> MathStacks -> Either EvalErr MathStacks

updateOps op ms@(MathStacks _ ops _) 

    | op `elem` ['+', '-', '*'] = return $ ms { operators=(op:ops) }

    | otherwise = Left $ OpErr ("invalid op=" ++ [op])



updateNum :: MathStacks -> MathStacks

updateNum ms@(MathStacks ns _ curr) = ms { numbers=(curr:ns), current=0 }



parse :: (Char, Int) -> MathStacks -> Either EvalErr MathStacks

parse (c, idx) ms@(MathStacks ns ops curr) 

    | c `elem` ['+', '-', '*'] = do

        -- current number run is done

        let ms0 = updateNum ms

        -- if there is existing multiplication on top. collapse it

        ms1 <- collapseOn ms0 "*"

        ms2 <- if c == '+' || c == '-' 

            -- if there is existing addition or subtraction, do it

            then collapseOn ms1 "+-"

            else return ms1 

        updateOps c ms2

    | isDigit c = Right $ updateCurr (digitToInt c) ms

    | otherwise = Left $ 

        ParseErr idx ("err char at pos=" ++ show idx ++ " char:" ++ [c])

    where nlen = length ns

          olen = length ops



updateOnceT :: StateT MathStacks (Either EvalErr) ()

updateOnceT = do --  in side of StateT MathStacks (Either EvalErr) monad

    ms <- get

    ms' <- lift $ exec ms

    put ms'



evalCharT :: (Char, Int) -> StateT MathStacks (Either EvalErr) ()

evalCharT (c, idx) = do

    ms <- get -- ms :: MathStacks

    -- promotes from Either EvalErr MathStacks type to StateT monad

    ms' <- lift $ parse (c, idx) ms 

    put ms'





evalStringT :: String -> StateT MathStacks (Either EvalErr) ()

evalStringT s = mapM_ evalCharT $ zip s [1..]



evalStringE :: String -> Either EvalErr MathStacks

evalStringE s = foldM (flip parse) emptyStack $ zip s [1..]



calcStringE :: String -> Either EvalErr MathStacks

calcStringE s = do

    (_, ms) <- (runStateT $ evalStringT s) emptyStack 

    return ms





top :: MathStacks -> Either EvalErr Int

top ms = do

    let ns = numbers ms

    if null ns 

        then Left $ StackErr "no value left"

        else return $ head ns



calcString :: String -> Either EvalErr Int

calcString s = do 

    ms <- evalStringE s -- or use ms <- calcStringE s

    ms' <- exec' $ updateNum ms

    top ms'



emptyStack = MathStacks   0



main :: IO ()

main = do 

    print $ calcString "13+15"

    print $ calcString "3+25*4"

    print $ calcString "1-2*2*2+7"

The solution is a much longer program than the C++ counterpart, which is not the impression I got with Haskell program. The part that I used StateT monad transformer is probably not necessary (function evalStringT and function calcStringE), however without these functions I don't think my solution will get much shorter. I am not even sure my solution is Haskellish enough so please point out anything that I can improve on my code. Thank you in advance.