Copyright | (C) 2011-2021 Edward Kmett |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | Edward Kmett <ekmett@gmail.com> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | Unsafe |
Language | Haskell2010 |
Unsafe utilities used throughout constraints
. As the names suggest, these
functions are unsafe in general and can cause your program to segfault if
used improperly. Handle with care.
Synopsis
- class a ~R# b => Coercible (a :: k) (b :: k)
- unsafeAxiom :: Dict c
- unsafeCoerceConstraint :: a :- b
- unsafeDerive :: Coercible n o => (o -> n) -> t o :- t n
- unsafeUnderive :: Coercible n o => (o -> n) -> t n :- t o
- unsafeSChar :: Char -> SChar c
- unsafeSNat :: Natural -> SNat n
- unsafeSSymbol :: String -> SSymbol s
Documentation
class a ~R# b => Coercible (a :: k) (b :: k) #
Coercible
is a two-parameter class that has instances for types a
and b
if
the compiler can infer that they have the same representation. This class
does not have regular instances; instead they are created on-the-fly during
type-checking. Trying to manually declare an instance of Coercible
is an error.
Nevertheless one can pretend that the following three kinds of instances exist. First, as a trivial base-case:
instance Coercible a a
Furthermore, for every type constructor there is
an instance that allows to coerce under the type constructor. For
example, let D
be a prototypical type constructor (data
or
newtype
) with three type arguments, which have roles nominal
,
representational
resp. phantom
. Then there is an instance of
the form
instance Coercible b b' => Coercible (D a b c) (D a b' c')
Note that the nominal
type arguments are equal, the
representational
type arguments can differ, but need to have a
Coercible
instance themself, and the phantom
type arguments can be
changed arbitrarily.
The third kind of instance exists for every newtype NT = MkNT T
and
comes in two variants, namely
instance Coercible a T => Coercible a NT
instance Coercible T b => Coercible NT b
This instance is only usable if the constructor MkNT
is in scope.
If, as a library author of a type constructor like Set a
, you
want to prevent a user of your module to write
coerce :: Set T -> Set NT
,
you need to set the role of Set
's type parameter to nominal
,
by writing
type role Set nominal
For more details about this feature, please refer to Safe Coercions by Joachim Breitner, Richard A. Eisenberg, Simon Peyton Jones and Stephanie Weirich.
Since: ghc-prim-0.4.0
unsafeAxiom :: Dict c Source #
Unsafely create a dictionary for any constraint.
unsafeCoerceConstraint :: a :- b Source #
Coerce a dictionary unsafely from one type to another
unsafeDerive :: Coercible n o => (o -> n) -> t o :- t n Source #
Coerce a dictionary unsafely from one type to a newtype of that type
unsafeUnderive :: Coercible n o => (o -> n) -> t n :- t o Source #
Coerce a dictionary unsafely from a newtype of a type to the base type
Unsafely creating GHC.TypeLits
singleton values
unsafeSChar :: Char -> SChar c Source #
Unsafely create an SChar
value directly from a Char
. Use this function
with care:
- The
Char
value must match theChar
c
encoded in the return type
.SChar
c - Be wary of using this function to create multiple values of type
, whereSChar
TT
is a type family that does not reduce (e.g.,Any
from GHC.Exts). If you do, GHC is liable to optimize away one of the values and replace it with the other during a common subexpression elimination pass. If the two values have different underlyingChar
values, this could be disastrous.
unsafeSNat :: Natural -> SNat n Source #
Unsafely create an SNat
value directly from a Natural
. Use this
function with care:
- The
Natural
value must match theNat
n
encoded in the return type
.SNat
n - Be wary of using this function to create multiple values of type
, whereSNat
TT
is a type family that does not reduce (e.g.,Any
from GHC.Exts). If you do, GHC is liable to optimize away one of the values and replace it with the other during a common subexpression elimination pass. If the two values have different underlyingNatural
values, this could be disastrous.
unsafeSSymbol :: String -> SSymbol s Source #
Unsafely create an SSymbol
value directly from a String
. Use this
function with care:
- The
String
value must match theSymbol
s
encoded in the return type
.SSymbol
s - Be wary of using this function to create multiple values of type
, whereSSymbol
TT
is a type family that does not reduce (e.g.,Any
from GHC.Exts). If you do, GHC is liable to optimize away one of the values and replace it with the other during a common subexpression elimination pass. If the two values have different underlyingString
values, this could be disastrous.