Last active
May 10, 2023 05:34
-
-
Save reverofevil/a444760c1aaa87fcffa0d794b1825c5f to your computer and use it in GitHub Desktop.
Shunting yard algorithm in Haskell
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import qualified Data.Map.Lazy as M | |
import Data.Maybe | |
data Assoc = L | R deriving (Eq, Show) | |
-- operator table | |
table = [ | |
(["||"], 20, L), | |
(["&&"], 30, L), | |
(["|"], 40, L), | |
(["^"], 50, L), | |
(["&"], 60, L), | |
(["===", "!==", "==", "!="], 70, L), | |
(["<=", ">=", "<", ">"], 80, L), | |
(["<<", ">>>", ">>"], 90, L), | |
(["+", "-"], 100, L), | |
(["*", "/", "%"], 110, L), | |
(["**"], 120, R)] | |
-- transform table into a Map | |
ot = M.fromList $ do | |
(ops, prec, assoc) <- table | |
op <- ops | |
return (op, (prec, assoc)) | |
-- find priority and associativity by name | |
desc o = fromJust $ M.lookup o ot | |
-- check if operator steals right operand from another operator | |
cmp (p1, a1) (p2, _) = pd > 0 || pd == 0 && a1 == L where | |
pd = p2 - p1 | |
-- create AST node for operator call | |
update top (v1, o2) = Call o2 [v1, top] | |
-- syntax trees that we're generating | |
data Ast = Call String [Ast] | Val Int deriving (Eq, Show) | |
-- if there's no operators, there's nothing to do either | |
yard a [] = a | |
yard a ((op, b) : xs) = result where | |
-- `stack` stores unfinished AST trees with no right argument, i.e. | |
-- `(1 + ?), (2 * ?)` (but we implement stack with a list, it's in reverse order) | |
-- `top` stores last "value" on top of the stack | |
go (stack, top) (o1, n) = (newStack, n) where | |
d1 = desc o1 | |
-- pop from stack trees that we know won't change anymore | |
(sat, unsat) = span (\(_, o2) -> d1 `cmp` desc o2) stack | |
-- combine trees and put them back onto the stack | |
newStack = (foldl update top sat, o1) : unsat | |
-- combine operator-operand pairs one by one | |
(stack, top) = foldl go ([(a, op)], b) xs | |
-- apply leftover AST trees on stack | |
result = foldl update top stack | |
main = print $ yard (Val 1) [("+", Val 2), ("*", Val 3)] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment