diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for joy-rewrite
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,26 @@
+Copyright (c) 2022, Johannes Riecken
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the
+   distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/joy-rewrite.cabal b/joy-rewrite.cabal
new file mode 100644
--- /dev/null
+++ b/joy-rewrite.cabal
@@ -0,0 +1,76 @@
+cabal-version:      2.4
+
+name:               joy-rewrite
+
+version:            0.1.0.0
+
+synopsis:           Transform Joy code using conditional rewrite rules
+
+description:
+  This package implements a rewriting function as detailed in the paper [A
+  Rewriting System for Joy](http://www.nsl.com/papers/rewritejoy.html) by Manfred
+  von Thun. It can be used to simplify expressions or to replace constant
+  expressions by their results.
+
+homepage:           https://github.com/johannes-riecken/joy-rewrite
+
+bug-reports:        https://github.com/johannes-riecken/joy-rewrite/issues
+
+license:            BSD-2-Clause
+
+license-file:       LICENSE
+
+author:             Johannes Riecken
+
+maintainer:         johannes.riecken@gmail.com
+
+category:           Language
+
+extra-source-files: CHANGELOG.md
+
+source-repository head
+  type: git
+  location: https://github.com/johannes-riecken/joy-rewrite.git
+
+library
+    exposed-modules:  Language.Joy.Rewrite
+
+    -- Modules included in this library but not exported.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+
+    -- Other library packages from which modules are imported.
+    build-depends:
+      base ^>=4.14.3.0,
+      containers ^>= 0.6.5.1,
+      monad-loops ^>= 0.4.3,
+      hspec ^>= 2.8.3,
+      parsec ^>= 3.1.14.0,
+      text ^>= 1.2.4
+
+    -- Directories containing source files.
+    hs-source-dirs:   src
+
+    -- Base language which the package is written in.
+    default-language: Haskell2010
+
+test-suite joy-rewrite-test
+    -- Base language which the package is written in.
+    default-language: Haskell2010
+
+    -- The interface type and version of the test suite.
+    type:             exitcode-stdio-1.0
+
+    -- Directories containing source files.
+    hs-source-dirs:   test
+
+    -- The entrypoint to the test suite.
+    main-is:          RewriteTest.hs
+
+    -- Test dependencies.
+    build-depends:
+      base ^>=4.14.3.0,
+      joy-rewrite,
+      hspec ^>= 2.8.3
diff --git a/src/Language/Joy/Rewrite.hs b/src/Language/Joy/Rewrite.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Joy/Rewrite.hs
@@ -0,0 +1,224 @@
+{-# OPTIONS_GHC -Wall #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+{-# LANGUAGE DeriveFunctor, FlexibleContexts, LambdaCase, OverloadedStrings #-}
+-- |
+-- Maintainer  :  Johannes Riecken <johannes.riecken@gmail.com>
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- This module includes combinators for rewriting Joy source code.
+----------------------------------------------------------------------------
+module Language.Joy.Rewrite
+  ( rewrite
+  , tokenize
+  ) where
+import Control.Applicative
+import Control.Arrow
+import Control.Monad
+import Control.Monad.Loops
+import Data.Foldable (asum)
+import Data.List
+import qualified Data.Text as T
+import Data.Text (Text(..))
+import qualified Data.Map as M
+import Data.Map (Map)
+import Test.Hspec
+import Text.Parsec hiding ((<|>), many)
+
+-- | Error is a generic error type.
+type Error = Text
+
+-- A rewrite rule matches a pattern and tries to rewrite it with the
+-- replacement. If there is a condition attached, the rewriting will only happen
+-- if the rewrite given in the condition can happen based on known rewrite
+-- rules.
+data Rule = Rule
+  { pat       :: [RuleExpr Text]
+  , repl      :: [RuleExpr Text]
+  , condition :: Maybe Condition
+  }
+  deriving Show
+
+data Condition = Condition
+  { premise    :: [RuleExpr Text]
+  , conclusion :: [RuleExpr Text]
+  }
+  deriving Show
+
+convertError :: Either ParseError a -> Either Error a
+convertError (Left x) = Left . T.pack $ show x
+convertError (Right x) = Right x
+
+-- Construct a Rule by parsing a string like "a b swap => b a"
+mkRule :: Text -> Either Error Rule
+mkRule xs = do
+  xs' <- tokenizeRule xs
+  if CondSep `elem` xs'
+    then do
+      (v,w) <- cut CondSep xs'
+      (a,b) <- cut RuleSep v
+      (c,d) <- cut RuleSep w
+      pure $ Rule a b (Just $ Condition c d)
+    else do
+      (a, b) <- tokenizeFromTo xs
+      pure $ Rule a b Nothing where
+
+  tokenizeFromTo :: Text -> Either Error ([RuleExpr Text], [RuleExpr Text])
+  tokenizeFromTo xs = tokenizeRule xs >>= cut RuleSep
+
+  cut :: Eq a => a -> [a] -> Either Error ([a], [a])
+  cut _ [] = Left "tried to cut empty list"
+  cut sep xs = Right . second tail . break (== sep) $ xs
+
+  tokenizeRule :: Text -> Either Error [RuleExpr Text]
+  tokenizeRule = convertError . fmap (fmap (fmap T.pack)) . parse parser "" . T.unpack   where
+    parser =
+      let metaVar     = MetaVar <$> fmap pure lower
+          metaListVar = MetaListVar <$> fmap pure upper
+          var = Var <$> (
+                string "["
+            <|> string "]"
+            <|> do
+                  x <- string "="
+                  notFollowedBy (string ">")
+                  pure x
+            <|> many1 digit
+            <|> ((:) <$> lower <*> many1 alphaNum)
+            )
+          ruleSep = RuleSep <$ string "=>"
+          condSep = CondSep <$ string ":-"
+      in  sepBy (try var <|> metaVar <|> metaListVar <|> ruleSep <|> condSep) spaces
+
+-- An atom in a Rule
+data RuleExpr a =
+      Var a -- matches with one exact atom, e.g. "swap"
+    | MetaVar a -- can match with any single atom and assign it to the variable name
+    | MetaListVar a -- matches a list of atoms and assigns it to the variable name
+    | RuleSep -- "=>"
+    | CondSep -- ":-" (read as "if")
+    deriving (Show, Eq, Ord, Functor)
+
+-- Stores the associations between rule variables and their matched Joy code
+type RuleMap a = Map (RuleExpr a) [a]
+
+-- | Given a list of rewrite rules and Joy code, apply the rules and return the resulting
+--   list of tokens.
+rewrite :: [Text] -> Text -> Either Error [Text]
+rewrite ruleStrs code = do
+  rs <- traverse mkRule ruleStrs
+  rewrite' rs (tokenize code) where
+
+  rewrite' :: [Rule] -> [Text] -> Either Error [Text]
+  rewrite' rules = fmap concat . unfoldrM
+    (\case
+      [] -> Right Nothing
+      xxs@(x : xs) ->
+        Right $ asum (map (\r -> case matchPat r xxs of
+                    Right (s, m) -> do
+                      case condition r of
+                        Nothing -> Just (concatMap (\k -> case k of
+                            Var k' -> M.findWithDefault [k'] k m
+                            _      -> m M.! k
+                            )
+                            (repl r)
+                          , drop (length s) xxs
+                          )
+                        Just c -> case rewrite' rules (apply m $ premise c) of
+                          Right x' -> case matchConclusion r x' of
+                            Right (_, m') -> Just (replTokens, drop (length s) xxs)
+                              where replTokens = apply (M.union m m') $ repl r
+                            _ -> Nothing
+                          _ -> Nothing
+                    _ -> Nothing
+                  ) rules
+                )
+          <|> Just ([x], xs)
+    )
+
+  -- Applies the stored rewrite associations to Joy code.
+  apply :: RuleMap Text -> [RuleExpr Text] -> [Text]
+  apply m = (=<<) (\x -> M.findWithDefault [(\case (Var x') -> x') x] x m)
+
+  -- Matches the pattern part of a rule. I didn't find anything like `runState`
+  -- for Parsec, so I return both the value and the state in the same tuple
+  -- format.
+  matchPat :: Rule -> [Text] -> Either Error ([Text], RuleMap Text)
+  matchPat r = convertError . runParser
+    (do
+      x <- mkParser (pat r)
+      y <- getState
+      pure (x, y)
+    )
+    M.empty
+    ""
+
+  matchConclusion
+    :: Rule -> [Text] -> Either Error ([Text], RuleMap Text)
+  matchConclusion r xs = do
+    conc <- conclusion <$> maybeToParseResult (condition r)
+    convertError $ runParser
+      (do
+        x <- mkParser conc
+        y <- getState
+        pure (x, y)
+      )
+      M.empty
+      ""
+      xs where
+    -- I think this is also a clear case where I should use a more generic error
+    -- type.
+    maybeToParseResult :: Maybe a -> Either Error a
+    maybeToParseResult = maybe (Left "") Right
+
+  mkParser :: [RuleExpr Text] -> Parsec [Text] (RuleMap Text) [Text]
+  mkParser = foldr
+    (\x acc -> case x of
+      Var x' -> do
+        modifyState $ M.insert (Var x') [x']
+        (:) <$> char' x' <*> acc
+      MetaVar x' -> do
+        -- `nonBracket'` and `nonTrueNonBracket'` are hacks because I couldn't
+        -- figure out how to reluctantly match as little as possible. I think
+        -- the parser-combinators package might contain what I need.
+        x'' <- nonBracket'
+        modifyState $ M.insert (MetaVar x') [x'']
+        (x'' :) <$> acc
+      MetaListVar x' -> do
+        x'' <- many nonTrueNonBracket'
+        modifyState $ M.insert (MetaListVar x') x''
+        (x'' ++) <$> acc
+      RuleSep -> error "assertion error: RuleSep found by mkParser"
+      CondSep -> error "assertion error: CondSep found by mkParser"
+    )
+    (pure [])
+
+-- | Split Joy code into tokens.
+tokenize :: Text -> [Text]
+tokenize = filter (not . T.null) . tokenize' where
+
+  tokenize' :: Text -> [Text]
+  tokenize' = unfoldr
+    (\xxs -> case T.uncons xxs of
+      Nothing        -> Nothing
+      Just ('[', xs) -> Just ("[", xs)
+      Just (']', xs) -> Just ("]", xs)
+      Just _   -> Just (a, T.dropWhile (== ' ') b)
+        where (a, b) = T.break (`elem` ("[] " :: String)) xxs
+    )
+
+-- I ended these with an apostrophe, because they work on tokens, not Strings.
+satisfy' :: (Eq a, Show a) => (a -> Bool) -> Parsec [a] u a
+satisfy' p = tokenPrim showTok posFromTok testTok
+ where
+  showTok t = show t
+  posFromTok pos _ _ = incSourceColumn pos 1
+  testTok t = mfilter p (Just t)
+
+char' :: (Eq a, Show a) => a -> Parsec [a] u a
+char' x = satisfy' (== x) <?> show x
+
+nonBracket' :: Parsec [Text] u Text
+nonBracket' = satisfy' (`notElem` ["[", "]"])
+
+nonTrueNonBracket' :: Parsec [Text] u Text
+nonTrueNonBracket' = satisfy' (`notElem` ["[", "]", "true"])
diff --git a/test/RewriteTest.hs b/test/RewriteTest.hs
new file mode 100644
--- /dev/null
+++ b/test/RewriteTest.hs
@@ -0,0 +1,85 @@
+module Main (main) where
+
+import Language.Joy.Rewrite
+import Test.Hspec
+
+main :: IO ()
+main = do
+  hspec $ do
+
+    describe "empty param" $ do
+      it "rewrites"
+        $ (do
+            let r0 = "[] [M] concat => [M]"
+            let r1 = "[a L] [M] concat => [a N] :- [L] [M] concat => [N]"
+            rewrite [r0, r1] "[] [1 2] concat"
+          )
+        `shouldBe` Right (tokenize "[1 2]")
+
+    describe "single elem" $ do
+      it "rewrites"
+        $ (do
+            let r0 = "[] [M] concat => [M]"
+            let r1 = "[a L] [M] concat => [a N] :- [L] [M] concat => [N]"
+            rewrite [r0, r1] "[1] [2 3] concat"
+          )
+        `shouldBe` Right (tokenize "[1 2 3]")
+      it "rewrites multiple elems"
+        $ (do
+            let r0 = "[] [M] concat => [M]"
+            let r1 = "[a L] [M] concat => [a N] :- [L] [M] concat => [N]"
+            rewrite [r0, r1] "[1 2] [3 4] concat"
+          )
+        `shouldBe` Right (tokenize "[1 2 3 4]")
+      it "rewrites ifte"
+        $ (do
+            let r0 = "a a = => true"
+            let r1 = "L [I] [T] [E] ifte => L T :- L I => M true"
+            rewrite [r0, r1] "1 1 [=] [5] [6] ifte"
+          )
+        `shouldBe` Right (tokenize "1 1 5")
+      it "returns original if nothing to rewrite"
+        $ (do
+            let r0 = "a a = => true"
+            let r1 = "L [I] [T] [E] ifte => L T :- L I => M true"
+            rewrite [r0, r1] "1 2 3 4 5"
+          )
+        `shouldBe` Right (tokenize "1 2 3 4 5")
+    it "substitutes given strings" $ do
+      rewrite ["a b swap => b a"] "foo bar swap" `shouldBe` Right ["bar", "foo"]
+      rewrite ["a b swap => b a"] "foo bar swap baz quux"
+        `shouldBe` Right ["bar", "foo", "baz", "quux"]
+      rewrite ["a b swap => b a"] "red green foo bar swap baz quux"
+        `shouldBe` Right ["red", "green", "bar", "foo", "baz", "quux"]
+      rewrite ["a b swap => b a"] "3 4 swap" `shouldBe` Right ["4", "3"]
+      rewrite ["a b => [b] a"] "a b s"
+        `shouldBe` Right ["[", "b", "]", "a", "s"]
+      rewrite ["a b => b a"] "a b swap" `shouldBe` Right ["b", "a", "swap"]
+      rewrite ["a b => b"] "a b s" `shouldBe` Right ["b", "s"]
+      rewrite ["a b => b a b a"] "a b s"
+        `shouldBe` Right ["b", "a", "b", "a", "s"]
+      rewrite ["a [P] dip => P a"] "a [b c] dip"
+        `shouldBe` Right ["b", "c", "a"]
+      rewrite ["[ ] unstack => newstack"] "[] unstack"
+        `shouldBe` Right ["newstack"]
+      rewrite ["[a b L] second => b"] "1 [2 3 4 5] second"
+        `shouldBe` Right ["1", "3"]
+      rewrite ["[a L] 1 at => a"] "[2 3 4] 1 at" `shouldBe` Right ["2"]
+      rewrite ["[] [L] concat => [L]"] "[ ] [1 2 3] concat"
+        `shouldBe` Right ["[", "1", "2", "3", "]"]
+
+    it "keeps trailing stuff" $ do
+      rewrite
+          [ "[] [M] concat => [M]"
+          , "[a L] [M] concat => [a N] :- [L] [M] concat => [N]"
+          ]
+          "[1 2] [3 4] concat 5 6"
+        `shouldBe` Right (tokenize "[1 2 3 4] 5 6")
+    it "rewrites in the middle" $ do
+      rewrite
+          [ "[] [M] concat => [M]"
+          , "[a L] [M] concat => [a N] :- [L] [M] concat => [N]"
+          ]
+          "1 2 [3 4] [5 6 7] concat 8 9"
+        `shouldBe` Right (tokenize "1 2 [3 4 5 6 7] 8 9")
+  pure ()