From 9964f245500697d6f0b4c01a94e789535be66c4b Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <m@jaspervdj.be>
Date: Sat, 10 Nov 2012 13:35:59 +0100
Subject: More efficient instances for compiler

---
 src/Hakyll/Core/Compiler/Internal.hs | 50 ++++++++++++++++++++++++++++++------
 1 file changed, 42 insertions(+), 8 deletions(-)

(limited to 'src/Hakyll/Core')

diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index 6abeed9..16863f8 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -97,53 +97,87 @@ data Compiler a b = Compiler
 
 --------------------------------------------------------------------------------
 instance Functor (Compiler a) where
-    fmap f ~(Compiler d j) = Compiler d $ fmap f . j
+    fmap f (Compiler d j) = Compiler d $ fmap f . j
+    {-# INLINE fmap #-}
 
 
 --------------------------------------------------------------------------------
 instance Applicative (Compiler a) where
     pure = fromJob . const . return
-    ~(Compiler d1 j1) <*> ~(Compiler d2 j2) =
+    {-# INLINE pure #-}
+
+    Compiler d1 j1 <*> Compiler d2 j2 =
         Compiler (liftM2 S.union d1 d2) $ \x -> j1 x <*> j2 x
+    {-# INLINE (<*>) #-}
 
 
 --------------------------------------------------------------------------------
 instance Alternative (Compiler a) where
     empty = fromJob $ const $ CompilerM $
         throwError "Hakyll.Core.Compiler.Internal: empty alternative"
-    ~(Compiler d1 j1) <|> ~(Compiler d2 j2) =
+
+    Compiler d1 j1 <|> Compiler d2 j2 =
         Compiler (liftM2 S.union d1 d2) $ \x -> CompilerM $
             catchError (unCompilerM $ j1 x) (\_ -> unCompilerM $ j2 x)
+    {-# INLINE (<|>) #-}
 
 
 --------------------------------------------------------------------------------
 instance Category Compiler where
     id = Compiler (return S.empty) return
-    ~(Compiler d1 j1) . ~(Compiler d2 j2) =
+    {-# INLINE id #-}
+
+    Compiler d1 j1 . Compiler d2 j2 =
         Compiler (liftM2 S.union d1 d2) (j1 <=< j2)
+    {-# INLINE (.) #-}
 
 
 --------------------------------------------------------------------------------
 instance Arrow Compiler where
     arr f = fromJob (return . f)
-    first ~(Compiler d j) = Compiler d $ \(x, y) -> do
+    {-# INLINE arr #-}
+
+    first (Compiler d j) = Compiler d $ \(x, y) -> do
         x' <- j x
         return (x', y)
+    {-# INLINE first #-}
+
+    second (Compiler d j) = Compiler d $ \(x, y) -> do
+        y' <- j y
+        return (x, y')
+    {-# INLINE second #-}
+
+    Compiler d1 j1 *** Compiler d2 j2 =
+        Compiler (liftM2 S.union d1 d2) $ \(x, y) -> do
+            x' <- j1 x
+            y' <- j2 y
+            return (x', y')
+    {-# INLINE (***) #-}
+
+    Compiler d1 j1 &&& Compiler d2 j2 =
+        Compiler (liftM2 S.union d1 d2) $ \x -> do
+            y1 <- j1 x
+            y2 <- j2 x
+            return (y1, y2)
+    {-# INLINE (&&&) #-}
 
 
 --------------------------------------------------------------------------------
 instance ArrowChoice Compiler where
-    left ~(Compiler d j) = Compiler d $ \e -> case e of
+    left (Compiler d j) = Compiler d $ \e -> case e of
         Left l  -> Left  <$> j l
         Right r -> Right <$> return r
-    -- Defined here for efficiency
-    ~(Compiler d1 j1) ||| ~(Compiler d2 j2) = Compiler (liftM2 S.union d1 d2) $
+    {-# INLINE left #-}
+
+    Compiler d1 j1 ||| Compiler d2 j2 = Compiler (liftM2 S.union d1 d2) $
         \e -> case e of Left x  -> j1 x; Right y -> j2 y
+    {-# INLINE (|||) #-}
 
 
 --------------------------------------------------------------------------------
 instance ArrowMap Compiler where
     mapA (Compiler d j) = Compiler d $ mapM j
+    {-# INLINE mapA #-}
 
 
 --------------------------------------------------------------------------------
-- 
cgit v1.2.3