RecursiveExplicit.hs

module RecursiveExplicit where

import Prelude hiding (sum)
import Data.Char (isDigit)

type Stack = [(Integer, Char)]

readInt :: String -> Integer
readInt = read

sumInvoker :: Stack -> String -> Integer
sumInvoker stack str = prodInvoker ((0, '+') : stack) str

sum :: Integer -> Stack -> String -> Integer
sum start stack str = case stack of
  (i, '+') : remStack -> case str of
    '+' : rest -> prodInvoker ((i + start, '+') : stack) rest
    rest -> dispatcher (i + start) remStack rest
  _ -> error $ "wrong stack state, (int, '+') expected on top " ++ show stack

prodInvoker :: Stack -> String -> Integer
prodInvoker stack str = exprInvoker ((1, '*') : stack) str

prod :: Integer -> Stack -> String -> Integer
prod start stack str = case stack of
  (i, '*') : remStack -> case str of
    '*' : rest -> exprInvoker ((i * start, '*') : stack) rest
    rest -> dispatcher (i * start) remStack rest
  _ -> error $ "wrong stack state, (int, '*') expected on top " ++ show stack

exprInvoker :: Stack -> String -> Integer
exprInvoker stack str = case str of
  '(' : rest -> sumInvoker ((0, 'e') : stack) rest
  x : rest -> if isDigit x
              then dispatcher (read [x]) stack rest
              else error $ x : ": unknown char"
  [] -> error "unexpected end of expression"

expr :: Integer -> Stack -> String -> Integer
expr start stack str = case stack of
  (i, 'e') : remStack -> case str of
    ')' : rest -> dispatcher start remStack rest
    _ -> error "closing parenthesis expected"
  _ -> error $ "wrong stack state, (int, 'e') expected on top" ++ show stack

-- end of line is managed by dispatcher
dispatcher :: Integer -> Stack -> String -> Integer
dispatcher start stack str = case stack of
  [] -> case str of
    [] -> start
    _  -> error $ "stack underflow, remaining string: " ++ str
  (_, '+') : _ -> sum start stack str
  (_, '*') : _ -> prod start stack str
  (_, 'e') : _ -> expr start stack str
  _ -> error $ "something strange on the stack: " ++ show stack

compute :: String -> Integer
compute str = sumInvoker [] str