diff --git a/CHANGES.md b/CHANGES.md
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,10 @@
+Version 1.5.1
+-------------
+* Thanks to David Fox (@ddssff), sweetening now tries to use more of TH's `Type`
+constructors.
+
+* Also thanks to David Fox, depend usefully on the th-orphans package.
+
 Version 1.5
 -----------
 * There is now a facility to register a list of `Dec` that internal reification
diff --git a/Language/Haskell/TH/Desugar/Core.hs b/Language/Haskell/TH/Desugar/Core.hs
--- a/Language/Haskell/TH/Desugar/Core.hs
+++ b/Language/Haskell/TH/Desugar/Core.hs
@@ -16,7 +16,9 @@
 import Language.Haskell.TH hiding (match, clause, cxt)
 import Language.Haskell.TH.Syntax hiding (lift)
 
+#if __GLASGOW_HASKELL__ < 709
 import Control.Applicative
+#endif
 import Control.Monad hiding (mapM)
 import Control.Monad.Zip
 import Control.Monad.Writer hiding (mapM)
diff --git a/Language/Haskell/TH/Desugar/Expand.hs b/Language/Haskell/TH/Desugar/Expand.hs
--- a/Language/Haskell/TH/Desugar/Expand.hs
+++ b/Language/Haskell/TH/Desugar/Expand.hs
@@ -28,7 +28,9 @@
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Control.Monad
+#if __GLASGOW_HASKELL__ < 709
 import Control.Applicative
+#endif
 import Language.Haskell.TH hiding (cxt)
 import Language.Haskell.TH.Syntax ( Quasi(..) )
 import Data.Data
@@ -42,7 +44,9 @@
 import Language.Haskell.TH.Desugar.Reify
 
 -- | Expands all type synonyms in a desugared type. Also expands open type family
--- applications, as long as the arguments have no free variables.
+-- applications, as long as the arguments have no free variables. Attempts to
+-- expand closed type family applications, but aborts the moment it spots anything
+-- strange, like a nested type family application or type variable.
 expandType :: DsMonad q => DType -> q DType
 expandType = go []
   where
diff --git a/Language/Haskell/TH/Desugar/Lift.hs b/Language/Haskell/TH/Desugar/Lift.hs
--- a/Language/Haskell/TH/Desugar/Lift.hs
+++ b/Language/Haskell/TH/Desugar/Lift.hs
@@ -20,23 +20,14 @@
 module Language.Haskell.TH.Desugar.Lift () where
 
 import Language.Haskell.TH.Desugar
+import Language.Haskell.TH.Instances ()
 import Language.Haskell.TH.Lift
-import Language.Haskell.TH
-#if __GLASGOW_HASKELL__ <= 708
-import Data.Word
-#endif
 
 $(deriveLiftMany [ ''DExp, ''DPat, ''DType, ''DKind, ''DPred, ''DTyVarBndr
                  , ''DMatch, ''DClause, ''DLetDec, ''DDec, ''DCon
                  , ''DConFields, ''DForeign, ''DPragma, ''DRuleBndr, ''DTySynEqn
                  , ''NewOrData
-                 , ''Lit, ''TyLit, ''Fixity, ''FixityDirection, ''Strict
-                 , ''Callconv, ''Safety, ''Inline, ''RuleMatch, ''Phases
-                 , ''AnnTarget, ''FunDep, ''FamFlavour, ''Role ])
-
-#if __GLASGOW_HASKELL__ <= 708
--- Other type liftings:
-                                      
-instance Lift Word8 where
-  lift word = return $ (VarE 'fromInteger) `AppE` (LitE $ IntegerL (toInteger word))
+#if __GLASGOW_HASKELL__ < 707
+                 , ''AnnTarget, ''Role
 #endif
+                 ])
diff --git a/Language/Haskell/TH/Desugar/Match.hs b/Language/Haskell/TH/Desugar/Match.hs
--- a/Language/Haskell/TH/Desugar/Match.hs
+++ b/Language/Haskell/TH/Desugar/Match.hs
@@ -20,10 +20,13 @@
 
 import Prelude hiding ( fail, exp )
 
+#if __GLASGOW_HASKELL__ < 709
 import Control.Applicative
+#endif
 import Control.Monad hiding ( fail )
 import qualified Data.Set as S
 import qualified Data.Map as Map
+import Language.Haskell.TH.Instances ()
 import Language.Haskell.TH.Syntax
 
 import Language.Haskell.TH.Desugar.Core
@@ -112,10 +115,6 @@
         PgAny   -> matchVariables vars (drop_group eqns)
 
     drop_group = map snd
-
-#if __GLASGOW_HASKELL__ <= 708
-deriving instance Ord Lit   -- ew. necessary for `subGroup`
-#endif
 
 -- analogous to GHC's tidyEqnInfo
 tidyClause :: DsMonad q => Name -> EquationInfo -> q (DExp -> DExp, EquationInfo)
diff --git a/Language/Haskell/TH/Desugar/Sweeten.hs b/Language/Haskell/TH/Desugar/Sweeten.hs
--- a/Language/Haskell/TH/Desugar/Sweeten.hs
+++ b/Language/Haskell/TH/Desugar/Sweeten.hs
@@ -7,6 +7,7 @@
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -173,7 +174,18 @@
 typeToTH (DAppT t1 t2)          = AppT (typeToTH t1) (typeToTH t2)
 typeToTH (DSigT ty ki)          = SigT (typeToTH ty) (kindToTH ki)
 typeToTH (DVarT n)              = VarT n
