summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2022-06-20 14:43:57 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-06-28 19:02:41 -0400
commit251471e7706ea3029b4a0c086035c16e7b67a081 (patch)
tree2a561e2a2efa544b7535c12ed71b62c536ba3fa1
parenteecab8f9847ebf576fbe2f6a2b9564c25a0230e0 (diff)
downloadhaskell-251471e7706ea3029b4a0c086035c16e7b67a081.tar.gz
Cleanup BuiltInSyntax vs UserSyntax
There was some confusion about whether FUN/TYPE/One/Many should be BuiltInSyntax or UserSyntax. The answer is certainly UserSyntax as BuiltInSyntax is for things which are directly constructed by the parser rather than going through normal renaming channels. I fixed all the obviously wrong places I could find and added a test for the original bug which was caused by this (#21752) Fixes #21752 #20695 #18302
-rw-r--r--compiler/GHC/Builtin/Names.hs5
-rw-r--r--compiler/GHC/Builtin/Types.hs10
-rw-r--r--compiler/GHC/Builtin/Types/Prim.hs11
-rw-r--r--compiler/GHC/Types/Name/Ppr.hs7
-rw-r--r--libraries/base/Data/Typeable/Internal.hs2
-rw-r--r--libraries/base/GHC/Exception.hs1
-rwxr-xr-xlibraries/base/GHC/Exts.hs4
-rw-r--r--libraries/base/Unsafe/Coerce.hs2
-rw-r--r--testsuite/tests/module/T21752.hs12
-rw-r--r--testsuite/tests/module/T21752A.hs14
-rw-r--r--testsuite/tests/module/all.T2
-rw-r--r--testsuite/tests/rename/should_compile/T18302A.hs4
-rw-r--r--testsuite/tests/rename/should_compile/T18302B.hs8
-rw-r--r--testsuite/tests/rename/should_compile/all.T1
-rw-r--r--testsuite/tests/simplCore/should_compile/T4201.stdout6
-rw-r--r--testsuite/tests/typecheck/should_compile/holes.stderr2
-rw-r--r--testsuite/tests/typecheck/should_compile/holes3.stderr2
17 files changed, 45 insertions, 48 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index 6050ceac0d..dba466aa8d 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -2783,4 +2783,7 @@ pretendNameIsInScope n
, tYPETyConKey
, runtimeRepTyConKey, boxedRepDataConKey
, eqTyConKey
- , listTyConKey ]
+ , listTyConKey
+ , oneDataConKey
+ , manyDataConKey
+ , funTyConKey ]
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs
index 148b9aa1ca..9410100737 100644
--- a/compiler/GHC/Builtin/Types.hs
+++ b/compiler/GHC/Builtin/Types.hs
@@ -527,14 +527,8 @@ multiplicityTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Multipli
multiplicityTyConKey multiplicityTyCon
oneDataConName, manyDataConName :: Name
-oneDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "One") oneDataConKey oneDataCon
-manyDataConName = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "Many") manyDataConKey manyDataCon
- -- It feels wrong to have One and Many be BuiltInSyntax. But otherwise,
- -- `Many`, in particular, is considered out of scope unless an appropriate
- -- file is open. The problem with this is that `Many` appears implicitly in
- -- types every time there is an `(->)`, hence out-of-scope errors get
- -- reported. Making them built-in make it so that they are always considered in
- -- scope.
+oneDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "One") oneDataConKey oneDataCon
+manyDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Many") manyDataConKey manyDataCon
runtimeRepTyConName, vecRepDataConName, tupleRepDataConName, sumRepDataConName, boxedRepDataConName :: Name
runtimeRepTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "RuntimeRep") runtimeRepTyConKey runtimeRepTyCon
diff --git a/compiler/GHC/Builtin/Types/Prim.hs b/compiler/GHC/Builtin/Types/Prim.hs
index e4d812a203..2eec67613d 100644
--- a/compiler/GHC/Builtin/Types/Prim.hs
+++ b/compiler/GHC/Builtin/Types/Prim.hs
@@ -11,8 +11,6 @@ Wired-in knowledge about primitive types
-- | This module defines TyCons that can't be expressed in Haskell.
-- They are all, therefore, wired-in TyCons. C.f module "GHC.Builtin.Types"
module GHC.Builtin.Types.Prim(
- mkPrimTyConName, -- For implicit parameters in GHC.Builtin.Types only
-
mkTemplateKindVar, mkTemplateKindVars,
mkTemplateTyVars, mkTemplateTyVarsFrom,
mkTemplateKiTyVars, mkTemplateKiTyVar,
@@ -471,7 +469,7 @@ multiplicityTyVar1, multiplicityTyVar2 :: TyVar
-}
funTyConName :: Name
-funTyConName = mkPrimTyConName (fsLit "FUN") funTyConKey funTyCon
+funTyConName = mkPrimTcName UserSyntax (fsLit "FUN") funTyConKey funTyCon
-- | The @FUN@ type constructor.
--
@@ -584,12 +582,7 @@ tYPETyCon = mkPrimTyCon tYPETyConName
-- If you edit these, you may need to update the GHC formalism
-- See Note [GHC Formalism] in GHC.Core.Lint
-tYPETyConName = mkPrimTyConName (fsLit "TYPE") tYPETyConKey tYPETyCon
-
-mkPrimTyConName :: FastString -> Unique -> TyCon -> Name
-mkPrimTyConName = mkPrimTcName BuiltInSyntax
- -- All of the super kinds and kinds are defined in Prim,
- -- and use BuiltInSyntax, because they are never in scope in the source
+tYPETyConName = mkPrimTcName UserSyntax (fsLit "TYPE") tYPETyConKey tYPETyCon
mkPrimTcName :: BuiltInSyntax -> FastString -> Unique -> TyCon -> Name
mkPrimTcName built_in_syntax occ key tycon
diff --git a/compiler/GHC/Types/Name/Ppr.hs b/compiler/GHC/Types/Name/Ppr.hs
index 27eb17afed..1d3bf36aba 100644
--- a/compiler/GHC/Types/Name/Ppr.hs
+++ b/compiler/GHC/Types/Name/Ppr.hs
@@ -21,6 +21,7 @@ import GHC.Builtin.Types
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Misc
+import GHC.Builtin.Types.Prim (tYPETyConName, funTyConName)
{-
@@ -109,7 +110,11 @@ mkPrintUnqualified unit_env env
, constraintKindTyConName
, heqTyConName
, coercibleTyConName
- , eqTyConName ]
+ , eqTyConName
+ , tYPETyConName
+ , funTyConName
+ , oneDataConName
+ , manyDataConName ]
right_name gre = greDefinitionModule gre == Just mod
diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs
index 2d2f735351..69530c911d 100644
--- a/libraries/base/Data/Typeable/Internal.hs
+++ b/libraries/base/Data/Typeable/Internal.hs
@@ -86,10 +86,8 @@ module Data.Typeable.Internal (
trLiftedRep
) where
-import GHC.Prim ( FUN )
import GHC.Base
import qualified GHC.Arr as A
-import GHC.Types ( TYPE, Multiplicity (Many) )
import Data.Type.Equality
import GHC.List ( splitAt, foldl', elem )
import GHC.Word
diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs
index 1a3b039416..66982b0043 100644
--- a/libraries/base/GHC/Exception.hs
+++ b/libraries/base/GHC/Exception.hs
@@ -38,7 +38,6 @@ import GHC.Base
import GHC.Show
import GHC.Stack.Types
import GHC.OldList
-import GHC.Prim
import GHC.IO.Unsafe
import {-# SOURCE #-} GHC.Stack.CCS
import GHC.Exception.Type
diff --git a/libraries/base/GHC/Exts.hs b/libraries/base/GHC/Exts.hs
index 662bea8964..f5b2498542 100755
--- a/libraries/base/GHC/Exts.hs
+++ b/libraries/base/GHC/Exts.hs
@@ -25,10 +25,6 @@
module GHC.Exts
(
- -- * Primitive types
-
- FUN, TYPE, -- See https://gitlab.haskell.org/ghc/ghc/issues/18302
-
-- ** Pointer types
Ptr(..), FunPtr(..),
diff --git a/libraries/base/Unsafe/Coerce.hs b/libraries/base/Unsafe/Coerce.hs
index fd45217fef..76c010a0bf 100644
--- a/libraries/base/Unsafe/Coerce.hs
+++ b/libraries/base/Unsafe/Coerce.hs
@@ -22,8 +22,6 @@ module Unsafe.Coerce
import GHC.Arr (amap) -- For amap/unsafeCoerce rule
import GHC.Base
-import GHC.Types
-
{- Note [Implementing unsafeCoerce]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The implementation of unsafeCoerce is surprisingly subtle.
diff --git a/testsuite/tests/module/T21752.hs b/testsuite/tests/module/T21752.hs
new file mode 100644
index 0000000000..72fad0b26a
--- /dev/null
+++ b/testsuite/tests/module/T21752.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE DataKinds #-}
+module T21752 where
+
+import T21752A
+
+type T = TYPE
+
+type F m a b = FUN m a b
+
+type M = Many
+
+type O = One
diff --git a/testsuite/tests/module/T21752A.hs b/testsuite/tests/module/T21752A.hs
new file mode 100644
index 0000000000..2c4771a112
--- /dev/null
+++ b/testsuite/tests/module/T21752A.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE DataKinds #-}
+module T21752A (
+ module GHC.Exts
+) where
+
+import GHC.Exts
+
+type T = TYPE
+
+type O = One
+type M = Many
+
+--type F = FUN
diff --git a/testsuite/tests/module/all.T b/testsuite/tests/module/all.T
index 212d9ecbb7..415f40717e 100644
--- a/testsuite/tests/module/all.T
+++ b/testsuite/tests/module/all.T
@@ -293,3 +293,5 @@ test('T13622', normal, compile, [''])
test('T13704a', normal, compile, ['-main-is Main.program'])
test('T13704b', [], multimod_compile, ['T13704b1.hs T13704b2.hs', '-main-is T13704b2.program -v0'])
test('T20562', normal, compile, [''])
+
+test('T21752', [extra_files(['T21752A.hs', 'T21752.hs'])], multimod_compile, ['T21752', '-v0'])
diff --git a/testsuite/tests/rename/should_compile/T18302A.hs b/testsuite/tests/rename/should_compile/T18302A.hs
deleted file mode 100644
index 7df51aa3ea..0000000000
--- a/testsuite/tests/rename/should_compile/T18302A.hs
+++ /dev/null
@@ -1,4 +0,0 @@
-module T18302A ( module GHC.Prim ) where
-
-import GHC.Prim
-
diff --git a/testsuite/tests/rename/should_compile/T18302B.hs b/testsuite/tests/rename/should_compile/T18302B.hs
deleted file mode 100644
index 6c8075fa9f..0000000000
--- a/testsuite/tests/rename/should_compile/T18302B.hs
+++ /dev/null
@@ -1,8 +0,0 @@
--- | Check that TYPE and (->) are re-exportable.
-module T18302B where
-
-import T18302A
-
-type T = TYPE
-type F = (->)
-
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index ac660606ab..1c02db6e6e 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -176,7 +176,6 @@ test('T17832', [], multimod_compile, ['T17832M1', 'T17832M2'])
test('T17837', normal, compile, [''])
test('T18497', [], makefile_test, ['T18497'])
test('T18264', [], makefile_test, ['T18264'])
-test('T18302', expect_broken(18302), compile, [''])
test('T17853', [], multimod_compile, ['T17853', '-v0'])
test('T19966', expect_broken(19966), compile, ['-fdefer-out-of-scope-variables'])
test('T20472', normal, compile, [''])
diff --git a/testsuite/tests/simplCore/should_compile/T4201.stdout b/testsuite/tests/simplCore/should_compile/T4201.stdout
index baeee0b0af..920ae57662 100644
--- a/testsuite/tests/simplCore/should_compile/T4201.stdout
+++ b/testsuite/tests/simplCore/should_compile/T4201.stdout
@@ -1,4 +1,4 @@
- lift :: Foo -> T
- [HasNoCafRefs, TagSig: <TagProper>, LambdaFormInfo: LFReEntrant 1,
Arity: 1, Strictness: <1!A>, CPR: 1,
- Unfolding: (bof `cast` (Sym (N:Foo[0]) %<'Many>_N ->_R <T>_R))]
+ Unfolding: (bof
+ `cast`
+ (Sym (N:Foo[0]) %<'GHC.Types.Many>_N ->_R <T>_R))]
diff --git a/testsuite/tests/typecheck/should_compile/holes.stderr b/testsuite/tests/typecheck/should_compile/holes.stderr
index cde126e969..dd5c497db2 100644
--- a/testsuite/tests/typecheck/should_compile/holes.stderr
+++ b/testsuite/tests/typecheck/should_compile/holes.stderr
@@ -52,8 +52,6 @@ holes.hs:11:15: warning: [-Wtyped-holes (in -Wdefault)]
LT :: Ordering
EQ :: Ordering
GT :: Ordering
- One :: GHC.Types.Multiplicity
- Many :: GHC.Types.Multiplicity
() :: ()
lines :: String -> [String]
unlines :: [String] -> String
diff --git a/testsuite/tests/typecheck/should_compile/holes3.stderr b/testsuite/tests/typecheck/should_compile/holes3.stderr
index 4dec2c57a5..c14e9e7b5c 100644
--- a/testsuite/tests/typecheck/should_compile/holes3.stderr
+++ b/testsuite/tests/typecheck/should_compile/holes3.stderr
@@ -55,8 +55,6 @@ holes3.hs:11:15: error:
LT :: Ordering
EQ :: Ordering
GT :: Ordering
- One :: GHC.Types.Multiplicity
- Many :: GHC.Types.Multiplicity
() :: ()
lines :: String -> [String]
unlines :: [String] -> String