diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs
index 61ab1a927748cf82874dafea51ee785f72050cb4..bc90dafa98ec23752589a6260833a5a881e1cd64 100644
--- a/compiler/basicTypes/RdrName.hs
+++ b/compiler/basicTypes/RdrName.hs
@@ -112,7 +112,7 @@ import Data.List( sortBy, foldl', nub )
 --           'ApiAnnotation.AnnOpen'  @'('@ or @'['@ or @'[:'@,
 --           'ApiAnnotation.AnnClose' @')'@ or @']'@ or @':]'@,,
 --           'ApiAnnotation.AnnBackquote' @'`'@,
---           'ApiAnnotation.AnnVal','ApiAnnotation.AnnTildehsh',
+--           'ApiAnnotation.AnnVal'
 --           'ApiAnnotation.AnnTilde',
 
 -- For details on above see note [Api annotations] in ApiAnnotation
diff --git a/compiler/parser/ApiAnnotation.hs b/compiler/parser/ApiAnnotation.hs
index 282d3904f8e990cd98d1a50080b7e6b0ff85ec5b..4d1758ff3c9e239b19f8cfe6b8ea57e7c87c6a02 100644
--- a/compiler/parser/ApiAnnotation.hs
+++ b/compiler/parser/ApiAnnotation.hs
@@ -280,7 +280,6 @@ data AnnKeywordId
     | AnnThIdTySplice -- ^ '$$'
     | AnnThTyQuote -- ^ double '''
     | AnnTilde -- ^ '~'
-    | AnnTildehsh -- ^ '~#'
     | AnnType
     | AnnUnit -- ^ '()' for types
     | AnnUsing
@@ -322,7 +321,7 @@ instance Outputable AnnotationComment where
 
 -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
 --             'ApiAnnotation.AnnClose','ApiAnnotation.AnnComma',
---             'ApiAnnotation.AnnRarrow','ApiAnnotation.AnnTildehsh',
+--             'ApiAnnotation.AnnRarrow'
 --             'ApiAnnotation.AnnTilde'
 --   - May have 'ApiAnnotation.AnnComma' when in a list
 type LRdrName = Located RdrName
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index fc8b98833269dd60937b10e9aa2df00e359f47f5..006faccf113a9aabca4373c6551ea467e327cf6a 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -678,7 +678,6 @@ data Token
   | ITrarrow            IsUnicodeSyntax
   | ITat
   | ITtilde
-  | ITtildehsh
   | ITdarrow            IsUnicodeSyntax
   | ITminus
   | ITbang
@@ -888,7 +887,6 @@ reservedSymsFM = listToUFM $
        ,("->",  ITrarrow NormalSyntax, always)
        ,("@",   ITat,                  always)
        ,("~",   ITtilde,               always)
-       ,("~#",  ITtildehsh,            magicHashEnabled)
        ,("=>",  ITdarrow NormalSyntax, always)
        ,("-",   ITminus,               always)
        ,("!",   ITbang,                always)
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 533e21d0d1c56327a41ba99dd7eab26f78d057bd..af8c95fb2bcd681c025b02ffb8cbe3af9710af02 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -522,7 +522,6 @@ are the most common patterns, rewritten as regular expressions for clarity:
  '->'           { L _ (ITrarrow _) }
  '@'            { L _ ITat }
  '~'            { L _ ITtilde }
- '~#'           { L _ ITtildehsh }
  '=>'           { L _ (ITdarrow _) }
  '-'            { L _ ITminus }
  '!'            { L _ ITbang }
@@ -3119,8 +3118,6 @@ ntgtycon :: { Located RdrName }  -- A "general" qualified tycon, excluding unit
         | '(' '->' ')'          {% ams (sLL $1 $> $ getRdrName funTyCon)
                                        [mop $1,mu AnnRarrow $2,mcp $3] }
         | '[' ']'               {% ams (sLL $1 $> $ listTyCon_RDR) [mos $1,mcs $2] }
-        | '(' '~#' ')'          {% ams (sLL $1 $> $ getRdrName eqPrimTyCon)
-                                        [mop $1,mj AnnTildehsh $2,mcp $3] }
 
 oqtycon :: { Located RdrName }  -- An "ordinary" qualified tycon;
                                 -- These can appear in export lists