RosettaCodeData/Task/Parsing-Shunting-yard-algorithm/Haskell/parsing-shunting-yard-algorithm-1.hs

33 lines
1 KiB
Haskell
Raw Permalink Normal View History

2013-10-27 22:24:23 +00:00
import Text.Printf
prec "^" = 4
prec "*" = 3
prec "/" = 3
prec "+" = 2
prec "-" = 2
leftAssoc "^" = False
leftAssoc _ = True
2014-01-17 05:32:22 +00:00
isOp (t:[]) = t `elem` "-+/*^"
isOp _ = False
2013-10-27 22:24:23 +00:00
simSYA xs = final ++ [lastStep]
where final = scanl f ([],[],"") xs
lastStep = (\(x,y,_) -> (reverse y ++ x, [], "")) $ last final
2015-02-20 00:35:01 -05:00
f (out,st,_) t | isOp t =
2013-10-27 22:24:23 +00:00
(reverse (takeWhile testOp st) ++ out
, (t:) $ (dropWhile testOp st), t)
2015-02-20 00:35:01 -05:00
| t == "(" = (out, "(":st, t)
| t == ")" = (reverse (takeWhile (/="(") st) ++ out,
2013-10-27 22:24:23 +00:00
tail $ dropWhile (/="(") st, t)
2015-02-20 00:35:01 -05:00
| otherwise = (t:out, st, t)
2013-10-27 22:24:23 +00:00
where testOp x = isOp x && (leftAssoc t && prec t == prec x
|| prec t < prec x)
main = do
a <- getLine
printf "%30s%20s%7s" "Output" "Stack" "Token"
mapM_ (\(x,y,z) -> printf "%30s%20s%7s\n"
(unwords $ reverse x) (unwords y) z) $ simSYA $ words a