diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,168 @@
+-----------------------------------------------------------------------------
+-----------------------------------------------------------------------------
+
+metaquote
+
+Copyright (c) Matt Morrow.
+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. The names of the author may not be used to endorse or promote
+   products derived from this software without specific prior written
+   permission.
+
+THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 REGENTS 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.
+
+-----------------------------------------------------------------------------
+-----------------------------------------------------------------------------
+
+th-lift
+
+Copyright (c) Ian Lynagh.
+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. The names of the author may not be used to endorse or promote
+   products derived from this software without specific prior written
+   permission.
+
+THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 REGENTS 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.
+
+-----------------------------------------------------------------------------
+-----------------------------------------------------------------------------
+
+haskell-src-exts
+
+This library (Haskell Source eXtensions) is derived from code from several
+sources: 
+
+  * Code from the GHC project which is largely (c) The University of
+    Glasgow, and distributable under a BSD-style license (see below),
+
+  * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
+    and freely redistributable (but see the full license for
+    restrictions).
+
+The full text of these licenses is reproduced below.  All of the
+licenses are BSD-style or compatible. 
+
+-----------------------------------------------------------------------------
+The haskell-src-exts package itself is distributable under the 
+modified BSD license:
+
+Copyright (c) 2005, Niklas Broberg
+All rights reserved.
+
+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.
+
+    * The names of its contributors may not 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.
+
+-----------------------------------------------------------------------------
+
+The Glasgow Haskell Compiler License
+
+Copyright 2004, The University Court of the University of Glasgow. 
+All rights reserved.
+
+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 name of the 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 UNIVERSITY COURT OF THE UNIVERSITY OF
+GLASGOW AND THE 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
+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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.
+
+-----------------------------------------------------------------------------
+
+Code derived from the document "Report on the Programming Language
+Haskell 98", is distributed under the following license:
+
+  Copyright (c) 2002 Simon Peyton Jones
+
+  The authors intend this Report to belong to the entire Haskell
+  community, and so we grant permission to copy and distribute it for
+  any purpose, provided that it is reproduced in its entirety,
+  including this Notice.  Modified versions of this Report may also be
+  copied and distributed for any purpose, provided that the modified
+  version is clearly presented as such, and that it does not claim to
+  be a definition of the Haskell 98 Language.
+
+-----------------------------------------------------------------------------
+
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+> import Distribution.Simple
+> main :: IO ()
+> main = defaultMain
diff --git a/haskell-src-meta-mwotton.cabal b/haskell-src-meta-mwotton.cabal
new file mode 100644
--- /dev/null
+++ b/haskell-src-meta-mwotton.cabal
@@ -0,0 +1,41 @@
+name:               haskell-src-meta-mwotton
+version:            0.1.0
+cabal-version:      >= 1.6
+build-type:         Simple
+license:            BSD3
+license-file:       LICENSE
+category:           Language
+author:             Matt Morrow
+copyright:          (c) Matt Morrow
+maintainer:         Mark Wotton <mwotton@gmail.com>
+stability:          experimental
+synopsis:           Parse source to template-haskell abstract syntax.
+description:        The translation from haskell-src-exts abstract syntax
+                    to template-haskell abstract syntax isn't 100% complete yet.
+
+library
+  build-Depends:      base == 4.*, ghc-prim,
+                      containers, pretty, syb,
+                      haskell-src-exts >= 1.2.0 && < 1.3,
+                      template-haskell >= 2.4.0.0
+  extensions:         TemplateHaskell, QuasiQuotes,
+                      RankNTypes, StandaloneDeriving,
+                      FlexibleInstances, FlexibleContexts,
+                      TypeSynonymInstances, PatternGuards
+                      DeriveDataTypeable
+  ghc-options:        -O2
+  hs-source-dirs:     src
+  exposed-modules:    Language.Haskell.Meta,
+                      Language.Haskell.Meta.Parse,
+                      Language.Haskell.Meta.Syntax,
+                      Language.Haskell.Meta.Syntax.Vars,
+                      Language.Haskell.Meta.Syntax.Translate,
+                      Language.Haskell.TH.Instances.Lift,
+                      Language.Haskell.Meta.Utils,
+                      Language.Haskell.Meta.QQ.Hs,
+                      Language.Haskell.Meta.QQ.Here,
+                      Language.Haskell.Meta.QQ.HsHere,
+                      Language.Haskell.Meta.QQ.Idiom,
+                      Language.Haskell.Meta.QQ.BF,
+                      Language.Haskell.Meta.QQ.SKI
+
diff --git a/src/Language/Haskell/Meta.hs b/src/Language/Haskell/Meta.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/Meta.hs
@@ -0,0 +1,19 @@
+
+{- |
+  Module      :  Language.Haskell.Meta
+  Copyright   :  (c) Matt Morrow 2008
+  License     :  BSD3
+  Maintainer  :  Matt Morrow <mjm2002@gmail.com>
+  Stability   :  experimental
+  Portability :  portable (template-haskell)
+-}
+
+module Language.Haskell.Meta (
+    module Language.Haskell.Meta.Parse
+  , module Language.Haskell.Meta.Syntax
+  , module Language.Haskell.TH.Instances.Lift
+) where
+
+import Language.Haskell.Meta.Parse
+import Language.Haskell.Meta.Syntax
+import Language.Haskell.TH.Instances.Lift
diff --git a/src/Language/Haskell/Meta/Parse.hs b/src/Language/Haskell/Meta/Parse.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/Meta/Parse.hs
@@ -0,0 +1,120 @@
+
+{- |
+  Module      :  Language.Haskell.Meta.Parse
+  Copyright   :  (c) Matt Morrow 2008
+  License     :  BSD3
+  Maintainer  :  Matt Morrow <mjm2002@gmail.com>
+  Stability   :  experimental
+  Portability :  portable (template-haskell)
+-}
+
+module Language.Haskell.Meta.Parse where
+
+import Language.Haskell.TH.Syntax
+import Language.Haskell.Meta.Syntax
+import qualified Language.Haskell.Exts.Syntax as Hs
+import Language.Haskell.Exts.Annotated.Fixity
+import Language.Haskell.Exts.Extension
+import Language.Haskell.Exts.Parser
+import Language.Haskell.Exts.Pretty
+
+-----------------------------------------------------------------------------
+
+-- * template-haskell
+
+parsePat :: String -> Either String Pat
+parsePat = either Left (Right . toPat) . parseHsPat
+
+parseExp :: String -> Either String Exp
+parseExp = either Left (Right . toExp) . parseHsExp
+
+parseType :: String -> Either String Type
+parseType = either Left (Right . toType) . parseHsType
+
+parseDecs :: String -> Either String [Dec]
+parseDecs  = either Left (Right . fmap toDec) . parseHsDecls
+
+-----------------------------------------------------------------------------
+
+myDefaultParseMode :: ParseMode
+myDefaultParseMode = ParseMode
+  {parseFilename = []
+  ,extensions = myDefaultExtensions
+  ,ignoreLanguagePragmas = False
+  ,fixities = baseFixities}
+
+myDefaultExtensions :: [Extension]
+myDefaultExtensions = [PostfixOperators
+                      ,QuasiQuotes
+                      ,UnicodeSyntax
+                      ,PatternSignatures
+                      ,MagicHash
+                      ,ForeignFunctionInterface
+                      ,TemplateHaskell
+                      ,RankNTypes
+                      ,MultiParamTypeClasses
+                      ,RecursiveDo]
+
+parseResultToEither :: ParseResult a -> Either String a
+parseResultToEither (ParseOk a) = Right a
+parseResultToEither (ParseFailed loc e)
+  = let line = Hs.srcLine loc - 1
+    in Left (unlines [show line,show loc,e])
+
+parseHsModule :: String -> Either String Hs.Module
+parseHsModule = parseResultToEither . parseModuleWithMode myDefaultParseMode
+
+parseHsDecls :: String -> Either String [Hs.Decl]
+parseHsDecls = either Left (Right . moduleDecls)
+  . parseResultToEither . parseModuleWithMode myDefaultParseMode
+
+
+parseHsType :: String -> Either String Hs.Type
+parseHsType = parseResultToEither . parseTypeWithMode myDefaultParseMode
+
+
+parseHsExp :: String -> Either String Hs.Exp
+parseHsExp = parseResultToEither . parseExpWithMode myDefaultParseMode
+
+parseHsPat :: String -> Either String Hs.Pat
+parseHsPat = parseResultToEither . parsePatWithMode myDefaultParseMode
+
+pprHsModule :: Hs.Module -> String
+pprHsModule = prettyPrint
+
+
+moduleDecls :: Hs.Module -> [Hs.Decl]
+moduleDecls (Hs.Module _ _ _ _ _ _ x) = x
+
+-- mkModule :: String -> Hs.Module
+-- mkModule s = Hs.Module undefined (Hs.ModuleName s) Nothing [] []
+
+emptySrcLoc :: Hs.SrcLoc
+emptySrcLoc = (Hs.SrcLoc [] 0 0)
+
+emptyHsModule :: String -> Hs.Module
+emptyHsModule n =
+    (Hs.Module
+        emptySrcLoc
+        (Hs.ModuleName n)
+        []
+        Nothing
+        Nothing
+        []
+        [])
+
+{-
+ghci> :i Module
+data Module
+  = Module SrcLoc
+           ModuleName
+           [OptionPragma]
+           (Maybe WarningText)
+           (Maybe [ExportSpec])
+           [ImportDecl]
+           [Decl]
+        -- Defined in Language.Haskell.Exts.Syntax
+instance Show Module -- Defined in Language.Haskell.Exts.Syntax
+-}
+
+-----------------------------------------------------------------------------
diff --git a/src/Language/Haskell/Meta/QQ/BF.hs b/src/Language/Haskell/Meta/QQ/BF.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/Meta/QQ/BF.hs
@@ -0,0 +1,183 @@
+{-# LANGUAGE BangPatterns, TemplateHaskell #-}
+
+module Language.Haskell.Meta.QQ.BF (
+   bf,bf2,bfHelloWorld
+) where
+
+import Language.Haskell.Meta
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Ppr
+import Language.Haskell.TH.Quote
+import Language.Haskell.TH.Syntax
+
+import Data.Char
+import Data.IntMap(IntMap,(!))
+import qualified Data.IntMap as IM
+
+
+bf :: QuasiQuoter
+bf = QuasiQuoter bfExpQ bfPatQ
+
+bf2 :: QuasiQuoter
+bf2 = QuasiQuoter bf2ExpQ bfPatQ
+
+bf2ExpQ :: String -> ExpQ
+bf2ExpQ s = [|eval (parse s)|]
+
+bfExpQ :: String -> ExpQ
+bfExpQ s = [|eval_ (parse s)|]
+
+bfPatQ :: String -> PatQ
+bfPatQ s = do
+  let p = (parsePat
+            . show
+              . parse) s
+  case p of
+    Left e -> fail e
+    Right p -> return p
+
+instance Lift Bf where
+  lift Inp = [|Inp|]
+  lift Out = [|Out|]
+  lift Inc = [|Inc|]
+  lift Dec = [|Dec|]
+  lift MovL = [|MovL|]
+  lift MovR = [|MovR|]
+  lift (While xs) = [|While $(lift xs)|]
+
+type Ptr = Int
+newtype Mem = Mem (IntMap Int) deriving (Show)
+
+data Bf = Inp
+        | Out
+        | Inc
+        | Dec
+        | MovL
+        | MovR
+        | While [Bf]
+  deriving (Eq,Ord,Read,Show)
+
+data Status = D Ptr Mem
+            | W Int Status
+            | R (Int -> Status)
+
+-- ghci> exec (parse helloWorld)
+-- Hello World!
+-- (4,Mem (fromList [(0,0),(1,87),(2,100),(3,33),(4,10)]))
+bfHelloWorld :: String
+bfHelloWorld = "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."
+
+eval_ :: [Bf] -> (String -> String)
+eval_ is = go (run 0 initMem is)
+  where go (D p m)    _    = []
+        go (W n s)    cs   = chr n : go s cs
+        go (R cont)   []   = "*** Exception: bf blocked on input"
+        go (R cont) (c:cs) = go ((cont . ord) c) cs
+
+eval :: [Bf] -> String -> (String, (Ptr, Mem))
+eval is = go [] (run 0 initMem is)
+  where go acc (D p m)    _    = (reverse acc, (p, m))
+        go acc (W n s)    cs   = go (chr n:acc) s cs
+        go _   (R cont)   []   = ("*** Exception: bf blocked on input",(-1, Mem IM.empty))
+        go acc (R cont) (c:cs) = go acc ((cont . ord) c) cs
+
+exec :: [Bf] -> IO (Ptr, Mem)
+exec is = go (run 0 initMem is)
+  where go (D p m)  = return (p, m)
+        go (W n s)  = putChar (chr n) >> go s
+        go (R cont) = go . cont . ord =<< getChar
+
+run :: Ptr -> Mem -> [Bf] -> Status
+run dp m is = step dp m is (\dp m -> D dp m)
+
+step :: Ptr -> Mem -> [Bf] -> (Ptr -> Mem -> Status) -> Status
+step dp m   []          k = k dp m
+step dp m (Inc:is)      k = step dp (inc dp m) is k
+step dp m (Dec:is)      k = step dp (dec dp m) is k
+step dp m (MovL:is)     k = step (dp-1) m is k
+step dp m (MovR:is)     k = step (dp+1) m is k
+step dp m (Inp:is)      k = R (\c -> step dp (wr m dp c) is k)
+step dp m (Out:is)      k = W (rd m dp) (step dp m is k)
+step dp m (While xs:is) k = let go dp m = if rd m dp == 0
+                                            then step dp m is k
+                                            else step dp m xs go
+                            in go dp m
+
+initMem :: Mem
+initMem = Mem IM.empty
+
+inc :: Ptr -> (Mem -> Mem)
+dec :: Ptr -> (Mem -> Mem)
+rd :: Mem -> Ptr -> Int
+wr :: Mem -> Ptr -> Int -> Mem
+upd :: Mem -> Ptr -> (Int -> Int) -> Mem
+inc p m = upd m p (+1)
+dec p m = upd m p (subtract 1)
+rd (Mem m) p = maybe 0 id (IM.lookup p m)
+wr (Mem m) p n = Mem (IM.insert p n m)
+upd m p f = wr m p (f (rd m p))
+
+parse :: String -> [Bf]
+parse s = go 0 [] s (\_ xs _ -> xs)
+  where go :: Int -> [Bf] -> String
+          -> (Int -> [Bf] -> String -> o) -> o
+        go !n acc   []     k = k n (reverse acc) []
+        go !n acc (',':cs) k = go (n+1) (Inp:acc) cs k
+        go !n acc ('.':cs) k = go (n+1) (Out:acc) cs k
+        go !n acc ('+':cs) k = go (n+1) (Inc:acc) cs k
+        go !n acc ('-':cs) k = go (n+1) (Dec:acc) cs k
+        go !n acc ('<':cs) k = go (n+1) (MovL:acc) cs k
+        go !n acc ('>':cs) k = go (n+1) (MovR:acc) cs k
+        go !n acc ('[':cs) k = go (n+1) [] cs (\n xs cs ->
+                                go n (While xs:acc) cs k)
+        go !n acc (']':cs) k = k (n+1) (reverse acc) cs
+        go !n acc (c  :cs) k = go n acc cs k
+
+
+
+test0 = do
+  a <- readFile "prime.bf"
+  return (parse a)
+
+
+
+
+
+
+
+{-
+data Bf = Inp
+        | Out
+        | Inc
+        | Dec
+        | MovL
+        | MovR
+        | While [Bf]
+        | Error String
+  deriving (Eq,Ord,Read,Show)
+
+parse :: String -> [Bf]
+parse s = let p n s = case go n [] s of
+                        (_,xs,[]) -> xs
+                        (n,xs, s) -> xs ++ p n s
+          in p 0 s
+  where go :: Int -> [Bf] -> [Char] -> (Int, [Bf], String)
+        go !n acc   []     = (n, reverse acc, [])
+        go !n acc (',':cs) = go (n+1) (Inp:acc) cs
+        go !n acc ('.':cs) = go (n+1) (Out:acc) cs
+        go !n acc ('+':cs) = go (n+1) (Inc:acc) cs
+        go !n acc ('-':cs) = go (n+1) (Dec:acc) cs
+        go !n acc ('<':cs) = go (n+1) (MovL:acc) cs
+        go !n acc ('>':cs) = go (n+1) (MovR:acc) cs
+        go !n acc ('[':cs) = case go (n+1) [] cs of
+                                (n,xs,cs) -> go n (While xs:acc) cs
+        go !n acc (']':cs) = (n+1, reverse acc, cs)
+        go !n acc (c  :cs) = (n+1, [Error ("go error: char "++show n
+                                    ++" illegal character: "++show c)], [])
+-}
+
+
+
+
+
+
diff --git a/src/Language/Haskell/Meta/QQ/Here.hs b/src/Language/Haskell/Meta/QQ/Here.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/Meta/QQ/Here.hs
@@ -0,0 +1,11 @@
+
+-- | Here!
+
+module Language.Haskell.Meta.QQ.Here (here) where
+
+import Language.Haskell.TH.Quote
+import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.Lib
+
+here :: QuasiQuoter
+here = QuasiQuoter (litE . stringL) (litP . stringL)
diff --git a/src/Language/Haskell/Meta/QQ/Hs.hs b/src/Language/Haskell/Meta/QQ/Hs.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/Meta/QQ/Hs.hs
@@ -0,0 +1,34 @@
+
+
+-- | Eat your face!
+
+module Language.Haskell.Meta.QQ.Hs (hs, pat) where
+
+import Language.Haskell.Meta
+import Language.Haskell.Meta.Utils
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Quote
+import Language.Haskell.TH.Syntax
+
+-- |
+-- > ghci> [$hs|\x -> (x,x)|] 42
+-- > (42,42)
+-- > ghci> (\[$hs|a@(x,_)|] -> (a,x)) (42,88)
+-- > ((42,88),42)
+hs :: QuasiQuoter
+hs = QuasiQuoter
+      (either fail transformE . parseExp)
+      (either fail transformP . parsePat)
+
+transformE :: Exp -> ExpQ
+transformE = return
+
+transformP :: Pat -> PatQ
+transformP = return
+
+pat :: QuasiQuoter
+pat = QuasiQuoter
+        (quoteExp hs)
+        (\s -> case parseExp s of
+                Left err -> fail err
+                Right e -> either fail return (parsePat . pretty $ e))
diff --git a/src/Language/Haskell/Meta/QQ/HsHere.hs b/src/Language/Haskell/Meta/QQ/HsHere.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/Meta/QQ/HsHere.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-}
+
+module Language.Haskell.Meta.QQ.HsHere (here) where
+
+import Language.Haskell.Meta
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Ppr
+import Language.Haskell.TH.Quote
+import Language.Haskell.TH.Syntax
+import Language.Haskell.Meta.Utils
+import Text.ParserCombinators.ReadP
+import Data.Typeable(Typeable)
+import Data.Generics(Data)
+
+data Here
+  = CodeH Exp
+  | TextH String
+  | ManyH [Here]
+  deriving (Eq,Show,Data,Typeable)
+
+here :: QuasiQuoter
+here = QuasiQuoter
+        {quoteExp = hereExpQ
+        ,quotePat = herePatQ}
+
+instance Lift Here
+  where lift = liftHere
+
+liftHere :: Here -> ExpQ
+liftHere (TextH s)  = (litE . stringL) s
+liftHere (CodeH e)  = [|show $(return e)|]
+liftHere (ManyH hs) = [|concat $(listE (fmap liftHere hs))|]
+
+
+hereExpQ :: String -> ExpQ
+hereExpQ s = case run s of
+              [] -> fail "here: parse error"
+              e:_ -> lift (cleanNames e)
+
+herePatQ :: String -> PatQ
+herePatQ s = do
+  e <- hereExpQ s
+  let p = (parsePat
+            . pprint
+              . cleanNames) e
+  case p of
+    Left e -> fail e
+    Right p -> return p
+
+run :: String -> [Here]
+run = fst . parse
+
+parse :: String -> ([Here], String)
+parse = runP hereP
+
+hereP :: ReadP Here
+hereP = (ManyH . mergeTexts)
+  `fmap` many (oneP =<< look)
+
+mergeTexts :: [Here] -> [Here]
+mergeTexts [] = []
+mergeTexts (TextH s:TextH t:hs)
+  = mergeTexts (TextH (s++t):hs)
+mergeTexts (h:hs) = h : mergeTexts hs
+
+oneP :: String -> ReadP Here
+oneP s
+  | [] <- s         = pfail
+  | '\\':'$':s <- s = do skip 2
+                         (TextH . ("\\$"++))
+                          `fmap` munch (/='\\')
+  | '$':'(':s <- s  = skip 2 >> go 1 [] s
+  | c:s <- s        = do skip 1
+                         (TextH . (c:))
+                          `fmap` munch (not.(`elem`"\\$"))
+  where go _ acc  []         = return (TextH (reverse acc))
+        go 1 []  (')':_) = skip 1 >> return (TextH "$()")
+        go 1 acc (')':_) = do skip (1 + length acc)
+                              let s = reverse acc
+                              either (const (return
+                                              (TextH s)))
+                                     (return . CodeH)
+                                     (parseExp s)
+        go n acc ('(':s)     = go (n+1) ('(':acc) s
+        go n acc (')':s)     = go (n-1) (')':acc) s
+        go n acc (c:s)       = go n (c:acc) s
+
+
+runP :: ReadP a -> String -> ([a], String)
+runP p s = case readP_to_S p s of
+              [] -> ([],[])
+              xs -> mapfst (:[]) (last xs)
+  where mapfst f (a,b) = (f a,b)
+skip :: Int -> ReadP ()
+skip n = count n get >> return ()
+lexemeP :: ReadP a -> ReadP a
+lexemeP p = p >>= \x -> skipSpaces >> return x
+nestedP :: (ReadP a -> ReadP a) -> (ReadP a -> ReadP a)
+nestedP nest p = p <++ nest (skipSpaces >> nestedP nest p)
+parensP  = between oparenP cparenP
+bracksP  = between oparenP cparenP
+oparenP  = char '('
+cparenP  = char ')'
+obrackP  = char '['
+cbrackP  = char ']'
+
diff --git a/src/Language/Haskell/Meta/QQ/Idiom.hs b/src/Language/Haskell/Meta/QQ/Idiom.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/Meta/QQ/Idiom.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
+
+-- | Idiom brackets. Vixey's idea.
+
+module Language.Haskell.Meta.QQ.Idiom (i) where
+
+import Data.Generics
+  (Data,everywhere,mkT)
+import Control.Applicative
+import Language.Haskell.Meta
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Quote
+import Language.Haskell.TH.Syntax
+
+-- ghci> [$i| (,) "foo" "bar" |]
+-- [('f','b'),('f','a'),('f','r'),('o','b'),('o','a'),('o','r'),('o','b'),('o','a'),('o','r')]
+i :: QuasiQuoter
+i = QuasiQuoter ((cleanNames <$>) . applicateQ)
+        (either fail return . parsePat)
+
+applicateQ :: String -> ExpQ
+applicateQ s = case either fail unwindE (parseExp s) of
+                  x:y:xs -> foldl
+                              (\e e' -> [|$e <*> $e'|])
+                              [|$(return x) <$> $(return y)|]
+                              (fmap return xs)
+                  _ -> fail "applicateQ fails."
+
+unwindE :: Exp -> [Exp]
+unwindE = go []
+  where go acc (e `AppE` e') = go (e':acc) e
+        go acc e = e:acc
+
+cleanNames :: (Data a) => a -> a
+cleanNames = everywhere (mkT cleanName)
+  where cleanName :: Name -> Name
+        cleanName n
+          | isNameU n = n
+          | otherwise = (mkName . nameBase) n
+        isNameU :: Name -> Bool
+        isNameU (Name _ (NameU _)) = True
+        isNameU _ = False
+
+
diff --git a/src/Language/Haskell/Meta/QQ/SKI.hs b/src/Language/Haskell/Meta/QQ/SKI.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/Meta/QQ/SKI.hs
@@ -0,0 +1,155 @@
+{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-}
+
+module Language.Haskell.Meta.QQ.SKI (SKI(..),ski) where
+
+import Language.Haskell.Meta
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Ppr
+import Language.Haskell.TH.Quote
+import Language.Haskell.TH.Syntax
+import Language.Haskell.Meta.Utils
+import Text.ParserCombinators.ReadP
+import Data.Typeable(Typeable)
+import Data.Generics(Data)
+import Text.PrettyPrint(render)
+
+data SKI = S | K | I | E Exp | SKI :$ SKI
+  deriving (Eq,Data,Typeable)
+
+run :: String -> [SKI]
+run = fmap eval . fst . parse
+
+-- I x = x
+-- K x y = x
+-- S x y z = (x z) (y z)
+eval :: SKI -> SKI
+eval (I :$ x)               = eval x
+eval ((K :$ x) :$ y)        = eval x
+eval (((S :$ x) :$ y :$ z)) = eval (eval (x :$ z) :$ eval (y :$ z))
+eval (E e :$ E e')          = E (unQ[|$(return e) $(return e')|])
+eval (x :$ y)               = eval0 ((eval x) :$ (eval y))
+eval  x                     = x
+eval0 (I :$ x)               = eval x
+eval0 ((K :$ x) :$ y)        = eval x
+eval0 (((S :$ x) :$ y :$ z)) = eval (eval (x :$ z) :$ eval (y :$ z))
+eval0 (E e :$ E e')          = E (unQ[|$(return e) $(return e')|])
+eval0  x                     = x
+
+ski :: QuasiQuoter
+ski = QuasiQuoter
+        {quoteExp = skiExpQ
+        ,quotePat = skiPatQ}
+
+instance Lift SKI where
+  lift = liftSKI
+
+liftSKI (E e) = return e
+liftSKI a     = go a
+  where go S = [|S|]
+        go K = [|K|]
+        go I = [|I|]
+        go (E e) = [|E e|]
+        go (x:$y) = [|$(go x) :$ $(go y)|]
+
+instance Show SKI where
+        showsPrec p (S) = showString "S"
+        showsPrec p (K) = showString "K"
+        showsPrec p (I) = showString "I"
+        showsPrec p (E x1)
+          = showParen (p > 10)
+              (showString (render (ppDoc x1)))
+        showsPrec p ((:$) x1 x2)
+          = showParen (p > 10)
+              (showsPrec 11 x1 . (showString " :$ " . showsPrec 10 x2))
+
+skiExpQ :: String -> ExpQ
+skiExpQ s = case run s of
+              [] -> fail "ski: parse error"
+              e:_ -> lift (cleanNames e)
+
+skiPatQ :: String -> PatQ
+skiPatQ s = do
+  e <- skiExpQ s
+  let p = (parsePat
+            . pprint
+              . cleanNames) e
+  case p of
+    Left e -> fail e
+    Right p -> return p
+
+-- ghci> parse "S(SS)IK(SK)"
+-- ([(((S :$ (S :$ S)) :$ I) :$ K) :$ (S :$ K)],"")
+parse :: String -> ([SKI], String)
+parse = runP skiP
+
+skiP :: ReadP SKI
+skiP = nestedP parensP
+  (let go a = (do b <- lexemeP (oneP <++ skiP)
+                  go (a:$b)) <++ return a
+    in lexemeP (go =<< lexemeP oneP))
+
+oneP :: ReadP SKI
+oneP = nestedP parensP
+  (lexemeP (choice [sP
+                   ,kP
+                   ,iP
+                   ,spliceP =<< look
+                   ]))
+
+spliceP :: String -> ReadP SKI
+spliceP s
+  | '[':s <- s = skip 1 >> go 1 [] s
+  | otherwise  = pfail
+  where go _ _   []         = pfail
+        go 1 acc (']':_) = do skip (1 + length acc)
+                              either (const pfail)
+                                     (return . E)
+                                     (parseExp (reverse acc))
+        go n acc ('[':s)     = go (n+1) ('[':acc) s
+        go n acc (']':s)     = go (n-1) (']':acc) s
+        go n acc (c:s)       = go n (c:acc) s
+
+
+
+sP = (char 's' +++ char 'S') >> return S
+kP = (char 'k' +++ char 'K') >> return K
+iP = (char 'i' +++ char 'I') >> return I
+
+runP :: ReadP a -> String -> ([a], String)
+runP p s = case readP_to_S p s of
+              [] -> ([],[])
+              xs -> mapfst (:[]) (last xs)
+  where mapfst f (a,b) = (f a,b)
+skip :: Int -> ReadP ()
+skip n = count n get >> return ()
+lexemeP :: ReadP a -> ReadP a
+lexemeP p = p >>= \x -> skipSpaces >> return x
+nestedP :: (ReadP a -> ReadP a) -> (ReadP a -> ReadP a)
+nestedP nest p = p <++ nest (skipSpaces >> nestedP nest p)
+parensP  = between oparenP cparenP
+bracksP  = between oparenP cparenP
+oparenP  = char '('
+cparenP  = char ')'
+obrackP  = char '['
+cbrackP  = char ']'
+
+
+
+
+{-
+import Prelude hiding (($))
+data Komb = S (Maybe (Komb, Maybe Komb)) | K (Maybe Komb) deriving Show
+S Nothing $ x = S (Just (x, Nothing))
+S (Just (x, Nothing)) $ y = S (Just (x, Just y))
+S (Just (x, Just y)) $ z = x $ z $ (y $ z)
+K Nothing $ x = K (Just x)
+K (Just x) $ y = y
+q x = x $ (c $ k) $ k $ k $ s
+ where s = S Nothing
+       k = K Nothing
+       c = s $ (b $ b $ s) $ k $ k
+       b = s $ (k $ s) $ k
+-}
+
+
+
diff --git a/src/Language/Haskell/Meta/Syntax.hs b/src/Language/Haskell/Meta/Syntax.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/Meta/Syntax.hs
@@ -0,0 +1,19 @@
+
+{- |
+  Module      :  Language.Haskell.Meta.Syntax
+  Copyright   :  (c) Matt Morrow 2008
+  License     :  BSD3
+  Maintainer  :  Matt Morrow <mjm2002@gmail.com>
+  Stability   :  experimental
+  Portability :  portable (template-haskell)
+-}
+
+module Language.Haskell.Meta.Syntax (
+    module Language.Haskell.Meta.Syntax.Vars
+  , module Language.Haskell.Meta.Syntax.Translate
+) where
+
+import Language.Haskell.Meta.Syntax.Vars
+import Language.Haskell.Meta.Syntax.Translate
+
+
diff --git a/src/Language/Haskell/Meta/Syntax/Translate.hs b/src/Language/Haskell/Meta/Syntax/Translate.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/Meta/Syntax/Translate.hs
@@ -0,0 +1,562 @@
+{-# LANGUAGE TemplateHaskell, TypeSynonymInstances #-}
+
+{- |
+  Module      :  Language.Haskell.Meta.Syntax.Translate
+  Copyright   :  (c) Matt Morrow 2008
+  License     :  BSD3
+  Maintainer  :  Matt Morrow <mjm2002@gmail.com>
+  Stability   :  experimental
+  Portability :  portable (template-haskell)
+-}
+
+module Language.Haskell.Meta.Syntax.Translate (
+    module Language.Haskell.Meta.Syntax.Translate
+) where
+
+import Data.Typeable
+import Data.Generics
+import Data.List (foldl')
+import Language.Haskell.TH.Syntax
+import qualified Language.Haskell.Exts.Syntax as Hs
+
+-----------------------------------------------------------------------------
+
+
+class ToName a where toName :: a -> Name
+class ToLit  a where toLit  :: a -> Lit
+class ToType a where toType :: a -> Type
+class ToPat  a where toPat  :: a -> Pat
+class ToExp  a where toExp  :: a -> Exp
+class ToDec  a where toDec  :: a -> Dec
+class ToStmt a where toStmt :: a -> Stmt
+class ToLoc  a where toLoc  :: a -> Loc
+class ToKind a where toKind :: a -> Kind
+class ToTVB  a where toTVB  :: a -> TyVarBndr
+class ToPred a where toPred :: a -> Pred
+
+errorMsg :: (Typeable a) => String -> a -> String
+errorMsg fun a = concat
+  [ fun,": "
+  , show . typeRepTyCon . typeOf $ a
+  , " not (yet?) implemented"
+  ]
+
+
+-----------------------------------------------------------------------------
+
+
+instance ToExp Lit where
+  toExp = LitE
+instance (ToExp a) => ToExp [a] where
+  toExp = ListE . fmap toExp
+instance (ToExp a, ToExp b) => ToExp (a,b) where
+  toExp (a,b) = TupE [toExp a, toExp b]
+instance (ToExp a, ToExp b, ToExp c) => ToExp (a,b,c) where
+  toExp (a,b,c) = TupE [toExp a, toExp b, toExp c]
+instance (ToExp a, ToExp b, ToExp c, ToExp d) => ToExp (a,b,c,d) where
+  toExp (a,b,c,d) = TupE [toExp a, toExp b, toExp c, toExp d]
+
+
+instance ToPat Lit where
+  toPat = LitP
+instance (ToPat a) => ToPat [a] where
+  toPat = ListP . fmap toPat
+instance (ToPat a, ToPat b) => ToPat (a,b) where
+  toPat (a,b) = TupP [toPat a, toPat b]
+instance (ToPat a, ToPat b, ToPat c) => ToPat (a,b,c) where
+  toPat (a,b,c) = TupP [toPat a, toPat b, toPat c]
+instance (ToPat a, ToPat b, ToPat c, ToPat d) => ToPat (a,b,c,d) where
+  toPat (a,b,c,d) = TupP [toPat a, toPat b, toPat c, toPat d]
+
+
+instance ToLit Char where
+  toLit = CharL
+instance ToLit String where
+  toLit = StringL
+instance ToLit Integer where
+  toLit = IntegerL
+instance ToLit Int where
+  toLit = IntegerL . toInteger
+instance ToLit Float where
+  toLit = RationalL . toRational
+instance ToLit Double where
+  toLit = RationalL . toRational
+
+
+-----------------------------------------------------------------------------
+
+
+-- * ToName {String,HsName,Module,HsSpecialCon,HsQName}
+
+
+instance ToName String where
+  toName = mkName
+
+instance ToName Hs.Name where
+  toName (Hs.Ident s) = toName s
+  toName (Hs.Symbol s) = toName s
+
+instance ToName Hs.Module where
+  toName (Hs.Module _ (Hs.ModuleName s) _ _ _ _ _) = toName s
+
+
+instance ToName Hs.SpecialCon where
+  toName Hs.UnitCon = '()
+  toName Hs.ListCon = '[]
+  toName Hs.FunCon  = ''(->)
+  toName (Hs.TupleCon _ n)
+    | n<2 = '()
+    | otherwise =
+      let x = maybe [] (++".") (nameModule '())
+      in toName . concat $ x : ["(",replicate (n-1) ',',")"]
+  toName Hs.Cons    = '(:)
+
+
+instance ToName Hs.QName where
+--  toName (Hs.Qual (Hs.Module []) n) = toName n
+  toName (Hs.Qual (Hs.ModuleName []) n) = toName n
+  toName (Hs.Qual (Hs.ModuleName m) n) =
+    let m' = show . toName $ m
+        n' = show . toName $ n
+    in toName . concat $ [m',".",n']
+  toName (Hs.UnQual n) = toName n
+  toName (Hs.Special s) = toName s
+
+
+
+-----------------------------------------------------------------------------
+
+-- * ToLit HsLiteral
+
+
+instance ToLit Hs.Literal where
+  toLit (Hs.Char a) = CharL a
+  toLit (Hs.String a) = StringL a
+  toLit (Hs.Int a) = IntegerL a
+  toLit (Hs.Frac a) = RationalL a
+  toLit (Hs.PrimChar a) = CharL a      -- XXX
+  toLit (Hs.PrimString a) = StringL a  -- XXX
+  toLit (Hs.PrimInt a) = IntPrimL a
+  toLit (Hs.PrimFloat a) = FloatPrimL a
+  toLit (Hs.PrimDouble a) = DoublePrimL a
+
+
+-----------------------------------------------------------------------------
+
+-- * ToPat HsPat
+
+
+instance ToPat Hs.Pat where
+  toPat (Hs.PVar n)
+    = VarP (toName n)
+  toPat (Hs.PLit l)
+    = LitP (toLit l)
+{-
+ghci> parseHsPat "-2"
+Right (HsPParen (HsPNeg (HsPLit (HsInt 2))))
+-}
+  toPat (Hs.PBangPat p) = BangP (toPat p)
+  toPat (Hs.PNeg p) = error "toPat: HsPNeg not supported"
+  toPat (Hs.PInfixApp p n q)= InfixP (toPat p) (toName n) (toPat q)
+  toPat (Hs.PApp n ps) = ConP (toName n) (fmap toPat ps)
+  toPat (Hs.PTuple ps) = TupP (fmap toPat ps)
+  toPat (Hs.PList ps) = ListP (fmap toPat ps)
+  toPat (Hs.PParen p) = toPat p
+  toPat (Hs.PRec n pfs) = let toFieldPat (Hs.PFieldPat n p) = (toName n, toPat p)
+                          in RecP (toName n) (fmap toFieldPat pfs)
+  toPat (Hs.PAsPat n p) = AsP (toName n) (toPat p)
+  toPat (Hs.PWildCard) = WildP
+  toPat (Hs.PIrrPat p) = TildeP (toPat p)
+  toPat (Hs.PatTypeSig _ p t) = SigP (toPat p) (toType t)
+  toPat (Hs.PRPat rps) = error "toPat: HsRPat not supported"
+  toPat (Hs.PXTag _ _ _ pM p) = error "toPat: HsPXTag not supported"
+  toPat (Hs.PXETag _ _ _ pM) = error "toPat: HsPXETag not supported"
+  toPat (Hs.PXPcdata _) = error "toPat: HsPXPcdata not supported"
+  toPat (Hs.PXPatTag p) = error "toPat: HsPXPatTag not supported"
+
+-----------------------------------------------------------------------------
+
+-- * ToExp HsExp
+
+instance ToExp Hs.QOp where
+  toExp (Hs.QVarOp n) = VarE (toName n)
+  toExp (Hs.QConOp n) = ConE (toName n)
+
+toFieldExp :: Hs.FieldUpdate -> FieldExp
+toFieldExp (Hs.FieldUpdate n e) = (toName n, toExp e)
+
+
+
+
+instance ToExp Hs.Exp where
+{-
+data HsExp
+  = HsVar HsQName
+-}
+--  | HsIPVar HsIPName
+{-
+  | HsLet HsBinds HsExp
+  | HsDLet [HsIPBind] HsExp
+  | HsWith HsExp [HsIPBind]
+  | HsCase HsExp [HsAlt]
+  | HsDo [HsStmt]
+  -- use mfix somehow
+  | HsMDo [HsStmt]
+-}
+  toExp (Hs.Var n)                 = VarE (toName n)
+  toExp (Hs.Con n)                 = ConE (toName n)
+  toExp (Hs.Lit l)                 = LitE (toLit l)
+  toExp (Hs.InfixApp e o f)        = InfixE (Just . toExp $ e) (toExp o) (Just . toExp $ f)
+  toExp (Hs.LeftSection e o)       = InfixE (Just . toExp $ e) (toExp o) Nothing
+  toExp (Hs.RightSection o f)      = InfixE Nothing (toExp o) (Just . toExp $ f)
+  toExp (Hs.App e f)               = AppE (toExp e) (toExp f)
+  toExp (Hs.NegApp e)              = AppE (VarE 'negate) (toExp e)
+  toExp (Hs.Lambda _ ps e)         = LamE (fmap toPat ps) (toExp e)
+  toExp (Hs.Let bs e)              = LetE (hsBindsToDecs bs) (toExp e)
+  -- toExp (HsWith e bs
+  toExp (Hs.If a b c)              = CondE (toExp a) (toExp b) (toExp c)
+  -- toExp (HsCase e xs)
+  -- toExp (HsDo ss)
+  -- toExp (HsMDo ss)
+  toExp (Hs.Tuple xs)              = TupE (fmap toExp xs)
+  toExp (Hs.List xs)               = ListE (fmap toExp xs)
+  toExp (Hs.Paren e)               = toExp e
+  toExp (Hs.RecConstr n xs)        = RecConE (toName n) (fmap toFieldExp xs)
+  toExp (Hs.RecUpdate e xs)        = RecUpdE (toExp e) (fmap toFieldExp xs)
+  toExp (Hs.EnumFrom e)            = ArithSeqE $ FromR (toExp e)
+  toExp (Hs.EnumFromTo e f)        = ArithSeqE $ FromToR (toExp e) (toExp f)
+  toExp (Hs.EnumFromThen e f)      = ArithSeqE $ FromThenR (toExp e) (toExp f)
+  toExp (Hs.EnumFromThenTo e f g)  = ArithSeqE $ FromThenToR (toExp e) (toExp f) (toExp g)
+  toExp (Hs.ExpTypeSig _ e t)      = SigE (toExp e) (toType t)
+  --  HsListComp HsExp [HsStmt]
+  -- toExp (HsListComp e ss) = CompE 
+  -- NEED: a way to go e -> Stmt
+  toExp a@(Hs.ListComp e ss)       = error $ errorMsg "toExp" a
+{- HsVarQuote HsQName
+  | HsTypQuote HsQName
+  | HsBracketExp HsBracket
+  | HsSpliceExp HsSplice
+data HsBracket
+  = HsExpBracket HsExp
+  | HsPatBracket HsPat
+  | HsTypeBracket HsType
+  | HsDeclBracket [HsDecl]
+data HsSplice = HsIdSplice String | HsParenSplice HsExp -}
+  toExp (Hs.SpliceExp spl) = toExp spl
+  toExp e = error $ errorMsg "toExp" e
+
+
+instance ToExp Hs.Splice where
+  toExp (Hs.IdSplice s) = VarE (toName s)
+  toExp (Hs.ParenSplice e) = toExp e
+
+
+-----------------------------------------------------------------------------
+
+{-
+class ToName a where toName :: a -> Name
+class ToLit  a where toLit  :: a -> Lit
+class ToType a where toType :: a -> Type
+class ToPat  a where toPat  :: a -> Pat
+class ToExp  a where toExp  :: a -> Exp
+class ToDec  a where toDec  :: a -> Dec
+class ToStmt a where toStmt :: a -> Stmt
+class ToLoc  a where toLoc  :: a -> Loc
+-}
+
+{-
+TODO:
+  []
+
+PARTIAL:
+  * ToExp HsExp
+  * ToStmt HsStmt
+  * ToDec HsDecl
+
+DONE:
+  * ToLit HsLiteral
+  * ToName {..}
+  * ToPat HsPat
+  * ToLoc SrcLoc
+  * ToType HsType
+
+-}
+-----------------------------------------------------------------------------
+
+-- * ToLoc SrcLoc
+
+instance ToLoc Hs.SrcLoc where
+  toLoc (Hs.SrcLoc fn l c) =
+    Loc fn [] [] (l,c) (-1,-1)
+
+-----------------------------------------------------------------------------
+
+-- * ToType HsType
+
+instance ToName Hs.TyVarBind where
+  toName (Hs.KindedVar n _) = toName n
+  toName (Hs.UnkindedVar n) = toName n
+
+instance ToTVB Hs.TyVarBind where
+  toTVB (Hs.KindedVar n k) = KindedTV (toName n) (toKind k)
+  toTVB (Hs.UnkindedVar n) = PlainTV (toName n)
+
+instance ToKind Hs.Kind where
+  toKind (Hs.KindStar)    = StarK
+  toKind (Hs.KindBang)    = StarK -- XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+  toKind (Hs.KindFn a b)  = ArrowK (toKind a) (toKind b)
+  toKind (Hs.KindParen a) = toKind a
+  toKind (Hs.KindVar _)   = StarK
+
+instance ToPred Hs.Asst where
+  toPred (Hs.ClassA qn ts)  = ClassP (toName qn) (fmap toType ts)
+  toPred (Hs.InfixA a qn b) = ClassP (toName qn) (fmap toType [a,b])
+  toPred (Hs.IParam a b)    = error "IParam not supported by TH (should something other than calling error happen here?"
+  toPred (Hs.EqualP a b)    = EqualP (toType a) (toType b)
+
+
+
+{- |
+TH does't handle
+  * unboxed tuples
+  * implicit params
+  * infix type constructors
+  * kind signatures
+-}
+instance ToType Hs.Type where
+  toType (Hs.TyForall tvbM cxt t) = ForallT (maybe [] (fmap toTVB) tvbM) (fmap toPred cxt) (toType t)
+  toType (Hs.TyFun a b) = toType a .->. toType b
+  toType (Hs.TyList t) = ListT `AppT` toType t
+  toType (Hs.TyTuple _ ts) = foldAppT (TupleT . length $ ts) (fmap toType ts)
+  toType (Hs.TyApp a b) = AppT (toType a) (toType b)
+  toType (Hs.TyVar n) = VarT (toName n)
+  toType (Hs.TyCon qn) = ConT (toName qn)
+  toType (Hs.TyParen t) = toType t
+  -- XXX: need to wrap the name in parens!
+  toType (Hs.TyInfix a o b) = AppT (AppT (ConT (toName o)) (toType a)) (toType b)
+  toType (Hs.TyKind t k) = SigT (toType t) (toKind k)
+
+
+
+
+(.->.) :: Type -> Type -> Type
+a .->. b = AppT (AppT ArrowT a) b
+
+{- |
+TH doesn't handle:
+  * implicit params
+  * equality constraints
+-}
+instance ToType Hs.Asst where
+  toType  (Hs.ClassA n ts)  = foldAppT (ConT . toName $ n) (fmap toType ts)
+  toType  (Hs.InfixA a n b) = foldAppT (ConT . toName $ n) (fmap toType [a,b])
+  toType a@(Hs.IParam _ _)  = error $ errorMsg "toType" a
+  toType a@(Hs.EqualP _ _)  = error $ errorMsg "toType" a
+
+foldAppT :: Type -> [Type] -> Type
+foldAppT t ts = foldl' AppT t ts
+
+-----------------------------------------------------------------------------
+
+-- * ToStmt HsStmt
+
+instance ToStmt Hs.Stmt where
+  toStmt (Hs.Generator _ p e)  = BindS (toPat p) (toExp e)
+  toStmt (Hs.Qualifier e)      = NoBindS (toExp e)
+  toStmt a@(Hs.LetStmt bnds)   = LetS (hsBindsToDecs bnds)
+
+
+-----------------------------------------------------------------------------
+
+-- * ToDec HsDecl
+
+-- data HsBinds = HsBDecls [HsDecl] | HsIPBinds [HsIPBind]
+hsBindsToDecs :: Hs.Binds -> [Dec]
+hsBindsToDecs (Hs.BDecls ds) = fmap toDec ds
+hsBindsToDecs a@(Hs.IPBinds ipbs) = error $ errorMsg "hsBindsToDecs" a
+-- data HsIPBind = HsIPBind SrcLoc HsIPName HsExp
+
+
+hsBangTypeToStrictType :: Hs.BangType -> (Strict, Type)
+hsBangTypeToStrictType (Hs.BangedTy t)   = (IsStrict, toType t)
+hsBangTypeToStrictType (Hs.UnBangedTy t) = (NotStrict, toType t)
+
+
+{-
+data HsTyVarBind = HsKindedVar HsName HsKind | HsUnkindedVar HsName
+data HsConDecl
+  = HsConDecl HsName [HsBangType]
+  | HsRecDecl HsName [([HsName], HsBangType)]
+-}
+{-
+hsQualConDeclToCon :: HsQualConDecl -> Con
+hsQualConDeclToCon (HsQualConDecl _ tvbs cxt condec) =
+  case condec of
+    HsConDecl n bangs ->
+    HsRecDecl n assocs ->
+-}
+
+instance ToDec Hs.Decl where
+  toDec (Hs.TypeDecl _ n ns t)
+    = TySynD (toName n) (fmap toTVB ns) (toType t)
+
+
+  toDec a@(Hs.DataDecl  _ dOrN cxt n ns qcds qns)
+    = case dOrN of
+        Hs.DataType -> DataD (fmap toPred cxt)
+                              (toName n)
+                              (fmap toTVB ns)
+                              (fmap qualConDeclToCon qcds)
+                              (fmap (toName . fst) qns)
+        Hs.NewType  -> let qcd = case qcds of
+                                  x:_ -> x
+                                  _   -> error "toDec: Newtype has no constructors!"
+                        in NewtypeD (fmap toPred cxt)
+                                    (toName n)
+                                    (fmap toTVB ns)
+                                    (qualConDeclToCon qcd)
+                                    (fmap (toName . fst) qns)
+
+-- data Hs.BangType
+--   = Hs.BangedTy Hs.Type
+--   | Hs.UnBangedTy Hs.Type
+--   | Hs.UnpackedTy Hs.Type
+-- data Hs.TyVarBind
+--   = Hs.KindedVar Hs.Name Hs.Kind | Hs.UnkindedVar Hs.Name
+-- data Hs.DataOrNew = Hs.DataType | Hs.NewType
+-- data Hs.QualConDecl
+--   = Hs.QualConDecl Hs.SrcLoc [Hs.TyVarBind] Hs.Context Hs.ConDecl
+-- data Hs.ConDecl
+--   = Hs.ConDecl Hs.Name [Hs.BangType]
+--   | Hs.RecDecl Hs.Name [([Hs.Name], Hs.BangType)]
+
+-- data Con
+--   = NormalC Name [StrictType]
+--   | RecC Name [VarStrictType]
+--   | InfixC StrictType Name StrictType
+--   | ForallC [Name] Cxt Con
+-- type StrictType = (Strict, Type)
+-- type VarStrictType = (Name, Strict, Type)
+
+
+  toDec a@(Hs.GDataDecl _ dOrN cxt n ns kM gadtDecs _) = error $ errorMsg "toDec" a
+  toDec a@(Hs.TypeFamDecl _ n ns kM)                   = error $ errorMsg "toDec" a
+  toDec a@(Hs.DataFamDecl _ cxt n ns kM)               = error $ errorMsg "toDec" a
+  toDec a@(Hs.TypeInsDecl _ ta tb)                     = error $ errorMsg "toDec" a
+  toDec a@(Hs.DataInsDecl _ dOrN t qcds qns)           = error $ errorMsg "toDec" a
+  toDec a@(Hs.GDataInsDecl _ dOrN t kM gadtDecs _)     = error $ errorMsg "toDec" a
+-- data HsOp = HsVarOp HsName | HsConOp HsName
+  toDec a@(Hs.InfixDecl _ asst i ops)                  = error $ errorMsg "toDec" a
+  toDec a@(Hs.ClassDecl _ cxt n ns funDeps cDecs)      = error $ errorMsg "toDec" a
+  toDec a@(Hs.InstDecl _ cxt qn ts instDecs)           = error $ errorMsg "toDec" a
+  toDec a@(Hs.DerivDecl _ cxt qn ts)                   = error $ errorMsg "toDec" a  
+  toDec a@(Hs.DefaultDecl _ ts)                        = error $ errorMsg "toDec" a
+  toDec a@(Hs.SpliceDecl _ s)                          = error $ errorMsg "toDec" a
+  toDec a@(Hs.TypeSig _ ns t)
+    -- XXXXXXXXXXXXXX: oh crap, we can't return a [Dec] from this class!
+    = let xs = fmap (flip SigD (toType t) . toName) ns
+      in case xs of x:_ -> x; [] -> error "toDec: malformed TypeSig!"
+
+
+{- data HsDecl = ... | HsFunBind [HsMatch] | ...
+data HsMatch = HsMatch SrcLoc HsName [HsPat] HsRhs HsBinds
+data Dec = FunD Name [Clause] | ...
+data Clause = Clause [Pat] Body [Dec] -}
+  toDec a@(Hs.FunBind mtchs)                           = hsMatchesToFunD mtchs
+{- ghci> parseExp "let x = 2 in x"
+LetE [ValD (VarP x) (NormalB (LitE (IntegerL 2))) []] (VarE x)
+ghci> unQ[| let x = 2 in x |]
+LetE [ValD (VarP x_0) (NormalB (LitE (IntegerL 2))) []] (VarE x_0) -}
+  toDec (Hs.PatBind _ p tM rhs bnds)                   = ValD ((maybe id
+                                                                      (flip SigP . toType)
+                                                                      tM) (toPat p))
+                                                              (hsRhsToBody rhs)
+                                                              (hsBindsToDecs bnds)
+  toDec a@(Hs.ForImp _ cconv safe str n t)             = error $ errorMsg "toDec" a
+  toDec a@(Hs.ForExp _ cconv      str n t)             = error $ errorMsg "toDec" a
+
+
+
+
+-- data Hs.Decl = ... | Hs.SpliceDecl Hs.SrcLoc Hs.Splice | ...
+-- data Hs.Splice = Hs.IdSplice String | Hs.ParenSplice Hs.Exp
+
+
+
+
+
+
+
+
+
+
+qualConDeclToCon :: Hs.QualConDecl -> Con
+qualConDeclToCon (Hs.QualConDecl _ [] [] cdecl) = conDeclToCon cdecl
+qualConDeclToCon (Hs.QualConDecl _ ns cxt cdecl) = ForallC (fmap toTVB ns)
+                                                    (fmap toPred cxt)
+                                                    (conDeclToCon cdecl)
+
+conDeclToCon :: Hs.ConDecl -> Con
+conDeclToCon (Hs.ConDecl n tys)
+  = NormalC (toName n) (fmap bangToStrictType tys)
+conDeclToCon (Hs.RecDecl n lbls)
+  = RecC (toName n) (concatMap (uncurry bangToVarStrictTypes) lbls)
+
+
+
+bangToVarStrictTypes :: [Hs.Name] -> Hs.BangType -> [VarStrictType]
+bangToVarStrictTypes ns t = let (a,b) = bangToStrictType t
+                            in fmap (\n->(toName n,a,b)) ns
+
+bangToStrictType :: Hs.BangType -> StrictType
+bangToStrictType (Hs.BangedTy   t) = (IsStrict, toType t)
+bangToStrictType (Hs.UnBangedTy t) = (NotStrict, toType t)
+bangToStrictType (Hs.UnpackedTy t) = (IsStrict, toType t)
+
+
+hsMatchesToFunD :: [Hs.Match] -> Dec
+hsMatchesToFunD [] = FunD (mkName []) []   -- errorish
+hsMatchesToFunD xs@(Hs.Match _ n _ _ _ _:_) = FunD (toName n) (fmap hsMatchToClause xs)
+
+
+hsMatchToClause :: Hs.Match -> Clause
+hsMatchToClause (Hs.Match _ _ ps _ rhs bnds) = Clause
+                                                (fmap toPat ps)
+                                                (hsRhsToBody rhs)
+                                                (hsBindsToDecs bnds)
+
+
+
+-- data HsRhs = HsUnGuardedRhs HsExp | HsGuardedRhs [HsGuardedRhs]
+-- data HsGuardedRhs = HsGuardedRhs SrcLoc [HsStmt] HsExp
+-- data Body = GuardedB [(Guard, Exp)] | NormalB Exp
+-- data Guard = NormalG Exp | PatG [Stmt]
+hsRhsToBody :: Hs.Rhs -> Body
+hsRhsToBody (Hs.UnGuardedRhs e) = NormalB (toExp e)
+hsRhsToBody (Hs.GuardedRhss hsgrhs) = let fromGuardedB (GuardedB a) = a
+                                      in GuardedB . concat
+                                          . fmap (fromGuardedB . hsGuardedRhsToBody)
+                                              $ hsgrhs
+
+
+
+hsGuardedRhsToBody :: Hs.GuardedRhs -> Body
+hsGuardedRhsToBody (Hs.GuardedRhs _ [] e)  = NormalB (toExp e)
+hsGuardedRhsToBody (Hs.GuardedRhs _ [s] e) = GuardedB [(hsStmtToGuard s, toExp e)]
+hsGuardedRhsToBody (Hs.GuardedRhs _ ss e)  = let ss' = fmap hsStmtToGuard ss
+                                                 (pgs,ngs) = unzip [(p,n)
+                                                               | (PatG p) <- ss'
+                                                               , n@(NormalG _) <- ss']
+                                                 e' = toExp e
+                                                 patg = PatG (concat pgs)
+                                            in GuardedB $ (patg,e') : zip ngs (repeat e')
+
+
+
+hsStmtToGuard :: Hs.Stmt -> Guard
+hsStmtToGuard (Hs.Generator _ p e) = PatG [BindS (toPat p) (toExp e)]
+hsStmtToGuard (Hs.Qualifier e)     = NormalG (toExp e)
+hsStmtToGuard a@(Hs.LetStmt _)     = error $ errorMsg "hsStmtToGuardExp" a
+
+
+-----------------------------------------------------------------------------
diff --git a/src/Language/Haskell/Meta/Syntax/Vars.hs b/src/Language/Haskell/Meta/Syntax/Vars.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/Meta/Syntax/Vars.hs
@@ -0,0 +1,166 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+{- |
+  Module      :  Language.Haskell.Meta.Syntax.Vars
+  Copyright   :  (c) Matt Morrow 2008
+  License     :  BSD3
+  Maintainer  :  Matt Morrow <mjm2002@gmail.com>
+  Stability   :  experimental
+  Portability :  portable (template-haskell)
+-}
+
+module Language.Haskell.Meta.Syntax.Vars (
+    Vars(..)
+) where
+
+import Data.Set (Set)
+import qualified Data.Set as S
+import Language.Haskell.TH.Syntax
+
+-----------------------------------------------------------------------------
+
+
+class Vars e v where
+  vars :: (Ord v) => e -> Set v
+  fvs  :: (Ord v) => e -> Set v
+  bvs  :: (Ord v) => e -> Set v
+  vars e = fvs e `S.union` bvs e
+  fvs e = vars e `S.difference` bvs e
+  bvs e = vars e `S.difference` fvs e
+
+
+instance (Vars e v) => Vars [e] v where
+  vars  = S.unions . fmap vars
+  fvs   = S.unions . fmap fvs
+  bvs   = S.unions . fmap bvs
+
+
+-----------------------------------------------------------------------------
+
+
+instance Vars Pat Name where
+  vars (LitP _) = S.empty
+  vars (VarP n) = S.singleton n
+  vars (TupP ps) = vars ps
+  vars (ConP n ps) = n `S.insert` vars ps
+  vars (InfixP p n q) = n `S.insert` vars [p,q]
+  vars (TildeP p) = vars p
+  vars (AsP n p) = n `S.insert` vars p
+  vars (WildP) = S.empty
+  vars (RecP n pfs) = (n `S.insert`) . vars . fmap snd $ pfs
+  vars (ListP ps) = vars ps
+  vars (SigP p _) = vars p
+  bvs (LitP _) = S.empty
+  bvs (VarP n) = S.singleton n
+  bvs (TupP ps) = bvs ps
+  bvs (ConP _ ps) = bvs ps
+  bvs (InfixP p _ q) = bvs [p,q]
+  bvs (TildeP p) = bvs p
+  bvs (AsP n p) = n `S.insert` bvs p
+  bvs (WildP) = S.empty
+  bvs (RecP _ pfs) = bvs . fmap snd $ pfs
+  bvs (ListP ps) = bvs ps
+  bvs (SigP p _)  = bvs p
+
+
+instance Vars Range Name where
+  vars (FromR e) = vars e
+  vars (FromThenR e f) = vars [e,f]
+  vars (FromToR e f) = vars [e,f]
+  vars (FromThenToR e f g) = vars [e,f,g]
+  fvs (FromR e) = fvs e
+  fvs (FromThenR e f) = fvs [e,f]
+  fvs (FromToR e f) = fvs [e,f]
+  fvs (FromThenToR e f g) = fvs [e,f,g]
+
+
+instance Vars Exp Name where
+  vars (LamE ps e) = fvs ps `S.union` vars e
+  vars (LetE ds e) = fvs e `S.union` vars ds
+  vars e = fvs e
+  fvs (VarE n) = S.singleton n
+  fvs (ConE n) = S.singleton n
+  fvs (LitE _) = S.empty
+  fvs (AppE a b) = fvs [a,b]
+  fvs (InfixE aM b cM) = fvs (b : concatMap (maybe [] (:[])) [aM,cM])
+  fvs (LamE ps e) = fvs e `S.difference` bvs ps
+  fvs (TupE es) = fvs es
+  fvs (CondE e f g) = fvs [e,f,g]
+  fvs (LetE ds e) = (fvs e `S.union` fvs ds) `S.difference` bvs ds
+  fvs (CaseE e ms) = fvs e `S.union` fvs ms
+  fvs (DoE ss) = fvs ss
+  fvs (CompE ss) = fvs ss
+  fvs (ArithSeqE r) = fvs r
+  fvs (ListE xs) = fvs xs
+  fvs (SigE e _) = fvs e
+  fvs (RecConE n xs) = (n `S.insert`) . fvs . fmap snd $ xs
+  fvs (RecUpdE e xs) = fvs . (e:) . fmap snd $ xs
+
+
+instance Vars Match Name where
+  fvs (Match p b decs) = (fvs b `S.union` fvs decs)
+          `S.difference` (bvs decs `S.union` bvs p)
+
+
+instance Vars Dec Name where
+  vars (FunD n cs) = n `S.insert` vars cs
+  vars (ValD p bdy decs) =
+    vars p `S.union` vars bdy `S.union` vars decs
+  vars (ClassD _ _ _ _ decs) = vars decs
+  vars (InstanceD _ _ decs) = vars decs
+  vars _ = S.empty
+  bvs (FunD n _) = S.singleton n
+  bvs (ValD p _ _) = bvs p
+  bvs (ClassD _ _ _ _ decs) = bvs decs
+  bvs (InstanceD _ _ decs) = bvs decs
+  bvs (SigD n _) = S.singleton n
+  bvs _ = S.empty
+
+
+-- data Clause = Clause [Pat] Body [Dec]
+instance Vars Clause Name where
+  vars (Clause ps bdy decs) =
+    vars ps `S.union` vars bdy `S.union` vars decs
+  fvs (Clause ps bdy decs) =
+    fvs bdy `S.difference` (bvs ps `S.union` bvs decs)
+
+
+-- data Body = GuardedB [(Guard, Exp)] | NormalB Exp
+instance Vars Body Name where
+  vars (NormalB e) = vars e
+  vars (GuardedB xs) = S.unions
+      . fmap (\(g,e) -> vars g `S.union` vars e)
+        $ xs
+  fvs (NormalB e) = fvs e
+  fvs (GuardedB xs) = S.unions
+      . fmap (\(g,e) -> fvs e `S.difference` bvs g)
+        $ xs
+
+
+-- data Guard = NormalG Exp | PatG [Stmt]
+instance Vars Guard Name where
+  vars (NormalG e) = vars e
+  vars (PatG ss) = vars ss
+  fvs (NormalG e) = fvs e
+  fvs (PatG ss) = fvs ss
+  bvs (NormalG e) = bvs e
+  bvs (PatG ss) = bvs ss
+
+
+-- data Stmt = BindS Pat Exp | LetS [Dec] | NoBindS Exp | ParS [[Stmt]]
+instance Vars Stmt Name where
+  vars (BindS p e) = vars p `S.union` vars e
+  vars (LetS decs) = vars decs
+  vars (NoBindS e) = vars e
+  vars (ParS sss) = vars . concat $ sss
+  fvs (BindS p e) = fvs e `S.difference` bvs p
+  fvs (LetS decs) = fvs decs
+  fvs (NoBindS e) = fvs e
+  fvs (ParS sss) = fvs . concat $ sss
+  bvs (BindS p e) = bvs p
+  bvs (LetS decs) = bvs decs
+  bvs (NoBindS e) = bvs e
+  bvs (ParS sss) = bvs . concat $ sss
+
+
+-----------------------------------------------------------------------------
diff --git a/src/Language/Haskell/Meta/Utils.hs b/src/Language/Haskell/Meta/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/Meta/Utils.hs
@@ -0,0 +1,517 @@
+{-# LANGUAGE TemplateHaskell, RankNTypes, StandaloneDeriving,
+             FlexibleContexts, FlexibleInstances, TypeSynonymInstances #-}
+
+-- | This module is a staging ground
+-- for to-be-organized-and-merged-nicely code.
+
+module Language.Haskell.Meta.Utils where
+
+import Data.Typeable
+import Data.Generics hiding(Fixity)
+import Language.Haskell.Meta
+import System.IO.Unsafe(unsafePerformIO)
+import Language.Haskell.Exts.Pretty(prettyPrint)
+import Language.Haskell.TH.Quote
+import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Ppr
+import Text.PrettyPrint
+import Control.Monad
+
+-----------------------------------------------------------------------------
+
+
+cleanNames :: (Data a) => a -> a
+cleanNames = everywhere (mkT cleanName)
+  where cleanName :: Name -> Name
+        cleanName n
+          | isNameU n = n
+          | otherwise = (mkName . nameBase) n
+        isNameU :: Name -> Bool
+        isNameU (Name _ (NameU _)) = True
+        isNameU _ = False
+
+
+-- | The type passed in must have a @Show@ instance which
+--  produces a valid Haskell expression. Returns an empty
+--  @String@ if this is not the case. This is not TH-specific,
+--  but useful in general.
+pretty :: (Show a) => a -> String
+pretty a = case parseHsExp (show a) of
+            Left _ -> []
+            Right e -> prettyPrint e
+
+
+pp :: (Data a, Ppr a) => a -> String
+pp = pprint . cleanNames
+
+ppDoc :: (Data a, Ppr a) => a -> Doc
+ppDoc = text . pp
+
+
+gpretty :: (Data a) => a -> String
+gpretty = either (const []) prettyPrint . parseHsExp . gshow
+
+
+instance Show ExpQ where show = show . cleanNames . unQ
+instance Show (Q [Dec]) where show = unlines . fmap (show . cleanNames) . unQ
+instance Show DecQ where show = show . cleanNames . unQ
+instance Show TypeQ where show = show . cleanNames . unQ
+instance Show (Q String) where show = unQ
+instance Show (Q Doc) where show = show . unQ
+
+deriving instance Typeable1 Q
+deriving instance Typeable QuasiQuoter
+
+
+-- | @unQ = unsafePerformIO . runQ@
+unQ :: Q a -> a
+unQ = unsafePerformIO . runQ
+
+
+nameToRawCodeStr :: Name -> String
+nameToRawCodeStr n =
+  let s = showNameParens n
+  in case nameSpaceOf n of
+      Just VarName -> "'"++s
+      Just DataName -> "'"++s
+      Just TcClsName -> "''"++s
+      _ -> concat ["(mkName \"", filter (/='"') s, "\")"]
+  where showNameParens :: Name -> String
+        showNameParens n =
+          let nb = nameBase n
+          in case nb of
+            (c:_) | isSym c -> concat ["(",nb,")"]
+            _  -> nb
+        isSym :: Char -> Bool
+        isSym = (`elem` "><.\\/!@#$%^&*-+?:|")
+
+
+-----------------------------------------------------------------------------
+
+
+(|$|) :: ExpQ -> ExpQ -> ExpQ
+infixr 0 |$|
+f |$| x = [|$f $x|]
+
+(|.|) :: ExpQ -> ExpQ -> ExpQ
+infixr 9 |.|
+g |.| f = [|$g . $f|]
+
+(|->|) :: TypeQ -> TypeQ -> TypeQ
+infixr 9 |->|
+a |->| b = appT (appT arrowT a) b
+
+
+
+unForall :: Type -> Type
+unForall (ForallT _ _ t) = t
+unForall t = t
+
+functionT :: [TypeQ] -> TypeQ
+functionT = foldl1 (|->|)
+
+mkVarT :: String -> TypeQ
+mkVarT = varT . mkName
+
+
+
+myNames :: [Name]
+myNames = let xs = fmap (:[]) ['a'..'z']
+              ys = iterate (join (zipWith (++))) xs
+           in fmap mkName (concat ys)
+
+{-
+renameTs env new acc [] = (reverse acc, env, new)
+renameTs env new acc (t:ts) =
+  let (t',env',new') = renameT env new t
+  in renameTs env' new' (t':acc) ts
+
+renameT :: [(Name, Name)] -> [Name] -> Type -> (Type, [(Name,Name)], [Name])
+renameT env (x:new) (VarT n)
+ | Just n' <- lookup n env = (VarT n',env,x:new)
+ | otherwise = (VarT x, (n,x):env, new) 
+renameT env new (ConT n) = (ConT ((mkName . nameBase) n), env, new)
+renameT env new t@(TupleT {}) = (t,env,new)
+renameT env new ArrowT = (ArrowT,env,new)
+renameT env new ListT = (ListT,env,new)
+renameT env new (AppT t t') = let (s,env',new') = renameT env new t
+                                  (s',env'',new'') = renameT env' new' t'
+                              in (AppT s s', env'', new'')
+renameT env new (ForallT ns cxt t) =
+  let unVarT (VarT n) = n
+      (ns',env2,new2) = renameTs env new [] (fmap VarT ns)
+      ns'' = fmap unVarT ns'
+      (cxt',env3,new3) = renameTs env2 new2 [] cxt
+      (t',env4,new4) = renameT env3 new3 t
+  in (ForallT ns'' cxt' t', env4, new4)
+-}
+
+
+
+
+{-
+applyT :: Type -> Type -> Type
+applyT (ForallT [] _ t) t' = t `AppT` t'
+applyT (ForallT (n:ns) cxt t) t' = ForallT ns cxt (substT [(tvbName n,t')] ns t)
+applyT t t' = t `AppT` t'
+-}
+
+
+tvbName :: TyVarBndr -> Name
+tvbName (PlainTV n) = n
+tvbName (KindedTV n _) = n
+
+
+{-
+substT :: [(Name, Type)] -> [Name] -> Type -> Type
+substT env bnd (ForallT ns _ t) = substT env (ns++bnd) t
+substT env bnd t@(VarT n)
+  | n `elem` bnd = t
+  | otherwise = maybe t id (lookup n env)
+substT env bnd (AppT t t') = AppT (substT env bnd t)
+                                  (substT env bnd t')
+substT _ _ t = t
+-}
+
+
+
+
+-- | Stolen from Igloo's th-lift.
+{-
+deriveLift :: Name -> Q Dec
+deriveLift n
+ = do i <- reify n
+      case i of
+        TyConI (DataD _ _ vs cons _) ->
+          let ctxt = cxt [conT ''Lift `appT` varT v | v <- vs]
+              typ = foldl appT (conT n) $ map varT vs
+              fun = funD 'lift (map doCons cons)
+          in instanceD ctxt (conT ''Lift `appT` typ) [fun]
+        _ -> error (modName ++ ".deriveLift: unhandled: " ++ pprint i)
+  where modName :: String
+        modName = "Language.Haskell.TH.Utils"
+        doCons :: Con -> Q Clause
+        doCons (NormalC c sts) = do
+          let ns = zipWith (\_ i -> "x" ++ show i) sts [0..]
+              con = [| conE c |]
+              args = [ [| lift $(varE (mkName n)) |] | n <- ns ]
+              e = foldl (\e1 e2 -> [| appE $e1 $e2 |]) con args
+          clause [conP c (map (varP . mkName) ns)] (normalB e) []
+        doCons c = error (modName ++ ".doCons: Unhandled constructor: " ++ pprint c)
+-}
+
+
+-- | Produces pretty code suitable
+--  for human consumption.
+{-
+deriveLiftPretty :: Name -> Q String
+deriveLiftPretty n = do
+  decs <- deriveLift n
+  case (parseHsDecls . pprint . cleanNames) decs of
+    Left e -> fail ("deriveLiftPretty: error while prettifying code: "++e)
+    Right hsdecs -> return (unlines . fmap prettyPrint $ hsdecs)
+-}
+
+
+
+splitCon :: Con -> (Name,[Type])
+splitCon c = (conName c, conTypes c)
+
+
+strictTypeTy :: StrictType -> Type
+strictTypeTy (_,t) = t
+
+varStrictTypeTy :: VarStrictType -> Type
+varStrictTypeTy (_,_,t) = t
+
+
+conTypes :: Con -> [Type]
+conTypes (NormalC _ sts) = fmap strictTypeTy sts
+conTypes (RecC    _ vts) = fmap varStrictTypeTy vts
+conTypes (InfixC t _ t') = fmap strictTypeTy [t,t']
+conTypes (ForallC _ _ c) = conTypes c
+
+
+conToConType :: Type -> Con -> Type
+conToConType ofType con = foldr (\a b -> AppT (AppT ArrowT a) b) ofType (conTypes con)
+
+
+
+decCons :: Dec -> [Con]
+decCons (DataD _ _ _ cons _) = cons
+decCons (NewtypeD _ _ _ con _) = [con]
+decCons _ = []
+
+
+decTyVars :: Dec -> [Name]
+decTyVars (DataD _ _ ns _ _) = fmap tvbName ns
+decTyVars (NewtypeD _ _ ns _ _) = fmap tvbName ns
+decTyVars (TySynD _ ns _) = fmap tvbName ns
+decTyVars (ClassD _ _ ns _ _) = fmap tvbName ns
+decTyVars _ = []
+
+
+decName :: Dec -> Maybe Name
+decName (FunD n _) = Just n
+decName (DataD _ n _ _ _) = Just n
+decName (NewtypeD _ n _ _ _) = Just n
+decName (TySynD n _ _) = Just n
+decName (ClassD _ n _ _ _) = Just n
+decName (SigD n _) = Just n
+decName (ForeignD fgn) = Just (foreignName fgn)
+decName _ = Nothing
+
+
+foreignName :: Foreign -> Name
+foreignName (ImportF _ _ _ n _) = n
+foreignName (ExportF _ _ n _) = n
+
+
+unwindT :: Type -> [Type]
+unwindT = go
+  where go :: Type -> [Type]
+        go (ForallT _ _ t) = go t
+        go (AppT (AppT ArrowT t) t') = t : go t'
+        go _ = []
+
+
+unwindE :: Exp -> [Exp]
+unwindE = go []
+  where go acc (e `AppE` e') = go (e':acc) e
+        go acc e = e:acc
+
+
+-- | The arity of a Type.
+arityT :: Type -> Int
+arityT = go 0
+  where go :: Int -> Type -> Int
+        go n (ForallT _ _ t) = go n t
+        go n (AppT (AppT ArrowT _) t) =
+          let n' = n+1 in n' `seq` go n' t
+        go n _ = n
+
+typeToName :: Type -> Maybe Name
+typeToName t
+  | ConT n <- t = Just n
+  | ArrowT <- t = Just ''(->)
+  | ListT  <- t = Just ''[]
+  | TupleT n <- t = Just $ tupleTypeName n
+  | ForallT _ _ t' <- t = typeToName t'
+  | otherwise = Nothing
+
+-- | Randomly useful.
+nameSpaceOf :: Name -> Maybe NameSpace
+nameSpaceOf (Name _ (NameG ns _ _)) = Just ns
+nameSpaceOf _ = Nothing
+
+conName :: Con -> Name
+conName (RecC n _) = n
+conName (NormalC n _) = n
+conName (InfixC _ n _) = n
+conName (ForallC _ _ con) = conName con
+
+recCName :: Con -> Maybe Name
+recCName (RecC n _) = Just n
+recCName _ = Nothing
+
+dataDCons :: Dec -> [Con]
+dataDCons (DataD _ _ _ cons _) = cons
+dataDCons _ = []
+
+fromDataConI :: Info -> Q (Maybe Exp)
+fromDataConI (DataConI dConN ty tyConN fxty) =
+  let n = arityT ty
+  in replicateM n (newName "a")
+      >>= \ns -> return (Just (LamE
+                    [ConP dConN (fmap VarP ns)]
+                    (TupE $ fmap VarE ns)))
+fromDataConI _ = return Nothing
+
+fromTyConI :: Info -> Maybe Dec
+fromTyConI (TyConI dec) = Just dec
+fromTyConI _ = Nothing
+
+mkFunD :: Name -> [Pat] -> Exp -> Dec
+mkFunD f xs e = FunD f [Clause xs (NormalB e) []]
+
+mkClauseQ :: [PatQ] -> ExpQ -> ClauseQ
+mkClauseQ ps e = clause ps (normalB e) []
+
+-----------------------------------------------------------------------------
+
+-- | The strategy for producing QuasiQuoters which
+--  this datatype aims to facilitate is as follows.
+--  Given a collection of datatypes which make up
+--  the to-be-quasiquoted languages AST, make each
+--  type in this collection an instance of at least
+--  @Show@ and @Lift@. Now, assuming @parsePat@ and
+--  @parseExp@, both of type @String -> Q a@ (where @a@
+--  is the top level type of the AST), are the pair of
+--  functions you wish to use for parsing in pattern and
+--  expression context respectively, put them inside
+--  a @Quoter@ datatype and pass this to quasify.
+data Quoter a = Quoter
+  { expQ :: (Lift a) => String -> Q a
+  , patQ :: (Show a) => String -> Q a }
+
+quasify :: (Show a, Lift a) => Quoter a -> QuasiQuoter
+quasify q = QuasiQuoter
+              (toExpQ (expQ q))
+              (toPatQ (patQ q))
+
+toExpQ :: (Lift a) => (String -> Q a) -> (String -> ExpQ)
+toExpQ parseQ = (lift =<<) . parseQ
+
+toPatQ :: (Show a) => (String -> Q a) -> (String -> PatQ)
+toPatQ parseQ = (showToPatQ =<<) . parseQ
+
+showToPatQ :: (Show a) => a -> PatQ
+showToPatQ = either fail return . parsePat . show
+
+-----------------------------------------------------------------------------
+
+eitherQ :: (e -> String) -> Either e a -> Q a
+eitherQ toStr = either (fail . toStr) return
+
+-----------------------------------------------------------------------------
+
+
+
+
+normalizeT :: (Data a) => a -> a
+normalizeT = everywhere (mkT go)
+  where go :: Type -> Type
+        go (ConT n) | n == ''[] = ListT
+        go (AppT (TupleT 1) t) = t
+        go (ConT n) | n == ''(,) = TupleT 2
+        go (ConT n) | n == ''(,,) = TupleT 3
+        go (ConT n) | n == ''(,,,) = TupleT 4
+        go (ConT n) | n == ''(,,,,) = TupleT 5
+        go (ConT n) | n == ''(,,,,,) = TupleT 6
+        go (ConT n) | n == ''(,,,,,,) = TupleT 7
+        go (ConT n) | n == ''(,,,,,,,) = TupleT 8
+        go (ConT n) | n == ''(,,,,,,,,) = TupleT 9
+        go (ConT n) | n == ''(,,,,,,,,,) = TupleT 10
+        go (ConT n) | n == ''(,,,,,,,,,,) = TupleT 11
+        go (ConT n) | n == ''(,,,,,,,,,,,) = TupleT 12
+        go (ConT n) | n == ''(,,,,,,,,,,,,) = TupleT 13
+        go (ConT n) | n == ''(,,,,,,,,,,,,,) = TupleT 14
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,) = TupleT 15
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,) = TupleT 16
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,) = TupleT 17
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,) = TupleT 18
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,) = TupleT 19
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,) = TupleT 20
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,) = TupleT 21
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,) = TupleT 22
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,) = TupleT 23
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 24
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 25
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 26
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 27
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 28
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 29
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 30
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 31
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 32
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 33
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 34
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 35
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 36
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 37
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 38
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 39
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 40
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 41
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 42
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 43
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 44
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 45
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 46
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 47
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 48
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 49
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 50
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 51
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 52
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 53
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 54
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 55
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 56
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 57
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 58
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 59
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 60
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 61
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 62
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 63
+        go (ConT n) | n == ''(,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) = TupleT 64
+        go t = t
+
+
+
+-----------------------------------------------------------------------------
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/Language/Haskell/TH/Instances/Lift.hs b/src/Language/Haskell/TH/Instances/Lift.hs
new file mode 100644
--- /dev/null
+++ b/src/Language/Haskell/TH/Instances/Lift.hs
@@ -0,0 +1,1024 @@
+{-# LANGUAGE TemplateHaskell, CPP, MagicHash, TypeSynonymInstances #-}
+
+{- |
+  Module      :  Language.Haskell.TH.Instances.Lift
+  Copyright   :  (c) Matt Morrow 2008
+  License     :  BSD3
+  Maintainer  :  Matt Morrow <mjm2002@gmail.com>
+  Stability   :  experimental
+  Portability :  portable (template-haskell)
+-}
+
+module Language.Haskell.TH.Instances.Lift () where
+
+import Language.Haskell.TH.Syntax.Internals
+import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Ppr
+import Data.List(intercalate)
+import GHC.Prim
+import GHC.Exts
+
+deriving instance Ord Exp
+deriving instance Ord Dec
+deriving instance Ord Stmt
+deriving instance Ord Type
+deriving instance Ord Foreign
+deriving instance Ord FunDep
+deriving instance Ord Con
+deriving instance Ord Body
+deriving instance Ord Clause
+deriving instance Ord Strict
+deriving instance Ord Safety
+deriving instance Ord Callconv
+deriving instance Ord Guard
+deriving instance Ord Range
+deriving instance Ord Match
+deriving instance Ord Pat
+deriving instance Ord Lit
+deriving instance Ord Kind
+deriving instance Ord FamFlavour
+deriving instance Ord Pragma
+deriving instance Ord TyVarBndr
+deriving instance Ord Pred
+deriving instance Ord InlineSpec
+
+
+
+instance Lift () where
+  lift () = [|()|]
+
+instance Show Loc where
+  show (Loc f p m s e) =
+    intercalate " " $
+      ("Loc":fmap show [f,p,m]++[show s,show e])
+
+instance Eq Loc where
+  (Loc a b c d e) == (Loc v w x y z)
+    = and $ [d==y,e==z] ++
+        (zipWith (==) [a,b,c] [v,w,x])
+
+-- TODO: make this better
+instance Ppr Loc where
+  ppr = showtextl . show
+
+
+instance Ppr Lit where
+  ppr l = ppr (LitE l)
+
+-- comic relief from HERA
+instance Lift Rational where lift _ = error "Rational.. what are you doing!"
+
+instance Lift Name where
+  lift (Name occName nameFlavour) = [| Name occName nameFlavour |]
+
+
+
+instance Lift ModName where
+  lift (ModName s) = [|ModName s|]
+instance Lift PkgName where
+  lift (PkgName s) = [|PkgName s|]
+instance Lift OccName where
+  lift (OccName s) = [|OccName s|]
+
+
+
+
+instance Lift Pragma where
+  lift (InlineP a b) = [|InlineP a b|]
+  lift (SpecialiseP a b c) = [|SpecialiseP a b c|]
+
+
+instance Lift InlineSpec where
+  lift (InlineSpec a b c) = [|InlineSpec a b c|]
+
+instance Lift Pred where
+  lift (ClassP a b) = [|ClassP a b|]
+  lift (EqualP a b) = [|EqualP a b|]
+
+
+
+
+instance Lift TyVarBndr where
+  lift (PlainTV a) = [|PlainTV a|]
+  lift (KindedTV a b) = [|KindedTV a b|]
+
+instance Lift Kind where
+  lift StarK = [|StarK|]
+  lift (ArrowK a b) = [|ArrowK a b|]
+
+
+
+instance Lift FamFlavour where
+  lift TypeFam = [|TypeFam|]
+  lift DataFam = [|DataFam|]
+
+
+
+instance Lift NameFlavour where
+  lift NameS = [| NameS |]
+  lift (NameQ modName) = [| NameQ modName |]
+  lift (NameU i) = [| case $( lift (I# i) ) of
+                          I# i' -> NameU i' |]
+  lift (NameL i) = [| case $( lift (I# i) ) of
+                          I# i' -> NameL i' |]
+  lift (NameG nameSpace pkgName modName)
+    = [| NameG nameSpace pkgName modName |]
+
+instance Lift NameSpace where
+  lift VarName = [| VarName |]
+  lift DataName = [| DataName |]
+  lift TcClsName = [| TcClsName |]
+
+
+instance Lift Dec where
+        lift (FunD x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "FunD")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (ValD x0 x1 x2)
+          = appE
+              (appE
+                 (appE
+                    (conE
+                       (Name (OccName "ValD")
+                          (NameG DataName (PkgName "template-haskell")
+                             (ModName "Language.Haskell.TH.Syntax"))))
+                    (lift x0))
+                 (lift x1))
+              (lift x2)
+        lift (DataD x0 x1 x2 x3 x4)
+          = appE
+              (appE
+                 (appE
+                    (appE
+                       (appE
+                          (conE
+                             (Name (OccName "DataD")
+                                (NameG DataName (PkgName "template-haskell")
+                                   (ModName "Language.Haskell.TH.Syntax"))))
+                          (lift x0))
+                       (lift x1))
+                    (lift x2))
+                 (lift x3))
+              (lift x4)
+        lift (NewtypeD x0 x1 x2 x3 x4)
+          = appE
+              (appE
+                 (appE
+                    (appE
+                       (appE
+                          (conE
+                             (Name (OccName "NewtypeD")
+                                (NameG DataName (PkgName "template-haskell")
+                                   (ModName "Language.Haskell.TH.Syntax"))))
+                          (lift x0))
+                       (lift x1))
+                    (lift x2))
+                 (lift x3))
+              (lift x4)
+        lift (TySynD x0 x1 x2)
+          = appE
+              (appE
+                 (appE
+                    (conE
+                       (Name (OccName "TySynD")
+                          (NameG DataName (PkgName "template-haskell")
+                             (ModName "Language.Haskell.TH.Syntax"))))
+                    (lift x0))
+                 (lift x1))
+              (lift x2)
+        lift (ClassD x0 x1 x2 x3 x4)
+          = appE
+              (appE
+                 (appE
+                    (appE
+                       (appE
+                          (conE
+                             (Name (OccName "ClassD")
+                                (NameG DataName (PkgName "template-haskell")
+                                   (ModName "Language.Haskell.TH.Syntax"))))
+                          (lift x0))
+                       (lift x1))
+                    (lift x2))
+                 (lift x3))
+              (lift x4)
+        lift (InstanceD x0 x1 x2)
+          = appE
+              (appE
+                 (appE
+                    (conE
+                       (Name (OccName "InstanceD")
+                          (NameG DataName (PkgName "template-haskell")
+                             (ModName "Language.Haskell.TH.Syntax"))))
+                    (lift x0))
+                 (lift x1))
+              (lift x2)
+        lift (SigD x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "SigD")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (ForeignD x0)
+          = appE
+              (conE
+                 (Name (OccName "ForeignD")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (PragmaD x0)
+          = appE
+              (conE
+                 (Name (OccName "PragmaD")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (FamilyD x0 x1 x2 x3)
+          = appE
+                (appE
+                  (appE
+                      (appE
+                        (conE
+                            (Name (OccName "FamilyD")
+                              (NameG DataName (PkgName "template-haskell")
+                                  (ModName "Language.Haskell.TH.Syntax"))))
+                        (lift x0))
+                      (lift x1))
+                  (lift x2))
+                (lift x3)
+        lift (DataInstD x0 x1 x2 x3 x4)
+          = appE
+              (appE
+                 (appE
+                    (appE
+                       (appE
+                          (conE
+                             (Name (OccName "DataInstD")
+                                (NameG DataName (PkgName "template-haskell")
+                                   (ModName "Language.Haskell.TH.Syntax"))))
+                          (lift x0))
+                       (lift x1))
+                    (lift x2))
+                 (lift x3))
+              (lift x4)
+        lift (NewtypeInstD x0 x1 x2 x3 x4)
+          = appE
+              (appE
+                 (appE
+                    (appE
+                       (appE
+                          (conE
+                             (Name (OccName "NewtypeInstD")
+                                (NameG DataName (PkgName "template-haskell")
+                                   (ModName "Language.Haskell.TH.Syntax"))))
+                          (lift x0))
+                       (lift x1))
+                    (lift x2))
+                 (lift x3))
+              (lift x4)
+        lift (TySynInstD x0 x1 x2)
+          = appE
+              (appE
+                 (appE
+                    (conE
+                       (Name (OccName "TySynInstD")
+                          (NameG DataName (PkgName "template-haskell")
+                             (ModName "Language.Haskell.TH.Syntax"))))
+                    (lift x0))
+                 (lift x1))
+              (lift x2)
+
+
+
+
+
+
+instance Lift Exp where
+        lift (VarE x0)
+          = appE
+              (conE
+                 (Name (OccName "VarE")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (ConE x0)
+          = appE
+              (conE
+                 (Name (OccName "ConE")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (LitE x0)
+          = appE
+              (conE
+                 (Name (OccName "LitE")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (AppE x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "AppE")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (InfixE x0 x1 x2)
+          = appE
+              (appE
+                 (appE
+                    (conE
+                       (Name (OccName "InfixE")
+                          (NameG DataName (PkgName "template-haskell")
+                             (ModName "Language.Haskell.TH.Syntax"))))
+                    (lift x0))
+                 (lift x1))
+              (lift x2)
+        lift (LamE x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "LamE")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (TupE x0)
+          = appE
+              (conE
+                 (Name (OccName "TupE")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (CondE x0 x1 x2)
+          = appE
+              (appE
+                 (appE
+                    (conE
+                       (Name (OccName "CondE")
+                          (NameG DataName (PkgName "template-haskell")
+                             (ModName "Language.Haskell.TH.Syntax"))))
+                    (lift x0))
+                 (lift x1))
+              (lift x2)
+        lift (LetE x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "LetE")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (CaseE x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "CaseE")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (DoE x0)
+          = appE
+              (conE
+                 (Name (OccName "DoE")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (CompE x0)
+          = appE
+              (conE
+                 (Name (OccName "CompE")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (ArithSeqE x0)
+          = appE
+              (conE
+                 (Name (OccName "ArithSeqE")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (ListE x0)
+          = appE
+              (conE
+                 (Name (OccName "ListE")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (SigE x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "SigE")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (RecConE x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "RecConE")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (RecUpdE x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "RecUpdE")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+
+instance Lift Lit where
+        lift (CharL x0)
+          = appE
+              (conE
+                 (Name (OccName "CharL")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (StringL x0)
+          = appE
+              (conE
+                 (Name (OccName "StringL")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (IntegerL x0)
+          = appE
+              (conE
+                 (Name (OccName "IntegerL")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (RationalL x0)
+          = appE
+              (conE
+                 (Name (OccName "RationalL")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (IntPrimL x0)
+          = appE
+              (conE
+                 (Name (OccName "IntPrimL")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 609
+        lift (WordPrimL x0)
+          = appE
+              (conE
+                 (Name (OccName "WordPrimL")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+#endif
+        lift (FloatPrimL x0)
+          = appE
+              (conE
+                 (Name (OccName "FloatPrimL")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (DoublePrimL x0)
+          = appE
+              (conE
+                 (Name (OccName "DoublePrimL")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+
+instance Lift Pat where
+        lift (LitP x0)
+          = appE
+              (conE
+                 (Name (OccName "LitP")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (VarP x0)
+          = appE
+              (conE
+                 (Name (OccName "VarP")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (TupP x0)
+          = appE
+              (conE
+                 (Name (OccName "TupP")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (ConP x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "ConP")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (InfixP x0 x1 x2)
+          = appE
+              (appE
+                 (appE
+                    (conE
+                       (Name (OccName "InfixP")
+                          (NameG DataName (PkgName "template-haskell")
+                             (ModName "Language.Haskell.TH.Syntax"))))
+                    (lift x0))
+                 (lift x1))
+              (lift x2)
+        lift (TildeP x0)
+          = appE
+              (conE
+                 (Name (OccName "TildeP")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (BangP x0)
+          = appE
+              (conE
+                 (Name (OccName "BangP")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (AsP x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "AsP")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (WildP)
+          = conE
+              (Name (OccName "WildP")
+                 (NameG DataName (PkgName "template-haskell")
+                    (ModName "Language.Haskell.TH.Syntax")))
+        lift (RecP x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "RecP")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (ListP x0)
+          = appE
+              (conE
+                 (Name (OccName "ListP")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (SigP x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "SigP")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+
+instance Lift Body where
+        lift (GuardedB x0)
+          = appE
+              (conE
+                 (Name (OccName "GuardedB")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (NormalB x0)
+          = appE
+              (conE
+                 (Name (OccName "NormalB")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+
+instance Lift Con where
+        lift (NormalC x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "NormalC")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (RecC x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "RecC")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (InfixC x0 x1 x2)
+          = appE
+              (appE
+                 (appE
+                    (conE
+                       (Name (OccName "InfixC")
+                          (NameG DataName (PkgName "template-haskell")
+                             (ModName "Language.Haskell.TH.Syntax"))))
+                    (lift x0))
+                 (lift x1))
+              (lift x2)
+        lift (ForallC x0 x1 x2)
+          = appE
+              (appE
+                 (appE
+                    (conE
+                       (Name (OccName "ForallC")
+                          (NameG DataName (PkgName "template-haskell")
+                             (ModName "Language.Haskell.TH.Syntax"))))
+                    (lift x0))
+                 (lift x1))
+              (lift x2)
+
+instance Lift Clause where
+        lift (Clause x0 x1 x2)
+          = appE
+              (appE
+                 (appE
+                    (conE
+                       (Name (OccName "Clause")
+                          (NameG DataName (PkgName "template-haskell")
+                             (ModName "Language.Haskell.TH.Syntax"))))
+                    (lift x0))
+                 (lift x1))
+              (lift x2)
+
+instance Lift Guard where
+        lift (NormalG x0)
+          = appE
+              (conE
+                 (Name (OccName "NormalG")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (PatG x0)
+          = appE
+              (conE
+                 (Name (OccName "PatG")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+
+instance Lift Strict where
+        lift (IsStrict)
+          = conE
+              (Name (OccName "IsStrict")
+                 (NameG DataName (PkgName "template-haskell")
+                    (ModName "Language.Haskell.TH.Syntax")))
+        lift (NotStrict)
+          = conE
+              (Name (OccName "NotStrict")
+                 (NameG DataName (PkgName "template-haskell")
+                    (ModName "Language.Haskell.TH.Syntax")))
+
+instance Lift FunDep where
+        lift (FunDep x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "FunDep")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+
+instance Lift Foreign where
+        lift (ImportF x0 x1 x2 x3 x4)
+          = appE
+              (appE
+                 (appE
+                    (appE
+                       (appE
+                          (conE
+                             (Name (OccName "ImportF")
+                                (NameG DataName (PkgName "template-haskell")
+                                   (ModName "Language.Haskell.TH.Syntax"))))
+                          (lift x0))
+                       (lift x1))
+                    (lift x2))
+                 (lift x3))
+              (lift x4)
+        lift (ExportF x0 x1 x2 x3)
+          = appE
+              (appE
+                 (appE
+                    (appE
+                       (conE
+                          (Name (OccName "ExportF")
+                             (NameG DataName (PkgName "template-haskell")
+                                (ModName "Language.Haskell.TH.Syntax"))))
+                       (lift x0))
+                    (lift x1))
+                 (lift x2))
+              (lift x3)
+
+instance Lift Callconv where
+        lift (CCall)
+          = conE
+              (Name (OccName "CCall")
+                 (NameG DataName (PkgName "template-haskell")
+                    (ModName "Language.Haskell.TH.Syntax")))
+        lift (StdCall)
+          = conE
+              (Name (OccName "StdCall")
+                 (NameG DataName (PkgName "template-haskell")
+                    (ModName "Language.Haskell.TH.Syntax")))
+
+instance Lift Safety where
+        lift (Unsafe)
+          = conE
+              (Name (OccName "Unsafe")
+                 (NameG DataName (PkgName "template-haskell")
+                    (ModName "Language.Haskell.TH.Syntax")))
+        lift (Safe)
+          = conE
+              (Name (OccName "Safe")
+                 (NameG DataName (PkgName "template-haskell")
+                    (ModName "Language.Haskell.TH.Syntax")))
+        lift (Threadsafe)
+          = conE
+              (Name (OccName "Threadsafe")
+                 (NameG DataName (PkgName "template-haskell")
+                    (ModName "Language.Haskell.TH.Syntax")))
+
+instance Lift Match where
+        lift (Match x0 x1 x2)
+          = appE
+              (appE
+                 (appE
+                    (conE
+                       (Name (OccName "Match")
+                          (NameG DataName (PkgName "template-haskell")
+                             (ModName "Language.Haskell.TH.Syntax"))))
+                    (lift x0))
+                 (lift x1))
+              (lift x2)
+
+instance Lift Stmt where
+        lift (BindS x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "BindS")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (LetS x0)
+          = appE
+              (conE
+                 (Name (OccName "LetS")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (NoBindS x0)
+          = appE
+              (conE
+                 (Name (OccName "NoBindS")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (ParS x0)
+          = appE
+              (conE
+                 (Name (OccName "ParS")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+
+instance Lift Range where
+        lift (FromR x0)
+          = appE
+              (conE
+                 (Name (OccName "FromR")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (FromThenR x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "FromThenR")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (FromToR x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "FromToR")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (FromThenToR x0 x1 x2)
+          = appE
+              (appE
+                 (appE
+                    (conE
+                       (Name (OccName "FromThenToR")
+                          (NameG DataName (PkgName "template-haskell")
+                             (ModName "Language.Haskell.TH.Syntax"))))
+                    (lift x0))
+                 (lift x1))
+              (lift x2)
+
+instance Lift Type where
+        lift (ForallT x0 x1 x2)
+          = appE
+              (appE
+                 (appE
+                    (conE
+                       (Name (OccName "ForallT")
+                          (NameG DataName (PkgName "template-haskell")
+                             (ModName "Language.Haskell.TH.Syntax"))))
+                    (lift x0))
+                 (lift x1))
+              (lift x2)
+        lift (VarT x0)
+          = appE
+              (conE
+                 (Name (OccName "VarT")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (ConT x0)
+          = appE
+              (conE
+                 (Name (OccName "ConT")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (TupleT x0)
+          = appE
+              (conE
+                 (Name (OccName "TupleT")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (ArrowT)
+          = conE
+              (Name (OccName "ArrowT")
+                 (NameG DataName (PkgName "template-haskell")
+                    (ModName "Language.Haskell.TH.Syntax")))
+        lift (ListT)
+          = conE
+              (Name (OccName "ListT")
+                 (NameG DataName (PkgName "template-haskell")
+                    (ModName "Language.Haskell.TH.Syntax")))
+        lift (AppT x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "AppT")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+        lift (SigT x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "SigT")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+
+
+
+
+
+
+instance Lift Info where
+        lift (ClassI x0)
+          = appE
+              (conE
+                 (Name (OccName "ClassI")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (ClassOpI x0 x1 x2 x3)
+          = appE
+              (appE
+                 (appE
+                    (appE
+                       (conE
+                          (Name (OccName "ClassOpI")
+                             (NameG DataName (PkgName "template-haskell")
+                                (ModName "Language.Haskell.TH.Syntax"))))
+                       (lift x0))
+                    (lift x1))
+                 (lift x2))
+              (lift x3)
+        lift (TyConI x0)
+          = appE
+              (conE
+                 (Name (OccName "TyConI")
+                    (NameG DataName (PkgName "template-haskell")
+                       (ModName "Language.Haskell.TH.Syntax"))))
+              (lift x0)
+        lift (PrimTyConI x0 x1 x2)
+          = appE
+              (appE
+                 (appE
+                    (conE
+                       (Name (OccName "PrimTyConI")
+                          (NameG DataName (PkgName "template-haskell")
+                             (ModName "Language.Haskell.TH.Syntax"))))
+                    (lift x0))
+                 (lift x1))
+              (lift x2)
+        lift (DataConI x0 x1 x2 x3)
+          = appE
+              (appE
+                 (appE
+                    (appE
+                       (conE
+                          (Name (OccName "DataConI")
+                             (NameG DataName (PkgName "template-haskell")
+                                (ModName "Language.Haskell.TH.Syntax"))))
+                       (lift x0))
+                    (lift x1))
+                 (lift x2))
+              (lift x3)
+        lift (VarI x0 x1 x2 x3)
+          = appE
+              (appE
+                 (appE
+                    (appE
+                       (conE
+                          (Name (OccName "VarI")
+                             (NameG DataName (PkgName "template-haskell")
+                                (ModName "Language.Haskell.TH.Syntax"))))
+                       (lift x0))
+                    (lift x1))
+                 (lift x2))
+              (lift x3)
+        lift (TyVarI x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "TyVarI")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+
+instance Lift Fixity where
+        lift (Fixity x0 x1)
+          = appE
+              (appE
+                 (conE
+                    (Name (OccName "Fixity")
+                       (NameG DataName (PkgName "template-haskell")
+                          (ModName "Language.Haskell.TH.Syntax"))))
+                 (lift x0))
+              (lift x1)
+
+instance Lift FixityDirection where
+        lift (InfixL)
+          = conE
+              (Name (OccName "InfixL")
+                 (NameG DataName (PkgName "template-haskell")
+                    (ModName "Language.Haskell.TH.Syntax")))
+        lift (InfixR)
+          = conE
+              (Name (OccName "InfixR")
+                 (NameG DataName (PkgName "template-haskell")
+                    (ModName "Language.Haskell.TH.Syntax")))
+        lift (InfixN)
+          = conE
+              (Name (OccName "InfixN")
+                 (NameG DataName (PkgName "template-haskell")
+                    (ModName "Language.Haskell.TH.Syntax")))