-typeToTH (DConT n)              = ConT n
+typeToTH (DConT n)
+  | n == ''[]                   = ListT
+#if __GLASGOW_HASKELL__ >= 709
+  | n == ''(~)                  = EqualityT
+#endif
+  | n == '[]                    = PromotedNilT
+  | n == '(:)                   = PromotedConsT
+  | Just deg <- tupleNameDegree_maybe n        = if isDataName n
+                                                 then PromotedTupleT deg
+                                                 else TupleT deg
+  | Just deg <- unboxedTupleNameDegree_maybe n = UnboxedTupleT deg
+  | otherwise                   = ConT n
 typeToTH DArrowT                = ArrowT
 typeToTH (DLitT lit)            = LitT lit
 
@@ -202,7 +214,7 @@
 predToTH (DAppPr p t) = AppT (predToTH p) (typeToTH t)
 predToTH (DSigPr p k) = SigT (predToTH p) (kindToTH k)
 predToTH (DVarPr n)   = VarT n
-predToTH (DConPr n)   = ConT n
+predToTH (DConPr n)   = typeToTH (DConT n)
 #endif
 
 kindToTH :: DKind -> Kind
diff --git a/Language/Haskell/TH/Desugar/Util.hs b/Language/Haskell/TH/Desugar/Util.hs
--- a/Language/Haskell/TH/Desugar/Util.hs
+++ b/Language/Haskell/TH/Desugar/Util.hs
@@ -11,7 +11,7 @@
 module Language.Haskell.TH.Desugar.Util (
   newUniqueName,
   impossible, 
-  nameOccursIn, allNamesIn, mkTypeName, mkDataName,
+  nameOccursIn, allNamesIn, mkTypeName, mkDataName, isDataName,
   stripVarP_maybe, extractBoundNamesStmt,
   concatMapM, mapMaybeM, expectJustM,
   liftSndM, liftThdOf3M, stripPlainTV_maybe,
@@ -67,6 +67,11 @@
     Nothing -> do
       Loc { loc_package = pkg, loc_module = modu } <- qLocation
       return $ mkNameG_d pkg modu str
+
+-- | Is this name a data constructor name? A 'False' answer means "unsure".
+isDataName :: Name -> Bool
+isDataName (Name _ (NameG DataName _ _)) = True
+isDataName _                             = False
 
 -- | Extracts the name out of a variable pattern, or returns @Nothing@
 stripVarP_maybe :: Pat -> Maybe Name
diff --git a/Test/Run.hs b/Test/Run.hs
--- a/Test/Run.hs
+++ b/Test/Run.hs
@@ -29,7 +29,9 @@
 import qualified Language.Haskell.TH.Syntax as Syn ( lift )
 
 import Control.Monad
+#if __GLASGOW_HASKELL__ < 709
 import Control.Applicative
+#endif
 
 #if __GLASGOW_HASKELL__ >= 707
 import Data.Proxy
@@ -234,6 +236,13 @@
     it "extracts record selectors" $ test_rec_sels
 
     it "works with standalone deriving" $ test_standalone_deriving
+
+    -- Remove map pprints here after switch to th-orphans
+    zipWithM (\t t' -> it ("can do Type->DType->Type of " ++ t) $ t == t')
+             $(sequence round_trip_types >>= Syn.lift . map pprint)
+             $(sequence round_trip_types >>=
+               mapM (\ t -> withLocalDeclarations [] (dsType t >>= expandType >>= return . typeToTH)) >>=
+              Syn.lift . map pprint)
 
     zipWith3M (\a b n -> it ("reifies local definition " ++ show n) $ a == b)
       local_reifications normal_reifications [1..]
diff --git a/Test/Splices.hs b/Test/Splices.hs
--- a/Test/Splices.hs
+++ b/Test/Splices.hs
@@ -362,4 +362,10 @@
   , [| let foo [] = True
            foo _  = False in (foo [], foo "hi") |]
   ]
-                             
+
+-- These foralls are needed because of bug trac9262, fixed in ghc-7.10.
+round_trip_types :: [TypeQ]
+round_trip_types =
+    [ [t|forall a. a ~ Int => a|]
+    , [t|forall a. [a]|]
+    , [t|forall a b. (a,b)|] ]
diff --git a/th-desugar.cabal b/th-desugar.cabal
--- a/th-desugar.cabal
+++ b/th-desugar.cabal
@@ -1,5 +1,5 @@
 name:           th-desugar
-version:        1.5
+version:        1.5.1
 cabal-version:  >= 1.10
 synopsis:       Functions to desugar Template Haskell
 homepage:       http://www.cis.upenn.edu/~eir/packages/th-desugar
@@ -26,7 +26,7 @@
 source-repository this
   type:     git
   location: https://github.com/goldfirere/th-desugar.git
-  tag:      v1.5
+  tag:      v1.5.1
 
 library
   build-depends:      
@@ -35,7 +35,8 @@
       containers >= 0.5,
       mtl >= 2.1,
       syb >= 0.4,
-      th-lift >= 0.6.1
+      th-lift >= 0.6.1,
+      th-orphans >= 0.9.1
   default-extensions: TemplateHaskell
   exposed-modules:    Language.Haskell.TH.Desugar,
                       Language.Haskell.TH.Desugar.Sweeten,
@@ -65,4 +66,5 @@
       syb >= 0.4,
       HUnit >= 1.2,
       hspec >= 1.3,
-      th-lift >= 0.6.1
+      th-lift >= 0.6.1,
+      th-orphans >= 0.9.1