diff --git a/Parser/Fix/Simple.hs b/Parser/Fix/Simple.hs
--- a/Parser/Fix/Simple.hs
+++ b/Parser/Fix/Simple.hs
@@ -5,10 +5,13 @@
 
 module Parser.Fix.Simple (TokenType (..), Fixity (..), parsefix, foldfix, shunt) where
 
+import Control.Arrow;
 import Control.Monad;
+import Control.Monad.State;
+import Control.Monad.Writer.Lazy;
 import Control.Monad.Instances;
 import Data.List;
-import Data.Maybe;
+import Util;
 
 -- | Fixity/Associativity
 data Fixity = Prefix | InfixLeft | InfixRight | InfixNull | Postfix deriving Eq;
@@ -54,27 +57,17 @@
 -}
 -- Dijkstra's algorithm
 shunt :: (t -> TokenType) -> [t] -> [t];
-shunt lookup_t = join . snd . mapAccumR
-  (\ stack t ->
+shunt lookup_t = (.) (execWriter . flip runStateT []) $ (.) (>> (get >>= tell)) $
+  (mapM_ $ \ t ->
    case lookup_t t of {
-     TokenPlain -> (stack, [t]);
+     TokenPlain -> tell [t];
      TokenOper fix1 p1 | or $ map (== fix1) [InfixLeft, InfixRight, InfixNull] ->
-       case map lookup_t stack of {
-         (TokenOper fix2 p2 : _) | fix1 == InfixLeft  && p1 <= p2 ||
-                                   fix1 == InfixRight && p1 <  p2 ->
-               (t : tail stack, [head stack]);
-         _ ->  (t : id stack,   []);
-       }
-                       | Postfix == fix1 -> (  stack, [t])
-                       | Prefix  == fix1 -> (t:stack, [])
-                       ;
-     TokenLParenth -> (t:stack, []);
-     TokenRParenth -> case break ((== TokenLParenth) . lookup_t) stack of {
-                        (ts, _:stack') -> (stack', ts);
-                        (ts, _)        -> (error "Mismatched Parentheses", ts);
-                      };
-   }) [];
-
-list :: (a -> [a] -> b) -> b -> [a] -> b;
-list f y []     = y;
-list f y (x:xs) = f x xs;
+       get >>* span (lookup_t >>>
+                     \ (TokenOper fix2 p2) ->
+                     fix1 == InfixLeft  && p1 <= p2 ||
+                     fix1 == InfixRight && p1 <  p2) >>= tell *=* put . (t:) >>* uncurry mappend
+                       | Postfix == fix1 -> tell [t]
+                       | Prefix  == fix1 -> modify (t:);
+     TokenLParenth -> modify (t:);
+     TokenRParenth -> get >>* break ((== TokenLParenth) . lookup_t) >>= tell *=* list (const put) (put $ error "Mismatched Parentheses") >>* uncurry mappend;
+   });
diff --git a/Util.hs b/Util.hs
new file mode 100644
--- /dev/null
+++ b/Util.hs
@@ -0,0 +1,36 @@
+module Util where
+
+import Control.Arrow;
+import Control.Monad;
+
+list :: (a -> [a] -> b) -> b -> [a] -> b;
+list f y []     = y;
+list f y (x:xs) = f x xs;
+
+swap :: (a,b) -> (b,a);
+swap (x,y) = (y,x);
+
+infixr 3 &=&;
+(&=&) :: Monad m => (a -> m b) -> (a -> m c) -> a -> m (b, c);
+(&=&) = curry $ uncurry (&&&) >>> (uncurry (liftM2 (,)) .);
+
+infixr 3 *=*;
+(*=*) :: Monad m => (a -> m b) -> (c -> m d) -> (a, c) -> m (b, d);
+(*=*) = curry $ uncurry (***) >>> (uncurry (liftM2 (,)) .);
+
+applyA :: ArrowApply a => a b (a b c) -> a b c;
+applyA = (&&& (arr id)) >>> (>>> app);
+
+apM :: Monad m => m (a -> m b) -> a -> m b;
+apM = fmap join . (. return) . ap;
+
+infixr 1 >*>;
+(>*>) :: Monad m => (a -> m b) -> (b -> c) -> a -> m c;
+f >*> g = f >=> return . g;
+
+infixl 1 >>*;
+(>>*) :: Monad m => m a -> (a -> b) -> m b;
+(>>*) = flip liftM;
+
+(<<) :: Monad m => m a -> m b -> m a;
+(<<) = flip (>>);
diff --git a/fix-parser-simple.cabal b/fix-parser-simple.cabal
--- a/fix-parser-simple.cabal
+++ b/fix-parser-simple.cabal
@@ -1,5 +1,5 @@
 Name:fix-parser-simple
-Version:15318.2
+Version:15319.1
 Description:Simple fix-expression parser
 License:LGPL
 License-File:license.txt
@@ -11,7 +11,8 @@
 Cabal-Version: >= 1.2
 
 Library {
-  Build-Depends: base >= 4 && < 5
+  Build-Depends: base >= 4 && < 5, mmtl
   Extensions: PatternGuards
   Exposed-Modules: Parser.Fix.Simple
+  Other-Modules: Util
 }