hydrogen-util-0.5: src/Hydrogen/Util.hs

module Hydrogen.Util where

import Hydrogen.Prelude

-- | Infix to postfix notation (an implementation of the Shunting-Yard-Algorithm)
sya :: (Ord p, Eq o)
    => (a -> Maybe o)   -- ^ Determine operator
    -> (o -> Bool)      -- ^ Is left precedence?
    -> (o -> p)         -- ^ Precedence of given operator
    -> [a]              -- ^ The input stream (infix notation)
    -> [a]              -- ^ The output stream (postfix notation)
sya mkOp isL p = sy []
  where
    sy (t : ts) (x : xs)
        | isOp x && isOp t && cmp t x = t : sy ts (x : xs)

    sy ts (x : xs)
        | isOp x    = sy (x : ts) xs
        | otherwise = x : sy ts xs

    sy ts [] = ts

    isOp = isJust . mkOp

    cmp o1 o2 = isL o1' && p o1' == p o2' || p o1' > p o2'
      where
        Just o1' = mkOp o1
        Just o2' = mkOp o2