Commit feb8a671 authored by Alec Theriault's avatar Alec Theriault Committed by Ryan Scott

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
parent 60b547b5
......@@ -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
......
......@@ -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 }
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
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 ->
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: ->
......@@ -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, [''])
......
......@@ -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 }
......
......@@ -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"
......
......@@ -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
......
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