diff --git a/Main.hs b/Main.hs
--- a/Main.hs
+++ b/Main.hs
@@ -1,15 +1,15 @@
 module Main where
 
-import Plugin.Pl.Common
-import Plugin.Pl.Optimize
-import Plugin.Pl.Parser
-import Plugin.Pl.PrettyPrinter
-import Plugin.Pl.Transform
-
-import System.Environment (getArgs)
-import System.Console.GetOpt
+import           Data.Foldable
+import           Plugin.Pl.Common
+import           Plugin.Pl.Optimize
+import           Plugin.Pl.Parser
+import           Plugin.Pl.PrettyPrinter
+import           Plugin.Pl.Transform
+import           System.Console.GetOpt
+import           System.Environment      (getArgs)
 
-data Flag = Verbose 
+data Flag = Verbose
           | StdIn
   deriving Eq
 
@@ -25,7 +25,7 @@
 parseArgs args =
   case getOpt Permute options args of
     (flags, nonOptions, []) -> return (flags, nonOptions)
-    (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
+    (_, _, errs) -> ioError (userError (fold errs ++ usageInfo header options))
 
 getQuery :: [Flag] -> [String] -> IO String
 getQuery flags nonOptions
diff --git a/Plugin/Pl/Common.hs b/Plugin/Pl/Common.hs
deleted file mode 100644
--- a/Plugin/Pl/Common.hs
+++ /dev/null
@@ -1,133 +0,0 @@
-module Plugin.Pl.Common (
-        Fixity(..), Expr(..), Pattern(..), Decl(..), TopLevel(..),
-        bt, mapTopLevel, mapTopLevel',
-        lookupFix, minPrec, maxPrec,
-        comp, flip', id', const', scomb, cons, nil, fix', if', readM,
-        makeList, getList,
-        Assoc(..),
-        module Data.Maybe,
-        module Control.Arrow,
-        module Data.List,
-        module Control.Monad,
-        module GHC.Base
-    ) where
-
-import           Data.List             (intersperse, minimumBy)
-import qualified Data.Map              as M
-import           Data.Maybe            (fromJust, fromMaybe, isJust)
-
-import           Control.Arrow         (first, second, (&&&), (***), (+++),
-                                        (|||))
-import           Control.Monad
-
-import           Language.Haskell.Exts (Assoc (..))
-
-import           GHC.Base              (assert)
-
-
--- The rewrite rules can be found at the end of the file Rules.hs
-
--- Not sure if passing the information if it was used as infix or prefix
--- is worth threading through the whole thing is worth the effort,
--- but it stays that way until the prettyprinting algorithm gets more
--- sophisticated.
-data Fixity = Pref | Inf deriving Show
-
-instance Eq Fixity where
-  _ == _ = True
-
-instance Ord Fixity where
-  compare _ _ = EQ
-
-data Expr
-  = Var Fixity String
-  | Lambda Pattern Expr
-  | App Expr Expr
-  | Let [Decl] Expr
-  deriving (Eq, Ord, Show)
-
-data Pattern
-  = PVar String
-  | PCons Pattern Pattern
-  | PTuple Pattern Pattern
-  deriving (Eq, Ord, Show)
-
-data Decl = Define {
-  declName :: String,
-  declExpr :: Expr
-} deriving (Eq, Ord, Show)
-
-data TopLevel = TLD Bool Decl | TLE Expr deriving (Eq, Ord, Show)
-
-mapTopLevel :: (Expr -> Expr) -> TopLevel -> TopLevel
-mapTopLevel f tl = case getExpr tl of (e, c) -> c $ f e
-
-mapTopLevel' :: Functor f => (Expr -> f Expr) -> TopLevel -> f TopLevel
-mapTopLevel' f tl = case getExpr tl of (e, c) -> c <$> f e
-
-getExpr :: TopLevel -> (Expr, Expr -> TopLevel)
-getExpr (TLD True (Define foo e)) = (Let [Define foo e] (Var Pref foo),
-                                     TLD False . Define foo)
-getExpr (TLD False (Define foo e)) = (e, TLD False . Define foo)
-getExpr (TLE e)      = (e, TLE)
-
-comp, flip', id', const', scomb, cons, nil, fix', if' :: Expr
-comp   = Var Inf  "."
-flip'  = Var Pref "flip"
-id'    = Var Pref "id"
-const' = Var Pref "const"
-scomb  = Var Pref "ap"
-cons   = Var Inf  ":"
-nil    = Var Pref "[]"
-fix'   = Var Pref "fix"
-if'    = Var Pref "if'"
-
-makeList :: [Expr] -> Expr
-makeList = foldr (\e1 e2 -> cons `App` e1 `App` e2) nil
-
--- Modularity is a drag
-getList :: Expr -> ([Expr], Expr)
-getList (c `App` x `App` tl) | c == cons = first (x:) $ getList tl
-getList e                    = ([],e)
-
-bt :: a
-bt = undefined
-
-shift, minPrec, maxPrec :: Int
-shift = 0
-maxPrec = shift + 10
-minPrec = 0
-
--- operator precedences are needed both for parsing and prettyprinting
-operators :: [[(String, (Assoc (), Int))]]
-operators = (map . map . second . second $ (+shift))
-  [[inf "." (AssocRight ()) 9, inf "!!" (AssocLeft ()) 9],
-   [inf name (AssocRight ()) 8 | name <- ["^", "^^", "**"]],
-   [inf name (AssocLeft ()) 7
-     | name <- ["*", "/", "`quot`", "`rem`", "`div`", "`mod`", ":%", "%"]],
-   [inf name (AssocLeft ()) 6  | name <- ["+", "-"]],
-   [inf name (AssocRight ()) 5 | name <- [":", "++"]],
-   [inf name (AssocNone ()) 4
-     | name <- ["==", "/=", "<", "<=", ">=", ">", "`elem`", "`notElem`"]],
-   [inf "&&" (AssocRight ()) 3],
-   [inf "||" (AssocRight ()) 2],
-   [inf ">>" (AssocLeft ()) 1, inf ">>=" (AssocLeft ()) 1, inf "=<<" (AssocRight ()) 1],
-   [inf name (AssocRight ()) 0 | name <- ["$", "$!", "`seq`"]]
-  ] where
-  inf name assoc fx = (name, (assoc, fx))
-
-opFM :: M.Map String (Assoc (), Int)
-opFM = M.fromList $ join operators
-
-lookupOp :: String -> Maybe (Assoc (), Int)
-lookupOp k = M.lookup k opFM
-
-lookupFix :: String -> (Assoc (), Int)
-lookupFix str = fromMaybe (AssocLeft (), 9 + shift) (lookupOp str)
-
-readM :: (Monad m, Read a) => String -> m a
-readM s = case [x | (x,t) <- reads s, ("","")  <- lex t] of
-            [x] -> return x
-            []  -> fail "readM: No parse."
-            _   -> fail "readM: Ambiguous parse."
-
diff --git a/Plugin/Pl/Optimize.hs b/Plugin/Pl/Optimize.hs
deleted file mode 100644
--- a/Plugin/Pl/Optimize.hs
+++ /dev/null
@@ -1,102 +0,0 @@
-{-# LANGUAGE ImplicitParams #-}
-module Plugin.Pl.Optimize (
-    optimize,
-  ) where
-
-import           Plugin.Pl.Common
-import           Plugin.Pl.PrettyPrinter (prettyExpr)
-import           Plugin.Pl.Rules
-
-import           Data.List               (nub)
-
-cut :: [a] -> [a]
-cut = take 1
-
-toMonadPlus :: MonadPlus m => Maybe a -> m a
-toMonadPlus Nothing  = mzero
-toMonadPlus (Just x)=return x
-
-type Size = Integer
--- This seems to be a better size for our purposes,
--- despite being "a little" slower because of the wasteful uglyprinting
-sizeExpr' :: Expr -> Size
-sizeExpr' e = 100 * fromIntegral (length $ prettyExpr e) + adjust e where
-  -- hackish thing to favor some expressions if the length is the same:
-  -- (+ x) --> (x +)
-  -- x >>= f --> f =<< x
-  -- f $ g x --> f (g x)
-  adjust :: Expr -> Size
-  adjust (Var _ str) -- Just n <- readM str = log (n*n+1) / 4
-                     | str == "uncurry"    = -400
---                     | str == "s"          = 500
-                     | str == "flip"       = 10
-                     | str == ">>="        = 5
-                     | str == "$"          = 1
-                     | str == "subtract"   = 1
-                     | str == "ap"         = 200
-                     | str == "liftM2"     = 101
-                     | str == "return"     = -200
-                     | str == "zipWith"    = -400
-                     | str == "const"      = 0 -- -200
-                     | str == "fmap"       = -100
-  adjust (Lambda _ e') = adjust e'
-  adjust (App e1 e2)  = adjust e1 + adjust e2
-  adjust _ = 0
-
-optimize :: Expr -> [Expr]
-optimize e = result where
-  result :: [Expr]
-  result = map (snd . fromJust) . takeWhile isJust .
-    iterate ((=<<) simpleStep) $ Just (sizeExpr' e, e)
-
-  simpleStep :: (Size, Expr) -> Maybe (Size, Expr)
-  simpleStep t = do
-    let chn = let ?first = True in step (snd t)
-        chnn = let ?first = False in step =<< chn
-        new = filter (\(x,_) -> x < fst t) . map (sizeExpr' &&& id) $
-                snd t: chn ++ chnn
-    case new of
-      []       -> Nothing
-      (new':_) -> return new'
-
-step :: (?first :: Bool) => Expr -> [Expr]
-step e = nub $ rewrite rules e
-
-rewrite :: (?first :: Bool) => RewriteRule -> Expr -> [Expr]
-rewrite rl e = case rl of
-    Up r1 r2     -> let e'  = cut $ rewrite r1 e
-                        e'' = rewrite r2 =<< e'
-                    in if null e'' then e' else e''
-    OrElse r1 r2 -> let e'  = rewrite r1 e
-                    in if null e' then rewrite r2 e else e'
-    Then r1 r2   -> rewrite r2 =<< nub (rewrite r1 e)
-    Opt  r       -> e: rewrite r e
-    If   p  r    -> if null (rewrite p e) then mzero else rewrite r e
-    Hard r       -> if ?first then rewrite r e else mzero
-    Or rs        -> (`rewrite` e) =<< rs
-    RR {}        -> rewDeep rl e
-    CRR {}       -> rewDeep rl e
-    Down {}      -> rewDeep rl e
-
-rewDeep :: (?first :: Bool) => RewriteRule -> Expr -> [Expr]
-rewDeep rule e = rew rule e `mplus` case e of
-    Var _ _    -> mzero
-    Lambda _ _ -> error "lambda: optimizer only works for closed expressions"
-    Let _ _    -> error "let: optimizer only works for closed expressions"
-    App e1 e2  -> ((`App` e2) `map` rewDeep rule e1) `mplus`
-                  ((e1 `App`) `map` rewDeep rule e2)
-
-rew :: (?first :: Bool) => RewriteRule -> Expr -> [Expr]
-rew (RR r1 r2) e = toMonadPlus $ fire r1 r2 e
-rew (CRR r) e = toMonadPlus $ r e
-rew (Or rs) e = (`rew` e) =<< rs
-rew (Down r1 r2) e
-  = if null e'' then e' else e'' where
-    e'  = cut $ rew r1 e
-    e'' = rewDeep r2 =<< e'
-rew r@Then   {} e = rewrite r e
-rew r@OrElse {} e = rewrite r e
-rew r@Up     {} e = rewrite r e
-rew r@Opt    {} e = rewrite r e
-rew r@If     {} e = rewrite r e
-rew r@Hard   {} e = rewrite r e
diff --git a/Plugin/Pl/Parser.hs b/Plugin/Pl/Parser.hs
deleted file mode 100644
--- a/Plugin/Pl/Parser.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-module Plugin.Pl.Parser (parsePF) where
-
-import           Plugin.Pl.Common
-
-import qualified Language.Haskell.Exts as HSE
-
-todo :: (Functor e, Show (e ())) => e a -> r
-todo thing = error ("pointfree: not supported: " ++ show (void thing))
-
-nameString :: HSE.Name a -> (Fixity, String)
-nameString (HSE.Ident _ s)  = (Pref, s)
-nameString (HSE.Symbol _ s) = (Inf, s)
-
-qnameString :: HSE.QName a -> (Fixity, String)
-qnameString (HSE.Qual _ m n) = fmap ((HSE.prettyPrint m ++ ".") ++) (nameString n)
-qnameString (HSE.UnQual _ n) = nameString n
-qnameString (HSE.Special _ sc) = case sc of
-  HSE.UnitCon _              -> (Pref, "()")
-  HSE.ListCon _              -> (Pref, "[]")
-  HSE.FunCon _               -> (Inf, "->")
-  HSE.TupleCon _ HSE.Boxed n -> (Inf, replicate (n-1) ',')
-  HSE.TupleCon{}             -> todo sc
-  HSE.Cons _                 -> (Inf, ":")
-  HSE.UnboxedSingleCon{}     -> todo sc
-  HSE.ExprHole{}             -> todo sc
-
-opString :: HSE.QOp a -> (Fixity, String)
-opString (HSE.QVarOp _ qn) = qnameString qn
-opString (HSE.QConOp _ qn) = qnameString qn
-
-list :: [Expr] -> Expr
-list = foldr (\y ys -> cons `App` y `App` ys) nil
-
-hseToExpr :: HSE.Exp a -> Expr
-hseToExpr expr = case expr of
-  HSE.Var _ qn -> uncurry Var (qnameString qn)
-  HSE.IPVar{} -> todo expr
-  HSE.Con _ qn -> uncurry Var (qnameString qn)
-  HSE.Lit _ l -> case l of
-    HSE.String _ _ s -> list (map (Var Pref . show) s)
-    _                -> Var Pref (HSE.prettyPrint l)
-  HSE.InfixApp _ p op q -> apps (Var Inf (snd (opString op))) [p,q]
-  HSE.App _ f x -> hseToExpr f `App` hseToExpr x
-  HSE.NegApp _ e -> Var Pref "negate" `App` hseToExpr e
-  HSE.Lambda _ ps e -> foldr (Lambda . hseToPattern) (hseToExpr e) ps
-  HSE.Let _ bs e -> case bs of
-    HSE.BDecls _ ds   -> Let (map hseToDecl ds) (hseToExpr e)
-    HSE.IPBinds _ ips -> todo ips
-  HSE.If _ b t f -> apps if' [b,t,f]
-  HSE.Case{} -> todo expr
-  HSE.Do{} -> todo expr
-  HSE.MDo{} -> todo expr
-  HSE.Tuple _ HSE.Boxed es -> apps (Var Inf (replicate (length es - 1) ','))  es
-  HSE.TupleSection{} -> todo expr
-  HSE.List _ xs -> list (map hseToExpr xs)
-  HSE.Paren _ e -> hseToExpr e
-  HSE.LeftSection _ l op -> Var Inf (snd (opString op)) `App` hseToExpr l
-  HSE.RightSection _ op r -> flip' `App` Var Inf (snd (opString op)) `App` hseToExpr r
-  HSE.RecConstr{} -> todo expr
-  HSE.RecUpdate{} -> todo expr
-  HSE.EnumFrom _ x -> apps (Var Pref "enumFrom") [x]
-  HSE.EnumFromTo _ x y -> apps (Var Pref "enumFromTo") [x,y]
-  HSE.EnumFromThen _ x y -> apps (Var Pref "enumFromThen") [x,y]
-  HSE.EnumFromThenTo _ x y z -> apps (Var Pref "enumFromThenTo") [x,y,z]
-  _ -> todo expr
-
-apps :: Expr -> [HSE.Exp a] -> Expr
-apps = foldl (\a x -> a `App` hseToExpr x)
-
-hseToDecl :: HSE.Decl a -> Decl
-hseToDecl dec = case dec of
-  HSE.PatBind _ (HSE.PVar _ n) (HSE.UnGuardedRhs _ e) Nothing ->
-    Define (snd (nameString n)) (hseToExpr e)
-  HSE.FunBind _ [HSE.Match _ n ps (HSE.UnGuardedRhs _ e) Nothing] ->
-    Define (snd (nameString n)) (foldr (\p x -> Lambda (hseToPattern p) x) (hseToExpr e) ps)
-  _ -> todo dec
-
-hseToPattern :: HSE.Pat a -> Pattern
-hseToPattern pat = case pat of
-  HSE.PVar _ n -> PVar (snd (nameString n))
-  HSE.PInfixApp _ l (HSE.Special _ (HSE.Cons _)) r -> PCons (hseToPattern l) (hseToPattern r)
-  HSE.PTuple _ HSE.Boxed [p,q] -> PTuple (hseToPattern p) (hseToPattern q)
-  HSE.PParen _ p -> hseToPattern p
-  HSE.PWildCard _ -> PVar "_"
-  _ -> todo pat
-
-parsePF :: String -> Either String TopLevel
-parsePF inp = case HSE.parseExp inp of
-  HSE.ParseOk e -> Right (TLE (hseToExpr e))
-  HSE.ParseFailed _ _ -> case HSE.parseDecl inp of
-    HSE.ParseOk d         -> Right (TLD True (hseToDecl d))
-    HSE.ParseFailed _ err -> Left err
diff --git a/Plugin/Pl/PrettyPrinter.hs b/Plugin/Pl/PrettyPrinter.hs
deleted file mode 100644
--- a/Plugin/Pl/PrettyPrinter.hs
+++ /dev/null
@@ -1,146 +0,0 @@
-{-# LANGUAGE PatternGuards #-}
-module Plugin.Pl.PrettyPrinter (
-  prettyDecl,
-  prettyExpr,
-  prettyTopLevel,
- ) where
-
-import           Plugin.Pl.Common
-
-import           Data.Char
-import           Data.List        (intercalate)
-
-prettyDecl :: Decl -> String
-prettyDecl (Define f e) = f ++ " = " ++ prettyExpr e
-
-prettyDecls :: [Decl] -> String
-prettyDecls = intercalate "; " . map prettyDecl
-
-prettyExpr :: Expr -> String
-prettyExpr = show . toSExpr
-
-prettyTopLevel :: TopLevel -> String
-prettyTopLevel (TLE e)   = prettyExpr e
-prettyTopLevel (TLD _ d) = prettyDecl d
-
-data SExpr
-  = SVar !String
-  | SLambda ![Pattern] !SExpr
-  | SLet ![Decl] !SExpr
-  | SApp !SExpr !SExpr
-  | SInfix !String !SExpr !SExpr
-  | LeftSection !String !SExpr  -- (x +)
-  | RightSection !String !SExpr -- (+ x)
-  | List ![SExpr]
-  | Tuple ![SExpr]
-  | Enum !Expr !(Maybe Expr) !(Maybe Expr)
-
-{-# INLINE toSExprHead #-}
-toSExprHead :: String -> [Expr] -> Maybe SExpr
-toSExprHead hd tl
-  | all (==',') hd, length hd+1 == length tl
-  = Just . Tuple . reverse $ map toSExpr tl
-  | otherwise = case (hd,reverse tl) of
-      ("enumFrom", [e])              -> Just $ Enum e Nothing   Nothing
-      ("enumFromThen", [e,e'])       -> Just $ Enum e (Just e') Nothing
-      ("enumFromTo", [e,e'])         -> Just $ Enum e Nothing   (Just e')
-      ("enumFromThenTo", [e,e',e'']) -> Just $ Enum e (Just e') (Just e'')
-      _                              -> Nothing
-
-toSExpr :: Expr -> SExpr
-toSExpr (Var _ v) = SVar v
-toSExpr (Lambda v e) = case toSExpr e of
-  (SLambda vs e') -> SLambda (v:vs) e'
-  e'              -> SLambda [v] e'
-toSExpr (Let ds e) = SLet ds $ toSExpr e
-toSExpr e | Just (hd,tl) <- getHead e, Just se <- toSExprHead hd tl = se
-toSExpr e | (ls, tl) <- getList e, tl == nil
-  = List $ map toSExpr ls
-toSExpr (App e1 e2) = case e1 of
-  App (Var Inf v) e0
-    -> SInfix v (toSExpr e0) (toSExpr e2)
-  Var Inf v | v /= "-"
-    -> LeftSection v (toSExpr e2)
-
-  Var _ "flip" | Var Inf v <- e2, v == "-" -> toSExpr $ Var Pref "subtract"
-
-  App (Var _ "flip") (Var pr v)
-    | v == "-"  -> toSExpr $ Var Pref "subtract" `App` e2
-    | v == "id" -> RightSection "$" (toSExpr e2)
-    | Inf <- pr, any (/= ',') v -> RightSection v (toSExpr e2)
-  _ -> SApp (toSExpr e1) (toSExpr e2)
-
-getHead :: Expr -> Maybe (String, [Expr])
-getHead (Var _ v)   = Just (v, [])
-getHead (App e1 e2) = second (e2:) `fmap` getHead e1
-getHead _           = Nothing
-
-instance Show SExpr where
-  showsPrec _ (SVar v) = (getPrefName v ++)
-  showsPrec p (SLambda vs e) = showParen (p > minPrec) $ ('\\':) .
-    foldr (.) id (intersperse (' ':) (map (prettyPrecPattern $ maxPrec+1) vs)) .
-    (" -> "++) . showsPrec minPrec e
-  showsPrec p (SApp e1 e2) = showParen (p > maxPrec) $
-    showsPrec maxPrec e1 . (' ':) . showsPrec (maxPrec+1) e2
-  showsPrec _ (LeftSection fx e) = showParen True $
-    showsPrec (snd (lookupFix fx) + 1) e . (' ':) . (getInfName fx++)
-  showsPrec _ (RightSection fx e) = showParen True $
-    (getInfName fx++) . (' ':) . showsPrec (snd (lookupFix fx) + 1) e
-  showsPrec _ (Tuple es) = showParen True
-    (join `id` intersperse ", " (map show es) ++)
-
-  showsPrec _ (List es)
-    | Just cs <- mapM ((=<<) readM . fromSVar) es = shows (cs::String)
-    | otherwise = ('[':) .
-      (join `id` intersperse ", " (map show es) ++) . (']':)
-    where fromSVar (SVar str) = Just str
-          fromSVar _          = Nothing
-  showsPrec _ (Enum fr tn to) = ('[':) . showString (prettyExpr fr) .
-    showsMaybe (((',':) . prettyExpr) `fmap` tn) . (".."++) .
-    showsMaybe (prettyExpr `fmap` to) . (']':)
-      where showsMaybe = maybe id (++)
-  showsPrec _ (SLet ds e) = ("let "++) . showString (prettyDecls ds ++ " in ") . shows e
-
-
-  showsPrec p (SInfix fx e1 e2) = showParen (p > fixity) $
-    showsPrec f1 e1 . (' ':) . (getInfName fx++) . (' ':) .
-    showsPrec f2 e2 where
-      fixity = snd $ lookupFix fx
-      (f1, f2) = case fst $ lookupFix fx of
-        AssocRight _ -> (fixity+1, fixity + infixSafe e2 (AssocLeft ()) fixity)
-        AssocLeft _ -> (fixity + infixSafe e1 (AssocRight ()) fixity, fixity+1)
-        AssocNone _ -> (fixity+1, fixity+1)
-
-      -- This is a little bit awkward, but at least seems to produce no false
-      -- results anymore
-      infixSafe :: SExpr -> Assoc () -> Int -> Int
-      infixSafe (SInfix fx'' _ _) assoc fx'
-        | lookupFix fx'' == (assoc, fx') = 1
-        | otherwise = 0
-      infixSafe _ _ _ = 0 -- doesn't matter
-
-prettyPrecPattern :: Int -> Pattern -> ShowS
-prettyPrecPattern _ (PVar v) = showString v
-prettyPrecPattern _ (PTuple p1 p2) = showParen True $
-  prettyPrecPattern 0 p1 . (", "++) . prettyPrecPattern 0 p2
-prettyPrecPattern p (PCons p1 p2) = showParen (p>5) $
-  prettyPrecPattern 6 p1 . (':':) . prettyPrecPattern 5 p2
-
-isOperator :: String -> Bool
-isOperator s =
-  case break (== '.') s of
-    (_, "") -> isUnqualOp s
-    (before, _dot : rest)
-      | isUnqualOp before -> isUnqualOp rest
-      | isModule before -> isOperator rest
-      | otherwise -> False
-  where
-    isModule "" = False
-    isModule (c : cs) = isUpper c && all (\c' -> isAlphaNum c' || c' `elem` ['\'', '_']) cs
-    isUnqualOp s' = s' /= "()" && all (\c -> isSymbol c || isPunctuation c) s'
-
-getInfName :: String -> String
-getInfName str = if isOperator str then str else "`"++str++"`"
-
-getPrefName :: String -> String
-getPrefName str = if isOperator str || ',' `elem` str then "("++str++")" else str
diff --git a/Plugin/Pl/Rules.hs b/Plugin/Pl/Rules.hs
deleted file mode 100644
--- a/Plugin/Pl/Rules.hs
+++ /dev/null
@@ -1,875 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE FlexibleInstances         #-}
-{-# LANGUAGE PatternGuards             #-}
-{-# LANGUAGE ScopedTypeVariables       #-}
---
--- | This marvellous module contributed by Thomas J\344ger
---
-module Plugin.Pl.Rules (RewriteRule(..), rules, fire) where
-
-import           Plugin.Pl.Common
-
-import           Data.Array
-import qualified Data.Set          as S
-
-import           Control.Monad.Fix (fix)
-
---import PlModule.PrettyPrinter
-
--- Next time I do somthing like this, I'll actually think about the combinator
--- language before, instead of producing something ad-hoc like this:
-data RewriteRule
-  = RR Rewrite Rewrite
-  | CRR (Expr -> Maybe Expr)
-  | Down RewriteRule RewriteRule
-  | Up RewriteRule RewriteRule
-  | Or [RewriteRule]
-  | OrElse RewriteRule RewriteRule
-  | Then RewriteRule RewriteRule
-  | Opt RewriteRule
-  | If RewriteRule RewriteRule
-  | Hard RewriteRule
-
--- No MLambda here because we only consider closed Terms (no alpha-renaming!).
-data MExpr
-  = MApp !MExpr !MExpr
-  | Hole !Int
-  | Quote !Expr
-  deriving Eq
-
---instance Show MExpr where
---  show = show . fromMExpr
-
-data Rewrite = Rewrite {
-  holes :: MExpr,
-  rid   :: Int -- rlength - 1
-} --deriving Show
-
--- What are you gonna do when no recursive modules are possible?
-class RewriteC a where
-  getRewrite :: a -> Rewrite
-
-instance RewriteC MExpr where
-  getRewrite rule = Rewrite {
-    holes   = rule,
-    rid = 0
-  }
-
-type ExprArr = Array Int Expr
-
-myFire :: ExprArr -> MExpr -> MExpr
-myFire xs (MApp e1 e2) = MApp (myFire xs e1) (myFire xs e2)
-myFire xs (Hole h)     = Quote $ xs ! h
-myFire _ me            = me
-
-nub' :: Ord a => [a] -> [a]
-nub' = S.toList . S.fromList
-
-uniqueArray :: Ord v => Int -> [(Int, v)] -> Maybe (Array Int v)
-uniqueArray n lst
-  | length (nub' lst) == n = Just $ array (0,n-1) lst
-  | otherwise = Nothing
-
-match :: Rewrite -> Expr -> Maybe ExprArr
-match (Rewrite hl rid') e  = uniqueArray rid' =<< matchWith hl e
-
-fire' :: Rewrite -> ExprArr -> MExpr
-fire' (Rewrite hl _)   = (`myFire` hl)
-
-fire :: Rewrite -> Rewrite -> Expr -> Maybe Expr
-fire r1 r2 e = (fromMExpr . fire' r2) `fmap` match r1 e
-
-matchWith :: MExpr -> Expr -> Maybe [(Int, Expr)]
-matchWith (MApp e1 e2) (App e1' e2') =
-  liftM2 (++) (matchWith e1 e1') (matchWith e2 e2')
-matchWith (Quote e) e' = if e == e' then Just [] else Nothing
-matchWith (Hole k) e = Just [(k,e)]
-matchWith _ _ = Nothing
-
-fromMExpr :: MExpr -> Expr
-fromMExpr (MApp e1 e2) = App (fromMExpr e1) (fromMExpr e2)
-fromMExpr (Hole _)     = Var Pref "Hole" -- error "Hole in MExpr"
-fromMExpr (Quote e)    = e
-
-instance RewriteC a => RewriteC (MExpr -> a) where
-  getRewrite rule = Rewrite {
-    holes = holes . getRewrite . rule . Hole $ pid,
-    rid   = pid + 1
-  } where
-    pid = rid $ getRewrite (bt :: a)
-
--- Yet another pointless transformation
-transformM :: Int -> MExpr -> MExpr
-transformM _ (Quote e) = constE `a` Quote e
-transformM n (Hole n') = if n == n' then idE else constE `a` Hole n'
-transformM n (Quote (Var _ ".") `MApp` e1 `MApp` e2)
-  | e1 `hasHole` n && not (e2 `hasHole` n)
-  = flipE `a` compE `a` e2 `c` transformM n e1
-transformM n e@(MApp e1 e2)
-  | fr1 && fr2 = sE `a` transformM n e1 `a` transformM n e2
-  | fr1        = flipE `a` transformM n e1 `a` e2
-  | fr2, Hole n' <- e2, n' == n = e1
-  | fr2        = e1 `c` transformM n e2
-  | otherwise  = constE `a` e
-  where
-    fr1 = e1 `hasHole` n
-    fr2 = e2 `hasHole` n
-
-hasHole :: MExpr -> Int -> Bool
-hasHole (MApp e1 e2) n = e1 `hasHole` n || e2 `hasHole` n
-hasHole (Quote _)   _  = False
-hasHole (Hole n')   n  = n == n'
-
---
--- haddock doesn't like n+k patterns, so rewrite them
---
-getVariants, getVariants' :: Rewrite -> [Rewrite]
-getVariants' r@(Rewrite _ 0)  = [r]
-getVariants' r@(Rewrite e nk)
-    | nk >= 1    = r : getVariants (Rewrite e' (nk-1))
-    | otherwise  = error "getVariants' : nk went negative"
-    where
-        e' = decHoles $ transformM 0 e
-
-        decHoles (Hole n')    = Hole (n'-1)
-        decHoles (MApp e1 e2) = decHoles e1 `MApp` decHoles e2
-        decHoles me           = me
-
-getVariants = getVariants' -- r = trace (show vs) vs where vs = getVariants' r
-
-rr, rr0, rr1, rr2 :: RewriteC a => a -> a -> RewriteRule
--- use this rewrite rule and rewrite rules derived from it by iterated
--- pointless transformation
-rrList :: RewriteC a => a -> a -> [RewriteRule]
-rrList r1 r2 = zipWith RR (getVariants r1') (getVariants r2') where
-  r1' = getRewrite r1
-  r2' = getRewrite r2
-
-rr  r1 r2 = Or          $ rrList r1 r2
-rr1 r1 r2 = Or . take 2 $ rrList r1 r2
-rr2 r1 r2 = Or . take 3 $ rrList r1 r2
-
--- use only this rewrite rule
-rr0 r1 r2 = RR r1' r2' where
-  r1' = getRewrite r1
-  r2' = getRewrite r2
-
-down, up :: RewriteRule -> RewriteRule
-down = fix . Down
-up   = fix . Up
-
-
-idE, flipE, bindE, extE, returnE, consE, appendE, nilE, foldrE, foldlE, fstE,
-  sndE, dollarE, constE, uncurryE, curryE, compE, headE, tailE, sE, commaE,
-  fixE, foldl1E, notE, equalsE, nequalsE, plusE, multE, zeroE, oneE, lengthE,
-  sumE, productE, concatE, concatMapE, joinE, mapE, fmapE, fmapIE, subtractE,
-  minusE, liftME, apE, liftM2E, seqME, zipE, zipWithE, onE, oedipusE, comp2E,
-  crossE, firstE, secondE, andE, orE, allE, anyE :: MExpr
-idE        = Quote $ Var Pref "id"
-flipE      = Quote $ Var Pref "flip"
-constE     = Quote $ Var Pref "const"
-compE      = Quote $ Var Inf "."
-comp2E     = Quote $ Var Inf ".*"
-comp3E     = Quote $ Var Inf ".**"
-eyeE       = Quote $ Var Inf "-."
-oedipusE   = Quote $ Var Inf "-.*"
-oedipus2E  = Quote $ Var Inf "-.**"
-onE        = Quote $ Var Pref "on"
-ampersandE = Quote $ Var Inf "&"
-sE         = Quote $ Var Pref "ap"
-fixE       = Quote $ Var Pref "fix"
-bindE      = Quote $ Var Inf  ">>="
-extE       = Quote $ Var Inf  "=<<"
-returnE    = Quote $ Var Pref "return"
-consE      = Quote $ Var Inf  ":"
-nilE       = Quote $ Var Pref "[]"
-appendE    = Quote $ Var Inf  "++"
-foldrE     = Quote $ Var Pref "foldr"
-foldlE     = Quote $ Var Pref "foldl"
-fstE       = Quote $ Var Pref "fst"
-sndE       = Quote $ Var Pref "snd"
-dollarE    = Quote $ Var Inf  "$"
-uncurryE   = Quote $ Var Pref "uncurry"
-curryE     = Quote $ Var Pref "curry"
-headE      = Quote $ Var Pref "head"
-tailE      = Quote $ Var Pref "tail"
-commaE     = Quote $ Var Inf  ","
-foldl1E    = Quote $ Var Pref "foldl1"
-equalsE    = Quote $ Var Inf  "=="
-nequalsE   = Quote $ Var Inf  "/="
-notE       = Quote $ Var Pref "not"
-plusE      = Quote $ Var Inf  "+"
-multE      = Quote $ Var Inf  "*"
-zeroE      = Quote $ Var Pref "0"
-oneE       = Quote $ Var Pref "1"
-lengthE    = Quote $ Var Pref "length"
-sumE       = Quote $ Var Pref "sum"
-productE   = Quote $ Var Pref "product"
-concatE    = Quote $ Var Pref "concat"
-concatMapE = Quote $ Var Pref "concatMap"
-joinE      = Quote $ Var Pref "join"
-mapE       = Quote $ Var Pref "map"
-fmapE      = Quote $ Var Pref "fmap"
-fmapIE     = Quote $ Var Inf  "fmap"
-subtractE  = Quote $ Var Pref "subtract"
-minusE     = Quote $ Var Inf  "-"
-liftME     = Quote $ Var Pref "liftM"
-liftM2E    = Quote $ Var Pref "liftM2"
-fishE      = Quote $ Var Inf  ">=>"
-kliesliE   = Quote $ Var Inf "<=<"
-apE        = Quote $ Var Inf  "ap"
-seqME      = Quote $ Var Inf  ">>"
-zipE       = Quote $ Var Pref "zip"
-zipWithE   = Quote $ Var Pref "zipWith"
-crossE     = Quote $ Var Inf  "***"
-firstE     = Quote $ Var Pref "first"
-secondE    = Quote $ Var Pref "second"
-andE       = Quote $ Var Pref "and"
-orE        = Quote $ Var Pref "or"
-allE       = Quote $ Var Pref "all"
-anyE       = Quote $ Var Pref "any"
-replaceE   = Quote $ Var Inf "<$"
-pointyE    = Quote $ Var Inf "$>"
-
-
-
-a, c, c2 :: MExpr -> MExpr -> MExpr
-a       = MApp
-c e1 e2 = compE `a` e1 `a` e2
-c2 e1 e2 = comp2E `a` e1 `a` e2
-c3 e1 e2 = comp3E `a` e1 `a` e2
-o e1 e2 = oedipusE `a` e1 `a` e2
-o2 e1 e2 = oedipus2E `a` e1 `a` e2
-eye e1 e2 = eyeE `a` e1 `a` e2
-infixl 9 `a`
-infixr 8 `c`
-infixr 8 `c2`
-infixr 8 `o`
-
-
-collapseLists :: Expr -> Maybe Expr
-collapseLists (Var _ "++" `App` e1 `App` e2)
-  | (xs,x) <- getList e1, x==nil,
-    (ys,y) <- getList e2, y==nil = Just $ makeList $ xs ++ ys
-collapseLists _ = Nothing
-
-data Binary = forall a b c. (Read a, Show a, Read b, Show b, Read c, Show c) => BA (a -> b -> c)
-
-evalBinary :: [(String, Binary)] -> Expr -> Maybe Expr
-evalBinary fs (Var _ f' `App` Var _ x' `App` Var _ y')
-  | Just (BA f) <- lookup f' fs = (Var Pref . show) `fmap` liftM2 f (readM x') (readM y')
-evalBinary _ _ = Nothing
-
-data Unary = forall a b. (Read a, Show a, Read b, Show b) => UA (a -> b)
-
-evalUnary :: [(String, Unary)] -> Expr -> Maybe Expr
-evalUnary fs (Var _ f' `App` Var _ x')
-  | Just (UA f) <- lookup f' fs = (Var Pref . show . f) `fmap` readM x'
-evalUnary _ _ = Nothing
-
-assocR, assocL, assoc :: [String] -> Expr -> Maybe Expr
--- (f `op` g) `op` h --> f `op` (g `op` h)
-assocR ops (Var f1 op1 `App` (Var f2 op2 `App` e1 `App` e2) `App` e3)
-  | op1 == op2 && op1 `elem` ops
-  = Just (Var f1 op1 `App` e1 `App` (Var f2 op2 `App` e2 `App` e3))
-assocR _ _ = Nothing
-
--- f `op` (g `op` h) --> (f `op` g) `op` h
-assocL ops (Var f1 op1 `App` e1 `App` (Var f2 op2 `App` e2 `App` e3))
-  | op1 == op2 && op1 `elem` ops
-  = Just (Var f1 op1 `App` (Var f2 op2 `App` e1 `App` e2) `App` e3)
-assocL _ _ = Nothing
-
--- op f . op g --> op (f `op` g)
-assoc ops (Var _ "." `App` (Var f1 op1 `App` e1) `App` (Var f2 op2 `App` e2))
-  | op1 == op2 && op1 `elem` ops
-  = Just (Var f1 op1 `App` (Var f2 op2 `App` e1 `App` e2))
-assoc _ _ = Nothing
-
-commutative :: [String] -> Expr -> Maybe Expr
-commutative ops (Var f op `App` e1 `App` e2)
-  | op `elem` ops = Just (Var f op `App` e2 `App` e1)
-commutative ops (Var _ "flip" `App` e@(Var _ op)) | op `elem` ops = Just e
-commutative _ _ = Nothing
-
--- TODO: Move rules into a file.
-{-# INLINE simplifies #-}
-simplifies :: RewriteRule
-simplifies = Or [
-  -- (f . g) x --> f (g x)
-  rr0 (\f g x -> (f `c` g) `a` x)
-      (\f g x -> f `a` (g `a` x)),
-  -- (g -. f) -> f (g x)
-  rr0 (\f g x -> (f `eye` g) `a` x)
-      (\f g x -> f `a` (g `a` x)),
-  -- (f .* g) x y -> f (g x y)
-  rr0  (\f g x y -> (f `c2` g) `a` x `a` y)
-       (\f g x y -> f `a` (g `a` x `a` y)),
-  -- (f .** g) x y z -> f (g x y z)
-  rr0 (\f g x y z -> (f `c3` g) `a` x `a` y `a` z)
-      (\f g x y z -> f `a` (g `a` x `a` y `a` z)),
-  -- (f -.* g) x y -> f x (g y)
-  rr0  (\f g x y -> (f `o` g) `a` x `a` y)
-       (\f g x y -> f `a` x `a` (g `a` y)),
-  -- (f -.** g) -> f x y (g z)
-  rr0 (\f g x y z -> (f `o2` g) `a` x `a` y `a` z)
-      (\f g x y z -> f `a` x `a` y `a` (g `a` z)),
-  -- x & f -> f x
-  rr0 (\f x -> x `a` ampersandE `a` f)
-      a,
-  -- id x --> x
-  rr0 (\x -> idE `a` x)
-      id,
-  -- flip (flip x) --> x
-  rr  (\x -> flipE `a` (flipE `a` x))
-      id,
-  -- flip id x . f --> flip f x
-  rr0 (\f x -> (flipE `a` idE `a` x) `c` f)
-      (\f x -> flipE `a` f `a` x),
-  -- id . f --> f
-  rr0 (\f -> idE `c` f)
-      id,
-  -- f . id --> f
-  rr0 (`c` idE)
-      id,
-  -- const x y --> x
-  rr0 (\x y -> constE `a` x `a` y)
-      const,
-  -- not (not x) --> x
-  rr  (\x -> notE `a` (notE `a` x))
-      id,
-  -- fst (x,y) --> x
-  rr  (\x y -> fstE `a` (commaE `a` x `a` y))
-      const,
-  -- snd (x,y) --> y
-  rr  (\x y -> sndE `a` (commaE `a` x `a` y))
-      (\_ y -> y),
-  -- head (x:xs) --> x
-  rr  (\x xs -> headE `a` (consE `a` x `a` xs))
-      const,
-  -- tail (x:xs) --> xs
-  rr  (\x xs -> tailE `a` (consE `a` x `a` xs))
-      (\_ xs -> xs),
-  -- uncurry f (x,y) --> f x y
-  rr1 (\f x y -> uncurryE `a` f `a` (commaE `a` x `a` y))
-      (\f x y -> f `a` x `a` y),
-  -- uncurry (,) --> id
-  rr  (uncurryE `a` commaE)
-      idE,
-  -- uncurry f . s (,) g --> s f g
-  rr1 (\f g -> (uncurryE `a` f) `c` (sE `a` commaE `a` g))
-      (\f g -> sE `a` f `a` g),
-  -- curry fst --> const
-  rr (curryE `a` fstE) constE,
-  -- curry snd --> const id
-  rr (curryE `a` sndE) (constE `a` idE),
-  -- s f g x --> f x (g x)
-  rr0 (\f g x -> sE `a` f `a` g `a` x)
-      (\f g x -> f `a` x `a` (g `a` x)),
-  -- flip f x y --> f y x
-  rr0 (\f x y -> flipE `a` f `a` x `a` y)
-      (\f x y -> f `a` y `a` x),
-  -- flip (=<<) --> (>>=)
-  rr0 (flipE `a` extE)
-      bindE,
-
-  -- TODO: Think about map/fmap
-  -- fmap id --> id
-  rr (fmapE `a` idE)
-     idE,
-  -- map id --> id
-  rr (mapE `a` idE)
-     idE,
-  -- (f . g) . h --> f . (g . h)
-  rr0 (\f g h -> (f `c` g) `c` h)
-      (\f g h -> f `c` (g `c` h)),
-  -- fmap f . fmap g -> fmap (f . g)
-  rr0 (\f g -> fmapE `a` f `c` fmapE `a` g)
-      (\f g -> fmapE `a` (f `c` g)),
-  -- map f . map g -> map (f . g)
-  rr0 (\f g -> mapE `a` f `c` mapE `a` g)
-      (\f g -> mapE `a` (f `c` g))
-
-  ]
-
-onceRewrites :: RewriteRule
-onceRewrites = Hard $ Or [
-  -- ($) --> id
-  rr0 dollarE
-      idE,
-  -- concatMap --> (=<<)
-  rr concatMapE extE,
-  -- concat    --> join
-  rr concatE joinE,
-  -- liftM --> fmap
-  rr liftME fmapE,
-  -- map --> fmap
-  rr mapE fmapE,
-  -- subtract -> flip (-)
-  rr  subtractE
-      (flipE `a` minusE)
-  ]
-
--- Now we can state rewrite rules in a nice high level way
--- Rewrite rules should be as pointful as possible since the pointless variants
--- will be derived automatically.
-rules :: RewriteRule
-rules = Or [
-  -- f (g x) --> (f . g) x
-  Hard $
-  rr  (\f g x -> f `a` (g `a` x))
-      (\f g x -> (f `c` g) `a` x),
-  -- (>>=) --> flip (=<<)
-  -- (>>=) --> flip (=<<)
-  Hard $
-  rr  bindE
-      (flipE `a` extE),
-  -- (.) id --> id
-  rr (compE `a` idE)
-     idE,
-  -- (++) [x] --> (:) x
-  rr  (\x -> appendE `a` (consE `a` x `a` nilE))
-      (\x -> consE `a` x),
-  -- (=<<) return --> id
-  rr  (extE `a` returnE)
-      idE,
-  -- (=<<) f (return x) -> f x
-  rr  (\f x -> extE `a` f `a` (returnE `a` x))
-      a,
-  -- (=<<) ((=<<) f . g) --> (=<<) f . (=<<) g
-  rr  (\f g -> extE `a` ((extE `a` f) `c` g))
-      (\f g -> (extE `a` f) `c` (extE `a` g)),
-  -- flip (f . g) --> flip (.) g . flip f
-  Hard $
-  rr  (\f g -> flipE `a` (f `c` g))
-      (\f g -> (flipE `a` compE `a` g) `c` (flipE `a` f)),
-  -- flip (.) f . flip id --> flip f
-  rr  (\f -> (flipE `a` compE `a` f) `c` (flipE `a` idE))
-      (\f -> flipE `a` f),
-  -- flip (.) f . flip flip --> flip (flip . f)
-  rr  (\f -> (flipE `a` compE `a` f) `c` (flipE `a` flipE))
-      (\f -> flipE `a` (flipE `c` f)),
-  -- flip (flip (flip . f) g) --> flip (flip . flip f) g
-  rr1 (\f g -> flipE `a` (flipE `a` (flipE `c` f) `a` g))
-      (\f g -> flipE `a` (flipE `c` flipE `a` f) `a` g),
-
-  -- flip (.) id --> id
-  rr (flipE `a` compE `a` idE)
-     idE,
-  -- (.) . flip id --> flip flip
-  rr  (compE `c` (flipE `a` idE))
-      (flipE `a` flipE),
-  -- s const x y --> y
-  rr  (\x y -> sE `a` constE `a` x `a` y)
-      (\_ y -> y),
-  -- s (const . f) g --> f
-  rr1 (\f g -> sE `a` (constE `c` f) `a` g)
-      const,
-  -- s (const f) --> (.) f
-  rr  (\f -> sE `a` (constE `a` f))
-      (\f -> compE `a` f),
-  -- s (f . fst) snd --> uncurry f
-  rr  (\f -> sE `a` (f `c` fstE) `a` sndE)
-      (\f -> uncurryE `a` f),
-  -- fst (join (,) x) --> x
-  rr (\x -> fstE `a` (joinE `a` commaE `a` x))
-     id,
-  -- snd (join (,) x) --> x
-  rr (\x -> sndE `a` (joinE `a` commaE `a` x))
-     id,
-  -- The next two are `simplifies', strictly speaking, but invoked rarely.
-  -- uncurry f (x,y) --> f x y
-  rr  (\f x y -> uncurryE `a` f `a` (commaE `a` x `a` y))
-      (\f x y -> f `a` x `a` y),
-  -- curry (uncurry f) --> f
-  rr (\f -> curryE `a` (uncurryE `a` f))
-     id,
-  -- uncurry (curry f) --> f
-  rr (\f -> uncurryE `a` (curryE `a` f))
-     id,
-  -- (const id . f) --> const id
-  rr  (\f -> (constE `a` idE) `c` f)
-      (\_ -> constE `a` idE),
-  -- const x . f --> const x
-  rr (\x f -> constE `a` x `c` f)
-     (\x _ -> constE `a` x),
-  -- fix f --> f (fix x)
-  Hard $
-  rr0 (\f -> fixE `a` f)
-      (\f -> f `a` (fixE `a` f)),
-  -- f (fix f) --> fix x
-  Hard $
-  rr0 (\f -> f `a` (fixE `a` f))
-      (\f -> fixE `a` f),
-  -- fix f --> f (f (fix x))
-  Hard $
-  rr0 (\f -> fixE `a` f)
-      (\f -> f `a` (f `a` (fixE `a` f))),
-  -- fix (const f) --> f
-  rr (\f -> fixE `a` (constE `a` f))
-     id,
-  -- flip const x --> id
-  rr  (\x -> flipE `a` constE `a` x)
-      (pure idE),
-  -- const . f --> flip (const f)
-  Hard $
-  rr  (\f -> constE `c` f)
-      (\f -> flipE `a` (constE `a` f)),
-  -- not (x == y) -> x /= y
-  rr2 (\x y -> notE `a` (equalsE `a` x `a` y))
-      (\x y -> nequalsE `a` x `a` y),
-  -- not (x /= y) -> x == y
-  rr2 (\x y -> notE `a` (nequalsE `a` x `a` y))
-      (\x y -> equalsE `a` x `a` y),
-  If (Or [rr plusE plusE, rr minusE minusE, rr multE multE]) $ down $ Or [
-    -- 0 + x --> x
-    rr  (\x -> plusE `a` zeroE `a` x)
-        id,
-    -- 0 * x --> 0
-    rr  (\x -> multE `a` zeroE `a` x)
-        (pure zeroE),
-    -- 1 * x --> x
-    rr  (\x -> multE `a` oneE `a` x)
-        id,
-    -- x - x --> 0
-    rr  (\x -> minusE `a` x `a` x)
-        (pure zeroE),
-    -- x - y + y --> x
-    rr  (\y x -> plusE `a` (minusE `a` x `a` y) `a` y)
-        (\_ x -> x),
-    -- x + y - y --> x
-    rr  (\y x -> minusE `a` (plusE `a` x `a` y) `a` y)
-        (\_ x -> x),
-    -- x + (y - z) --> x + y - z
-    rr  (\x y z -> plusE `a` x `a` (minusE `a` y `a` z))
-        (\x y z -> minusE `a` (plusE `a` x `a` y) `a` z),
-    -- x - (y + z) --> x - y - z
-    rr  (\x y z -> minusE `a` x `a` (plusE `a` y `a` z))
-        (\x y z -> minusE `a` (minusE `a` x `a` y) `a` z),
-    -- x - (y - z) --> x + y - z
-    rr  (\x y z -> minusE `a` x `a` (minusE `a` y `a` z))
-        (\x y z -> minusE `a` (plusE `a` x `a` y) `a` z)
-  ],
-
-  -- flip ($) -> &
-  rr (flipE `a` dollarE)
-     ampersandE,
-
-  -- fmap . const -> (<$)
-  rr (fmapE `c` constE)
-     replaceE,
-
-  -- flip (<$) -> ($>)
-  Hard $
-  rr (flipE `a` replaceE)
-     pointyE,
-
-  Hard onceRewrites,
-  -- join (fmap f x) --> f =<< x
-  rr (\f x -> joinE `a` (fmapE `a` f `a` x))
-     (\f x -> extE `a` f `a` x),
-  -- (=<<) id --> join
-  rr (extE `a` idE) joinE,
-  -- join --> (=<<) id
-  Hard $
-  rr joinE (extE `a` idE),
-  -- join (return x) --> x
-  rr (\x -> joinE `a` (returnE `a` x))
-     id,
-  -- (return . f) =<< m --> fmap f m
-  rr (\f m -> extE `a` (returnE `c` f) `a` m)
-     (\f m -> fmapIE `a` f `a` m),
-  -- (x >>=) . (return .) . f  --> flip (fmap . f) x
-  rr (\f x -> bindE `a` x `c` (compE `a` returnE) `c` f)
-     (\f x -> flipE `a` (fmapIE `c` f) `a` x),
-  -- (>>=) (return f) --> flip id f
-  rr (\f -> bindE `a` (returnE `a` f))
-     (\f -> flipE `a` idE `a` f),
-  -- liftM2 f x --> ap (f `fmap` x)
-  Hard $
-  rr (\f x -> liftM2E `a` f `a` x)
-     (\f x -> apE `a` (fmapIE `a` f `a` x)),
-  -- liftM2 f (return x) --> fmap (f x)
-  rr (\f x -> liftM2E `a` f `a` (returnE `a` x))
-     (\f x -> fmapIE `a` (f `a` x)),
-  -- f `fmap` return x --> return (f x)
-  rr (\f x -> fmapE `a` f `a` (returnE `a` x))
-     (\f x -> returnE `a` (f `a` x)),
-  -- (=<<) . flip (fmap . f) --> flip liftM2 f
-  Hard $
-  rr (\f -> extE `c` flipE `a` (fmapE `c` f))
-     (\f -> flipE `a` liftM2E `a` f),
-
-  -- ((f .) .) . g --> (f .** g)
-  Hard $ rr (\f g -> (compE `a` (compE `a` f)) `c` g)
-     (\f g -> (comp3E `a` f `a` g)),
-
-  -- (f .) . g --> (f .* g)
-  Hard $ rr (\f g -> (compE `a` f) `c` g)
-     (\f g -> comp2E `a` f `a` g),
-
-  -- flip (.) -> (-.)
-  rr (flipE `a` compE)
-     eyeE,
-
-  -- (x &) -> ($ x)
-  rr (\x -> ampersandE `a` x)
-     (\x -> dollarE `a` x),
-
-  -- f -.* (g . f) -> on g f
-  Hard $
-  rr (\f g -> oedipusE `a` f `a` (compE `a` g `a` f))
-     (\f g -> onE `a` g `a` f),
-
-  -- (.) -> fmap
-  Hard $
-  rr compE fmapE,
-
-  -- join .* map x y -> (=<<) x y
-  Hard $
-  rr (joinE `c2` mapE) extE,
-
-  -- map f (zip xs ys) --> zipWith (curry f) xs ys
-  Hard $
-  rr (\f xs ys -> mapE `a` f `a` (zipE `a` xs `a` ys))
-     (\f xs ys -> zipWithE `a` (curryE `a` f) `a` xs `a` ys),
-
-  -- zipWith (,) --> zip (,)
-  rr (zipWithE `a` commaE) zipE,
-
-  -- all f --> and . map f
-  Hard $
-  rr (\f -> allE `a` f)
-     (\f -> andE `c` mapE `a` f),
-  -- and . map f --> all f
-  rr (\f -> andE `c` mapE `a` f)
-     (\f -> allE `a` f),
-  -- any f --> or . map f
-  Hard $
-  rr (\f -> anyE `a` f)
-     (\f -> orE `c` mapE `a` f),
-  -- or . map f --> any f
-  rr (\f -> orE `c` mapE `a` f)
-     (\f -> anyE `a` f),
-
-  -- return f `ap` x --> fmap f x
-  rr (\f x -> apE `a` (returnE `a` f) `a` x)
-     (\f x -> fmapIE `a` f `a` x),
-  -- ap (f `fmap` x) --> liftM2 f x
-  rr (\f x -> apE `a` (fmapIE `a` f `a` x))
-     (\f x -> liftM2E `a` f `a` x),
-  -- f `ap` x --> (`fmap` x) =<< f
-  Hard $
-  rr (\f x -> apE `a` f `a` x)
-     (\f x -> extE `a` (flipE `a` fmapIE `a` x) `a` f),
-  -- (`fmap` x) =<< f --> f `ap` x
-  rr (\f x -> extE `a` (flipE `a` fmapIE `a` x) `a` f)
-     (\f x -> apE `a` f `a` x),
-  -- (x >>=) . flip (fmap . f) -> liftM2 f x
-  rr (\f x -> bindE `a` x `c` flipE `a` (fmapE `c` f))
-     (\f x -> liftM2E `a` f `a` x),
-
-  -- (f =<< m) x --> f (m x) x
-  rr0 (\f m x -> extE `a` f `a` m `a` x)
-      (\f m x -> f `a` (m `a` x) `a` x),
-  -- (fmap f g x) --> f (g x)
-  rr0 (\f g x -> fmapE `a` f `a` g `a` x)
-      (\f g x -> f `a` (g `a` x)),
-  -- return x y --> y
-  rr  (\y x -> returnE `a` x `a` y)
-      const,
-  -- liftM2 f g h x --> g x `h` h x
-  rr0 (\f g h x -> liftM2E `a` f `a` g `a` h `a` x)
-      (\f g h x -> f `a` (g `a` x) `a` (h `a` x)),
-  -- ap f id --> join f
-  rr  (\f -> apE `a` f `a` idE)
-      (\f -> joinE `a` f),
-
-  -- flip flip f . ((.) .* g) --> f -.** g
-  Hard $
-  rr (\f g -> (flipE `a` flipE `a` f `c` (compE `c2` g)))
-     (\f g -> oedipus2E `a` f `a` g),
-
-  -- (. f) . g --> (f -.* g)
-  Hard $
-  rr (\f g -> (flipE `a` compE `a` f) `c` g)
-     (\f g -> oedipusE `a` f `a` g),
-
-  -- (=<<) const q --> flip (>>) q
-  Hard $ -- ??
-  rr (\q p -> extE `a` (constE `a` q) `a` p)
-     (\q p -> seqME `a` p `a` q),
-  -- p >> q --> const q =<< p
-  Hard $
-  rr (\p q -> seqME `a` p `a` q)
-     (\p q -> extE `a` (constE `a` q) `a` p),
-
-  -- ap (f -.* ((,) . f . fst)) snd --> f (***) f
-  Hard $
-  rr (\f -> apE `a` (f `o` (commaE `c` f `c` fstE)) `a` sndE)
-     (\f -> joinE `a` crossE `a` f),
-
-  -- flip (=<<) --> >>=
-  rr (flipE `a` extE)
-     bindE,
-
-  -- flip (>=>) --> <=<
-  rr (flipE `a` fishE)
-     kliesliE,
-
-  -- (.) . (=<<) --> <=<
-  rr (compE `c` extE)
-     kliesliE,
-
-  -- join . (g .* f) --> f >=> g
-  Hard $
-    rr (\f g -> joinE `c` (g `c2` f))
-       (\f g -> fishE `a` f `a` g),
-
-  -- (`ap` snd) . (fst -.* (flip =<< (.) .* ((,) .))) --> join (***)
-  -- Hard $
-  rr ((flipE `a` apE `a` sndE) `c` (fstE `o` (extE `a` flipE `a` (compE `c2` (compE `a` commaE)))))
-     (joinE `a` crossE),
-
-  -- experimental support for Control.Arrow stuff
-  -- (costs quite a bit of performace)
-  -- uncurry ((. g) . (,) . f) --> f *** g
-  rr (\f g -> uncurryE `a` ((flipE `a` compE `a` g) `c` commaE `c` f))
-     (\f g -> crossE `a` f `a` g),
-  -- uncurry ((,) . f) --> first f
-  rr (\f -> uncurryE `a` (commaE `c` f))
-     (\f -> firstE `a` f),
-  -- uncurry ((. g) . (,)) --> second g
-  rr (\g -> uncurryE `a` ((flipE `a` compE `a` g) `c` commaE))
-     (\g -> secondE `a` g),
-  -- I think we need all three of them:
-  -- uncurry (const f) --> f . snd
-  rr (\f -> uncurryE `a` (constE `a` f))
-     (`c` sndE),
-  -- uncurry const --> fst
-  rr (uncurryE `a` constE)
-     fstE,
-  -- uncurry (const . f) --> f . fst
-  rr (\f -> uncurryE `a` (constE `c` f))
-     (`c` fstE),
-
-  -- TODO is this the right place?
-  -- [x] --> return x
-  Hard $
-  rr (\x -> consE `a` x `a` nilE)
-     (\x -> returnE `a` x),
-  -- list destructors
-  Hard $
-  If (Or [rr consE consE, rr nilE nilE]) $ Or [
-    down $ Or [
-      -- length [] --> 0
-      rr (lengthE `a` nilE)
-         zeroE,
-      -- length (x:xs) --> 1 + length xs
-      rr (\x xs -> lengthE `a` (consE `a` x `a` xs))
-         (\_ xs -> plusE `a` oneE `a` (lengthE `a` xs))
-    ],
-    -- map/fmap elimination
-    down $ Or [
-      -- map f (x:xs) --> f x: map f xs
-      rr (\f x xs -> mapE `a` f `a` (consE `a` x `a` xs))
-         (\f x xs -> consE `a` (f `a` x) `a` (mapE `a` f `a` xs)),
-      -- fmap f (x:xs) --> f x: Fmap f xs
-      rr (\f x xs -> fmapE `a` f `a` (consE `a` x `a` xs))
-         (\f x xs -> consE `a` (f `a` x) `a` (fmapE `a` f `a` xs)),
-      -- map f []     --> []
-      rr (\f -> mapE `a` f `a` nilE)
-         (pure nilE),
-      -- fmap f []     --> []
-      rr (\f -> fmapE `a` f `a` nilE)
-         (pure nilE)
-    ],
-    -- foldr elimination
-    down $ Or [
-      -- foldr f z (x:xs) --> f x (foldr f z xs)
-      rr (\f x xs z -> (foldrE `a` f `a` z) `a` (consE `a` x `a` xs))
-         (\f x xs z -> (f `a` x) `a` (foldrE `a` f `a` z `a` xs)),
-      -- foldr f z [] --> z
-      rr (\f z -> foldrE `a` f `a` z `a` nilE)
-         (\_ z -> z)
-    ],
-    -- foldl elimination
-    down $ Opt (CRR $ assocL ["."]) `Then` Or [
-      -- sum xs --> foldl (+) 0 xs
-      rr (\xs -> sumE `a` xs)
-         (\xs -> foldlE `a` plusE `a` zeroE `a` xs),
-      -- product xs --> foldl (*) 1 xs
-      rr (\xs -> productE `a` xs)
-         (\xs -> foldlE `a` multE `a` oneE `a` xs),
-      -- foldl1 f (x:xs) --> foldl f x xs
-      rr (\f x xs -> foldl1E `a` f `a` (consE `a` x `a` xs))
-         (\f x xs -> foldlE `a` f `a` x `a` xs),
-      -- foldl f z (x:xs) --> foldl f (f z x) xs
-      rr (\f z x xs -> (foldlE `a` f `a` z) `a` (consE `a` x `a` xs))
-         (\f z x xs -> foldlE `a` f `a` (f `a` z `a` x) `a` xs),
-      -- foldl f z [] --> z
-      rr (\f z -> foldlE `a` f `a` z `a` nilE)
-         (\_ z -> z),
-      -- special rule:
-      -- foldl f z [x] --> f z x
-      rr (\f z x -> foldlE `a` f `a` z `a` (returnE `a` x))
-         (\f z x -> f `a` z `a` x),
-      rr (\f z x -> foldlE `a` f `a` z `a` (consE `a` x `a` nilE))
-         (\f z x -> f `a` z `a` x)
-    ] `OrElse` (
-      -- (:) x --> (++) [x]
-      Opt (rr0 (\x -> consE `a` x)
-         (\x -> appendE `a` (consE `a` x `a` nilE))) `Then`
-      -- More special rule: (:) x . (++) ys --> (++) (x:ys)
-      up (rr0 (\x ys -> (consE `a` x) `c` (appendE `a` ys))
-         (\x ys -> appendE `a` (consE `a` x `a` ys)))
-      )
-  ],
-
-  -- Complicated Transformations
-  CRR collapseLists,
-  up $ Or [CRR (evalUnary unaryBuiltins), CRR (evalBinary binaryBuiltins)],
-  up $ CRR (assoc assocOps),
-  up $ CRR (assocL assocOps),
-  up $ CRR (assocR assocOps),
-  Up (CRR (commutative commutativeOps)) $ down $ Or [CRR $ assocL assocLOps,
-                                                     CRR $ assocR assocROps],
-
-  Hard simplifies
-  ] `Then` Opt (up simplifies)
-assocLOps, assocROps, assocOps :: [String]
-assocLOps = ["+", "*", "&&", "||", "max", "min"]
-assocROps = [".", "++", ".*", ".**"]
-assocOps  = assocLOps ++ assocROps
-
-commutativeOps :: [String]
-commutativeOps = ["*", "+", "==", "/=", "max", "min"]
-
-unaryBuiltins :: [(String,Unary)]
-unaryBuiltins = [
-    ("not",    UA (not    :: Bool -> Bool)),
-    ("negate", UA (negate :: Integer -> Integer)),
-    ("signum", UA (signum :: Integer -> Integer)),
-    ("abs",    UA (abs    :: Integer -> Integer))
-  ]
-
-binaryBuiltins :: [(String,Binary)]
-binaryBuiltins = [
-    ("+",    BA ((+)  :: Integer -> Integer -> Integer)),
-    ("-",    BA ((-)  :: Integer -> Integer -> Integer)),
-    ("*",    BA ((*)  :: Integer -> Integer -> Integer)),
-    ("^",    BA ((^)  :: Integer -> Integer -> Integer)),
-    ("<",    BA ((<)  :: Integer -> Integer -> Bool)),
-    (">",    BA ((>)  :: Integer -> Integer -> Bool)),
-    ("==",   BA ((==) :: Integer -> Integer -> Bool)),
-    ("/=",   BA ((/=) :: Integer -> Integer -> Bool)),
-    ("<=",   BA ((<=) :: Integer -> Integer -> Bool)),
-    (">=",   BA ((>=) :: Integer -> Integer -> Bool)),
-    ("div",  BA (div  :: Integer -> Integer -> Integer)),
-    ("mod",  BA (mod  :: Integer -> Integer -> Integer)),
-    ("max",  BA (max  :: Integer -> Integer -> Integer)),
-    ("min",  BA (min  :: Integer -> Integer -> Integer)),
-    ("&&",   BA ((&&) :: Bool -> Bool -> Bool)),
-    ("||",   BA ((||) :: Bool -> Bool -> Bool))
-  ]
diff --git a/Plugin/Pl/Transform.hs b/Plugin/Pl/Transform.hs
deleted file mode 100644
--- a/Plugin/Pl/Transform.hs
+++ /dev/null
@@ -1,146 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE PatternGuards     #-}
-module Plugin.Pl.Transform (
-    transform,
-  ) where
-
-import           Control.Monad.Trans.State
-import           Data.Graph                (flattenSCC, flattenSCCs,
-                                            stronglyConnComp)
-import qualified Data.Map                  as M
-import           Data.Maybe
-import           Plugin.Pl.Common
-
-occursP :: String -> Pattern -> Bool
-occursP v (PVar v')      = v == v'
-occursP v (PTuple p1 p2) = v `occursP` p1 || v `occursP` p2
-occursP v (PCons  p1 p2) = v `occursP` p1 || v `occursP` p2
-
-freeIn :: String -> Expr -> Int
-freeIn v (Var _ v') = fromEnum $ v == v'
-freeIn v (Lambda pat e) = if v `occursP` pat then 0 else freeIn v e
-freeIn v (App e1 e2) = freeIn v e1 + freeIn v e2
-freeIn v (Let ds e') = if v `elem` map declName ds then 0
-  else freeIn v e' + sum [freeIn v e | Define _ e <- ds]
-
-isFreeIn :: String -> Expr -> Bool
-isFreeIn v e = freeIn v e > 0
-
-tuple :: [Expr] -> Expr
-tuple  = foldr1 (\x y -> Var Inf "," `App` x `App` y)
-
-tupleP :: [String] -> Pattern
-tupleP vs = foldr1 PTuple $ PVar `map` vs
-
-dependsOn :: [Decl] -> Decl -> [Decl]
-dependsOn ds d = [d' | d' <- ds, declName d' `isFreeIn` declExpr d]
-
-unLet :: Expr -> Expr
-unLet (App e1 e2) = App (unLet e1) (unLet e2)
-unLet (Let [] e) = unLet e
-unLet (Let ds e) = unLet $
-  Lambda (tupleP $ declName `map` dsYes) (Let dsNo e) `App`
-    (fix' `App` Lambda (tupleP $ declName `map` dsYes)
-                        (tuple  $ declExpr `map` dsYes))
-    where
-  comps = stronglyConnComp [(d',d',dependsOn ds d') | d' <- ds]
-  dsYes = flattenSCC $ head comps
-  dsNo = flattenSCCs $ tail comps
-
-unLet (Lambda v e) = Lambda v (unLet e)
-unLet (Var f x) = Var f x
-
-type Env = M.Map String String
-
--- It's a pity we still need that for the pointless transformation.
--- Otherwise a newly created id/const/... could be bound by a lambda
--- e.g. transform' (\id x -> x) ==> transform' (\id -> id) ==> id
-alphaRename :: Expr -> Expr
-alphaRename e = alpha e `evalState` M.empty where
-  alpha :: Expr -> State Env Expr
-  alpha (Var f v)     = Var f . fromMaybe v . M.lookup v <$> get
-  alpha (App e1 e2)   = liftM2 App (alpha e1) (alpha e2)
-  alpha (Let _ _)     = assert False bt
-  alpha (Lambda v e') = inEnv $ liftM2 Lambda (alphaPat v) (alpha e')
-
-  -- act like a reader monad
-  inEnv :: State s a -> State s a
-  inEnv f = gets $ evalState f
-
-  alphaPat (PVar v) = do
-    fm <- get
-    let v' = "$" ++ show (M.size fm)
-    put $ M.insert v v' fm
-    return $ PVar v'
-  alphaPat (PTuple p1 p2) = liftM2 PTuple (alphaPat p1) (alphaPat p2)
-  alphaPat (PCons p1 p2) = liftM2 PCons (alphaPat p1) (alphaPat p2)
-
-
-transform :: Expr -> Expr
-transform = transform' . alphaRename . unLet
-
--- Infinite generator of variable names.
-varNames :: [String]
-varNames = flip replicateM usableChars =<< [1..]
-  where
-    usableChars = ['a'..'z']
-
--- First variable name not already in use
-fresh :: [String] -> String
-fresh variables = head . filter (not . flip elem variables) $ varNames
-
-names :: Expr -> [String]
-names (Var _ str)     = [str]
--- Lambda pattern names are rewritten to be meaningless/unwritable, so we don't
--- need to include them here. Variables from lambdas used in expressions are
--- also rewritten, but there's no reason to special-case it unless it's provably
--- poor-performing to scan over the result in `fresh`, which I doubt it is.
-names (Lambda _ exp') = names exp'
-names (App exp1 exp2) = names exp1 ++ names exp2
-names (Let dlcs exp') = (dnames =<< dlcs) ++ names exp'
-  where
-    dnames (Define nm exp'') = nm : names exp''
-
-transform' :: Expr -> Expr
-transform' exp' = go exp'
-  where
-    -- Explicit sharing for readability
-    vars = names exp'
-
-    go Let {} =
-      assert False bt
-    go (Var f v) =
-      Var f v
-    go (App e1 e2) =
-      App (go e1) (go e2)
-    go (Lambda (PTuple p1 p2) e) =
-      go $
-        Lambda (PVar var) $ (Lambda p1 . Lambda p2 $ e) `App` f `App` s
-      where
-        var   = fresh vars
-        f     = Var Pref "fst" `App` Var Pref var
-        s     = Var Pref "snd" `App` Var Pref var
-    go (Lambda (PCons p1 p2) e) =
-      go $
-        Lambda (PVar var) $ (Lambda p1 . Lambda p2 $ e) `App` f `App` s
-      where
-        var = fresh vars
-        f   = Var Pref "head" `App` Var Pref var
-        s   = Var Pref "tail" `App` Var Pref var
-    go (Lambda (PVar v) e) =
-      go $ getRidOfV e
-      where
-        getRidOfV (Var f v') | v == v'   = id'
-                             | otherwise = const' `App` Var f v'
-        getRidOfV l@(Lambda pat _) =
-          assert (not $ v `occursP` pat) $ getRidOfV $ go l
-        getRidOfV Let {} = assert False bt
-        getRidOfV e'@(App e1 e2)
-          | fr1 && fr2 = scomb `App` getRidOfV e1 `App` getRidOfV e2
-          | fr1 = flip' `App` getRidOfV e1 `App` e2
-          | Var _ v' <- e2, v' == v = e1
-          | fr2 = comp `App` e1 `App` getRidOfV e2
-          | otherwise = const' `App` e'
-          where
-            fr1 = v `isFreeIn` e1
-            fr2 = v `isFreeIn` e2
diff --git a/Pointfree.hs b/Pointfree.hs
deleted file mode 100644
--- a/Pointfree.hs
+++ /dev/null
@@ -1,31 +0,0 @@
-module Pointfree where
-
-import Plugin.Pl.Common (mapTopLevel, mapTopLevel')
-import Plugin.Pl.Optimize (optimize)
-import Plugin.Pl.Parser (parsePF)
-import Plugin.Pl.PrettyPrinter (prettyTopLevel)
-import Plugin.Pl.Transform (transform)
-
-import Data.Maybe (listToMaybe)
-
-{- |
-  >>> pointfree "I'm not a valid Haskell expression!"
-  []
-  >>> pointfree "sum xs = foldr (+) 0 xs"
-  ["sum = id (fix (const (foldr (+) 0)))","sum = fix (const (foldr (+) 0))","sum = foldr (+) 0"]
--}
-pointfree :: String -> [String]
-pointfree
-  = either
-    (const [])
-    (map prettyTopLevel . mapTopLevel' optimize . mapTopLevel transform)
-  . parsePF
-
-{- |
-  >>> pointfree' "I'm not a valid Haskell expression!"
-  Nothing
-  >>> pointfree' "sum xs = foldr (+) 0 xs"
-  Just "sum = foldr (+) 0"
--}
-pointfree' :: String -> Maybe String
-pointfree' = listToMaybe . reverse . pointfree
diff --git a/lib/Pointfree.hs b/lib/Pointfree.hs
new file mode 100644
--- /dev/null
+++ b/lib/Pointfree.hs
@@ -0,0 +1,30 @@
+module Pointfree where
+
+import           Data.Maybe              (listToMaybe)
+import           Plugin.Pl.Common        (mapTopLevel, mapTopLevel')
+import           Plugin.Pl.Optimize      (optimize)
+import           Plugin.Pl.Parser        (parsePF)
+import           Plugin.Pl.PrettyPrinter (prettyTopLevel)
+import           Plugin.Pl.Transform     (transform)
+
+{- |
+  >>> pointfree "I'm not a valid Haskell expression!"
+  []
+  >>> pointfree "sum xs = foldr (+) 0 xs"
+  ["sum = id (fix (const (foldr (+) 0)))","sum = fix (const (foldr (+) 0))","sum = foldr (+) 0"]
+-}
+pointfree :: String -> [String]
+pointfree
+  = either
+    (pure [])
+    (map prettyTopLevel . mapTopLevel' optimize . mapTopLevel transform)
+  . parsePF
+
+{- |
+  >>> pointfree' "I'm not a valid Haskell expression!"
+  Nothing
+  >>> pointfree' "sum xs = foldr (+) 0 xs"
+  Just "sum = foldr (+) 0"
+-}
+pointfree' :: String -> Maybe String
+pointfree' = listToMaybe . reverse . pointfree
diff --git a/pointfree-fancy.cabal b/pointfree-fancy.cabal
--- a/pointfree-fancy.cabal
+++ b/pointfree-fancy.cabal
@@ -1,11 +1,12 @@
-cabal-version: >=1.8
+cabal-version: 2.0
 name: pointfree-fancy
-version: 1.1.1.7
+version: 1.1.1.8
 license: BSD3
 license-file: LICENSE
 maintainer: Vanessa McHale <vamchale@gmail.com>
 author: Thomas Jäger
-tested-with: ghc ==8.0.1 ghc ==8.2.2 ghc ==8.4.1 ghc ==7.10.3
+tested-with: ghc ==8.0.2 ghc ==8.2.2 ghc ==8.4.3 ghc ==7.10.3
+             ghc ==8.6.1
 synopsis: Tool for refactoring expressions into pointfree form
 description:
     The pointfree tool is a standalone command-line version of the pl
@@ -23,55 +24,49 @@
 library
     exposed-modules:
         Pointfree
-    other-modules:
+    hs-source-dirs: lib
+    default-language: Haskell98
+    ghc-options: -Wall
+    build-depends:
+        base -any,
+        pointfree-internal -any
+
+library pointfree-internal
+    exposed-modules:
         Plugin.Pl.Common
         Plugin.Pl.Parser
         Plugin.Pl.PrettyPrinter
         Plugin.Pl.Optimize
         Plugin.Pl.Rules
         Plugin.Pl.Transform
+    hs-source-dirs: src
+    default-language: Haskell98
+    other-extensions: FlexibleInstances PatternGuards ImplicitParams
+                      ExistentialQuantification FlexibleInstances ScopedTypeVariables
     ghc-options: -Wall
     build-depends:
-        base >=4.5 && <5.0,
+        base >=4.8 && <5.0,
         array >=0.3 && <0.6,
-        containers >=0.4 && <0.6,
+        containers >=0.4 && <0.7,
         haskell-src-exts >=1.18 && <1.21,
         transformers <0.6
 
 executable pointfree
     main-is: Main.hs
-    other-modules:
-        Plugin.Pl.Common
-        Plugin.Pl.Parser
-        Plugin.Pl.PrettyPrinter
-        Plugin.Pl.Optimize
-        Plugin.Pl.Rules
-        Plugin.Pl.Transform
+    default-language: Haskell98
     ghc-options: -Wall
     build-depends:
         base >=4.3 && <5.0,
-        array >=0.3 && <0.6,
-        containers >=0.4 && <0.6,
-        haskell-src-exts >=1.18 && <1.21,
-        transformers <0.6
+        pointfree-internal -any
 
 test-suite tests
     type: exitcode-stdio-1.0
     main-is: Test.hs
     hs-source-dirs: . test
-    other-modules:
-        Plugin.Pl.Common
-        Plugin.Pl.Parser
-        Plugin.Pl.PrettyPrinter
-        Plugin.Pl.Optimize
-        Plugin.Pl.Rules
-        Plugin.Pl.Transform
+    default-language: Haskell98
     ghc-options: -Wall
     build-depends:
-        array >=0.3 && <0.6,
         base <5,
-        containers >=0.3 && <0.6,
-        haskell-src-exts >=1.18 && <1.21,
+        pointfree-internal -any,
         HUnit >=1.1 && <1.7,
-        QuickCheck >=2.1 && <2.11,
-        transformers <0.6
+        QuickCheck >=2.1 && <2.11
diff --git a/src/Plugin/Pl/Common.hs b/src/Plugin/Pl/Common.hs
new file mode 100644
--- /dev/null
+++ b/src/Plugin/Pl/Common.hs
@@ -0,0 +1,130 @@
+module Plugin.Pl.Common (
+        Fixity(..), Expr(..), Pattern(..), Decl(..), TopLevel(..),
+        bt, mapTopLevel, mapTopLevel',
+        lookupFix, minPrec, maxPrec,
+        comp, flip', id', const', scomb, cons, nil, fix', if', readM,
+        makeList, getList,
+        Assoc(..),
+        module Data.Maybe,
+        module Control.Arrow,
+        module Data.List,
+        module Control.Monad,
+        module GHC.Base
+    ) where
+
+import           Control.Arrow         (first, second, (&&&), (***), (+++),
+                                        (|||))
+import           Control.Monad
+import           Data.List             (intersperse, minimumBy)
+import qualified Data.Map              as M
+import           Data.Maybe            (fromJust, fromMaybe, isJust)
+import           GHC.Base              (assert)
+import           Language.Haskell.Exts (Assoc (..))
+
+
+-- The rewrite rules can be found at the end of the file Rules.hs
+
+-- Not sure if passing the information if it was used as infix or prefix
+-- is worth threading through the whole thing is worth the effort,
+-- but it stays that way until the prettyprinting algorithm gets more
+-- sophisticated.
+data Fixity = Pref | Inf deriving Show
+
+instance Eq Fixity where
+  _ == _ = True
+
+instance Ord Fixity where
+  compare _ _ = EQ
+
+data Expr
+  = Var Fixity String
+  | Lambda Pattern Expr
+  | App Expr Expr
+  | Let [Decl] Expr
+  deriving (Eq, Ord, Show)
+
+data Pattern
+  = PVar String
+  | PCons Pattern Pattern
+  | PTuple Pattern Pattern
+  deriving (Eq, Ord, Show)
+
+data Decl = Define {
+  declName :: String,
+  declExpr :: Expr
+} deriving (Eq, Ord, Show)
+
+data TopLevel = TLD Bool Decl | TLE Expr deriving (Eq, Ord, Show)
+
+mapTopLevel :: (Expr -> Expr) -> TopLevel -> TopLevel
+mapTopLevel f tl = case getExpr tl of (e, c) -> c $ f e
+
+mapTopLevel' :: Functor f => (Expr -> f Expr) -> TopLevel -> f TopLevel
+mapTopLevel' f tl = case getExpr tl of (e, c) -> c <$> f e
+
+getExpr :: TopLevel -> (Expr, Expr -> TopLevel)
+getExpr (TLD True (Define foo e)) = (Let [Define foo e] (Var Pref foo),
+                                     TLD False . Define foo)
+getExpr (TLD False (Define foo e)) = (e, TLD False . Define foo)
+getExpr (TLE e)      = (e, TLE)
+
+comp, flip', id', const', scomb, cons, nil, fix', if' :: Expr
+comp   = Var Inf  "."
+flip'  = Var Pref "flip"
+id'    = Var Pref "id"
+const' = Var Pref "const"
+scomb  = Var Pref "ap"
+cons   = Var Inf  ":"
+nil    = Var Pref "[]"
+fix'   = Var Pref "fix"
+if'    = Var Pref "if'"
+
+makeList :: [Expr] -> Expr
+makeList = foldr (\e1 e2 -> cons `App` e1 `App` e2) nil
+
+-- Modularity is a drag
+getList :: Expr -> ([Expr], Expr)
+getList (c `App` x `App` tl) | c == cons = first (x:) $ getList tl
+getList e                    = ([],e)
+
+bt :: a
+bt = undefined
+
+shift, minPrec, maxPrec :: Int
+shift = 0
+maxPrec = shift + 10
+minPrec = 0
+
+-- operator precedences are needed both for parsing and prettyprinting
+operators :: [[(String, (Assoc (), Int))]]
+operators = (map . map . second . second $ (+shift))
+  [[inf "." (AssocRight ()) 9, inf "!!" (AssocLeft ()) 9],
+   [inf name (AssocRight ()) 8 | name <- ["^", "^^", "**"]],
+   [inf name (AssocLeft ()) 7
+     | name <- ["*", "/", "`quot`", "`rem`", "`div`", "`mod`", ":%", "%"]],
+   [inf name (AssocLeft ()) 6  | name <- ["+", "-"]],
+   [inf name (AssocRight ()) 5 | name <- [":", "++"]],
+   [inf name (AssocNone ()) 4
+     | name <- ["==", "/=", "<", "<=", ">=", ">", "`elem`", "`notElem`"]],
+   [inf "&&" (AssocRight ()) 3],
+   [inf "||" (AssocRight ()) 2],
+   [inf ">>" (AssocLeft ()) 1, inf ">>=" (AssocLeft ()) 1, inf "=<<" (AssocRight ()) 1],
+   [inf name (AssocRight ()) 0 | name <- ["$", "$!", "`seq`"]]
+  ] where
+  inf name assoc fx = (name, (assoc, fx))
+
+opFM :: M.Map String (Assoc (), Int)
+opFM = M.fromList $ join operators
+
+lookupOp :: String -> Maybe (Assoc (), Int)
+lookupOp k = M.lookup k opFM
+
+lookupFix :: String -> (Assoc (), Int)
+lookupFix str = fromMaybe (AssocLeft (), 9 + shift) (lookupOp str)
+
+readM :: (Monad m, Read a) => String -> m a
+readM s = case [x | (x,t) <- reads s, ("","")  <- lex t] of
+            [x] -> return x
+            []  -> fail "readM: No parse."
+            _   -> fail "readM: Ambiguous parse."
+
diff --git a/src/Plugin/Pl/Optimize.hs b/src/Plugin/Pl/Optimize.hs
new file mode 100644
--- /dev/null
+++ b/src/Plugin/Pl/Optimize.hs
@@ -0,0 +1,102 @@
+{-# LANGUAGE ImplicitParams #-}
+module Plugin.Pl.Optimize (
+    optimize,
+  ) where
+
+import           Plugin.Pl.Common
+import           Plugin.Pl.PrettyPrinter (prettyExpr)
+import           Plugin.Pl.Rules
+
+import           Data.List               (nub)
+
+cut :: [a] -> [a]
+cut = take 1
+
+toMonadPlus :: MonadPlus m => Maybe a -> m a
+toMonadPlus Nothing  = mzero
+toMonadPlus (Just x)=return x
+
+type Size = Integer
+-- This seems to be a better size for our purposes,
+-- despite being "a little" slower because of the wasteful uglyprinting
+sizeExpr' :: Expr -> Size
+sizeExpr' e = 100 * fromIntegral (length $ prettyExpr e) + adjust e where
+  -- hackish thing to favor some expressions if the length is the same:
+  -- (+ x) --> (x +)
+  -- x >>= f --> f =<< x
+  -- f $ g x --> f (g x)
+  adjust :: Expr -> Size
+  adjust (Var _ str) -- Just n <- readM str = log (n*n+1) / 4
+                     | str == "uncurry"    = -400
+--                     | str == "s"          = 500
+                     | str == "flip"       = 10
+                     | str == ">>="        = 5
+                     | str == "$"          = 1
+                     | str == "subtract"   = 1
+                     | str == "ap"         = 200
+                     | str == "liftM2"     = 101
+                     | str == "return"     = -200
+                     | str == "zipWith"    = -400
+                     | str == "const"      = 0 -- -200
+                     | str == "fmap"       = -100
+  adjust (Lambda _ e') = adjust e'
+  adjust (App e1 e2)  = adjust e1 + adjust e2
+  adjust _ = 0
+
+optimize :: Expr -> [Expr]
+optimize e = result where
+  result :: [Expr]
+  result = map (snd . fromJust) . takeWhile isJust .
+    iterate ((=<<) simpleStep) $ Just (sizeExpr' e, e)
+
+  simpleStep :: (Size, Expr) -> Maybe (Size, Expr)
+  simpleStep t = do
+    let chn = let ?first = True in step (snd t)
+        chnn = let ?first = False in step =<< chn
+        new = filter (\(x,_) -> x < fst t) . map (sizeExpr' &&& id) $
+                snd t: chn ++ chnn
+    case new of
+      []       -> Nothing
+      (new':_) -> return new'
+
+step :: (?first :: Bool) => Expr -> [Expr]
+step e = nub $ rewrite rules e
+
+rewrite :: (?first :: Bool) => RewriteRule -> Expr -> [Expr]
+rewrite rl e = case rl of
+    Up r1 r2     -> let e'  = cut $ rewrite r1 e
+                        e'' = rewrite r2 =<< e'
+                    in if null e'' then e' else e''
+    OrElse r1 r2 -> let e'  = rewrite r1 e
+                    in if null e' then rewrite r2 e else e'
+    Then r1 r2   -> rewrite r2 =<< nub (rewrite r1 e)
+    Opt  r       -> e: rewrite r e
+    If   p  r    -> if null (rewrite p e) then mzero else rewrite r e
+    Hard r       -> if ?first then rewrite r e else mzero
+    Or rs        -> (`rewrite` e) =<< rs
+    RR {}        -> rewDeep rl e
+    CRR {}       -> rewDeep rl e
+    Down {}      -> rewDeep rl e
+
+rewDeep :: (?first :: Bool) => RewriteRule -> Expr -> [Expr]
+rewDeep rule e = rew rule e `mplus` case e of
+    Var _ _    -> mzero
+    Lambda _ _ -> error "lambda: optimizer only works for closed expressions"
+    Let _ _    -> error "let: optimizer only works for closed expressions"
+    App e1 e2  -> ((`App` e2) `map` rewDeep rule e1) `mplus`
+                  ((e1 `App`) `map` rewDeep rule e2)
+
+rew :: (?first :: Bool) => RewriteRule -> Expr -> [Expr]
+rew (RR r1 r2) e = toMonadPlus $ fire r1 r2 e
+rew (CRR r) e = toMonadPlus $ r e
+rew (Or rs) e = (`rew` e) =<< rs
+rew (Down r1 r2) e
+  = if null e'' then e' else e'' where
+    e'  = cut $ rew r1 e
+    e'' = rewDeep r2 =<< e'
+rew r@Then   {} e = rewrite r e
+rew r@OrElse {} e = rewrite r e
+rew r@Up     {} e = rewrite r e
+rew r@Opt    {} e = rewrite r e
+rew r@If     {} e = rewrite r e
+rew r@Hard   {} e = rewrite r e
diff --git a/src/Plugin/Pl/Parser.hs b/src/Plugin/Pl/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/Plugin/Pl/Parser.hs
@@ -0,0 +1,92 @@
+module Plugin.Pl.Parser (parsePF) where
+
+import           Plugin.Pl.Common
+
+import qualified Language.Haskell.Exts as HSE
+
+todo :: (Functor e, Show (e ())) => e a -> r
+todo thing = error ("pointfree: not supported: " ++ show (void thing))
+
+nameString :: HSE.Name a -> (Fixity, String)
+nameString (HSE.Ident _ s)  = (Pref, s)
+nameString (HSE.Symbol _ s) = (Inf, s)
+
+qnameString :: HSE.QName a -> (Fixity, String)
+qnameString (HSE.Qual _ m n) = fmap ((HSE.prettyPrint m ++ ".") ++) (nameString n)
+qnameString (HSE.UnQual _ n) = nameString n
+qnameString (HSE.Special _ sc) = case sc of
+  HSE.UnitCon _              -> (Pref, "()")
+  HSE.ListCon _              -> (Pref, "[]")
+  HSE.FunCon _               -> (Inf, "->")
+  HSE.TupleCon _ HSE.Boxed n -> (Inf, replicate (n-1) ',')
+  HSE.TupleCon{}             -> todo sc
+  HSE.Cons _                 -> (Inf, ":")
+  HSE.UnboxedSingleCon{}     -> todo sc
+  HSE.ExprHole{}             -> todo sc
+
+opString :: HSE.QOp a -> (Fixity, String)
+opString (HSE.QVarOp _ qn) = qnameString qn
+opString (HSE.QConOp _ qn) = qnameString qn
+
+list :: [Expr] -> Expr
+list = foldr (\y ys -> cons `App` y `App` ys) nil
+
+hseToExpr :: HSE.Exp a -> Expr
+hseToExpr expr = case expr of
+  HSE.Var _ qn -> uncurry Var (qnameString qn)
+  HSE.IPVar{} -> todo expr
+  HSE.Con _ qn -> uncurry Var (qnameString qn)
+  HSE.Lit _ l -> case l of
+    HSE.String _ _ s -> list (map (Var Pref . show) s)
+    _                -> Var Pref (HSE.prettyPrint l)
+  HSE.InfixApp _ p op q -> apps (Var Inf (snd (opString op))) [p,q]
+  HSE.App _ f x -> hseToExpr f `App` hseToExpr x
+  HSE.NegApp _ e -> Var Pref "negate" `App` hseToExpr e
+  HSE.Lambda _ ps e -> foldr (Lambda . hseToPattern) (hseToExpr e) ps
+  HSE.Let _ bs e -> case bs of
+    HSE.BDecls _ ds   -> Let (map hseToDecl ds) (hseToExpr e)
+    HSE.IPBinds _ ips -> todo ips
+  HSE.If _ b t f -> apps if' [b,t,f]
+  HSE.Case{} -> todo expr
+  HSE.Do{} -> todo expr
+  HSE.MDo{} -> todo expr
+  HSE.Tuple _ HSE.Boxed es -> apps (Var Inf (replicate (length es - 1) ','))  es
+  HSE.TupleSection{} -> todo expr
+  HSE.List _ xs -> list (map hseToExpr xs)
+  HSE.Paren _ e -> hseToExpr e
+  HSE.LeftSection _ l op -> Var Inf (snd (opString op)) `App` hseToExpr l
+  HSE.RightSection _ op r -> flip' `App` Var Inf (snd (opString op)) `App` hseToExpr r
+  HSE.RecConstr{} -> todo expr
+  HSE.RecUpdate{} -> todo expr
+  HSE.EnumFrom _ x -> apps (Var Pref "enumFrom") [x]
+  HSE.EnumFromTo _ x y -> apps (Var Pref "enumFromTo") [x,y]
+  HSE.EnumFromThen _ x y -> apps (Var Pref "enumFromThen") [x,y]
+  HSE.EnumFromThenTo _ x y z -> apps (Var Pref "enumFromThenTo") [x,y,z]
+  _ -> todo expr
+
+apps :: Expr -> [HSE.Exp a] -> Expr
+apps = foldl (\a x -> a `App` hseToExpr x)
+
+hseToDecl :: HSE.Decl a -> Decl
+hseToDecl dec = case dec of
+  HSE.PatBind _ (HSE.PVar _ n) (HSE.UnGuardedRhs _ e) Nothing ->
+    Define (snd (nameString n)) (hseToExpr e)
+  HSE.FunBind _ [HSE.Match _ n ps (HSE.UnGuardedRhs _ e) Nothing] ->
+    Define (snd (nameString n)) (foldr (\p x -> Lambda (hseToPattern p) x) (hseToExpr e) ps)
+  _ -> todo dec
+
+hseToPattern :: HSE.Pat a -> Pattern
+hseToPattern pat = case pat of
+  HSE.PVar _ n -> PVar (snd (nameString n))
+  HSE.PInfixApp _ l (HSE.Special _ (HSE.Cons _)) r -> PCons (hseToPattern l) (hseToPattern r)
+  HSE.PTuple _ HSE.Boxed [p,q] -> PTuple (hseToPattern p) (hseToPattern q)
+  HSE.PParen _ p -> hseToPattern p
+  HSE.PWildCard _ -> PVar "_"
+  _ -> todo pat
+
+parsePF :: String -> Either String TopLevel
+parsePF inp = case HSE.parseExp inp of
+  HSE.ParseOk e -> Right (TLE (hseToExpr e))
+  HSE.ParseFailed _ _ -> case HSE.parseDecl inp of
+    HSE.ParseOk d         -> Right (TLD True (hseToDecl d))
+    HSE.ParseFailed _ err -> Left err
diff --git a/src/Plugin/Pl/PrettyPrinter.hs b/src/Plugin/Pl/PrettyPrinter.hs
new file mode 100644
--- /dev/null
+++ b/src/Plugin/Pl/PrettyPrinter.hs
@@ -0,0 +1,146 @@
+{-# LANGUAGE PatternGuards #-}
+module Plugin.Pl.PrettyPrinter (
+  prettyDecl,
+  prettyExpr,
+  prettyTopLevel,
+ ) where
+
+import           Plugin.Pl.Common
+
+import           Data.Char
+import           Data.List        (intercalate)
+
+prettyDecl :: Decl -> String
+prettyDecl (Define f e) = f ++ " = " ++ prettyExpr e
+
+prettyDecls :: [Decl] -> String
+prettyDecls = intercalate "; " . map prettyDecl
+
+prettyExpr :: Expr -> String
+prettyExpr = show . toSExpr
+
+prettyTopLevel :: TopLevel -> String
+prettyTopLevel (TLE e)   = prettyExpr e
+prettyTopLevel (TLD _ d) = prettyDecl d
+
+data SExpr
+  = SVar !String
+  | SLambda ![Pattern] !SExpr
+  | SLet ![Decl] !SExpr
+  | SApp !SExpr !SExpr
+  | SInfix !String !SExpr !SExpr
+  | LeftSection !String !SExpr  -- (x +)
+  | RightSection !String !SExpr -- (+ x)
+  | List ![SExpr]
+  | Tuple ![SExpr]
+  | Enum !Expr !(Maybe Expr) !(Maybe Expr)
+
+{-# INLINE toSExprHead #-}
+toSExprHead :: String -> [Expr] -> Maybe SExpr
+toSExprHead hd tl
+  | all (==',') hd, length hd+1 == length tl
+  = Just . Tuple . reverse $ map toSExpr tl
+  | otherwise = case (hd,reverse tl) of
+      ("enumFrom", [e])              -> Just $ Enum e Nothing   Nothing
+      ("enumFromThen", [e,e'])       -> Just $ Enum e (Just e') Nothing
+      ("enumFromTo", [e,e'])         -> Just $ Enum e Nothing   (Just e')
+      ("enumFromThenTo", [e,e',e'']) -> Just $ Enum e (Just e') (Just e'')
+      _                              -> Nothing
+
+toSExpr :: Expr -> SExpr
+toSExpr (Var _ v) = SVar v
+toSExpr (Lambda v e) = case toSExpr e of
+  (SLambda vs e') -> SLambda (v:vs) e'
+  e'              -> SLambda [v] e'
+toSExpr (Let ds e) = SLet ds $ toSExpr e
+toSExpr e | Just (hd,tl) <- getHead e, Just se <- toSExprHead hd tl = se
+toSExpr e | (ls, tl) <- getList e, tl == nil
+  = List $ map toSExpr ls
+toSExpr (App e1 e2) = case e1 of
+  App (Var Inf v) e0
+    -> SInfix v (toSExpr e0) (toSExpr e2)
+  Var Inf v | v /= "-"
+    -> LeftSection v (toSExpr e2)
+
+  Var _ "flip" | Var Inf v <- e2, v == "-" -> toSExpr $ Var Pref "subtract"
+
+  App (Var _ "flip") (Var pr v)
+    | v == "-"  -> toSExpr $ Var Pref "subtract" `App` e2
+    | v == "id" -> RightSection "$" (toSExpr e2)
+    | Inf <- pr, any (/= ',') v -> RightSection v (toSExpr e2)
+  _ -> SApp (toSExpr e1) (toSExpr e2)
+
+getHead :: Expr -> Maybe (String, [Expr])
+getHead (Var _ v)   = Just (v, [])
+getHead (App e1 e2) = second (e2:) `fmap` getHead e1
+getHead _           = Nothing
+
+instance Show SExpr where
+  showsPrec _ (SVar v) = (getPrefName v ++)
+  showsPrec p (SLambda vs e) = showParen (p > minPrec) $ ('\\':) .
+    foldr (.) id (intersperse (' ':) (map (prettyPrecPattern $ maxPrec+1) vs)) .
+    (" -> "++) . showsPrec minPrec e
+  showsPrec p (SApp e1 e2) = showParen (p > maxPrec) $
+    showsPrec maxPrec e1 . (' ':) . showsPrec (maxPrec+1) e2
+  showsPrec _ (LeftSection fx e) = showParen True $
+    showsPrec (snd (lookupFix fx) + 1) e . (' ':) . (getInfName fx++)
+  showsPrec _ (RightSection fx e) = showParen True $
+    (getInfName fx++) . (' ':) . showsPrec (snd (lookupFix fx) + 1) e
+  showsPrec _ (Tuple es) = showParen True
+    (join `id` intersperse ", " (map show es) ++)
+
+  showsPrec _ (List es)
+    | Just cs <- mapM ((=<<) readM . fromSVar) es = shows (cs::String)
+    | otherwise = ('[':) .
+      (join `id` intersperse ", " (map show es) ++) . (']':)
+    where fromSVar (SVar str) = Just str
+          fromSVar _          = Nothing
+  showsPrec _ (Enum fr tn to) = ('[':) . showString (prettyExpr fr) .
+    showsMaybe (((',':) . prettyExpr) `fmap` tn) . (".."++) .
+    showsMaybe (prettyExpr `fmap` to) . (']':)
+      where showsMaybe = maybe id (++)
+  showsPrec _ (SLet ds e) = ("let "++) . showString (prettyDecls ds ++ " in ") . shows e
+
+
+  showsPrec p (SInfix fx e1 e2) = showParen (p > fixity) $
+    showsPrec f1 e1 . (' ':) . (getInfName fx++) . (' ':) .
+    showsPrec f2 e2 where
+      fixity = snd $ lookupFix fx
+      (f1, f2) = case fst $ lookupFix fx of
+        AssocRight _ -> (fixity+1, fixity + infixSafe e2 (AssocLeft ()) fixity)
+        AssocLeft _ -> (fixity + infixSafe e1 (AssocRight ()) fixity, fixity+1)
+        AssocNone _ -> (fixity+1, fixity+1)
+
+      -- This is a little bit awkward, but at least seems to produce no false
+      -- results anymore
+      infixSafe :: SExpr -> Assoc () -> Int -> Int
+      infixSafe (SInfix fx'' _ _) assoc fx'
+        | lookupFix fx'' == (assoc, fx') = 1
+        | otherwise = 0
+      infixSafe _ _ _ = 0 -- doesn't matter
+
+prettyPrecPattern :: Int -> Pattern -> ShowS
+prettyPrecPattern _ (PVar v) = showString v
+prettyPrecPattern _ (PTuple p1 p2) = showParen True $
+  prettyPrecPattern 0 p1 . (", "++) . prettyPrecPattern 0 p2
+prettyPrecPattern p (PCons p1 p2) = showParen (p>5) $
+  prettyPrecPattern 6 p1 . (':':) . prettyPrecPattern 5 p2
+
+isOperator :: String -> Bool
+isOperator s =
+  case break (== '.') s of
+    (_, "") -> isUnqualOp s
+    (before, _dot : rest)
+      | isUnqualOp before -> isUnqualOp rest
+      | isModule before -> isOperator rest
+      | otherwise -> False
+  where
+    isModule "" = False
+    isModule (c : cs) = isUpper c && all (\c' -> isAlphaNum c' || c' `elem` ['\'', '_']) cs
+    isUnqualOp s' = s' /= "()" && all (\c -> isSymbol c || isPunctuation c) s'
+
+getInfName :: String -> String
+getInfName str = if isOperator str then str else "`"++str++"`"
+
+getPrefName :: String -> String
+getPrefName str = if isOperator str || ',' `elem` str then "("++str++")" else str
diff --git a/src/Plugin/Pl/Rules.hs b/src/Plugin/Pl/Rules.hs
new file mode 100644
--- /dev/null
+++ b/src/Plugin/Pl/Rules.hs
@@ -0,0 +1,875 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances         #-}
+{-# LANGUAGE PatternGuards             #-}
+{-# LANGUAGE ScopedTypeVariables       #-}
+--
+-- | This marvellous module contributed by Thomas J\344ger
+--
+module Plugin.Pl.Rules (RewriteRule(..), rules, fire) where
+
+import           Plugin.Pl.Common
+
+import           Data.Array
+import qualified Data.Set          as S
+
+import           Control.Monad.Fix (fix)
+
+--import PlModule.PrettyPrinter
+
+-- Next time I do somthing like this, I'll actually think about the combinator
+-- language before, instead of producing something ad-hoc like this:
+data RewriteRule
+  = RR Rewrite Rewrite
+  | CRR (Expr -> Maybe Expr)
+  | Down RewriteRule RewriteRule
+  | Up RewriteRule RewriteRule
+  | Or [RewriteRule]
+  | OrElse RewriteRule RewriteRule
+  | Then RewriteRule RewriteRule
+  | Opt RewriteRule
+  | If RewriteRule RewriteRule
+  | Hard RewriteRule
+
+-- No MLambda here because we only consider closed Terms (no alpha-renaming!).
+data MExpr
+  = MApp !MExpr !MExpr
+  | Hole !Int
+  | Quote !Expr
+  deriving Eq
+
+--instance Show MExpr where
+--  show = show . fromMExpr
+
+data Rewrite = Rewrite {
+  holes :: MExpr,
+  rid   :: Int -- rlength - 1
+} --deriving Show
+
+-- What are you gonna do when no recursive modules are possible?
+class RewriteC a where
+  getRewrite :: a -> Rewrite
+
+instance RewriteC MExpr where
+  getRewrite rule = Rewrite {
+    holes   = rule,
+    rid = 0
+  }
+
+type ExprArr = Array Int Expr
+
+myFire :: ExprArr -> MExpr -> MExpr
+myFire xs (MApp e1 e2) = MApp (myFire xs e1) (myFire xs e2)
+myFire xs (Hole h)     = Quote $ xs ! h
+myFire _ me            = me
+
+nub' :: Ord a => [a] -> [a]
+nub' = S.toList . S.fromList
+
+uniqueArray :: Ord v => Int -> [(Int, v)] -> Maybe (Array Int v)
+uniqueArray n lst
+  | length (nub' lst) == n = Just $ array (0,n-1) lst
+  | otherwise = Nothing
+
+match :: Rewrite -> Expr -> Maybe ExprArr
+match (Rewrite hl rid') e  = uniqueArray rid' =<< matchWith hl e
+
+fire' :: Rewrite -> ExprArr -> MExpr
+fire' (Rewrite hl _)   = (`myFire` hl)
+
+fire :: Rewrite -> Rewrite -> Expr -> Maybe Expr
+fire r1 r2 e = (fromMExpr . fire' r2) `fmap` match r1 e
+
+matchWith :: MExpr -> Expr -> Maybe [(Int, Expr)]
+matchWith (MApp e1 e2) (App e1' e2') =
+  liftM2 (++) (matchWith e1 e1') (matchWith e2 e2')
+matchWith (Quote e) e' = if e == e' then Just [] else Nothing
+matchWith (Hole k) e = Just [(k,e)]
+matchWith _ _ = Nothing
+
+fromMExpr :: MExpr -> Expr
+fromMExpr (MApp e1 e2) = App (fromMExpr e1) (fromMExpr e2)
+fromMExpr (Hole _)     = Var Pref "Hole" -- error "Hole in MExpr"
+fromMExpr (Quote e)    = e
+
+instance RewriteC a => RewriteC (MExpr -> a) where
+  getRewrite rule = Rewrite {
+    holes = holes . getRewrite . rule . Hole $ pid,
+    rid   = pid + 1
+  } where
+    pid = rid $ getRewrite (bt :: a)
+
+-- Yet another pointless transformation
+transformM :: Int -> MExpr -> MExpr
+transformM _ (Quote e) = constE `a` Quote e
+transformM n (Hole n') = if n == n' then idE else constE `a` Hole n'
+transformM n (Quote (Var _ ".") `MApp` e1 `MApp` e2)
+  | e1 `hasHole` n && not (e2 `hasHole` n)
+  = flipE `a` compE `a` e2 `c` transformM n e1
+transformM n e@(MApp e1 e2)
+  | fr1 && fr2 = sE `a` transformM n e1 `a` transformM n e2
+  | fr1        = flipE `a` transformM n e1 `a` e2
+  | fr2, Hole n' <- e2, n' == n = e1
+  | fr2        = e1 `c` transformM n e2
+  | otherwise  = constE `a` e
+  where
+    fr1 = e1 `hasHole` n
+    fr2 = e2 `hasHole` n
+
+hasHole :: MExpr -> Int -> Bool
+hasHole (MApp e1 e2) n = e1 `hasHole` n || e2 `hasHole` n
+hasHole (Quote _)   _  = False
+hasHole (Hole n')   n  = n == n'
+
+--
+-- haddock doesn't like n+k patterns, so rewrite them
+--
+getVariants, getVariants' :: Rewrite -> [Rewrite]
+getVariants' r@(Rewrite _ 0)  = [r]
+getVariants' r@(Rewrite e nk)
+    | nk >= 1    = r : getVariants (Rewrite e' (nk-1))
+    | otherwise  = error "getVariants' : nk went negative"
+    where
+        e' = decHoles $ transformM 0 e
+
+        decHoles (Hole n')    = Hole (n'-1)
+        decHoles (MApp e1 e2) = decHoles e1 `MApp` decHoles e2
+        decHoles me           = me
+
+getVariants = getVariants' -- r = trace (show vs) vs where vs = getVariants' r
+
+rr, rr0, rr1, rr2 :: RewriteC a => a -> a -> RewriteRule
+-- use this rewrite rule and rewrite rules derived from it by iterated
+-- pointless transformation
+rrList :: RewriteC a => a -> a -> [RewriteRule]
+rrList r1 r2 = zipWith RR (getVariants r1') (getVariants r2') where
+  r1' = getRewrite r1
+  r2' = getRewrite r2
+
+rr  r1 r2 = Or          $ rrList r1 r2
+rr1 r1 r2 = Or . take 2 $ rrList r1 r2
+rr2 r1 r2 = Or . take 3 $ rrList r1 r2
+
+-- use only this rewrite rule
+rr0 r1 r2 = RR r1' r2' where
+  r1' = getRewrite r1
+  r2' = getRewrite r2
+
+down, up :: RewriteRule -> RewriteRule
+down = fix . Down
+up   = fix . Up
+
+
+idE, flipE, bindE, extE, returnE, consE, appendE, nilE, foldrE, foldlE, fstE,
+  sndE, dollarE, constE, uncurryE, curryE, compE, headE, tailE, sE, commaE,
+  fixE, foldl1E, notE, equalsE, nequalsE, plusE, multE, zeroE, oneE, lengthE,
+  sumE, productE, concatE, concatMapE, joinE, mapE, fmapE, fmapIE, subtractE,
+  minusE, liftME, apE, liftM2E, seqME, zipE, zipWithE, onE, oedipusE, comp2E,
+  crossE, firstE, secondE, andE, orE, allE, anyE :: MExpr
+idE        = Quote $ Var Pref "id"
+flipE      = Quote $ Var Pref "flip"
+constE     = Quote $ Var Pref "const"
+compE      = Quote $ Var Inf "."
+comp2E     = Quote $ Var Inf ".*"
+comp3E     = Quote $ Var Inf ".**"
+eyeE       = Quote $ Var Inf "-."
+oedipusE   = Quote $ Var Inf "-.*"
+oedipus2E  = Quote $ Var Inf "-.**"
+onE        = Quote $ Var Pref "on"
+ampersandE = Quote $ Var Inf "&"
+sE         = Quote $ Var Pref "ap"
+fixE       = Quote $ Var Pref "fix"
+bindE      = Quote $ Var Inf  ">>="
+extE       = Quote $ Var Inf  "=<<"
+returnE    = Quote $ Var Pref "return"
+consE      = Quote $ Var Inf  ":"
+nilE       = Quote $ Var Pref "[]"
+appendE    = Quote $ Var Inf  "++"
+foldrE     = Quote $ Var Pref "foldr"
+foldlE     = Quote $ Var Pref "foldl"
+fstE       = Quote $ Var Pref "fst"
+sndE       = Quote $ Var Pref "snd"
+dollarE    = Quote $ Var Inf  "$"
+uncurryE   = Quote $ Var Pref "uncurry"
+curryE     = Quote $ Var Pref "curry"
+headE      = Quote $ Var Pref "head"
+tailE      = Quote $ Var Pref "tail"
+commaE     = Quote $ Var Inf  ","
+foldl1E    = Quote $ Var Pref "foldl1"
+equalsE    = Quote $ Var Inf  "=="
+nequalsE   = Quote $ Var Inf  "/="
+notE       = Quote $ Var Pref "not"
+plusE      = Quote $ Var Inf  "+"
+multE      = Quote $ Var Inf  "*"
+zeroE      = Quote $ Var Pref "0"
+oneE       = Quote $ Var Pref "1"
+lengthE    = Quote $ Var Pref "length"
+sumE       = Quote $ Var Pref "sum"
+productE   = Quote $ Var Pref "product"
+concatE    = Quote $ Var Pref "concat"
+concatMapE = Quote $ Var Pref "concatMap"
+joinE      = Quote $ Var Pref "join"
+mapE       = Quote $ Var Pref "map"
+fmapE      = Quote $ Var Pref "fmap"
+fmapIE     = Quote $ Var Inf  "fmap"
+subtractE  = Quote $ Var Pref "subtract"
+minusE     = Quote $ Var Inf  "-"
+liftME     = Quote $ Var Pref "liftM"
+liftM2E    = Quote $ Var Pref "liftM2"
+fishE      = Quote $ Var Inf  ">=>"
+kliesliE   = Quote $ Var Inf "<=<"
+apE        = Quote $ Var Inf  "ap"
+seqME      = Quote $ Var Inf  ">>"
+zipE       = Quote $ Var Pref "zip"
+zipWithE   = Quote $ Var Pref "zipWith"
+crossE     = Quote $ Var Inf  "***"
+firstE     = Quote $ Var Pref "first"
+secondE    = Quote $ Var Pref "second"
+andE       = Quote $ Var Pref "and"
+orE        = Quote $ Var Pref "or"
+allE       = Quote $ Var Pref "all"
+anyE       = Quote $ Var Pref "any"
+replaceE   = Quote $ Var Inf "<$"
+pointyE    = Quote $ Var Inf "$>"
+
+
+
+a, c, c2 :: MExpr -> MExpr -> MExpr
+a       = MApp
+c e1 e2 = compE `a` e1 `a` e2
+c2 e1 e2 = comp2E `a` e1 `a` e2
+c3 e1 e2 = comp3E `a` e1 `a` e2
+o e1 e2 = oedipusE `a` e1 `a` e2
+o2 e1 e2 = oedipus2E `a` e1 `a` e2
+eye e1 e2 = eyeE `a` e1 `a` e2
+infixl 9 `a`
+infixr 8 `c`
+infixr 8 `c2`
+infixr 8 `o`
+
+
+collapseLists :: Expr -> Maybe Expr
+collapseLists (Var _ "++" `App` e1 `App` e2)
+  | (xs,x) <- getList e1, x==nil,
+    (ys,y) <- getList e2, y==nil = Just $ makeList $ xs ++ ys
+collapseLists _ = Nothing
+
+data Binary = forall a b c. (Read a, Show a, Read b, Show b, Read c, Show c) => BA (a -> b -> c)
+
+evalBinary :: [(String, Binary)] -> Expr -> Maybe Expr
+evalBinary fs (Var _ f' `App` Var _ x' `App` Var _ y')
+  | Just (BA f) <- lookup f' fs = (Var Pref . show) `fmap` liftM2 f (readM x') (readM y')
+evalBinary _ _ = Nothing
+
+data Unary = forall a b. (Read a, Show a, Read b, Show b) => UA (a -> b)
+
+evalUnary :: [(String, Unary)] -> Expr -> Maybe Expr
+evalUnary fs (Var _ f' `App` Var _ x')
+  | Just (UA f) <- lookup f' fs = (Var Pref . show . f) `fmap` readM x'
+evalUnary _ _ = Nothing
+
+assocR, assocL, assoc :: [String] -> Expr -> Maybe Expr
+-- (f `op` g) `op` h --> f `op` (g `op` h)
+assocR ops (Var f1 op1 `App` (Var f2 op2 `App` e1 `App` e2) `App` e3)
+  | op1 == op2 && op1 `elem` ops
+  = Just (Var f1 op1 `App` e1 `App` (Var f2 op2 `App` e2 `App` e3))
+assocR _ _ = Nothing
+
+-- f `op` (g `op` h) --> (f `op` g) `op` h
+assocL ops (Var f1 op1 `App` e1 `App` (Var f2 op2 `App` e2 `App` e3))
+  | op1 == op2 && op1 `elem` ops
+  = Just (Var f1 op1 `App` (Var f2 op2 `App` e1 `App` e2) `App` e3)
+assocL _ _ = Nothing
+
+-- op f . op g --> op (f `op` g)
+assoc ops (Var _ "." `App` (Var f1 op1 `App` e1) `App` (Var f2 op2 `App` e2))
+  | op1 == op2 && op1 `elem` ops
+  = Just (Var f1 op1 `App` (Var f2 op2 `App` e1 `App` e2))
+assoc _ _ = Nothing
+
+commutative :: [String] -> Expr -> Maybe Expr
+commutative ops (Var f op `App` e1 `App` e2)
+  | op `elem` ops = Just (Var f op `App` e2 `App` e1)
+commutative ops (Var _ "flip" `App` e@(Var _ op)) | op `elem` ops = Just e
+commutative _ _ = Nothing
+
+-- TODO: Move rules into a file.
+{-# INLINE simplifies #-}
+simplifies :: RewriteRule
+simplifies = Or [
+  -- (f . g) x --> f (g x)
+  rr0 (\f g x -> (f `c` g) `a` x)
+      (\f g x -> f `a` (g `a` x)),
+  -- (g -. f) -> f (g x)
+  rr0 (\f g x -> (f `eye` g) `a` x)
+      (\f g x -> f `a` (g `a` x)),
+  -- (f .* g) x y -> f (g x y)
+  rr0  (\f g x y -> (f `c2` g) `a` x `a` y)
+       (\f g x y -> f `a` (g `a` x `a` y)),
+  -- (f .** g) x y z -> f (g x y z)
+  rr0 (\f g x y z -> (f `c3` g) `a` x `a` y `a` z)
+      (\f g x y z -> f `a` (g `a` x `a` y `a` z)),
+  -- (f -.* g) x y -> f x (g y)
+  rr0  (\f g x y -> (f `o` g) `a` x `a` y)
+       (\f g x y -> f `a` x `a` (g `a` y)),
+  -- (f -.** g) -> f x y (g z)
+  rr0 (\f g x y z -> (f `o2` g) `a` x `a` y `a` z)
+      (\f g x y z -> f `a` x `a` y `a` (g `a` z)),
+  -- x & f -> f x
+  rr0 (\f x -> x `a` ampersandE `a` f)
+      a,
+  -- id x --> x
+  rr0 (\x -> idE `a` x)
+      id,
+  -- flip (flip x) --> x
+  rr  (\x -> flipE `a` (flipE `a` x))
+      id,
+  -- flip id x . f --> flip f x
+  rr0 (\f x -> (flipE `a` idE `a` x) `c` f)
+      (\f x -> flipE `a` f `a` x),
+  -- id . f --> f
+  rr0 (\f -> idE `c` f)
+      id,
+  -- f . id --> f
+  rr0 (`c` idE)
+      id,
+  -- const x y --> x
+  rr0 (\x y -> constE `a` x `a` y)
+      const,
+  -- not (not x) --> x
+  rr  (\x -> notE `a` (notE `a` x))
+      id,
+  -- fst (x,y) --> x
+  rr  (\x y -> fstE `a` (commaE `a` x `a` y))
+      const,
+  -- snd (x,y) --> y
+  rr  (\x y -> sndE `a` (commaE `a` x `a` y))
+      (\_ y -> y),
+  -- head (x:xs) --> x
+  rr  (\x xs -> headE `a` (consE `a` x `a` xs))
+      const,
+  -- tail (x:xs) --> xs
+  rr  (\x xs -> tailE `a` (consE `a` x `a` xs))
+      (\_ xs -> xs),
+  -- uncurry f (x,y) --> f x y
+  rr1 (\f x y -> uncurryE `a` f `a` (commaE `a` x `a` y))
+      (\f x y -> f `a` x `a` y),
+  -- uncurry (,) --> id
+  rr  (uncurryE `a` commaE)
+      idE,
+  -- uncurry f . s (,) g --> s f g
+  rr1 (\f g -> (uncurryE `a` f) `c` (sE `a` commaE `a` g))
+      (\f g -> sE `a` f `a` g),
+  -- curry fst --> const
+  rr (curryE `a` fstE) constE,
+  -- curry snd --> const id
+  rr (curryE `a` sndE) (constE `a` idE),
+  -- s f g x --> f x (g x)
+  rr0 (\f g x -> sE `a` f `a` g `a` x)
+      (\f g x -> f `a` x `a` (g `a` x)),
+  -- flip f x y --> f y x
+  rr0 (\f x y -> flipE `a` f `a` x `a` y)
+      (\f x y -> f `a` y `a` x),
+  -- flip (=<<) --> (>>=)
+  rr0 (flipE `a` extE)
+      bindE,
+
+  -- TODO: Think about map/fmap
+  -- fmap id --> id
+  rr (fmapE `a` idE)
+     idE,
+  -- map id --> id
+  rr (mapE `a` idE)
+     idE,
+  -- (f . g) . h --> f . (g . h)
+  rr0 (\f g h -> (f `c` g) `c` h)
+      (\f g h -> f `c` (g `c` h)),
+  -- fmap f . fmap g -> fmap (f . g)
+  rr0 (\f g -> fmapE `a` f `c` fmapE `a` g)
+      (\f g -> fmapE `a` (f `c` g)),
+  -- map f . map g -> map (f . g)
+  rr0 (\f g -> mapE `a` f `c` mapE `a` g)
+      (\f g -> mapE `a` (f `c` g))
+
+  ]
+
+onceRewrites :: RewriteRule
+onceRewrites = Hard $ Or [
+  -- ($) --> id
+  rr0 dollarE
+      idE,
+  -- concatMap --> (=<<)
+  rr concatMapE extE,
+  -- concat    --> join
+  rr concatE joinE,
+  -- liftM --> fmap
+  rr liftME fmapE,
+  -- map --> fmap
+  rr mapE fmapE,
+  -- subtract -> flip (-)
+  rr  subtractE
+      (flipE `a` minusE)
+  ]
+
+-- Now we can state rewrite rules in a nice high level way
+-- Rewrite rules should be as pointful as possible since the pointless variants
+-- will be derived automatically.
+rules :: RewriteRule
+rules = Or [
+  -- f (g x) --> (f . g) x
+  Hard $
+  rr  (\f g x -> f `a` (g `a` x))
+      (\f g x -> (f `c` g) `a` x),
+  -- (>>=) --> flip (=<<)
+  -- (>>=) --> flip (=<<)
+  Hard $
+  rr  bindE
+      (flipE `a` extE),
+  -- (.) id --> id
+  rr (compE `a` idE)
+     idE,
+  -- (++) [x] --> (:) x
+  rr  (\x -> appendE `a` (consE `a` x `a` nilE))
+      (\x -> consE `a` x),
+  -- (=<<) return --> id
+  rr  (extE `a` returnE)
+      idE,
+  -- (=<<) f (return x) -> f x
+  rr  (\f x -> extE `a` f `a` (returnE `a` x))
+      a,
+  -- (=<<) ((=<<) f . g) --> (=<<) f . (=<<) g
+  rr  (\f g -> extE `a` ((extE `a` f) `c` g))
+      (\f g -> (extE `a` f) `c` (extE `a` g)),
+  -- flip (f . g) --> flip (.) g . flip f
+  Hard $
+  rr  (\f g -> flipE `a` (f `c` g))
+      (\f g -> (flipE `a` compE `a` g) `c` (flipE `a` f)),
+  -- flip (.) f . flip id --> flip f
+  rr  (\f -> (flipE `a` compE `a` f) `c` (flipE `a` idE))
+      (\f -> flipE `a` f),
+  -- flip (.) f . flip flip --> flip (flip . f)
+  rr  (\f -> (flipE `a` compE `a` f) `c` (flipE `a` flipE))
+      (\f -> flipE `a` (flipE `c` f)),
+  -- flip (flip (flip . f) g) --> flip (flip . flip f) g
+  rr1 (\f g -> flipE `a` (flipE `a` (flipE `c` f) `a` g))
+      (\f g -> flipE `a` (flipE `c` flipE `a` f) `a` g),
+
+  -- flip (.) id --> id
+  rr (flipE `a` compE `a` idE)
+     idE,
+  -- (.) . flip id --> flip flip
+  rr  (compE `c` (flipE `a` idE))
+      (flipE `a` flipE),
+  -- s const x y --> y
+  rr  (\x y -> sE `a` constE `a` x `a` y)
+      (\_ y -> y),
+  -- s (const . f) g --> f
+  rr1 (\f g -> sE `a` (constE `c` f) `a` g)
+      const,
+  -- s (const f) --> (.) f
+  rr  (\f -> sE `a` (constE `a` f))
+      (\f -> compE `a` f),
+  -- s (f . fst) snd --> uncurry f
+  rr  (\f -> sE `a` (f `c` fstE) `a` sndE)
+      (\f -> uncurryE `a` f),
+  -- fst (join (,) x) --> x
+  rr (\x -> fstE `a` (joinE `a` commaE `a` x))
+     id,
+  -- snd (join (,) x) --> x
+  rr (\x -> sndE `a` (joinE `a` commaE `a` x))
+     id,
+  -- The next two are `simplifies', strictly speaking, but invoked rarely.
+  -- uncurry f (x,y) --> f x y
+  rr  (\f x y -> uncurryE `a` f `a` (commaE `a` x `a` y))
+      (\f x y -> f `a` x `a` y),
+  -- curry (uncurry f) --> f
+  rr (\f -> curryE `a` (uncurryE `a` f))
+     id,
+  -- uncurry (curry f) --> f
+  rr (\f -> uncurryE `a` (curryE `a` f))
+     id,
+  -- (const id . f) --> const id
+  rr  (\f -> (constE `a` idE) `c` f)
+      (\_ -> constE `a` idE),
+  -- const x . f --> const x
+  rr (\x f -> constE `a` x `c` f)
+     (\x _ -> constE `a` x),
+  -- fix f --> f (fix x)
+  Hard $
+  rr0 (\f -> fixE `a` f)
+      (\f -> f `a` (fixE `a` f)),
+  -- f (fix f) --> fix x
+  Hard $
+  rr0 (\f -> f `a` (fixE `a` f))
+      (\f -> fixE `a` f),
+  -- fix f --> f (f (fix x))
+  Hard $
+  rr0 (\f -> fixE `a` f)
+      (\f -> f `a` (f `a` (fixE `a` f))),
+  -- fix (const f) --> f
+  rr (\f -> fixE `a` (constE `a` f))
+     id,
+  -- flip const x --> id
+  rr  (\x -> flipE `a` constE `a` x)
+      (pure idE),
+  -- const . f --> flip (const f)
+  Hard $
+  rr  (\f -> constE `c` f)
+      (\f -> flipE `a` (constE `a` f)),
+  -- not (x == y) -> x /= y
+  rr2 (\x y -> notE `a` (equalsE `a` x `a` y))
+      (\x y -> nequalsE `a` x `a` y),
+  -- not (x /= y) -> x == y
+  rr2 (\x y -> notE `a` (nequalsE `a` x `a` y))
+      (\x y -> equalsE `a` x `a` y),
+  If (Or [rr plusE plusE, rr minusE minusE, rr multE multE]) $ down $ Or [
+    -- 0 + x --> x
+    rr  (\x -> plusE `a` zeroE `a` x)
+        id,
+    -- 0 * x --> 0
+    rr  (\x -> multE `a` zeroE `a` x)
+        (pure zeroE),
+    -- 1 * x --> x
+    rr  (\x -> multE `a` oneE `a` x)
+        id,
+    -- x - x --> 0
+    rr  (\x -> minusE `a` x `a` x)
+        (pure zeroE),
+    -- x - y + y --> x
+    rr  (\y x -> plusE `a` (minusE `a` x `a` y) `a` y)
+        (\_ x -> x),
+    -- x + y - y --> x
+    rr  (\y x -> minusE `a` (plusE `a` x `a` y) `a` y)
+        (\_ x -> x),
+    -- x + (y - z) --> x + y - z
+    rr  (\x y z -> plusE `a` x `a` (minusE `a` y `a` z))
+        (\x y z -> minusE `a` (plusE `a` x `a` y) `a` z),
+    -- x - (y + z) --> x - y - z
+    rr  (\x y z -> minusE `a` x `a` (plusE `a` y `a` z))
+        (\x y z -> minusE `a` (minusE `a` x `a` y) `a` z),
+    -- x - (y - z) --> x + y - z
+    rr  (\x y z -> minusE `a` x `a` (minusE `a` y `a` z))
+        (\x y z -> minusE `a` (plusE `a` x `a` y) `a` z)
+  ],
+
+  -- flip ($) -> &
+  rr (flipE `a` dollarE)
+     ampersandE,
+
+  -- fmap . const -> (<$)
+  rr (fmapE `c` constE)
+     replaceE,
+
+  -- flip (<$) -> ($>)
+  Hard $
+  rr (flipE `a` replaceE)
+     pointyE,
+
+  Hard onceRewrites,
+  -- join (fmap f x) --> f =<< x
+  rr (\f x -> joinE `a` (fmapE `a` f `a` x))
+     (\f x -> extE `a` f `a` x),
+  -- (=<<) id --> join
+  rr (extE `a` idE) joinE,
+  -- join --> (=<<) id
+  Hard $
+  rr joinE (extE `a` idE),
+  -- join (return x) --> x
+  rr (\x -> joinE `a` (returnE `a` x))
+     id,
+  -- (return . f) =<< m --> fmap f m
+  rr (\f m -> extE `a` (returnE `c` f) `a` m)
+     (\f m -> fmapIE `a` f `a` m),
+  -- (x >>=) . (return .) . f  --> flip (fmap . f) x
+  rr (\f x -> bindE `a` x `c` (compE `a` returnE) `c` f)
+     (\f x -> flipE `a` (fmapIE `c` f) `a` x),
+  -- (>>=) (return f) --> flip id f
+  rr (\f -> bindE `a` (returnE `a` f))
+     (\f -> flipE `a` idE `a` f),
+  -- liftM2 f x --> ap (f `fmap` x)
+  Hard $
+  rr (\f x -> liftM2E `a` f `a` x)
+     (\f x -> apE `a` (fmapIE `a` f `a` x)),
+  -- liftM2 f (return x) --> fmap (f x)
+  rr (\f x -> liftM2E `a` f `a` (returnE `a` x))
+     (\f x -> fmapIE `a` (f `a` x)),
+  -- f `fmap` return x --> return (f x)
+  rr (\f x -> fmapE `a` f `a` (returnE `a` x))
+     (\f x -> returnE `a` (f `a` x)),
+  -- (=<<) . flip (fmap . f) --> flip liftM2 f
+  Hard $
+  rr (\f -> extE `c` flipE `a` (fmapE `c` f))
+     (\f -> flipE `a` liftM2E `a` f),
+
+  -- ((f .) .) . g --> (f .** g)
+  Hard $ rr (\f g -> (compE `a` (compE `a` f)) `c` g)
+     (\f g -> (comp3E `a` f `a` g)),
+
+  -- (f .) . g --> (f .* g)
+  Hard $ rr (\f g -> (compE `a` f) `c` g)
+     (\f g -> comp2E `a` f `a` g),
+
+  -- flip (.) -> (-.)
+  rr (flipE `a` compE)
+     eyeE,
+
+  -- (x &) -> ($ x)
+  rr (\x -> ampersandE `a` x)
+     (\x -> dollarE `a` x),
+
+  -- f -.* (g . f) -> on g f
+  Hard $
+  rr (\f g -> oedipusE `a` f `a` (compE `a` g `a` f))
+     (\f g -> onE `a` g `a` f),
+
+  -- (.) -> fmap
+  Hard $
+  rr compE fmapE,
+
+  -- join .* map x y -> (=<<) x y
+  Hard $
+  rr (joinE `c2` mapE) extE,
+
+  -- map f (zip xs ys) --> zipWith (curry f) xs ys
+  Hard $
+  rr (\f xs ys -> mapE `a` f `a` (zipE `a` xs `a` ys))
+     (\f xs ys -> zipWithE `a` (curryE `a` f) `a` xs `a` ys),
+
+  -- zipWith (,) --> zip (,)
+  rr (zipWithE `a` commaE) zipE,
+
+  -- all f --> and . map f
+  Hard $
+  rr (\f -> allE `a` f)
+     (\f -> andE `c` mapE `a` f),
+  -- and . map f --> all f
+  rr (\f -> andE `c` mapE `a` f)
+     (\f -> allE `a` f),
+  -- any f --> or . map f
+  Hard $
+  rr (\f -> anyE `a` f)
+     (\f -> orE `c` mapE `a` f),
+  -- or . map f --> any f
+  rr (\f -> orE `c` mapE `a` f)
+     (\f -> anyE `a` f),
+
+  -- return f `ap` x --> fmap f x
+  rr (\f x -> apE `a` (returnE `a` f) `a` x)
+     (\f x -> fmapIE `a` f `a` x),
+  -- ap (f `fmap` x) --> liftM2 f x
+  rr (\f x -> apE `a` (fmapIE `a` f `a` x))
+     (\f x -> liftM2E `a` f `a` x),
+  -- f `ap` x --> (`fmap` x) =<< f
+  Hard $
+  rr (\f x -> apE `a` f `a` x)
+     (\f x -> extE `a` (flipE `a` fmapIE `a` x) `a` f),
+  -- (`fmap` x) =<< f --> f `ap` x
+  rr (\f x -> extE `a` (flipE `a` fmapIE `a` x) `a` f)
+     (\f x -> apE `a` f `a` x),
+  -- (x >>=) . flip (fmap . f) -> liftM2 f x
+  rr (\f x -> bindE `a` x `c` flipE `a` (fmapE `c` f))
+     (\f x -> liftM2E `a` f `a` x),
+
+  -- (f =<< m) x --> f (m x) x
+  rr0 (\f m x -> extE `a` f `a` m `a` x)
+      (\f m x -> f `a` (m `a` x) `a` x),
+  -- (fmap f g x) --> f (g x)
+  rr0 (\f g x -> fmapE `a` f `a` g `a` x)
+      (\f g x -> f `a` (g `a` x)),
+  -- return x y --> y
+  rr  (\y x -> returnE `a` x `a` y)
+      const,
+  -- liftM2 f g h x --> g x `h` h x
+  rr0 (\f g h x -> liftM2E `a` f `a` g `a` h `a` x)
+      (\f g h x -> f `a` (g `a` x) `a` (h `a` x)),
+  -- ap f id --> join f
+  rr  (\f -> apE `a` f `a` idE)
+      (\f -> joinE `a` f),
+
+  -- flip flip f . ((.) .* g) --> f -.** g
+  Hard $
+  rr (\f g -> (flipE `a` flipE `a` f `c` (compE `c2` g)))
+     (\f g -> oedipus2E `a` f `a` g),
+
+  -- (. f) . g --> (f -.* g)
+  Hard $
+  rr (\f g -> (flipE `a` compE `a` f) `c` g)
+     (\f g -> oedipusE `a` f `a` g),
+
+  -- (=<<) const q --> flip (>>) q
+  Hard $ -- ??
+  rr (\q p -> extE `a` (constE `a` q) `a` p)
+     (\q p -> seqME `a` p `a` q),
+  -- p >> q --> const q =<< p
+  Hard $
+  rr (\p q -> seqME `a` p `a` q)
+     (\p q -> extE `a` (constE `a` q) `a` p),
+
+  -- ap (f -.* ((,) . f . fst)) snd --> f (***) f
+  Hard $
+  rr (\f -> apE `a` (f `o` (commaE `c` f `c` fstE)) `a` sndE)
+     (\f -> joinE `a` crossE `a` f),
+
+  -- flip (=<<) --> >>=
+  rr (flipE `a` extE)
+     bindE,
+
+  -- flip (>=>) --> <=<
+  rr (flipE `a` fishE)
+     kliesliE,
+
+  -- (.) . (=<<) --> <=<
+  rr (compE `c` extE)
+     kliesliE,
+
+  -- join . (g .* f) --> f >=> g
+  Hard $
+    rr (\f g -> joinE `c` (g `c2` f))
+       (\f g -> fishE `a` f `a` g),
+
+  -- (`ap` snd) . (fst -.* (flip =<< (.) .* ((,) .))) --> join (***)
+  -- Hard $
+  rr ((flipE `a` apE `a` sndE) `c` (fstE `o` (extE `a` flipE `a` (compE `c2` (compE `a` commaE)))))
+     (joinE `a` crossE),
+
+  -- experimental support for Control.Arrow stuff
+  -- (costs quite a bit of performace)
+  -- uncurry ((. g) . (,) . f) --> f *** g
+  rr (\f g -> uncurryE `a` ((flipE `a` compE `a` g) `c` commaE `c` f))
+     (\f g -> crossE `a` f `a` g),
+  -- uncurry ((,) . f) --> first f
+  rr (\f -> uncurryE `a` (commaE `c` f))
+     (\f -> firstE `a` f),
+  -- uncurry ((. g) . (,)) --> second g
+  rr (\g -> uncurryE `a` ((flipE `a` compE `a` g) `c` commaE))
+     (\g -> secondE `a` g),
+  -- I think we need all three of them:
+  -- uncurry (const f) --> f . snd
+  rr (\f -> uncurryE `a` (constE `a` f))
+     (`c` sndE),
+  -- uncurry const --> fst
+  rr (uncurryE `a` constE)
+     fstE,
+  -- uncurry (const . f) --> f . fst
+  rr (\f -> uncurryE `a` (constE `c` f))
+     (`c` fstE),
+
+  -- TODO is this the right place?
+  -- [x] --> return x
+  Hard $
+  rr (\x -> consE `a` x `a` nilE)
+     (\x -> returnE `a` x),
+  -- list destructors
+  Hard $
+  If (Or [rr consE consE, rr nilE nilE]) $ Or [
+    down $ Or [
+      -- length [] --> 0
+      rr (lengthE `a` nilE)
+         zeroE,
+      -- length (x:xs) --> 1 + length xs
+      rr (\x xs -> lengthE `a` (consE `a` x `a` xs))
+         (\_ xs -> plusE `a` oneE `a` (lengthE `a` xs))
+    ],
+    -- map/fmap elimination
+    down $ Or [
+      -- map f (x:xs) --> f x: map f xs
+      rr (\f x xs -> mapE `a` f `a` (consE `a` x `a` xs))
+         (\f x xs -> consE `a` (f `a` x) `a` (mapE `a` f `a` xs)),
+      -- fmap f (x:xs) --> f x: Fmap f xs
+      rr (\f x xs -> fmapE `a` f `a` (consE `a` x `a` xs))
+         (\f x xs -> consE `a` (f `a` x) `a` (fmapE `a` f `a` xs)),
+      -- map f []     --> []
+      rr (\f -> mapE `a` f `a` nilE)
+         (pure nilE),
+      -- fmap f []     --> []
+      rr (\f -> fmapE `a` f `a` nilE)
+         (pure nilE)
+    ],
+    -- foldr elimination
+    down $ Or [
+      -- foldr f z (x:xs) --> f x (foldr f z xs)
+      rr (\f x xs z -> (foldrE `a` f `a` z) `a` (consE `a` x `a` xs))
+         (\f x xs z -> (f `a` x) `a` (foldrE `a` f `a` z `a` xs)),
+      -- foldr f z [] --> z
+      rr (\f z -> foldrE `a` f `a` z `a` nilE)
+         (\_ z -> z)
+    ],
+    -- foldl elimination
+    down $ Opt (CRR $ assocL ["."]) `Then` Or [
+      -- sum xs --> foldl (+) 0 xs
+      rr (\xs -> sumE `a` xs)
+         (\xs -> foldlE `a` plusE `a` zeroE `a` xs),
+      -- product xs --> foldl (*) 1 xs
+      rr (\xs -> productE `a` xs)
+         (\xs -> foldlE `a` multE `a` oneE `a` xs),
+      -- foldl1 f (x:xs) --> foldl f x xs
+      rr (\f x xs -> foldl1E `a` f `a` (consE `a` x `a` xs))
+         (\f x xs -> foldlE `a` f `a` x `a` xs),
+      -- foldl f z (x:xs) --> foldl f (f z x) xs
+      rr (\f z x xs -> (foldlE `a` f `a` z) `a` (consE `a` x `a` xs))
+         (\f z x xs -> foldlE `a` f `a` (f `a` z `a` x) `a` xs),
+      -- foldl f z [] --> z
+      rr (\f z -> foldlE `a` f `a` z `a` nilE)
+         (\_ z -> z),
+      -- special rule:
+      -- foldl f z [x] --> f z x
+      rr (\f z x -> foldlE `a` f `a` z `a` (returnE `a` x))
+         (\f z x -> f `a` z `a` x),
+      rr (\f z x -> foldlE `a` f `a` z `a` (consE `a` x `a` nilE))
+         (\f z x -> f `a` z `a` x)
+    ] `OrElse` (
+      -- (:) x --> (++) [x]
+      Opt (rr0 (\x -> consE `a` x)
+         (\x -> appendE `a` (consE `a` x `a` nilE))) `Then`
+      -- More special rule: (:) x . (++) ys --> (++) (x:ys)
+      up (rr0 (\x ys -> (consE `a` x) `c` (appendE `a` ys))
+         (\x ys -> appendE `a` (consE `a` x `a` ys)))
+      )
+  ],
+
+  -- Complicated Transformations
+  CRR collapseLists,
+  up $ Or [CRR (evalUnary unaryBuiltins), CRR (evalBinary binaryBuiltins)],
+  up $ CRR (assoc assocOps),
+  up $ CRR (assocL assocOps),
+  up $ CRR (assocR assocOps),
+  Up (CRR (commutative commutativeOps)) $ down $ Or [CRR $ assocL assocLOps,
+                                                     CRR $ assocR assocROps],
+
+  Hard simplifies
+  ] `Then` Opt (up simplifies)
+assocLOps, assocROps, assocOps :: [String]
+assocLOps = ["+", "*", "&&", "||", "max", "min"]
+assocROps = [".", "++", ".*", ".**"]
+assocOps  = assocLOps ++ assocROps
+
+commutativeOps :: [String]
+commutativeOps = ["*", "+", "==", "/=", "max", "min"]
+
+unaryBuiltins :: [(String,Unary)]
+unaryBuiltins = [
+    ("not",    UA (not    :: Bool -> Bool)),
+    ("negate", UA (negate :: Integer -> Integer)),
+    ("signum", UA (signum :: Integer -> Integer)),
+    ("abs",    UA (abs    :: Integer -> Integer))
+  ]
+
+binaryBuiltins :: [(String,Binary)]
+binaryBuiltins = [
+    ("+",    BA ((+)  :: Integer -> Integer -> Integer)),
+    ("-",    BA ((-)  :: Integer -> Integer -> Integer)),
+    ("*",    BA ((*)  :: Integer -> Integer -> Integer)),
+    ("^",    BA ((^)  :: Integer -> Integer -> Integer)),
+    ("<",    BA ((<)  :: Integer -> Integer -> Bool)),
+    (">",    BA ((>)  :: Integer -> Integer -> Bool)),
+    ("==",   BA ((==) :: Integer -> Integer -> Bool)),
+    ("/=",   BA ((/=) :: Integer -> Integer -> Bool)),
+    ("<=",   BA ((<=) :: Integer -> Integer -> Bool)),
+    (">=",   BA ((>=) :: Integer -> Integer -> Bool)),
+    ("div",  BA (div  :: Integer -> Integer -> Integer)),
+    ("mod",  BA (mod  :: Integer -> Integer -> Integer)),
+    ("max",  BA (max  :: Integer -> Integer -> Integer)),
+    ("min",  BA (min  :: Integer -> Integer -> Integer)),
+    ("&&",   BA ((&&) :: Bool -> Bool -> Bool)),
+    ("||",   BA ((||) :: Bool -> Bool -> Bool))
+  ]
diff --git a/src/Plugin/Pl/Transform.hs b/src/Plugin/Pl/Transform.hs
new file mode 100644
--- /dev/null
+++ b/src/Plugin/Pl/Transform.hs
@@ -0,0 +1,146 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PatternGuards     #-}
+module Plugin.Pl.Transform (
+    transform,
+  ) where
+
+import           Control.Monad.Trans.State
+import           Data.Graph                (flattenSCC, flattenSCCs,
+                                            stronglyConnComp)
+import qualified Data.Map                  as M
+import           Data.Maybe
+import           Plugin.Pl.Common
+
+occursP :: String -> Pattern -> Bool
+occursP v (PVar v')      = v == v'
+occursP v (PTuple p1 p2) = v `occursP` p1 || v `occursP` p2
+occursP v (PCons  p1 p2) = v `occursP` p1 || v `occursP` p2
+
+freeIn :: String -> Expr -> Int
+freeIn v (Var _ v') = fromEnum $ v == v'
+freeIn v (Lambda pat e) = if v `occursP` pat then 0 else freeIn v e
+freeIn v (App e1 e2) = freeIn v e1 + freeIn v e2
+freeIn v (Let ds e') = if v `elem` map declName ds then 0
+  else freeIn v e' + sum [freeIn v e | Define _ e <- ds]
+
+isFreeIn :: String -> Expr -> Bool
+isFreeIn v e = freeIn v e > 0
+
+tuple :: [Expr] -> Expr
+tuple  = foldr1 (\x y -> Var Inf "," `App` x `App` y)
+
+tupleP :: [String] -> Pattern
+tupleP vs = foldr1 PTuple $ PVar `map` vs
+
+dependsOn :: [Decl] -> Decl -> [Decl]
+dependsOn ds d = [d' | d' <- ds, declName d' `isFreeIn` declExpr d]
+
+unLet :: Expr -> Expr
+unLet (App e1 e2) = App (unLet e1) (unLet e2)
+unLet (Let [] e) = unLet e
+unLet (Let ds e) = unLet $
+  Lambda (tupleP $ declName `map` dsYes) (Let dsNo e) `App`
+    (fix' `App` Lambda (tupleP $ declName `map` dsYes)
+                        (tuple  $ declExpr `map` dsYes))
+    where
+  comps = stronglyConnComp [(d',d',dependsOn ds d') | d' <- ds]
+  dsYes = flattenSCC $ head comps
+  dsNo = flattenSCCs $ tail comps
+
+unLet (Lambda v e) = Lambda v (unLet e)
+unLet (Var f x) = Var f x
+
+type Env = M.Map String String
+
+-- It's a pity we still need that for the pointless transformation.
+-- Otherwise a newly created id/const/... could be bound by a lambda
+-- e.g. transform' (\id x -> x) ==> transform' (\id -> id) ==> id
+alphaRename :: Expr -> Expr
+alphaRename e = alpha e `evalState` M.empty where
+  alpha :: Expr -> State Env Expr
+  alpha (Var f v)     = Var f . fromMaybe v . M.lookup v <$> get
+  alpha (App e1 e2)   = liftM2 App (alpha e1) (alpha e2)
+  alpha (Let _ _)     = assert False bt
+  alpha (Lambda v e') = inEnv $ liftM2 Lambda (alphaPat v) (alpha e')
+
+  -- act like a reader monad
+  inEnv :: State s a -> State s a
+  inEnv f = gets $ evalState f
+
+  alphaPat (PVar v) = do
+    fm <- get
+    let v' = "$" ++ show (M.size fm)
+    put $ M.insert v v' fm
+    return $ PVar v'
+  alphaPat (PTuple p1 p2) = liftM2 PTuple (alphaPat p1) (alphaPat p2)
+  alphaPat (PCons p1 p2) = liftM2 PCons (alphaPat p1) (alphaPat p2)
+
+
+transform :: Expr -> Expr
+transform = transform' . alphaRename . unLet
+
+-- Infinite generator of variable names.
+varNames :: [String]
+varNames = flip replicateM usableChars =<< [1..]
+  where
+    usableChars = ['a'..'z']
+
+-- First variable name not already in use
+fresh :: [String] -> String
+fresh variables = head . filter (not . flip elem variables) $ varNames
+
+names :: Expr -> [String]
+names (Var _ str)     = [str]
+-- Lambda pattern names are rewritten to be meaningless/unwritable, so we don't
+-- need to include them here. Variables from lambdas used in expressions are
+-- also rewritten, but there's no reason to special-case it unless it's provably
+-- poor-performing to scan over the result in `fresh`, which I doubt it is.
+names (Lambda _ exp') = names exp'
+names (App exp1 exp2) = names exp1 ++ names exp2
+names (Let dlcs exp') = (dnames =<< dlcs) ++ names exp'
+  where
+    dnames (Define nm exp'') = nm : names exp''
+
+transform' :: Expr -> Expr
+transform' exp' = go exp'
+  where
+    -- Explicit sharing for readability
+    vars = names exp'
+
+    go Let {} =
+      assert False bt
+    go (Var f v) =
+      Var f v
+    go (App e1 e2) =
+      App (go e1) (go e2)
+    go (Lambda (PTuple p1 p2) e) =
+      go $
+        Lambda (PVar var) $ (Lambda p1 . Lambda p2 $ e) `App` f `App` s
+      where
+        var   = fresh vars
+        f     = Var Pref "fst" `App` Var Pref var
+        s     = Var Pref "snd" `App` Var Pref var
+    go (Lambda (PCons p1 p2) e) =
+      go $
+        Lambda (PVar var) $ (Lambda p1 . Lambda p2 $ e) `App` f `App` s
+      where
+        var = fresh vars
+        f   = Var Pref "head" `App` Var Pref var
+        s   = Var Pref "tail" `App` Var Pref var
+    go (Lambda (PVar v) e) =
+      go $ getRidOfV e
+      where
+        getRidOfV (Var f v') | v == v'   = id'
+                             | otherwise = const' `App` Var f v'
+        getRidOfV l@(Lambda pat _) =
+          assert (not $ v `occursP` pat) $ getRidOfV $ go l
+        getRidOfV Let {} = assert False bt
+        getRidOfV e'@(App e1 e2)
+          | fr1 && fr2 = scomb `App` getRidOfV e1 `App` getRidOfV e2
+          | fr1 = flip' `App` getRidOfV e1 `App` e2
+          | Var _ v' <- e2, v' == v = e1
+          | fr2 = comp `App` e1 `App` getRidOfV e2
+          | otherwise = const' `App` e'
+          where
+            fr1 = v `isFreeIn` e1
+            fr2 = v `isFreeIn` e2
diff --git a/test/Test.hs b/test/Test.hs
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -1,42 +1,40 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Main (main) where
 
-import           Test.HUnit
-import           Test.QuickCheck
-
+import           Data.Char               (isSpace)
+import           Data.Foldable           (fold)
 import           Plugin.Pl.Common
 import           Plugin.Pl.Optimize
 import           Plugin.Pl.Parser
 import           Plugin.Pl.PrettyPrinter
 import           Plugin.Pl.Transform
-
-import           Data.Char               (isSpace)
-
 import           System.Environment      (getArgs)
 import           System.Exit             (exitFailure)
 import           System.IO               (BufferMode (NoBuffering),
                                           hSetBuffering, stdout)
+import           Test.HUnit
+import           Test.QuickCheck
 
 instance Arbitrary Expr where
-  arbitrary = sized $ \size -> frequency $ zipWith (,) [1,size,size]
+  arbitrary = sized $ \size -> frequency $ zip [1,size,size]
     [arbVar,
      liftM2 Lambda arbitrary arbitrary,
      let se = resize (size `div` 2) arbitrary in liftM2 App se se ]
 
   shrink (Var _ _) = []
   shrink (Lambda v e) =
-    e : map (\v' -> Lambda v' e) (shrink v) ++ map (Lambda v) (shrink e)
+    e : map (`Lambda` e) (shrink v) ++ map (Lambda v) (shrink e)
   shrink (App e1 e2) = [e1, e2] ++
     map (App e1) (shrink e2) ++ map (`App` e2) (shrink e1)
   -- Let isn't generated by arbitrary, so we can probably ignore it
-  shrink (Let{}) = error "Expr.shrink: Let"
+  shrink Let{} = error "Expr.shrink: Let"
 
 instance Arbitrary Pattern where
   arbitrary = sized $ \size ->
     let
       spat = resize (size `div` 5) arbitrary
     in
-      frequency $ zipWith (,) [1,size,size] [
+      frequency $ zip [1,size,size] [
         (PVar . return) `fmap` choose ('a','z'),
         liftM2 PTuple spat spat,
         liftM2 PCons  spat spat]
@@ -71,10 +69,10 @@
     print d
     putStrLn "Transformed to pointfree style:"
     let d' = mapTopLevel transform d
-    print $ d'
+    print d'
     putStrLn "Optimized expression:"
     mapM_ print $ mapTopLevel' optimize d'
-  Left err -> putStrLn $ err
+  Left err -> putStrLn err
 
 unitTest :: String -> [String] -> Test
 unitTest inp out = TestCase $ do
@@ -86,7 +84,7 @@
     [] -> error "Test case expected result missing!"
     [x] -> assertEqual (inp ++ " failed.") x res
     _ -> assertBool
-      (concat [inp, " failed.",
+      (fold [inp, " failed.",
         "\nexpected one of:\n", show out,
         "\n        but got:\n", show res])
       (res `elem` out)
@@ -236,5 +234,4 @@
 doTests = do
   Counts{ errors = es, failures = fs } <- runTestTT unitTests
   qcTests
-  when (es > 0 || fs > 0) $ exitFailure
-  return ()
+  when (es > 0 || fs > 0) exitFailure