You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
87 lines
2.8 KiB
Haskell
87 lines
2.8 KiB
Haskell
module Main where
|
|
|
|
import Data.Char
|
|
import qualified Data.Map as M
|
|
|
|
data Token = Number Double | ParenOpen | ParenClose | AddOp | MulOp | DivOp | SubOp deriving (Show, Eq)
|
|
|
|
isOp:: Token -> Bool
|
|
isOp AddOp = True
|
|
isOp MulOp = True
|
|
isOp DivOp = True
|
|
isOp SubOp = True
|
|
isOp _ = False
|
|
|
|
scanNumber:: String -> (Double, String)
|
|
scanNumber xs = (num, str) where
|
|
(n, str) = span isNumber xs
|
|
num = read n :: Double
|
|
|
|
opmap:: M.Map Char Token
|
|
opmap = M.fromList [ ('+', AddOp), ('*', MulOp), ('/', DivOp), ('(', ParenOpen), ('-', SubOp), (')', ParenClose)]
|
|
|
|
tokenize:: String -> [Maybe Token]
|
|
tokenize s = loop s [] where
|
|
loop str tokens
|
|
| null str = tokens
|
|
| isNumber $ head str = let
|
|
(num, str') = scanNumber str
|
|
tokens' = tokens ++ [Just (Number num)]
|
|
in loop str' tokens'
|
|
-- Skip whitespaces
|
|
| (\c -> c == ' ') $ head str = loop (tail str) tokens
|
|
-- Otherwise lookup for op
|
|
| otherwise = loop (tail str) (tokens ++ [M.lookup (head str) opmap])
|
|
|
|
opPriority :: Token -> Int
|
|
opPriority AddOp = 0
|
|
opPriority SubOp = 0
|
|
opPriority MulOp = 1
|
|
opPriority DivOp = 1
|
|
opPriority ParenOpen = 2
|
|
opPriority ParenClose = 2
|
|
opPriority (Number _) = 3
|
|
|
|
-- Shunting yard algo
|
|
transform:: [Maybe Token] -> [Token]
|
|
-- tokens - stack - output
|
|
transform ts = transform' ts [] [] where
|
|
transform' [] [] out = out
|
|
transform' [] st out =
|
|
if head st == ParenOpen
|
|
then error "Mismatched parentheses"
|
|
else transform' [] (tail st) (out ++ [head st])
|
|
transform' (t:ts) st out = case t of
|
|
Nothing -> error "Illegal tokens"
|
|
Just (Number n) -> transform' ts st (out ++ [Number n])
|
|
Just ParenOpen -> transform' ts (ParenOpen:st) out
|
|
Just ParenClose -> transform' ts st0 out0 where
|
|
st0 = tail $ dropWhile (/= ParenOpen) st
|
|
out0 = out ++ takeWhile (/= ParenOpen) st
|
|
Just o1 -> transform' ts st1 out1 where
|
|
cond o2 = isOp o2 && (opPriority o1 <= opPriority o2)
|
|
spl = span cond st
|
|
st1 = o1 : snd spl
|
|
out1 = out ++ fst spl
|
|
|
|
eval :: [Token] -> Token
|
|
eval ts = head $ eval' [] ts where
|
|
eval' :: [Token] -> [Token] -> [Token]
|
|
eval' st (t:ts) = let
|
|
numFromToken (Number n) = n
|
|
fstNum = numFromToken . head
|
|
sndNum = numFromToken . head . tail
|
|
rem = tail . tail
|
|
in case t of
|
|
Number n -> eval' (t : st) ts
|
|
AddOp -> eval' ((Number (sndNum st + fstNum st)) : (rem st)) ts
|
|
MulOp -> eval' ((Number (sndNum st * fstNum st)) : (rem st)) ts
|
|
DivOp -> eval' ((Number (sndNum st / fstNum st)) : (rem st)) ts
|
|
SubOp -> eval' ((Number (sndNum st - fstNum st)) : (rem st)) ts
|
|
eval' st [] = st
|
|
|
|
main = do
|
|
s <- getLine
|
|
let Number res = eval $ transform $ tokenize s
|
|
print res
|