fixed calculator

master
nihonium 1 year ago
parent 4790712b97
commit 6d21a8d12a
No known key found for this signature in database
GPG Key ID: 0251623741027CFC

@ -46,23 +46,23 @@ opPriority (Number _) = 3
transform:: [Maybe Token] -> [Token] transform:: [Maybe Token] -> [Token]
-- tokens - stack - output -- tokens - stack - output
transform ts = transform' ts [] [] where transform ts = transform' ts [] [] where
transform' [] [] q = q transform' [] [] out = out
transform' [] s q = transform' [] st out =
if head s == ParenOpen if head st == ParenOpen
then error "Mismatched parentheses" then error "Mismatched parentheses"
else transform' [] (tail s) (q ++ [head s]) else transform' [] (tail st) (out ++ [head st])
transform' (x:xs) s q = case x of transform' (t:ts) st out = case t of
Nothing -> error "Illegal tokens" Nothing -> error "Illegal tokens"
(Just (Number n)) -> transform' xs s (q ++ [Number n]) Just (Number n) -> transform' ts st (out ++ [Number n])
(Just ParenOpen) -> transform' xs (ParenOpen:s) q Just ParenOpen -> transform' ts (ParenOpen:st) out
(Just ParenClose) -> transform' xs s0 q0 where Just ParenClose -> transform' ts st0 out0 where
s0 = tail $ dropWhile (/= ParenOpen) s st0 = tail $ dropWhile (/= ParenOpen) st
q0 = q ++ takeWhile (/= ParenOpen) s out0 = out ++ takeWhile (/= ParenOpen) st
(Just o1) -> transform' xs s1 q1 where Just o1 -> transform' ts st1 out1 where
cond o2 = isOp o2 && (opPriority o1 < opPriority o2) cond o2 = isOp o2 && (opPriority o1 <= opPriority o2)
spl = span cond s spl = span cond st
s1 = o1 : snd spl st1 = o1 : snd spl
q1 = q ++ fst spl out1 = out ++ fst spl
eval :: [Token] -> Token eval :: [Token] -> Token
eval ts = head $ eval' [] ts where eval ts = head $ eval' [] ts where
@ -74,8 +74,8 @@ eval ts = head $ eval' [] ts where
rem = tail . tail rem = tail . tail
in case t of in case t of
Number n -> eval' (t : st) ts Number n -> eval' (t : st) ts
AddOp -> eval' ((Number (fstNum st + sndNum st)) : (rem st)) ts AddOp -> eval' ((Number (sndNum st + fstNum st)) : (rem st)) ts
MulOp -> eval' ((Number (fstNum st * sndNum st)) : (rem st)) ts MulOp -> eval' ((Number (sndNum st * fstNum st)) : (rem st)) ts
DivOp -> 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 SubOp -> eval' ((Number (sndNum st - fstNum st)) : (rem st)) ts
eval' st [] = st eval' st [] = st