Make unboxedTuple{Type,Data}Name support 0- and 1-tuples

Previously, these functions were hardcoded so as to always `error`
whenever given an argument of 0 or 1. This restriction can be lifted
pretty easily, however.

This requires a slight tweak to `isBuiltInOcc_maybe` in `TysWiredIn` to
allow it to recognize `Unit#` (which is the hard-wired `OccName` for
unboxed 1-tuples).

Fixes #12977.

Test Plan: make test TEST=12977

Reviewers: austin, goldfire, bgamari

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2847

GHC Trac Issues: #12977

5 files changed, 25 insertions, 11 deletions

diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 18cf53093d..6e028fcf34 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -691,6 +691,7 @@ isBuiltInOcc_maybe occ =
 
       -- unboxed tuple data/tycon
       "(##)"  -> Just $ tup_name Unboxed 0
+      "Unit#" -> Just $ tup_name Unboxed 1
       _ | Just rest <- "(#" `stripPrefix` name
         , (commas, rest') <- BS.span (==',') rest
         , "#)" <- rest'
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 4e21e8b841..c9bccf665f 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -1187,20 +1187,17 @@ unboxedTupleDataName :: Int -> Name
 -- | Unboxed tuple type constructor
 unboxedTupleTypeName :: Int -> Name
 
-unboxedTupleDataName 0 = error "unboxedTupleDataName 0"
-unboxedTupleDataName 1 = error "unboxedTupleDataName 1"
-unboxedTupleDataName n = mk_unboxed_tup_name (n-1) DataName
-
-unboxedTupleTypeName 0 = error "unboxedTupleTypeName 0"
-unboxedTupleTypeName 1 = error "unboxedTupleTypeName 1"
-unboxedTupleTypeName n = mk_unboxed_tup_name (n-1) TcClsName
+unboxedTupleDataName n = mk_unboxed_tup_name n DataName
+unboxedTupleTypeName n = mk_unboxed_tup_name n TcClsName
 
 mk_unboxed_tup_name :: Int -> NameSpace -> Name
-mk_unboxed_tup_name n_commas space
-  = Name occ (NameG space (mkPkgName "ghc-prim") tup_mod)
+mk_unboxed_tup_name n space
+  = Name (mkOccName tup_occ) (NameG space (mkPkgName "ghc-prim") tup_mod)
   where
-    occ = mkOccName ("(#" ++ replicate n_commas ',' ++ "#)")
-    tup_mod = mkModName "GHC.Tuple"
+    tup_occ | n == 1    = "Unit#" -- See Note [One-tuples] in TysWiredIn
+            | otherwise = "(#" ++ replicate n_commas ',' ++ "#)"
+    n_commas = n - 1
+    tup_mod  = mkModName "GHC.Tuple"
 
 -----------------------------------------------------
 --              Locations
diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md
index c4b8f034cf..1f41a6a528 100644
--- a/libraries/template-haskell/changelog.md
+++ b/libraries/template-haskell/changelog.md
@@ -16,6 +16,9 @@
   * Add support for attaching deriving strategies to `deriving` statements
     (#10598)
 
+  * `unboxedTupleTypeName` and `unboxedTupleDataName` now work for unboxed
+    0-tuples and 1-tuples (#12977)
+
 ## 2.11.0.0  *May 2016*
 
   * Bundled with GHC 8.0.1
diff --git a/testsuite/tests/th/T12977.hs b/testsuite/tests/th/T12977.hs
new file mode 100644
index 0000000000..69832b89d8
--- /dev/null
+++ b/testsuite/tests/th/T12977.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UnboxedTuples #-}
+module T12977 where
+
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Syntax
+
+zero :: () -> $(conT (unboxedTupleTypeName 0))
+zero () =  $(conE (unboxedTupleDataName 0))
+
+one :: () -> $(conT (unboxedTupleTypeName 1) `appT` conT ''Int)
+one () =  $(conE (unboxedTupleDataName 1)) 42
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index b144419f45..c2c9fa28fd 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -444,3 +444,4 @@ test('T12646', normal, compile, ['-v0'])
 test('T12788', extra_clean(['T12788_Lib.hi', 'T12788_Lib.o']),
                multimod_compile_fail,
                ['T12788.hs', '-v0 ' + config.ghc_th_way_flags])
+test('T12977', normal, compile, ['-v0'])