Задача: интерактивный (read-eval loop) калькулятор с поддержкой присваивания переменным, приоритетами и ассоциативностью. Парсер принципиально с нуля.

Что можно улучшить?

Я как-то боюсь добавлять сюда обработку ошибок — кажется оно станет совсем нечитаемым тогда.

import IO
import Char
import Data.Map

main = do hSetBuffering stdout NoBuffering
          readEvalLoop Data.Map.empty

readEvalLoop env = do putStr ">>> "
                      s <- getLine
                      (result,newenv) <- return $ eval s env 
                      putStr result
                      readEvalLoop newenv

eval s env = case (tokenize s) of
             [] -> ("",env)
             ts -> let (rv,newenv) = (calculate ts env) in (show rv ++ "\n", newenv)

tokenize :: String -> [Token]
tokenize []                           = []
tokenize (c:cs) | isSpace(c)          = tokenize cs
                | c `elem` "=+-/*^()" = (Symbol c):(tokenize cs)
                | isDigit(c)          = readNumber [c] cs
                | isAlpha(c)         = readIdent [c] cs

readNumber num []                     = [Number (read num)]
readNumber num s@(c:cs) | c == '.'    = readDigits (num ++ [c]) cs
                        | isDigit(c)  = readNumber (num ++ [c]) cs
                        | True        = (Number (read num)):(tokenize s)

readDigits num []                     = [Number (read num)]
readDigits num s@(c:cs) | isDigit(c)  = readDigits (num ++ [c]) cs
                        | True        = (Number (read num)):(tokenize s)

readIdent name []                     = [Ident name]
readIdent name s@(c:cs) | isAlphaNum(c) = readIdent (name ++ [c]) cs
                        | otherwise   = (Ident name):(tokenize s)

data Token = Number Float
           | Symbol Char
           | Ident String

calculate [Number x] env = (x, env)
calculate ts env = case (reduce ts [0] env) of
                   (val, [], newenv) -> (val, newenv)

reduce :: [Token] -> [Integer] -> Data.Map.Map String Float -> (Float, [Token], Data.Map.Map String Float)
reduce [Number x] (p:ps) env = (x, [], env)
reduce (Symbol '(' : rest) (p:ps) env = reduce rest (0:p:ps) env
reduce (Number x : Symbol ')' : rest) (p:ps) env | p == 0 = reduce (Number x : rest) ps env
                                                 | p > 0  = (x, Symbol ')' : rest, env)
reduce (Symbol '-' : rest) (p:ps) env = let (x, zs, newenv) = reduce rest (priority 'u':ps) env
                                        in reduce (Number (-x) : zs) (p:ps) newenv
reduce (Number x : Symbol op : rest) (p:ps) env = if priority op < p || not (isRightAssoc op) && priority op == p
    then (x, Symbol op : rest, env)
    else let (y,zs,newenv) = reduce rest (priority op : ps) env
         in reduce (Number (arithmetic x op y) : zs) (p:ps) newenv
reduce (Ident v : Symbol '=' : rest) (p:ps) env = if priority '=' < p 
    then case Data.Map.lookup v env :: Maybe Float of
         Just x -> (x, Symbol '=' : rest, env) -- this is impossible, but let's handle it anyway
    else let (y,zs,ne) = reduce rest (priority '=' : ps) env
             newenv = Data.Map.insert v y ne
         in reduce (Ident v : zs) (p:ps) newenv
reduce (Ident v : rest) pps env = case Data.Map.lookup v env :: Maybe Float of
                                  Just x -> reduce (Number x : rest) pps env

priority op = case op of
              '=' -> 1
              '+' -> 2 ; '-' -> 2
              '*' -> 3 ; '/' -> 3
              'u' -> 4 -- unary minus
              '^' -> 5

isRightAssoc op | op == '^' = True
                | otherwise = False

arithmetic :: Float -> Char -> Float -> Float
arithmetic x '+' y = x + y
arithmetic x '-' y = x - y
arithmetic x '*' y = x * y
arithmetic x '/' y = x / y
arithmetic x '^' y = x ** y