diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) 2012 Mathieu Boespflug
+
+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.
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/cassette.cabal b/cassette.cabal
new file mode 100644
--- /dev/null
+++ b/cassette.cabal
@@ -0,0 +1,28 @@
+Name:           cassette
+Version:        0.1.0
+Author:         Mathieu Boespflug
+Maintainer:     Mathieu Boespflug <mboes@cs.mcgill.ca>
+Synopsis:       A combinator library for simultaneously defining parsers and pretty printers.
+Description:
+    Combinator library for defining both type safe parsers and pretty printers simultaneously.
+    This library performs well in practice because parsers and printers are implemented in CPS
+    and because arguments are always curried, rather than packed into nested tuples.
+Category:       Parsing, Text
+License:        BSD3
+License-File:   LICENSE
+Cabal-Version:  >= 1.10.0
+Build-Type:     Simple
+Tested-With:    GHC == 7.4.1
+
+library
+  Hs-Source-Dirs: src
+  Build-Depends:  base >= 4 && < 5
+  Default-Language:     Haskell2010
+  default-extensions:   RankNTypes
+  other-extensions:     ImpredicativeTypes
+  Exposed-Modules:      Text.Cassette
+                        Text.Cassette.Prim
+                        Text.Cassette.Lead
+                        Text.Cassette.Combinator
+                        Text.Cassette.Char
+                        Text.Cassette.Number
diff --git a/src/Text/Cassette.hs b/src/Text/Cassette.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Cassette.hs
@@ -0,0 +1,62 @@
+-- | The combinators of this library are all pairs of functions going in
+-- opposite directions. These pairs are called /cassettes/, sporting two
+-- tracks (the two functions), one of which is read is one direction, the
+-- other of which (accessed by flipping the cassette) is read in the opossite
+-- direction.
+--
+-- Here is an example specification for the lambda-calculus:
+--
+-- > varL = K7 leadout leadin where
+-- >   leadout k k' s x = k (\ s _ -> k' s x) s (Var x)
+-- >   leadin k k' s t@(Var x)  = k (\ s _ -> k' s t) s x
+-- >   leadin k k' s t          = k' s t
+-- >
+-- > absL = K7 leadout leadin where
+-- >   leadout k k' s t' x = k (\ s _ -> k' s t' x) s (Lam x t')
+-- >   leadin k k' s t@(Lam x t)  = k (\ s _ _ -> k' s t) s t x
+-- >   leadin k k' s t            = k' s t
+-- >
+-- > appL = K7 leadout leadin where
+-- >   leadout k s t2 t1 = k (\ s _ -> k' s t2 t1) s (App t1 t2)
+-- >   leadin k k' s t@(App t1 t2)  = k (\ s _ _ -> k' s t) s t2 t1
+-- >   leadin k k' s t            = k' s t
+-- >
+-- > parens p = char '(' <> p <> char ')'
+-- >
+-- > term :: PP Term
+-- > term  =   varL --> ident
+-- >       <|> absL --> char '\' <> ident <> term
+-- >       <|> appL --> parens (term <> sepSpace <> term)
+--
+-- From this single specification, we can extract a parser,
+--
+-- > parse term :: PP Term -> String -> Maybe Term
+--
+-- and also a pretty printer,
+--
+-- > pretty term :: PP Term -> Term -> Maybe String
+--
+-- Specifications are built from primitive and derived combinators, which
+-- affect the input string in some way. For each constructor of each datatype,
+-- we need to write a /lead/, which is a pair of a construction function and a
+-- destruction function. Leads are pure combinators that do not affect the
+-- input string. By convention, we suffix their name with "L".
+--
+-- Internally, the primitive combinators are written in CPS. Leads also need
+-- to be written in this style, being primitive. They can, however, be
+-- automatically generated for every datatype using some Template Haskell
+-- hackery (in a separate package). A number of leads for standard datatypes
+-- are defined in the 'Text.Cassette.Lead' module.
+
+module Text.Cassette
+       ( module Text.Cassette.Prim
+       , module Text.Cassette.Lead
+       , module Text.Cassette.Combinator
+       , module Text.Cassette.Char
+       , module Text.Cassette.Number ) where
+
+import Text.Cassette.Prim
+import Text.Cassette.Lead
+import Text.Cassette.Combinator
+import Text.Cassette.Char
+import Text.Cassette.Number
diff --git a/src/Text/Cassette/Char.hs b/src/Text/Cassette/Char.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Cassette/Char.hs
@@ -0,0 +1,67 @@
+module Text.Cassette.Char where
+
+import Text.Cassette.Prim
+import Text.Cassette.Combinator
+import Data.Char
+
+
+-- | Succeeds if the current character is in the supplied list of characters.
+-- See also 'satisfy'.
+--
+-- > vowel = oneOf "aeiou"
+oneOf :: [Char] -> PP Char
+oneOf xs = satisfy (`elem` xs)
+
+-- | Dual of 'oneOf'.
+noneOf :: [Char] -> PP Char
+noneOf xs = satisfy (not . (`elem` xs))
+
+-- | The 'satisfy' combinator, unshifted.
+skip :: (Char -> Bool) -> Char -> PP0
+skip p x = unshift x $ satisfy p
+
+-- The next three combinators take their specification from the
+-- invertible-syntax package.
+
+-- | 'skipSpace' marks a position where whitespace is allowed to
+-- occur. It accepts arbitrary space while parsing, and produces
+-- no space while printing.
+skipSpace :: PP0
+skipSpace = unshift "" $ many (satisfy isSpace)
+
+-- | 'optSpace' marks a position where whitespace is desired to occur.
+-- It accepts arbitrary space while parsing, and produces a
+-- single space character while printing.
+optSpace :: PP0
+optSpace = unshift " " $ many (satisfy isSpace)
+
+-- | 'sepSpace' marks a position where whitespace is required to
+-- occur. It requires one or more space characters while parsing,
+-- and produces a single space character while printing.
+sepSpace :: PP0
+sepSpace = string " " <> skipSpace
+
+-- | Parses a newline character (\'\\n\').
+newline :: PP0
+newline = char '\n'
+
+-- | Parses a tab character (\'\\t\').
+tab :: PP0
+tab = char '\t'
+
+upper, lower, alphaNum, letter, digit, hexDigit, octDigit, anyChar :: PP Char
+
+upper = satisfy isUpper
+lower = satisfy isLower
+alphaNum = satisfy isAlphaNum
+letter = satisfy isAlpha
+digit = satisfy isDigit
+hexDigit = satisfy isHexDigit
+octDigit = satisfy isOctDigit
+
+-- | Any character.
+anyChar = satisfy (const True)
+
+-- | A specific character.
+char :: Char -> PP0
+char x = string [x]
diff --git a/src/Text/Cassette/Combinator.hs b/src/Text/Cassette/Combinator.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Cassette/Combinator.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE RankNTypes, ImpredicativeTypes #-}
+module Text.Cassette.Combinator where
+
+import Text.Cassette.Prim
+import Text.Cassette.Lead
+
+
+-- | Applies each cassette in the supplied list in order, until one of them
+-- succeeds.
+choice :: [PP a] -> PP a
+choice [p] = p
+choice (p:ps) = p <|> choice ps
+
+-- | @count n p@ matches @n@ occurrences of @p@.
+count :: Int -> PP a -> PP [a]
+count 0 _ = nilL
+count n p = consL --> p <> count (n - 1) p
+
+-- | Tries to apply the given cassette. It returns the value of the cassette
+-- on success, the first argument otherwise.
+option :: a -> PP a -> PP a
+option x p = p <|> shift x nothing
+
+-- | Tries to apply the given cassette. It returns a value of the form @Just
+-- x@ on success, @Nothing@ otherwise.
+optionMaybe :: PP a -> PP (Maybe a)
+optionMaybe p = justL --> p <|> nothingL
+
+-- | Tries to match the given cassette and discards the result, otherwise does
+-- nothing in case of failure.
+optional :: PP a -> PP0
+optional p = unshift [] (count 1 p <|> count 0 p)
+
+-- | Apply the given cassette zero or more times.
+many :: PP a -> PP [a]
+many p = many1 p <|> nilL
+
+-- | Apply the given cassette one or more times.
+many1 :: PP a -> PP [a]
+many1 p = consL --> p <> many p
+
+-- | Apply the given cassette zero or more times, discarding the result.
+skipMany :: PP a -> PP0
+skipMany p = unshift [] $ many p
+
+-- | Apply the given cassette one or more times, discarding the result.
+skipMany1 :: PP a -> PP0
+skipMany1 p = unshift [] $ many1 p
+
+-- | Apply the first argument zero or more times, separated by the second
+-- argument.
+sepBy :: PP a -> PP0 -> PP [a]
+sepBy px psep = sepBy1 px psep <|> nilL
+
+-- | Apply the first argument one or more times, separated by the second
+-- argument.
+sepBy1 :: PP a -> PP0 -> PP [a]
+sepBy1 px psep = consL --> px <> many (psep <> px)
+
+-- | @chainl p op x@ matches zero or more occurrences of @p@, separated by
+-- @op@. Returns a value obtained by a /left associative/ application of all
+-- functions returned by @op@ to the values returned by @p@. If there are zero
+-- occurrences of @p@, the value @x@ is returned.
+chainl :: PP0 -> BinL a a a -> PP a -> a -> PP a
+chainl opP opL xP dflt = chainl1 opP opL xP <|> shift dflt nothing
+
+-- | Match a a left-associative chain of infix operators.
+chainl1 :: PP0 -> BinL a a a -> PP a -> PP a
+chainl1 opP opL xP = catanal opL --> xP <> many (opP <> xP)
+
+-- | @chainr p op x@ matches zero or more occurrences of @p@, separated by
+-- @op@. Returns a value obtained by a /right associative/ application of all
+-- functions returned by @op@ to the values returned by @p@. If there are zero
+-- occurrences of @p@, the value @x@ is returned.
+chainr :: PP0 -> BinL a a a -> PP a -> a -> PP a
+chainr opP opL xP dflt = chainr1 opP opL xP <|> shift dflt nothing
+
+-- | Match a a right-associative chain of infix operators.
+chainr1 :: PP0 -> BinL a a a -> PP a -> PP a
+chainr1 opP opL xP = catanar opL --> xP <> many (opP <> xP)
+
+-- | @notFollowedBy p@ only succeeds when @p@ fails. This combinator does
+-- not consume/produce any input.
+notFollowedBy :: PP0 -> PP0
+notFollowedBy p = unshift () $ shift () (p <> empty) <|> shift () nothing
+
+-- | Applies first argument zero or more times until second argument succeeds.
+manyTill :: PP a -> PP0 -> PP [a]
+manyTill xP endP = nilL --> endP <|> consL --> xP <> manyTill xP endP
diff --git a/src/Text/Cassette/Lead.hs b/src/Text/Cassette/Lead.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Cassette/Lead.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE RankNTypes #-}
+module Text.Cassette.Lead where
+
+import Text.Cassette.Prim
+
+
+-- | The type of binary leads, parameterized by the type of the left operand,
+-- the right operand, and the type of the result.
+type UnL a b =
+  forall r r'. K7 (C (b -> r))  (C (a -> r))
+                  (C (b -> r')) (C (a -> r'))
+
+-- | The type of binary leads, parameterized by the type of the left operand,
+-- the right operand, and the type of the result.
+type BinL a b c =
+  forall r r'. K7 (C (c -> r))  (C (b -> a -> r))
+                  (C (c -> r')) (C (b -> a -> r'))
+
+-- | Lift a pair of symmetric functions to a lead.
+liftL :: Sym a b -> UnL a b
+liftL (Sym (K7 f f')) =
+  K7 (\k k' s x -> k (\s _ -> k' s x) s (f x))
+     (\k k' s y -> k (\s _ -> k' s y) s (f' y))
+
+-- | Iterates a one step construction function (resp. deconstruction)
+-- function, i.e. a lead, thus obtaining a right fold (resp. unfold). The
+-- resulting lead is a catamorphism on one side and an anamorpism on the
+-- other, hence the name. The type of this function is the same as that of
+-- 'foldr', lifted to cassettes.
+catanar :: BinL a b b -> BinL b [a] b
+catanar (K7 f f') = K7 g g' where
+  g k k' s xs@[]      z = k (\s _ -> k' s xs z) s z
+  g k k' s xs@(x:xs') z =
+    g (\k' s z -> f k (\s _ _ -> k' s z) s z x) (\s _ _ -> k' s xs z) s xs' z
+  g' k k' s z =
+    f' (\k' s z x -> g' (\k' s xs' z -> k k' s (x:xs') z) (\s _ -> k' s z x) s z)
+       (\s _ -> k (\s _ _ -> k' s z) s [] z) s z
+
+-- | Iterates a one step construction function (resp. deconstruction)
+-- function, i.e. a lead, thus obtaining a left fold (resp. unfold). The
+-- resulting lead is a catamorphism on one side and an anamorpism on the
+-- other, hence the name. The type of this function is the same as that of
+-- 'foldl', lifted to cassettes.
+catanal :: BinL a b a -> BinL a [b] a
+catanal (K7 f f') = K7 g (g' []) where
+  g k k' s xs@[]      z = k (\s _ -> k' s xs z) s z
+  g k k' s xs@(x:xs') z =
+    f (\k' s z -> g k (\s _ _ -> k' s z) s xs' z) (\s _ _ -> k' s xs z) s x z
+  g' xs' k k' s z =
+    f' (\k' s x z -> g' (x:xs') k (\s _ -> k' s x z) s z) (\s _ -> k (\s _ _ -> k' s z) s xs' z) s z
+
+consL :: BinL a [a] [a]
+consL = K7 (\k k' s xs' x -> k (\s _ -> k' s xs' x) s (x:xs'))
+           (\k k' s xs -> case xs of
+               x:xs' -> k (\s _ _ -> k' s xs) s xs' x
+               _ -> k' s xs)
+
+nilL :: PP [a]
+nilL = shift [] nothing
+
+justL :: UnL a (Maybe a)
+justL = K7 (\k k' s x -> k (\s _ -> k' s x) s (Just x))
+           (\k k' s mb -> maybe (k' s mb) (k (\s _ -> k' s mb) s) mb)
+
+nothingL :: PP (Maybe a)
+nothingL = shift Nothing nothing
+
+pairL :: BinL a b (a, b)
+pairL = K7 (\k k' s x2 x1 -> k (\s _ -> k' s x2 x1) s (x1, x2))
+           (\k k' s t@(x1, x2) -> k (\s _ _ -> k' s t) s x2 x1)
+
+tripleL :: K7 (C ((a,b,c) -> r))  (C (c -> b -> a -> r))
+              (C ((a,b,c) -> r')) (C (c -> b -> a -> r'))
+tripleL = K7 (\k k' s x3 x2 x1 -> k (\s _ -> k' s x3 x2 x1) s (x1, x2, x3))
+             (\k k' s t@(x1, x2, x3) -> k (\s _ _ _ -> k' s t) s x3 x2 x1)
+
+quadrupleL :: K7 (C ((a,b,c,d) -> r))  (C (d -> c -> b -> a -> r))
+                 (C ((a,b,c,d) -> r')) (C (d -> c -> b -> a -> r'))
+quadrupleL = K7 (\k k' s x4 x3 x2 x1 -> k (\s _ -> k' s x4 x3 x2 x1) s (x1, x2, x3, x4))
+                (\k k' s t@(x1, x2, x3, x4) -> k (\s _ _ _ _ -> k' s t) s x4 x3 x2 x1)
diff --git a/src/Text/Cassette/Number.hs b/src/Text/Cassette/Number.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Cassette/Number.hs
@@ -0,0 +1,14 @@
+-- | This module exports combinators for parsing number literals.
+module Text.Cassette.Number where
+
+import Text.Cassette.Prim
+import Text.Cassette.Lead
+import Text.Cassette.Combinator
+import Text.Cassette.Char
+
+
+-- | An integer literal, positive or negative.
+int :: PP Int
+int = intL --> many1 digit <|>
+      intL --> consL --> satisfy (== '-') <> many1 digit
+  where intL = liftL $ Sym $ K7 read show
diff --git a/src/Text/Cassette/Prim.hs b/src/Text/Cassette/Prim.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Cassette/Prim.hs
@@ -0,0 +1,138 @@
+{-# LANGUAGE RankNTypes #-}
+module Text.Cassette.Prim
+       ( -- * Datatypes
+         K7(..), Sym(..), C, PP, PP0
+         -- * Composition
+       , (<>), (-->), (<|>)
+         -- * Extraction
+       , play, flip, parse, pretty
+         -- * Primitive combinators
+       , empty, nothing, shift, unshift, string, satisfy, lookAhead, eof
+       ) where
+
+import Data.List (stripPrefix)
+import Control.Category
+import Prelude hiding (flip, id, (.))
+import qualified Prelude
+
+
+-- | A cassette consists of two tracks, represented by functions. The
+-- functions on each track are not necessarily inverses of each other, and do
+-- not necessarily connect the same start and end types.
+data K7 a b c d = K7 { sideA :: a -> b, sideB :: d -> c }
+
+-- | Symmetric cassettes do have functions that are inverses of each other on
+-- each track. Symmetric cassettes form a category under splicing (see
+-- '(<>)').
+newtype Sym a b = Sym { unSym :: K7 a b a b }
+
+infixr 9 <>
+
+-- | Tape splicing operator. Functions on each track are composed pairwise.
+(<>) :: K7 b c b' c' -> K7 a b a' b' -> K7 a c a' c'
+-- Irrefutable patterns to support definitions of combinators by coinduction.
+~(K7 f f') <> ~(K7 g g') = K7 (f . g) (g' . f')
+
+instance Category Sym where
+  id = Sym (K7 id id)
+  Sym csst1 . Sym csst2 = Sym (csst1 <> csst2)
+
+infixr 8 -->
+
+-- | A synonym to '(<>)' with its arguments flipped and with lower precedence.
+(-->) = Prelude.flip (<>)
+
+-- | The type of string transformers in CPS, /i.e./ functions from strings to
+-- strings.
+type C r = (String -> r) -> String -> r
+
+-- | The type of cassettes with a string transformer on each side. The A-side
+-- produces a value in addition to transforming the string, /i.e./ it is a
+-- parser. The B-side consumes a value to transform the string, /i.e./ it is a
+-- printer.
+type PP a = forall r r'. K7 (C (a -> r)) (C r) (C (a -> r')) (C r')
+type PP0  = forall r r'. K7 (C r) (C r) (C r') (C r')
+
+-- | Select the A-side.
+play :: K7 a b c d -> a -> b
+play csst = sideA csst
+
+-- | Switch the A-side and B-side around.
+flip :: K7 a b c d -> K7 d c b a
+flip (K7 f g) = K7 g f
+
+-- | Extract the parser from a cassette.
+parse :: PP a -> String -> Maybe a
+parse csst = play csst (\_ _ x -> Just x) (const Nothing)
+
+-- | Flip the cassette around to extract the pretty printer.
+pretty :: PP a -> a -> Maybe String
+pretty csst = play (flip csst) (const Just) (\_ _ -> Nothing) ""
+
+-- Use same priority and associativity as in Parsec.
+infixr 1 <|>
+
+-- | Choice operator. If the first cassette fails, then try the second parser.
+-- Note that this is an unrestricted backtracking operator: it never commits
+-- to any particular choice.
+(<|>) :: PP a -> PP a -> PP a
+K7 f f' <|> K7 g g' =
+  K7 (\k k' s -> f k (\s' -> g k k' s) s)
+     (\k k' s x -> f' k (\s' -> g' k k' s) s x)
+
+-- | Always fail.
+empty :: PP0
+empty = K7 (\k k' s -> k' s) (\k k' s -> k' s)
+
+-- | Do nothing.
+nothing :: PP0
+nothing = K7 id id
+
+-- | Turn the given pure transformer into a parsing/printing pair. That is,
+-- return a cassette that produces and output on the one side, and consumes an
+-- input on the other, in addition to the string transformations of the given
+-- pure transformer. @shift x p@ produces @x@ as the output of @p@ on the
+-- parsing side, and on the printing side accepts an input that is ignored.
+shift :: a -> PP0 -> PP a
+shift x ~(K7 f f') =
+  K7 (\k k' -> f (\k' s -> k (\s _ -> k' s) s x) k')
+     (\k k' s x -> f' k (\s -> k' s x) s)
+
+-- | Turn the given cassette into a pure string transformer. That is, return a
+-- cassette that does not produce an output or consume an input. @unshift x p@
+-- throws away the output of @p@ on the parsing side, and on the printing side
+-- sets the input to @x@.
+unshift :: a -> PP a -> PP0
+unshift x ~(K7 f f') =
+  K7 (\k k' -> f (\k' s x -> k (\s -> k' s x) s) k')
+     (\k k' s -> f' k (\s _ -> k' s) s x)
+
+write :: (a -> String) -> C r -> C (a -> r)
+write f = \k k' s x -> k (\s -> k' s x) (f x ++ s)
+
+write0 :: String -> C r -> C r
+write0 x = \k k' s -> write id k (\s _ -> k' s) s x
+
+-- | Strip/add the given string from/to the output string.
+string :: String -> PP0
+-- We could implement 'string' in terms of many, satisfy, char and unshift,
+-- but don't, purely to reduce unnecessary choice points during parsing.
+string x = K7 (\k k' s -> maybe (k' s) (k k') $ stripPrefix x s) (write0 x)
+
+-- | Successful only if predicate holds.
+satisfy :: (Char -> Bool) -> PP Char
+satisfy p = K7 f g where
+  f k k' (x:xs) | p x = k (\s _ -> k' s) xs x
+  f k k' s = k' s
+  g k k' s x | p x = k (\s -> k' s x) (x:s)
+             | otherwise = k' s x
+
+-- | Parse/print without consuming/producing any input.
+lookAhead :: PP a -> PP a
+lookAhead (K7 f f') = K7 (\k k' s -> f (\k' _ -> k k' s) k' s) (\k k' s -> f' (\k' _ -> k k' s) k' s)
+
+-- | Succeeds if input string is empty.
+eof :: PP0
+eof = K7 isEmpty isEmpty where
+  isEmpty k k' "" = k k' ""
+  isEmpty k k' s  = k' s