Improve generated `GHC.Prim` docs

Summary:
* Extended `genprimcode` to generate Haddock-compatible deprecations,
  as well as displaying information about which functions are LLVM-only
  and which functions can fail with an unchecked exception.

* Ported existing deprecations to the new format, and also added a
  deprecation on `par#` (see Trac #15227).

* Emit an error on fixity/deprecation of builtins, unless we are
  processing the module in which that name is defined (see Trac #15233).
  That means the following is no longer accepted (outside of `GHC.Types`):

```
infixr 7 :
{-# DEPRECATED (:) "cons is deprecated" #-}
```

* Generate `data (->) a b` with docs and fixity in `GHC.Prim`. This
  means: GHC can now parse `data (->) a b` and `infixr 0 ->` (only in
  `GHC.Prim`) and `genprimcode` can digest `primtype (->) a b` (See Trac
  #4861)

as well as some misc fixes along the way.

Reviewers: bgamari, RyanGlScott

Reviewed By: RyanGlScott

Subscribers: RyanGlScott, rwbarton, mpickering, carter

GHC Trac Issues: #15227, #15233, #4861

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

12 files changed, 190 insertions, 77 deletions

diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs
index 34ba1cbb7a..bff507f973 100644
--- a/compiler/iface/LoadIface.hs
+++ b/compiler/iface/LoadIface.hs
@@ -1012,8 +1012,9 @@ ghcPrimIface
         mi_fix_fn  = mkIfaceFixCache fixities
     }
   where
+    -- The fixities listed here for @`seq`@ or @->@ should match
+    -- those in primops.txt.pp (from which Haddock docs are generated).
     fixities = (getOccName seqId, Fixity NoSourceText 0 InfixR)
-                                      -- seq is infixr 0
              : (occName funTyConName, funTyFixity)  -- trac #10145
              : mapMaybe mkFixity allThePrimOps
     mkFixity op = (,) (primOpOcc op) <$> primOpFixity op
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index adfbf2c332..8789c9b333 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -3238,6 +3238,7 @@ tyconsym :: { Located RdrName }
 op      :: { Located RdrName }   -- used in infix decls
         : varop                 { $1 }
         | conop                 { $1 }
+        | '->'                  { sL1 $1 $ getRdrName funTyCon }
 
 varop   :: { Located RdrName }
         : varsym                { $1 }
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 6e64d73d34..20c7d2792a 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -691,6 +691,9 @@ isBuiltInOcc_maybe occ =
       -- equality tycon
       "~"    -> Just eqTyConName
 
+      -- function tycon
+      "->"   -> Just funTyConName
+
       -- boxed tuple data/tycon
       "()"    -> Just $ tup_name Boxed 0
       _ | Just rest <- "(" `BS.stripPrefix` name
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 9e14648c43..2d2fff4268 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -19,6 +19,9 @@
 -- add a new one can be found in the Commentary:
 --
 --  http://ghc.haskell.org/trac/ghc/wiki/Commentary/PrimOps
+--
+-- Note in particular that Haskell block-style comments are not recognized
+-- here, so stick to '--' (even for Notes spanning mutliple lines).
 
 -- This file is divided into named sections, each containing or more
 -- primop entries. Section headers have the format:
@@ -73,6 +76,7 @@ defaults
    fixity           = Nothing
    llvm_only        = False
    vector           = []
+   deprecated_msg   = {}      -- A non-empty message indicates deprecation
 
 -- Currently, documentation is produced using latex, so contents of
 -- description fields should be legal latex. Descriptions can contain
@@ -154,6 +158,21 @@ section "The word size story."
 #define WORD64 Word#
 #endif
 
+-- This type won't be exported directly (since there is no concrete
+-- syntax for this sort of export) so we'll have to manually patch
+-- export lists in both GHC and Haddock.
+primtype (->) a b
+  {The builtin function type, written in infix form as {\tt a -> b} and
+   in prefix form as {\tt (->) a b}. Values of this type are functions
+   taking inputs of type {\tt a} and producing outputs of type {\tt b}.
+
+   Note that {\tt a -> b} permits levity-polymorphism in both {\tt a} and
+   {\tt b}, so that types like {\tt Int\# -> Int\#} can still be well-kinded.
+  }
+  with fixity = infixr 0
+         -- This fixity is only the one picked up by Haddock. If you
+         -- change this, do update 'ghcPrimIface' in 'LoadIface.hs'.
+
 ------------------------------------------------------------------------
 section "Char#"
         {Operations on 31-bit characters.}
@@ -243,17 +262,26 @@ primop   IntQuotRemOp "quotRemInt#"    GenPrimOp
    with can_fail = True
 
 primop   AndIOp   "andI#"   Dyadic    Int# -> Int# -> Int#
+   {Bitwise "and".}
    with commutable = True
 
 primop   OrIOp   "orI#"     Dyadic    Int# -> Int# -> Int#
+   {Bitwise "or".}
    with commutable = True
 
 primop   XorIOp   "xorI#"   Dyadic    Int# -> Int# -> Int#
+   {Bitwise "xor".}
    with commutable = True
 
 primop   NotIOp   "notI#"   Monadic   Int# -> Int#
+   {Bitwise "not", also known as the binary complement.}
 
 primop   IntNegOp    "negateInt#"    Monadic   Int# -> Int#
+   {Unary negation.
+    Since the negative {\tt Int#} range extends one further than the
+    positive range, {\tt negateInt#} of the most negative number is an
+    identity operation. This way, {\tt negateInt#} is always its own inverse.}
+
 primop   IntAddCOp   "addIntC#"    GenPrimOp   Int# -> Int# -> (# Int#, Int# #)
          {Add signed integers reporting overflow.
           First member of result is the sum truncated to an {\tt Int#};
@@ -1194,7 +1222,8 @@ primop  SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp
    MutableByteArray# s -> Int#
    {Return the size of the array in bytes. Note that this is deprecated as it is
    unsafe in the presence of concurrent resize operations on the same byte
-   array. See {\tt getSizeofMutableByteArray}.}
+   array.}
+   with deprecated_msg = { Use 'getSizeofMutableByteArray#' instead }
 
 primop  GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp
    MutableByteArray# s -> State# s -> (# State# s, Int# #)
@@ -1813,7 +1842,7 @@ primop FetchXorByteArrayOp_Int "fetchXorIntArray#" GenPrimOp
 section "Arrays of arrays"
         {Operations on {\tt ArrayArray\#}. An {\tt ArrayArray\#} contains references to {\em unpointed}
          arrays, such as {\tt ByteArray\#s}. Hence, it is not parameterised by the element types,
-         just like a {\tt ByteArray\#}, but it needs to be scanned during GC, just like an {\tt Array#}.
+         just like a {\tt ByteArray\#}, but it needs to be scanned during GC, just like an {\tt Array\#}.
          We represent an {\tt ArrayArray\#} exactly as a {\tt Array\#}, but provide element-type-specific
          indexing, reading, and writing.}
 ------------------------------------------------------------------------
@@ -1939,11 +1968,13 @@ primop   AddrRemOp "remAddr#" GenPrimOp Addr# -> Int# -> Int#
           is divided by the {\tt Int\#} arg.}
 #if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64)
 primop   Addr2IntOp  "addr2Int#"     GenPrimOp   Addr# -> Int#
-        {Coerce directly from address to int. Strongly deprecated.}
+        {Coerce directly from address to int.}
    with code_size = 0
+        deprecated_msg = { This operation is strongly deprecated. }
 primop   Int2AddrOp   "int2Addr#"    GenPrimOp  Int# -> Addr#
-        {Coerce directly from int to address. Strongly deprecated.}
+        {Coerce directly from int to address.}
    with code_size = 0
+        deprecated_msg = { This operation is strongly deprecated. }
 #endif
 
 primop   AddrGtOp  "gtAddr#"   Compare   Addr# -> Addr# -> Int#
@@ -2924,6 +2955,7 @@ primop  ParOp "par#" GenPrimOp
       -- gets evaluated strictly, which it should *not* be
    has_side_effects = True
    code_size = { primOpCodeSizeForeignCall }
+   deprecated_msg = { Use 'spark#' instead }
 
 primop SparkOp "spark#" GenPrimOp
    a -> State# s -> (# State# s, a #)
@@ -2963,29 +2995,28 @@ primop  DataToTagOp "dataToTag#" GenPrimOp
 primop  TagToEnumOp "tagToEnum#" GenPrimOp
    Int# -> a
 
-{- Note [dataToTag#]
-~~~~~~~~~~~~~~~~~~~~
-The dataToTag# primop should always be applied to an evaluated argument.
-The way to ensure this is to invoke it via the 'getTag' wrapper in GHC.Base:
-   getTag :: a -> Int#
-   getTag !x = dataToTag# x
-
-But now consider
-    \z. case x of y -> let v = dataToTag# y in ...
-
-To improve floating, the FloatOut pass (deliberately) does a
-binder-swap on the case, to give
-    \z. case x of y -> let v = dataToTag# x in ...
-
-Now FloatOut might float that v-binding outside the \z.  But that is
-bad because that might mean x gets evaluated much too early!  (CorePrep
-adds an eval to a dataToTag# call, to ensure that the argument really is
-evaluated; see CorePrep Note [dataToTag magic].)
-
-Solution: make DataToTag into a can_fail primop.  That will stop it floating
-(see Note [PrimOp can_fail and has_side_effects] in PrimOp).  It's a bit of
-a hack but never mind.
--}
+-- Note [dataToTag#]
+-- ~~~~~~~~~~~~~~~~~~~~
+-- The dataToTag# primop should always be applied to an evaluated argument.
+-- The way to ensure this is to invoke it via the 'getTag' wrapper in GHC.Base:
+--    getTag :: a -> Int#
+--    getTag !x = dataToTag# x
+--
+-- But now consider
+--     \z. case x of y -> let v = dataToTag# y in ...
+--
+-- To improve floating, the FloatOut pass (deliberately) does a
+-- binder-swap on the case, to give
+--     \z. case x of y -> let v = dataToTag# x in ...
+--
+-- Now FloatOut might float that v-binding outside the \z.  But that is
+-- bad because that might mean x gets evaluated much too early!  (CorePrep
+-- adds an eval to a dataToTag# call, to ensure that the argument really is
+-- evaluated; see CorePrep Note [dataToTag magic].)
+--
+-- Solution: make DataToTag into a can_fail primop.  That will stop it floating
+-- (see Note [PrimOp can_fail and has_side_effects] in PrimOp).  It's a bit of
+-- a hack but never mind.
 
 ------------------------------------------------------------------------
 section "Bytecode operations"
@@ -3106,6 +3137,9 @@ pseudoop   "seq"
      In particular, this means that {\tt b} may be evaluated before
      {\tt a}. If you need to guarantee a specific order of evaluation,
      you must use the function {\tt pseq} from the "parallel" package. }
+   with fixity = infixr 0
+         -- This fixity is only the one picked up by Haddock. If you
+         -- change this, do update 'ghcPrimIface' in 'LoadIface.hs'.
 
 pseudoop   "unsafeCoerce#"
    a -> b
@@ -3141,6 +3175,7 @@ pseudoop   "unsafeCoerce#"
         to, use {\tt Any}, which is not an algebraic data type.
 
         }
+   with can_fail = True
 
 -- NB. It is tempting to think that casting a value to a type that it doesn't have is safe
 -- as long as you don't "do anything" with the value in its cast form, such as seq on it.  This
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 516c43c14a..c28f47e43d 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -1508,8 +1508,18 @@ lookupLocalTcNames ctxt what rdr_name
        ; when (null names) $ addErr (head errs) -- Bleat about one only
        ; return names }
   where
-    lookup rdr = do { name <- lookupBindGroupOcc ctxt what rdr
-                    ; return (fmap ((,) rdr) name) }
+    lookup rdr = do { this_mod <- getModule
+                    ; nameEither <- lookupBindGroupOcc ctxt what rdr
+                    ; return (guard_builtin_syntax this_mod rdr nameEither) }
+
+    -- Guard against the built-in syntax (ex: `infixl 6 :`), see #15233
+    guard_builtin_syntax this_mod rdr (Right name)
+      | Just _ <- isBuiltInOcc_maybe (occName rdr)
+      , this_mod /= nameModule name
+      = Left (hsep [text "Illegal", what, text "of built-in syntax:", ppr rdr])
+      | otherwise
+      = Right (rdr, name)
+    guard_builtin_syntax _ _ (Left err) = Left err
 
 dataTcOccs :: RdrName -> [RdrName]
 -- Return both the given name and the same name promoted to the TcClsName
diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs
index 0bbd8c9e0e..6f53bc3c98 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -2288,6 +2288,7 @@ newTyConDataCon_maybe _ = Nothing
 -- @data Eq a => T a ...@
 tyConStupidTheta :: TyCon -> [PredType]
 tyConStupidTheta (AlgTyCon {algTcStupidTheta = stupid}) = stupid
+tyConStupidTheta (FunTyCon {}) = []
 tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)
 
 -- | Extract the 'TyVar's bound by a vanilla type synonym
diff --git a/testsuite/tests/parser/should_fail/T15233.hs b/testsuite/tests/parser/should_fail/T15233.hs
new file mode 100644
index 0000000000..ee369cd189
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T15233.hs
@@ -0,0 +1,9 @@
+module T15233 where
+
+-- ghc-8.6 would accept (but silently ignore) both of the following:
+infixl 7 :
+{-# DEPRECATED (:) "Deprecting cons" #-}
+
+-- this was never accepted by ghc-8.6, but now that GHC.Prim emits a fixity
+-- declaration for `(->)`, we need to make sure it is disallowed elsewhere.
+infixr 4 ->
diff --git a/testsuite/tests/parser/should_fail/T15233.stderr b/testsuite/tests/parser/should_fail/T15233.stderr
new file mode 100644
index 0000000000..3371bef758
--- /dev/null
+++ b/testsuite/tests/parser/should_fail/T15233.stderr
@@ -0,0 +1,8 @@
+
+T15233.hs:4:10: error:
+    Illegal fixity signature of built-in syntax: :
+
+T15233.hs:5:16: error: Illegal deprecation of built-in syntax: :
+
+T15233.hs:9:10: error:
+    Illegal fixity signature of built-in syntax: ->
diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T
index 1ae1abb709..4612b78e0f 100644
--- a/testsuite/tests/parser/should_fail/all.T
+++ b/testsuite/tests/parser/should_fail/all.T
@@ -129,6 +129,7 @@ test('typeops_B', normal, compile_fail, [''])
 test('typeops_C', normal, compile_fail, [''])
 test('typeops_D', normal, compile_fail, [''])
 test('T15053', normal, compile_fail, [''])
+test('T15233', normal, compile_fail, [''])
 test('typeopsDataCon_A', normal, compile_fail, [''])
 test('typeopsDataCon_B', normal, compile_fail, [''])
 test('strictnessDataCon_A', normal, compile_fail, [''])
diff --git a/utils/genprimopcode/Lexer.x b/utils/genprimopcode/Lexer.x
index ad2590bcb8..06624b2ec0 100644
--- a/utils/genprimopcode/Lexer.x
+++ b/utils/genprimopcode/Lexer.x
@@ -68,7 +68,7 @@ words :-
     <0>         "VECTUPLE"          { mkT TVECTUPLE }
     <0>         [a-z][a-zA-Z0-9\#_]* { mkTv TLowerName }
     <0>         [A-Z][a-zA-Z0-9\#_]* { mkTv TUpperName }
-    <0>         [0-9][0-9]*         { mkTv (TInteger . read) }
+    <0>         \-? [0-9][0-9]*     { mkTv (TInteger . read) }
     <0>         \" [^\"]* \"        { mkTv (TString . tail . init) }
     <in_braces> [^\{\}]+            { mkTv TNoBraces }
     <in_braces> \n                  { mkTv TNoBraces }
diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs
index c409050250..a0e9d5482e 100644
--- a/utils/genprimopcode/Main.hs
+++ b/utils/genprimopcode/Main.hs
@@ -273,7 +273,7 @@ gen_hs_source (Info defaults entries) =
                      -- the base package when haddocking ghc-prim
 
        -- Now the main payload
-    ++ unlines (concatMap ent entries') ++ "\n\n\n"
+    ++ "\n" ++ unlines (concatMap ent entries') ++ "\n\n\n"
 
      where entries' = concatMap desugarVectorSpec entries
 
@@ -288,11 +288,17 @@ gen_hs_source (Info defaults entries) =
            hdr (PrimOpSpec { name = n })                         = wrapOp n ++ ","
            hdr (PrimVecOpSpec { name = n })                      = wrapOp n ++ ","
            hdr (PseudoOpSpec { name = n })                       = wrapOp n ++ ","
-           hdr (PrimTypeSpec { ty = TyApp (TyCon n) _ })         = wrapTy n ++ ","
+           hdr (PrimTypeSpec { ty = TyApp (TyCon "->") _ })      = ""
+                  -- GHC lacks the syntax to explicitly export "->"
+           hdr (PrimTypeSpec { ty = TyApp (TyCon n) _ })         = wrapOp n ++ ","
            hdr (PrimTypeSpec {})                                 = error $ "Illegal type spec"
-           hdr (PrimVecTypeSpec { ty = TyApp (VecTyCon n _) _ }) = wrapTy n ++ ","
+           hdr (PrimVecTypeSpec { ty = TyApp (VecTyCon n _) _ }) = wrapOp n ++ ","
            hdr (PrimVecTypeSpec {})                              = error $ "Illegal type spec"
 
+           sec s = "\n-- * " ++ escape (title s) ++ "\n"
+                    ++ (unlines $ map ("-- " ++ ) $ lines $ unlatex $ escape $ "|" ++ desc s)
+
+
            ent   (Section {})         = []
            ent o@(PrimOpSpec {})      = spec o
            ent o@(PrimVecOpSpec {})   = spec o
@@ -300,48 +306,67 @@ gen_hs_source (Info defaults entries) =
            ent o@(PrimVecTypeSpec {}) = spec o
            ent o@(PseudoOpSpec {})    = spec o
 
-           sec s = "\n-- * " ++ escape (title s) ++ "\n"
-                        ++ (unlines $ map ("-- " ++ ) $ lines $ unlatex $ escape $ "|" ++ desc s) ++ "\n"
-
-           spec o = comm : decls
-             where decls = case o of  -- See Note [Placeholder declarations]
-                        PrimOpSpec { name = n, ty = t, opts = options } ->
-                            prim_fixity n options ++ prim_decl n t
-                        PrimVecOpSpec { name = n, ty = t, opts = options } ->
-                            prim_fixity n options ++ prim_decl n t
-                        PseudoOpSpec { name = n, ty = t } ->
-                            prim_decl n t
-                        PrimTypeSpec { ty = t }   ->
-                            [ "data " ++ pprTy t ]
-                        PrimVecTypeSpec { ty = t }   ->
-                            [ "data " ++ pprTy t ]
-                        Section { } -> []
-
-                   comm = case (desc o) of
-                        [] -> ""
-                        d -> "\n" ++ (unlines $ map ("-- " ++ ) $ lines $ unlatex $ escape $ "|" ++ d)
-
-           prim_fixity n options = [ pprFixity fixity n | OptionFixity (Just fixity) <- options ]
-
-           prim_decl n t = [ wrapOp n ++ " :: " ++ pprTy t,
-                             wrapOp n ++ " = " ++ wrapOpRhs n ]
-
-           wrapOp nm | isAlpha (head nm) = nm
-                     | otherwise         = "(" ++ nm ++ ")"
-
-           wrapTy nm | isAlpha (head nm) = nm
-                     | otherwise         = "(" ++ nm ++ ")"
-
-           wrapOpRhs "tagToEnum#" = "let x = x in x"
-           wrapOpRhs nm           = wrapOp nm
+           spec o = ([ "" ] ++) . concat $
+             -- Doc comments
+             [ case unlatex (escape (desc o)) ++ extra (opts o) of
+                 "" -> []
+                 cmmt -> map ("-- " ++) $ lines $ "|" ++ cmmt
+
+             -- Deprecations
+             , [ d | Just n <- [getName o], d <- prim_deprecated (opts o) n ]
+
+             -- Fixity
+             , [ f | Just n <- [getName o], f <- prim_fixity (opts o) n ]
+
+             -- Declarations (see Note [Placeholder declarations])
+             , case o of
+                 PrimOpSpec { name = n, ty = t }    -> prim_func n t
+                 PrimVecOpSpec { name = n, ty = t } -> prim_func n t
+                 PseudoOpSpec { name = n, ty = t }  -> prim_func n t
+                 PrimTypeSpec { ty = t }    -> prim_data t
+                 PrimVecTypeSpec { ty = t } -> prim_data t
+                 Section { } -> error "Section is not an entity"
+             ]
+
+           extra options = case on_llvm_only options ++ can_fail options of
+             [m1,m2] -> "\n\n__/Warning:/__ this " ++ m1 ++ " and " ++ m2 ++ "."
+             [m] -> "\n\n__/Warning:/__ this " ++ m ++ "."
+             _ -> ""
+
+           on_llvm_only options
+             = [ "is only available on LLVM"
+               | Just (OptionTrue _) <- [lookup_attrib "llvm_only" options] ]
+
+           can_fail options
+             = [ "can fail with an unchecked exception"
+               | Just (OptionTrue _) <- [lookup_attrib "can_fail" options] ]
+
+           prim_deprecated options n
+              = [ "{-# DEPRECATED " ++ wrapOp n ++ " \"" ++ msg ++ "\" #-}"
+                | Just (OptionString _ msg)
+                    <- [lookup_attrib "deprecated_msg" options] ]
+
+           prim_fixity options n
+              = [ pprFixityDir d ++ " " ++ show i ++ " " ++ asInfix n
+                | OptionFixity (Just (Fixity _ i d)) <- options ]
+
+           prim_func n t = [ wrapOp n ++ " :: " ++ pprTy t,
+                             wrapOp n ++ " = " ++ funcRhs n ]
+
+           funcRhs "tagToEnum#" = "let x = x in x"
+           funcRhs nm           = wrapOp nm
               -- Special case for tagToEnum#: see Note [Placeholder declarations]
 
+           prim_data t = [ "data " ++ pprTy t ]
+
            unlatex s = case s of
                 '\\':'t':'e':'x':'t':'t':'t':'{':cs -> markup "@" "@" cs
+                '{':'\\':'t':'e':'x':'t':'t':'t':' ':cs -> markup "@" "@" cs
                 '{':'\\':'t':'t':cs -> markup "@" "@" cs
                 '{':'\\':'i':'t':cs -> markup "/" "/" cs
+                '{':'\\':'e':'m':cs -> markup "/" "/" cs
                 c : cs -> c : unlatex cs
-                [] -> []
+                "" -> ""
            markup s t xs = s ++ mk (dropWhile isSpace xs)
                 where mk ""        = t
                       mk ('\n':cs) = ' ' : mk cs
@@ -350,8 +375,13 @@ gen_hs_source (Info defaults entries) =
            escape = concatMap (\c -> if c `elem` special then '\\':c:[] else c:[])
                 where special = "/'`\"@<"
 
-           pprFixity (Fixity _ i d) n
-             = pprFixityDir d ++ " " ++ show i ++ " " ++ n
+-- | Extract a string representation of the name
+getName :: Entry -> Maybe String
+getName PrimOpSpec{ name = n } = Just n
+getName PrimVecOpSpec{ name = n } = Just n
+getName PseudoOpSpec{ name = n } = Just n
+getName PrimTypeSpec{ ty = TyApp tc _ } = Just (show tc)
+getName _ = Nothing
 
 {- Note [Placeholder declarations]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -374,13 +404,15 @@ We don't do this for *all* bindings because for ones with an unboxed
 RHS we would get other complaints (e.g.can't unify "*" with "#").
 -}
 
+-- | "Pretty"-print a type
 pprTy :: Ty -> String
 pprTy = pty
     where
           pty (TyF t1 t2) = pbty t1 ++ " -> " ++ pty t2
           pty (TyC t1 t2) = pbty t1 ++ " => " ++ pty t2
           pty t      = pbty t
-          pbty (TyApp tc ts) = show tc ++ concat (map (' ' :) (map paty ts))
+
+          pbty (TyApp tc ts) = unwords (wrapOp (show tc) : map paty ts)
           pbty (TyUTup ts)   = "(# "
                             ++ concat (intersperse "," (map pty ts))
                             ++ " #)"
@@ -389,6 +421,16 @@ pprTy = pty
           paty (TyVar tv)    = tv
           paty t             = "(" ++ pty t ++ ")"
 
+-- | Turn an identifier or operator into its prefix form
+wrapOp :: String -> String
+wrapOp nm | isAlpha (head nm) = nm
+          | otherwise         = "(" ++ nm ++ ")"
+
+-- | Turn an identifer or operator into its infix form
+asInfix :: String -> String
+asInfix nm | isAlpha (head nm) = "`" ++ nm ++ "`"
+           | otherwise         = nm
+
 gen_latex_doc :: Info -> String
 gen_latex_doc (Info defaults entries)
    = "\\primopdefaults{"
@@ -565,9 +607,10 @@ gen_latex_doc (Info defaults entries)
 
 gen_wrappers :: Info -> String
 gen_wrappers (Info _ entries)
-   = "{-# LANGUAGE MagicHash, NoImplicitPrelude, UnboxedTuples #-}\n"
+   =    "{-# LANGUAGE MagicHash, NoImplicitPrelude, UnboxedTuples #-}\n"
         -- Dependencies on Prelude must be explicit in libraries/base, but we
         -- don't need the Prelude here so we add NoImplicitPrelude.
+     ++ "{-# OPTIONS_GHC -Wno-deprecations #-}\n"
      ++ "module GHC.PrimopWrappers where\n"
      ++ "import qualified GHC.Prim\n"
      ++ "import GHC.Tuple ()\n"
diff --git a/utils/genprimopcode/Parser.y b/utils/genprimopcode/Parser.y
index cd712d7584..89e61d5236 100644
--- a/utils/genprimopcode/Parser.y
+++ b/utils/genprimopcode/Parser.y
@@ -183,10 +183,11 @@ ppT : lowerName { TyVar $1 }
 
 pTycon :: { TyCon }
 pTycon : upperName { TyCon $1 }
-       | '(' ')'   { TyCon "()" }
-       | SCALAR    { SCALAR }
-       | VECTOR    { VECTOR }
-       | VECTUPLE  { VECTUPLE }
+       | '(' ')'      { TyCon "()" }
+       | '(' '->' ')' { TyCon "->" }
+       | SCALAR       { SCALAR }
+       | VECTOR       { VECTOR }
+       | VECTUPLE     { VECTUPLE }
 
 {
 parse :: String -> Either String Info