Commit 9868f91f authored by Chaitanya Koparkar's avatar Chaitanya Koparkar Committed by Ben Gamari

Turn a TH Name for built-in syntax into an unqualified RdrName

Previously, the Renamer would turn any fully qualified Template Haskell
name into a corresponding fully qualified `RdrName`. But this is not
what we want for built-in syntax, as it produces unnecessarily qualified
names (eg. GHC.Types.[], GHC.Tuple.(,) etc.).

Test Plan: ./validate

Reviewers: RyanGlScott, bgamari, goldfire

Reviewed By: RyanGlScott, bgamari

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #13776

Differential Revision: https://phabricator.haskell.org/D4506
parent fbd9b886
......@@ -1625,8 +1625,14 @@ thRdrName loc ctxt_ns th_occ th_name
occ :: OccName.OccName
occ = mk_occ ctxt_ns th_occ
-- Return an unqualified exact RdrName if we're dealing with built-in syntax.
-- See Trac #13776.
thOrigRdrName :: String -> TH.NameSpace -> PkgName -> ModName -> RdrName
thOrigRdrName occ th_ns pkg mod = (mkOrig $! (mkModule (mk_pkg pkg) (mk_mod mod))) $! (mk_occ (mk_ghc_ns th_ns) occ)
thOrigRdrName occ th_ns pkg mod =
let occ' = mk_occ (mk_ghc_ns th_ns) occ
in case isBuiltInOcc_maybe occ' of
Just name -> nameRdrName name
Nothing -> (mkOrig $! (mkModule (mk_pkg pkg) (mk_mod mod))) $! occ'
thRdrNameGuesses :: TH.Name -> [RdrName]
thRdrNameGuesses (TH.Name occ flavour)
......
{-# LANGUAGE TemplateHaskell #-}
module T13776 where
import Language.Haskell.TH
spliceTy1 :: $(conT ''(,) `appT` conT ''Int `appT` conT ''Int)
spliceTy1 = (1,2)
spliceTy2 :: $(conT ''[] `appT` conT ''Int)
spliceTy2 = []
spliceExp1 :: (Int, Int)
spliceExp1 = $(conE '(,) `appE` litE (integerL 1) `appE` litE (integerL 1))
spliceExp2 :: [Int]
spliceExp2 = $(conE '[])
splicePat1 :: (Int, Int) -> ()
splicePat1 $(conP '(,) [litP (integerL 1), litP (integerL 1)]) = ()
splicePat2 :: [Int] -> ()
splicePat2 $(conP '[] []) = ()
T13776.hs:10:16-42: Splicing type
conT ''[] `appT` conT ''Int ======> [] Int
T13776.hs:7:16-61: Splicing type
conT ''(,) `appT` conT ''Int `appT` conT ''Int ======> (,) Int Int
T13776.hs:14:16-74: Splicing expression
conE '(,) `appE` litE (integerL 1) `appE` litE (integerL 1)
======>
((,) 1) 1
T13776.hs:17:16-23: Splicing expression
conE '[] ======> []
T13776.hs:20:14-61: Splicing pattern
conP '(,) [litP (integerL 1), litP (integerL 1)] ======> (,) 1 1
T13776.hs:23:14-24: Splicing pattern
conP '[] [] ======> []
......@@ -4,4 +4,4 @@ T3319.hs:8:3-93: Splicing declarations
(ImportF
CCall Unsafe "&" (mkName "foo") (AppT (ConT ''Ptr) (ConT ''())))]
======>
foreign import ccall unsafe "&" foo :: Ptr GHC.Tuple.()
foreign import ccall unsafe "&" foo :: Ptr ()
......@@ -3,4 +3,4 @@ T5700.hs:8:3-9: Splicing declarations
======>
instance C D where
{-# INLINE inlinable #-}
inlinable _ = GHC.Tuple.()
inlinable _ = ()
......@@ -8,4 +8,4 @@ TH_foreignInterruptible.hs:8:3-100: Splicing declarations
(mkName "foo")
(AppT (ConT ''Ptr) (ConT ''())))]
======>
foreign import ccall interruptible "&" foo :: Ptr GHC.Tuple.()
foreign import ccall interruptible "&" foo :: Ptr ()
......@@ -403,5 +403,6 @@ test('T14838', [], multimod_compile,
['T14838.hs', '-v0 -Wincomplete-patterns ' + config.ghc_th_way_flags])
test('T14817', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T14843', normal, compile, ['-v0'])
test('T13776', normal, compile, ['-ddump-splices -v0'])
test('T14888', normal, compile,
['-v0 -ddump-splices -dsuppress-uniques ' + config.ghc_th_way_flags])
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment