diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,26 @@
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+
+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.
+
+Neither the name of the Northeastern University; nor the names of its
+contributors may be used to endorse or promote products derived from
+this software without specific prior written permission.
+
+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/Language/Haskell/Preprocessor.hs b/Language/Haskell/Preprocessor.hs
new file mode 100644
--- /dev/null
+++ b/Language/Haskell/Preprocessor.hs
@@ -0,0 +1,122 @@
+module Language.Haskell.Preprocessor (
+  module Language.Haskell.Preprocessor.Ast,
+  module Language.Haskell.Preprocessor.Parser,
+  module Language.Haskell.Preprocessor.Printer,
+  module Language.Haskell.Preprocessor.SynSpec,
+  module Language.Haskell.Preprocessor.Util,
+  module Data.Monoid,
+  Loc.Locatable(..), Loc.cloneLoc, Loc.scrub,
+  Extension(..), base, transform,
+  hLoad, fileLoad, stdinLoad,
+  hDump, fileDump, stdoutDump, stringDump
+) where
+
+import IO
+import System
+
+import Data.Monoid (Monoid(..))
+import qualified Control.Monad.Writer as W
+
+import qualified Language.Haskell.Preprocessor.Loc   as Loc
+import qualified Language.Haskell.Preprocessor.Error as E
+import Language.Haskell.Preprocessor.Ast
+import Language.Haskell.Preprocessor.Parser
+import Language.Haskell.Preprocessor.Printer
+import Language.Haskell.Preprocessor.SynSpec
+import Language.Haskell.Preprocessor.Util
+
+data Extension = Extension {
+                   keywords    :: [[Keyword]],
+                   transformer :: [Ast] -> [Ast],
+                   synspec     :: SynSpec,
+                   usage       :: Maybe (IO ()),
+                   syntaxerror :: Maybe (E.Error -> IO ())
+                 }
+
+instance Monoid Extension where
+  mempty          = Extension {
+                      keywords    = [],
+                      transformer = id,
+                      synspec     = mempty,
+                      usage       = Nothing,
+                      syntaxerror = Nothing
+                    }
+  e1 `mappend` e2 = Extension {
+                      keywords    = keywords e1 ++ keywords e2,
+                      transformer = transformer e1 . transformer e2,
+                      synspec     = synspec e1 `mappend` synspec e2,
+                      usage       = usage e1       <+ usage e2,
+                      syntaxerror = syntaxerror e1 <+ syntaxerror e2
+                    }
+    where Just a  <+ _ = Just a
+          Nothing <+ b = b
+
+base :: Extension
+base  = Extension {
+          keywords    = [],
+          transformer = id,
+          synspec     = defaultSpec,
+          usage       = Just (do
+            prog <- getProgName
+            hPutStrLn stderr $
+              "Usage: "++prog++" [ INFILE | SOURCE INFILE OUTFILE ]"),
+          syntaxerror = Just (hPutStrLn stderr . show)
+        }
+
+transform :: Extension -> [String] -> IO ()
+transform extension files = do
+    easts <- case files of
+      []     -> stdinLoad spec
+      [file] -> fileLoad spec file file
+      [source, file, _]
+             -> fileLoad spec source file
+      _      -> do case usage extension of
+                     Just m  -> m
+                     Nothing -> return ()
+                   exitFailure
+    asts  <- case easts of
+      Left e  -> do case syntaxerror extension of
+                      Just m  -> m e
+                      Nothing -> return ()
+                    exitFailure
+      Right r -> return r
+    let result = transformer extension asts
+    case files of
+      [_, _, file] -> fileDump spec file result
+      _            -> stdoutDump spec result
+  where
+    spec = (synspec extension) {
+             blocks = keywords extension ++ blocks (synspec extension)
+           }
+
+-- Loading
+
+hLoad :: SynSpec -> String -> Handle -> IO (Either E.Error [Ast])
+hLoad spec source handle = do
+  input <- hGetContents handle
+  return (parseBy spec source input)
+
+fileLoad :: SynSpec -> String -> FilePath -> IO (Either E.Error [Ast])
+fileLoad spec source filename = do
+  input <- readFile filename
+  return (parseBy spec source input)
+
+stdinLoad :: SynSpec -> IO (Either E.Error [Ast])
+stdinLoad spec = hLoad spec "-" stdin
+
+-- Dumping
+
+hDump        :: SynSpec -> Handle -> [Ast] -> IO ()
+hDump _       = dump . hPutStr
+
+stringDump   :: SynSpec -> [Ast] -> String
+stringDump _  = W.execWriter . dump W.tell
+
+fileDump     :: SynSpec -> String -> [Ast] -> IO ()
+fileDump spec filename ast =
+  bracket (openFile filename WriteMode) hClose $ \handle ->
+    hDump spec handle ast
+
+stdoutDump   :: SynSpec -> [Ast] -> IO ()
+stdoutDump _  = dump putStr
+
diff --git a/Language/Haskell/Preprocessor/Ast.hs b/Language/Haskell/Preprocessor/Ast.hs
new file mode 100644
--- /dev/null
+++ b/Language/Haskell/Preprocessor/Ast.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module Language.Haskell.Preprocessor.Ast (
+  Ast(..), flatten, flattenList, format, cons,
+  module Language.Haskell.Preprocessor.Token
+) where
+
+import Data.Typeable (Typeable)
+import Data.Generics (Data, mkT, everywhere)
+import Char (isDigit)
+
+import Language.Haskell.Preprocessor.Loc (Locatable(..), bogus)
+import Language.Haskell.Preprocessor.Token
+
+data Ast =
+    Single { item   :: Token }
+  | Block  { item   :: Token,
+             lbrace :: Maybe Token,
+             body   :: [Ast],
+             rbrace :: Maybe Token,
+             next   :: Ast }
+  | Empty
+  deriving (Eq, Show, Typeable, Data)
+
+flatten              :: Ast -> [Token] -> [Token]
+flatten (Single item) = (com item ++) . (item { com = [] }:)
+flatten Empty         = id
+flatten (Block item lbrace body rbrace next)
+                      = (item :) .
+                        maybe id (:) lbrace .
+                        flattenList body .
+                        maybe id (:) rbrace .
+                        flatten next
+
+flattenList          :: [Ast] -> [Token] -> [Token]
+flattenList lst = foldr (.) id (map flatten lst)
+
+format :: Data a => a -> [Ast] -> a
+format a subs = everywhere (mkT replace) a where
+  replace (Single Token { tag = CharLit,
+                          val = '\'':'#':rest@(_:_) })
+    | all isDigit num && index < length subs
+      = subs !! index where
+          num   = init rest
+          index = read num - 1
+  replace t = t
+
+cons :: Token -> Ast -> Ast
+cons a b = Block a Nothing [b] Nothing Empty
+
+instance Locatable Ast where
+  getLoc Empty   = bogus
+  getLoc ast     = loc (item ast)
+
+  setLoc Empty _ = Empty
+  setLoc ast   l = ast { item = setLoc (item ast) l }
diff --git a/Language/Haskell/Preprocessor/Error.hs b/Language/Haskell/Preprocessor/Error.hs
new file mode 100644
--- /dev/null
+++ b/Language/Haskell/Preprocessor/Error.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module Language.Haskell.Preprocessor.Error (
+  Error(..), fromParseError, errorAt
+) where
+
+import Text.ParserCombinators.Parsec.Error
+import Data.Typeable (Typeable)
+import Data.Generics (Data)
+
+import Language.Haskell.Preprocessor.Loc
+
+data Error = Error { loc :: Loc,
+                     msg :: String }
+  deriving (Typeable, Data)
+
+errorAt :: Locatable a => a -> String -> b
+errorAt a m = error (show (Error (getLoc a) m))
+
+fromParseError :: ParseError -> Error
+fromParseError pe =
+  Error { loc = fromSourcePos (errorPos pe),
+          msg = indent 4 $
+                showErrorMessages
+                  "or" "Unknown" "Expecting"
+                  "Unexpected" "end-of-input"
+                  (errorMessages pe) }
+    where indent n = unlines . map (replicate n ' ' ++) . lines
+
+instance Show Error where
+  showsPrec _ (Error loc msg)
+    | isBogus loc = ("Error: "++) . (msg++)
+    | otherwise   = ("At "++) . shows loc . (": "++) . (msg ++)
+
diff --git a/Language/Haskell/Preprocessor/Lexer.hs b/Language/Haskell/Preprocessor/Lexer.hs
new file mode 100644
--- /dev/null
+++ b/Language/Haskell/Preprocessor/Lexer.hs
@@ -0,0 +1,210 @@
+module Language.Haskell.Preprocessor.Lexer (
+  scan, dscan, module T
+) where
+
+import Char
+
+import Language.Haskell.Preprocessor.Token as T
+import Language.Haskell.Preprocessor.Loc
+import qualified Language.Haskell.Preprocessor.SynSpec as SS
+
+scan           :: SS.SynSpec -> String -> String -> [Token]
+scan spec file  = pass3 spec . pass2 spec . pass1 spec file
+
+dscan          :: String -> String -> [Token]
+dscan           = scan SS.defaultSpec
+
+lexerr         :: Loc -> String -> [Token]
+lexerr loc msg  = [newToken { tag = Error, T.loc = loc, val = msg }]
+
+pass1 :: SS.SynSpec -> String -> String -> [Token]
+pass1 spec file str = bol (initial file) str where
+  unboxed = SS.unboxed spec
+  pragmas = SS.pragmas spec
+
+  varinit c = isLower c || c == '_'
+  coninit c = isUpper c
+  opinit  c = c `elem` ":!$%&*+./<=>?@\\^|-~"
+
+  varcont c = isAlphaNum c || c `elem` "'_"
+  concont   = varcont
+  opcont  c = opinit c || c == '#'
+
+  rawnext tag loc inp val = loc' `seq` new : token loc' inp where
+    new  = newToken { T.tag = tag, T.loc = loc, T.val = val }
+    loc' = advance loc val
+
+  next  tag loc inp val = rawnext tag loc inp val
+  rnext tag loc inp val = next tag loc inp (reverse val)
+
+  bol loc inp = case inp of
+    '#':r -> let (acc, inp) = eatWhile (/= '\n') r "#"
+                 val        = reverse acc in
+             case fromDirective val of
+               Nothing  -> next CPragma loc inp val
+               Just loc ->
+                 case inp of
+                   '\n':r -> bol loc r
+                   _      -> []
+    c:inp | isSpace c -> bol (advance loc c) inp
+    _ -> token loc inp
+
+  token loc inp = case inp of
+    '(':'#':r     | unboxed -> next Other loc r "(#"
+    '#':')':r     | unboxed -> next Other loc r "#)"
+    '{':'-':'#':r | pragmas -> next Other loc r "{-#"
+    '#':'-':'}':r | pragmas -> next Other loc r "#-}"
+    '{':'-':r -> lexComment loc r "-{" 1
+    '(':r     -> next Other loc r "("
+    ')':r     -> next Other loc r ")"
+    '[':r     -> next Other loc r "["
+    ']':r     -> next Other loc r "]"
+    '{':r     -> next Other loc r "{"
+    '}':r     -> next Other loc r "}"
+    ';':r     -> next Other loc r ";"
+    ',':r     -> next Other loc r ","
+    '`':r     -> next Other loc r "`"
+    '\'':r    -> lexChar loc r "'"
+    '"':r     -> lexString loc r "\""
+    '-':'-':r -> lexHyphen loc r "--"
+    '\n':r -> bol (advance loc '\n') r
+    c:r | isSpace c -> token (advance loc c) r
+        | coninit c -> lexCon loc r [c]
+        | varinit c -> lexVar loc r [c]
+        | opinit c  -> lexOp loc r [c]
+        | isDigit c -> lexNumber loc r [c]
+    c:_    -> lexerr loc ("unexpected character " ++ show c)
+    []     -> []
+
+  lexChar   loc inp acc = case inp of
+    '\'':'#':r
+      | unboxed -> rnext CharLit loc r ('#':'\'':acc)
+    '\'':r      -> rnext CharLit loc r ('\'':acc)
+    '\\':'\'':r -> lexChar loc r ('\'':'\\':acc)
+    '\\':'\\':r -> lexChar loc r ('\\':'\\':acc)
+    c:r         -> lexChar loc r (c:acc)
+    []          -> lexerr loc "eof in character literal"
+
+  lexString loc inp acc = case inp of
+    '"':'#':r
+      | unboxed -> rnext StringLit loc r ('#':'"':acc)
+    '"':r       -> rnext StringLit loc r ('"':acc)
+    '\\':'"':r  -> lexString loc r ('"':'\\':acc)
+    '\\':'\\':r -> lexString loc r ('\\':'\\':acc)
+    c:r         -> lexString loc r (c:acc)
+    []          -> lexerr loc "eof in string literal"
+
+  lexNumber loc inp acc = case inp of
+    c:r | isDigit c     -> lexNumber loc r (c:acc)
+        | c == '.' && not (null r) && isDigit (head r)
+                        -> lexFloat loc r (c:acc)
+        | c `elem` "eE" -> lexMaybeExp IntLit loc inp acc
+    '#':r | unboxed     -> rnext IntLit loc r ('#':acc)
+    _                   -> rnext IntLit loc inp acc
+
+  lexFloat loc inp acc = case eatWhile isDigit inp acc of
+    (acc, r@(c:_)) | c `elem` "eE" -> lexMaybeExp FloatLit loc r acc
+    (acc, '#':r) | unboxed         -> rnext FloatLit loc r ('#':acc)
+    (acc, r)                       -> rnext FloatLit loc r acc
+
+  lexMaybeExp tag loc inp acc = case inp of
+    e:'-':d:r | isDigit d -> lexExp loc r (d:'-':e:acc)
+    e:'+':d:r | isDigit d -> lexExp loc r (d:'+':e:acc)
+    e:d:r     | isDigit d -> lexExp loc r (d:e:acc)
+    _                     -> rnext tag loc inp acc
+
+  lexExp loc inp acc = case eatWhile isDigit inp acc of
+    (acc, '#':r) -> rnext FloatLit loc r ('#':acc)
+    (acc, r)     -> rnext FloatLit loc r acc
+
+  lexVar    loc inp acc = case inp of
+    c:r | varcont c -> lexVar loc r (c:acc)
+    '#':r | unboxed -> rnext Variable loc r ('#':acc)
+    _               -> rnext Variable loc inp acc
+
+  lexOp     loc inp acc = case inp of
+    c:r | opcont c -> lexOp loc r (c:acc)
+    _              -> rnext Operator loc inp acc
+
+  lexCon    loc inp acc = case inp of
+    c:r | concont c -> lexVar loc r (c:acc)
+    '#':r | unboxed -> rnext Constructor loc r ('#':acc)
+    '.':r -> case r of
+               c:s | coninit c -> lexCon loc s (c:'.':acc)
+                   | varinit c -> lexVar loc s (c:'.':acc)
+                   | opcont c  -> lexOp loc s (c:'.':acc)
+               _ -> rnext Constructor loc inp acc
+    _ -> rnext Constructor loc inp acc
+
+  lexHyphen loc inp acc = case inp of
+    '-':r           -> lexHyphen loc r ('-':acc)
+    c:r | opcont c  -> lexOp loc r (c:acc)
+    _               -> case eatWhile (/= '\n') inp acc of
+                         (acc, r) -> rnext Comment loc r acc
+
+  lexComment :: Loc -> String -> String -> Int -> [Token]
+  lexComment loc inp acc 0 = rnext Comment loc inp acc
+  lexComment loc inp acc n = case inp of
+    '-':'}':r -> lexComment loc r ('}':'-':acc) (n - 1)
+    '{':'-':r -> lexComment loc r ('-':'{':acc) (n + 1)
+    c:r       -> lexComment loc r (c:acc) n
+    []        -> lexerr loc "eof in comment"
+
+  eatWhile pred inp acc = case inp of
+    c:r | pred c  -> eatWhile pred r (c:acc)
+    _             -> (acc, inp)
+
+pass2 :: SS.SynSpec -> [Token] -> [Token]
+pass2 _ = loop [] where
+  loop acc toks = case toks of
+    t@Token { tag = Comment } : rest
+       -> loop (t:acc) rest
+    t : rest
+       -> t { com = reverse acc } : loop [] rest
+    [] -> case acc of
+      []         -> []
+      t:_ -> [newToken { tag = Other,
+                         com = reverse acc,
+                         loc = loc t `advance` '\n'} ]
+
+pass3 :: SS.SynSpec -> [Token] -> [Token]
+pass3 spec = loop [] where
+  levelnest = SS.levelnest spec
+  indents   = [ s | block <- SS.blocks spec, SS.I s <- block ]
+
+  indent loc = Token VIndent [] loc ""
+  semi   loc = Token VSemi   [] loc ""
+  dedent loc = Token VDedent [] loc ""
+
+  loop stk toks = case toks of
+    []   -> []
+    t:ts
+      | val t `elem` indents ->
+          case ts of
+            []   -> t : indent _loc : dedent _loc : check _loc stk []
+                    where _loc = loc t
+            t':_
+              | val t' == "{" ->
+                  t : check (loc t') stk ts
+              | otherwise     ->
+                  t : indent (loc t') : begin (loc t') stk ts
+      | otherwise  -> t : check (loc t) stk ts
+
+  begin _loc stk toks = case stk of
+      []        -> loop [n] toks
+      m:_ -> case n `compare` m of
+        GT      -> loop (n:stk) toks
+        EQ | levelnest
+                -> loop (n:stk) toks
+        _       -> dedent _loc : check _loc stk toks
+    where n = col _loc
+
+  check _loc stk toks = case (stk, toks) of
+    (ms,   [])   -> map (const (dedent _loc)) ms
+    (m:ms, t:ts) ->
+      case col (loc t) `compare` m of
+        LT -> dedent (loc t) : check (loc t) ms (t:ts)
+        EQ -> semi (loc t) : loop (m:ms) (t:ts)
+        _  -> loop (m:ms) (t:ts)
+    ([],   ts) -> loop [] ts
+
diff --git a/Language/Haskell/Preprocessor/Loc.hs b/Language/Haskell/Preprocessor/Loc.hs
new file mode 100644
--- /dev/null
+++ b/Language/Haskell/Preprocessor/Loc.hs
@@ -0,0 +1,120 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module Language.Haskell.Preprocessor.Loc (
+  Loc, file, line, col,
+  initial, bogus, isBogus,
+  Advance(..), scrub,
+  Locatable(..), cloneLoc,
+  toDirective, fromDirective,
+  toSourcePos, fromSourcePos
+) where
+
+import Data.Typeable ()
+import Data.Generics
+import Text.ParserCombinators.Parsec.Pos
+
+newtype Loc = Loc { toSourcePos :: SourcePos }
+  deriving (Eq, Ord, Typeable)
+
+fromSourcePos :: SourcePos -> Loc
+fromSourcePos  = Loc
+
+new :: String -> Int -> Int -> Loc
+new file line col = fromSourcePos (newPos file line col)
+
+file :: Loc -> String
+file  = sourceName . toSourcePos
+
+line :: Loc -> Int
+line  = sourceLine . toSourcePos
+
+col  :: Loc -> Int
+col   = sourceColumn . toSourcePos
+
+initial :: String -> Loc
+initial = fromSourcePos . initialPos
+
+bogus   :: Loc
+bogus    = new "<bogus>" (-1) (-1)
+
+isBogus :: Loc -> Bool
+isBogus loc = case (file loc, line loc, col loc) of
+  ("<bogus>", -1, -1) -> True
+  _                   -> False
+
+class Advance a where
+  advance     :: Loc -> a -> Loc
+
+instance Advance Char where
+  advance loc _
+    | isBogus loc = loc
+  advance loc c   = fromSourcePos (updatePosChar (toSourcePos loc) c)
+
+instance Advance a => Advance [a] where
+  advance loc lst = foldl advance loc lst
+
+class Locatable a where
+  getLoc   :: a -> Loc
+  setLoc   :: a -> Loc -> a
+
+instance Locatable Loc where
+  getLoc   = id
+  setLoc _ = id
+
+instance Locatable a => Locatable (Maybe a) where
+  getLoc Nothing    = bogus
+  getLoc (Just a)   = getLoc a
+  setLoc Nothing _  = Nothing
+  setLoc (Just a) l = Just (setLoc a l)
+
+instance Locatable a => Locatable [a] where
+  getLoc []       = bogus
+  getLoc (x:_)    = getLoc x
+  setLoc [] _     = []
+  setLoc (x:xs) l = (setLoc x l:xs)
+
+instance (Locatable a, Locatable b) => Locatable (Either a b) where
+  getLoc (Left x)  = getLoc x
+  getLoc (Right x) = getLoc x
+  setLoc (Left x)  l = Left (setLoc x l)
+  setLoc (Right x) l = Right (setLoc x l)
+
+cloneLoc :: Locatable a => a -> a -> a
+cloneLoc a b = setLoc a (getLoc b)
+
+scrub :: Data a => a -> a
+scrub a = everywhere (mkT bogosify) a where
+  bogosify :: Loc -> Loc
+  bogosify  = const bogus
+
+toDirective :: Loc -> String
+toDirective loc = "# " ++ show (line loc) ++ " " ++ show (file loc)
+
+fromDirective :: String -> Maybe Loc
+fromDirective = toMaybe . parse where
+  toMaybe []    = Nothing
+  toMaybe (x:_) = Just x
+  parse str = do
+    r <- case str of
+           '#':' ':s                 -> [s]
+           '#':'l':'i':'n':'e':' ':s -> [s]
+           _                         -> []
+    (n, r') <- reads r
+    (f, "") <- reads r'
+    return (new f n 1)
+
+instance Show Loc where
+  showsPrec p loc = showsPrec p (toSourcePos loc)
+
+tyLoc  :: DataType
+tyLoc   = mkDataType "Language.Haskell.Preprocessor.Loc.Loc" [conLoc]
+conLoc :: Constr
+conLoc  = mkConstr tyLoc "Loc" [] Prefix
+
+instance Data Loc where
+  gfoldl f z loc = z new `f` file loc `f` line loc `f` col loc
+  gunfold k z c  = case constrIndex c of
+                     1 -> k (k (k (z new)))
+                     _ -> error "gunfold"
+  toConstr _     = conLoc
+  dataTypeOf _   = tyLoc
+
diff --git a/Language/Haskell/Preprocessor/Parser.hs b/Language/Haskell/Preprocessor/Parser.hs
new file mode 100644
--- /dev/null
+++ b/Language/Haskell/Preprocessor/Parser.hs
@@ -0,0 +1,164 @@
+module Language.Haskell.Preprocessor.Parser (
+  quasi, quasiBy, parse, parseBy, parseTokens, parseTokensBy
+) where
+
+import List (delete, union)
+
+import qualified Language.Haskell.Preprocessor.SynSpec as SS
+import qualified Language.Haskell.Preprocessor.Error   as E
+import qualified Language.Haskell.Preprocessor.Loc     as Loc
+import qualified Language.Haskell.Preprocessor.Lexer   as Lexer
+import Language.Haskell.Preprocessor.Ast
+
+import qualified Text.ParserCombinators.Parsec as P
+
+quasiBy :: SS.SynSpec -> String -> [Ast] -> [Ast]
+quasiBy spec input subs =
+  case parseBy spec "<quasi>" input of
+    Left e  -> error (show e)
+    Right r -> format (Loc.scrub r) subs
+
+quasi :: String -> [Ast] -> [Ast]
+quasi = quasiBy SS.defaultSpec
+
+parse :: String -> String -> Either E.Error [Ast]
+parse  = parseBy SS.defaultSpec
+
+parseBy :: SS.SynSpec -> String -> String -> Either E.Error [Ast]
+parseBy spec file input = parseTokensBy spec tokens where
+  tokens = Lexer.scan spec file input
+
+parseTokens :: [Token] -> Either E.Error [Ast]
+parseTokens  = parseTokensBy SS.defaultSpec
+
+type Grammar = [Rule]
+data Rule = Branch SS.Keyword Grammar
+          | Epsilon
+  deriving (Eq, Show)
+
+leftFactor :: [[SS.Keyword]] -> Grammar
+leftFactor  = foldr add [] where
+  add :: [SS.Keyword] -> Grammar -> Grammar
+  add []     gram = delete Epsilon gram ++ [Epsilon]
+  add (kw:r) gram = case findSplit (headIs kw) gram of
+    Just (a, Branch kw' r', c)
+            -> Branch (max kw kw') (add r r') : a ++ c
+    _       -> Branch kw (add r []) : gram
+
+  max (SS.I kw) _ = SS.I kw
+  max _ (SS.I kw) = SS.I kw
+  max x _         = x
+
+  headIs kw (Branch kw' _) = SS.getKey kw == SS.getKey kw'
+  headIs _  _              = False
+
+  findSplit _    [] = Nothing
+  findSplit pred (x:xs)
+    | pred x        = Just ([], x, xs)
+    | otherwise     = do (a, b, c) <- findSplit pred xs
+                         Just (x:a, b, c)
+
+parseTokensBy :: SS.SynSpec -> [Token] -> Either E.Error [Ast]
+parseTokensBy spec input = case P.parse start source input of
+    Left pe    -> Left (E.fromParseError pe)
+    Right asts -> Right asts
+  where
+
+  gram = leftFactor (SS.blocks spec)
+
+  start = do
+    res <- until []
+    P.eof
+    return res
+
+  source = case input of
+    t:_ -> Loc.file (loc t)
+    _   -> "<bogus>"
+
+  until stop = P.many (any stop)
+
+  any stop   = parseRules gram (single stop) stop
+
+  single stop = do
+    item <- tokenP (\i -> val i `notElem` stop && tag i /= VDedent)
+    return (Single item)
+
+  parseRules r orelse stop =
+    foldr (<|>) orelse (map (flip parseRule stop) r)
+
+  parseRule Epsilon _                           = return Empty
+  parseRule (Branch (SS.I key) r) stop          = do
+    item <- tokenV key
+    curlyBraces item r stop <|> virtualBraces item r stop
+  parseRule (Branch (SS.P key) [Epsilon]) _     = do
+    item <- tokenV key
+    return (Single item)
+  parseRule (Branch (SS.P key) r) stop          = do
+    item <- tokenV key
+    body <- until (follow stop r)
+    next <- parseRules r P.pzero stop           <??> r
+    return (Block item Nothing body Nothing next)
+
+  curlyBraces item r stop                       = do
+    lbrace <- tokenV "{"                        <?> "{"
+    body   <- until ["}"]
+    rbrace <- tokenV "}"                        <?> "}"
+    next   <- parseRules r P.pzero stop         <??> r
+    return (Block item (Just lbrace) body (Just rbrace) next)
+
+  virtualBraces item r stop                     = do
+    lbrace <- tokenT VIndent
+    body   <- until (follow stop r)
+    rbrace <- do
+                vbrace <- tokenT VDedent
+                return (Just vbrace)
+          <|> do
+                killDedent
+                return Nothing
+    next   <- parseRules r P.pzero stop         <??> r
+    return (Block item (Just lbrace) body rbrace next)
+
+  follow oldStop r
+    | Epsilon `elem` r = oldStop `union` newStop
+    | otherwise        = newStop
+    where newStop = [ SS.getKey kw | Branch kw _ <- r ]
+
+  killDedent = do
+      inp <- P.getInput
+      P.setInput (clean 0 inp)
+    where
+      clean     :: Int -> [Token] -> [Token]
+      clean _ [] = []
+      clean 0 (  Token { tag = VDedent }:r) = r
+      clean n (t@Token { tag = VIndent }:r) = t : clean (n + 1) r
+      clean n (t@Token { tag = VDedent }:r) = t : clean (n - 1) r
+      clean n (t                        :r) = t : clean n r
+
+  tokenRaw :: (Token -> Maybe a) -> P.GenParser Token () a
+  tokenRaw = P.token val (Loc.toSourcePos . loc)
+
+  token :: (Token -> Maybe a) -> P.GenParser Token () a
+  token pred = tokenRaw pred <|> errorToken
+
+  tokenP :: (Token -> Bool) -> P.GenParser Token () Token
+  tokenP pred = token (\i -> if pred i then Just i else Nothing)
+
+  tokenV :: String -> P.GenParser Token () Token
+  tokenV v = tokenP ((== v) . val)
+
+  tokenT :: Tag -> P.GenParser Token () Token
+  tokenT t = tokenP ((== t) . tag)
+
+  errorToken :: P.GenParser Token () a
+  errorToken = do
+    tok <- tokenRaw (\i -> if tag i == Error then Just i else Nothing)
+    P.setPosition (Loc.toSourcePos (loc tok))
+    fail (val tok)
+
+  (<|>) = (P.<|>)
+  (<?>) = (P.<?>)
+
+  p <??> []              = p
+  p <??> (Epsilon:_)     = p
+  p <??> (Branch kw _:r) = (p <?> SS.getKey kw) <??> r
+
diff --git a/Language/Haskell/Preprocessor/Printer.hs b/Language/Haskell/Preprocessor/Printer.hs
new file mode 100644
--- /dev/null
+++ b/Language/Haskell/Preprocessor/Printer.hs
@@ -0,0 +1,53 @@
+module Language.Haskell.Preprocessor.Printer ( dump ) where
+
+import Language.Haskell.Preprocessor.Ast
+import Language.Haskell.Preprocessor.Token
+import Language.Haskell.Preprocessor.Loc
+
+import Control.Monad (foldM)
+
+dump :: Monad m => (String -> m ()) -> [Ast] -> m ()
+dump write forest = start where
+  start = do
+    let items = flattenList forest []
+        here  = case items of
+                  []  -> bogus
+                  x:_ -> initial (file (loc x))
+    write (toDirective here)
+    write "\n"
+    foldM sayToken here items
+    write "\n"
+
+  sayToken here item
+    | null (val item) = do
+        return here
+    | isBogus (loc item) = do
+        foldM sayString here [" ", val item, " "]
+    | otherwise = do
+        here <- goto here (loc item)
+        sayString here (val item)
+
+  goto here there
+    | line here < line there = do
+        let directive = toDirective there
+            newlines  = line there - line here
+        if length directive < newlines
+          then do
+            write "\n"; write directive; write "\n"
+          else do
+            write (replicate (line there - line here) '\n')
+        write (replicate (col there - 1) ' ')
+        return there
+    | line here == line there && col here <= col there = do
+        write (replicate (col there - col here) ' ')
+        return there
+    | otherwise = do
+        write "\n"
+        write (toDirective there)
+        write "\n"
+        write (replicate (col there - 1) ' ')
+        return there
+
+  sayString here str = do
+    write str
+    return (here `advance` str)
diff --git a/Language/Haskell/Preprocessor/SynSpec.hs b/Language/Haskell/Preprocessor/SynSpec.hs
new file mode 100644
--- /dev/null
+++ b/Language/Haskell/Preprocessor/SynSpec.hs
@@ -0,0 +1,55 @@
+module Language.Haskell.Preprocessor.SynSpec (
+  SynSpec(..), Keyword(..),
+  pair, defaultSpec
+) where
+
+import Data.Monoid (Monoid(..))
+
+data SynSpec = SynSpec {
+                 unboxed   :: Bool,
+                 pragmas   :: Bool,
+                 levelnest :: Bool,
+                 blocks    :: [[Keyword]]
+               }
+  deriving (Eq, Show)
+
+instance Monoid SynSpec where
+  mempty          = SynSpec {
+                      unboxed   = False,
+                      pragmas   = False,
+                      levelnest = False,
+                      blocks    = []
+                    }
+  s1 `mappend` s2 = SynSpec {
+                      unboxed   = unboxed s1   || unboxed s2,
+                      pragmas   = pragmas s1   || pragmas s2,
+                      levelnest = levelnest s1 || levelnest s2,
+                      blocks    = blocks s1    ++ blocks s2
+                    }
+
+data Keyword = I { getKey :: String }
+             | P { getKey :: String }
+  deriving (Eq, Show)
+
+pair    :: String -> String -> [Keyword]
+pair l r = [P l, P r]
+
+defaultSpec :: SynSpec
+defaultSpec = SynSpec {
+                unboxed   = True,
+                pragmas   = False,
+                levelnest = False,
+                blocks    = [
+                  pair "(#" "#)",
+                  pair "{-#" "#-}",
+                  pair "(" ")",
+                  pair "[" "]",
+                  pair "{" "}",
+                  [P "if", P "then", P "else"],
+                  [P "case", I "of"],
+                  [I "let", P "in"],
+                  [I "let"],
+                  [I "where"],
+                  [I "do"]
+                ]
+              }
diff --git a/Language/Haskell/Preprocessor/Token.hs b/Language/Haskell/Preprocessor/Token.hs
new file mode 100644
--- /dev/null
+++ b/Language/Haskell/Preprocessor/Token.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module Language.Haskell.Preprocessor.Token (
+  Token(..), Tag(..), newToken
+) where
+
+import Language.Haskell.Preprocessor.Loc
+import Data.Typeable ()
+import Data.Generics
+
+data Token = Token { tag :: Tag,
+                     com :: [Token],
+                     loc :: Loc,
+                     val :: String }
+  deriving (Eq, Typeable, Data)
+
+newToken :: Token
+newToken = Token {
+             tag = Other,
+             com = [],
+             loc = bogus,
+             val = ""
+           }
+
+data Tag =
+    CPragma
+  | Variable
+  | Constructor
+  | Operator
+  | Other
+  | CharLit
+  | StringLit
+  | IntLit
+  | FloatLit
+  | VIndent
+  | VDedent
+  | VSemi
+  | Comment
+  | Error
+  deriving (Eq, Show, Typeable, Data)
+
+instance Show Token where
+  showsPrec _ t = shows (tag t) . ('(':) . shows (val t) . (')':)
+
+instance Locatable Token where
+  getLoc     = loc
+  setLoc t l = t { loc = l }
+
diff --git a/Language/Haskell/Preprocessor/Util.hs b/Language/Haskell/Preprocessor/Util.hs
new file mode 100644
--- /dev/null
+++ b/Language/Haskell/Preprocessor/Util.hs
@@ -0,0 +1,56 @@
+module Language.Haskell.Preprocessor.Util (
+  parens, noParens,
+  splitVal, splitTag, splitSemis, splitAllBy, splitBy,
+  valIs, tagIs
+) where
+
+import Language.Haskell.Preprocessor.Ast
+
+parens, noParens :: [Ast] -> Ast
+parens asts = Block {
+    item   = newToken { tag = Other, val = "(" },
+    lbrace = Nothing,
+    body   = asts,
+    rbrace = Nothing,
+    next   = Single newToken { tag = Other, val = ")" }
+  }
+noParens asts = Block {
+    item   = newToken { tag = Other, val = "" },
+    lbrace = Nothing,
+    body   = asts,
+    rbrace = Nothing,
+    next   = Single newToken { tag = Other, val = "" }
+  }
+
+splitVal :: String -> [Ast] -> Maybe ([Ast], Ast, [Ast])
+splitVal = splitBy . valIs
+
+splitTag :: Tag -> [Ast] -> Maybe ([Ast], Ast, [Ast])
+splitTag = splitBy . tagIs
+
+splitSemis :: [Ast] -> [[Ast]]
+splitSemis = filter (not . null) . splitAllBy isSemi where
+  isSemi t = valIs ";" t || tagIs VSemi t
+
+splitAllBy :: (Ast -> Bool) -> [Ast] -> [[Ast]]
+splitAllBy _    [] = []
+splitAllBy pred lst = case splitBy pred lst of
+  Nothing        -> [lst]
+  Just (f, _, b) -> f : splitAllBy pred b
+
+splitBy :: (Ast -> Bool) -> [Ast] -> Maybe ([Ast], Ast, [Ast])
+splitBy pred lst = case lst of
+  []               -> Nothing
+  x:xs | pred x    -> Just ([], x, xs)
+       | otherwise -> do
+           (front, middle, back) <- splitBy pred xs
+           return (x:front, middle, back)
+
+valIs :: String -> Ast -> Bool
+valIs v Single { item = t } = val t == v
+valIs _ _                   = False
+
+tagIs :: Tag -> Ast -> Bool
+tagIs v Single { item = t } = tag t == v
+tagIs _ _                   = False
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,4 @@
+#!/usr/bin/env runhaskell
+
+import Distribution.Simple
+main = defaultMain
diff --git a/TODO b/TODO
new file mode 100644
--- /dev/null
+++ b/TODO
@@ -0,0 +1,1 @@
+Haddock.
diff --git a/preprocessor-tools.cabal b/preprocessor-tools.cabal
new file mode 100644
--- /dev/null
+++ b/preprocessor-tools.cabal
@@ -0,0 +1,39 @@
+Name:           preprocessor-tools
+Version:        0.1
+Cabal-Version:  >= 1.2
+License:        BSD3
+License-File:   LICENSE
+Stability:      experimental
+Author:         Jesse A. Tov <tov@ccs.neu.edu>
+Maintainer:     tov@ccs.neu.edu
+Homepage:       http://www.ccs.neu.edu/~tov/session-types
+Category:       Source-tools, Language, Code Generation
+Synopsis:       A framework for extending Haskell's syntax via quick-and-dirty preprocessors
+Build-type:     Simple
+Description:
+        This library provides a quick-and-dirty (but often effective)
+        method for extending Haskell's syntax using a custom
+        preprocessor.  It parses Haskell into a bare-bones AST with just
+        enough knowledge of the syntax to preserve nesting, and then
+        allows transformations on the AST.
+        .
+        See the package ixdopp for an example of how to do this.
+
+Extra-Source-Files:
+    TODO
+
+Library
+  Build-Depends:        haskell98, base, mtl, parsec
+  Extensions:           DeriveDataTypeable
+  Exposed-modules:
+    Language.Haskell.Preprocessor,
+    Language.Haskell.Preprocessor.Ast,
+    Language.Haskell.Preprocessor.Error,
+    Language.Haskell.Preprocessor.Loc,
+    Language.Haskell.Preprocessor.Parser,
+    Language.Haskell.Preprocessor.Printer,
+    Language.Haskell.Preprocessor.SynSpec,
+    Language.Haskell.Preprocessor.Token,
+    Language.Haskell.Preprocessor.Util
+  Other-modules:
+    Language.Haskell.Preprocessor.Lexer