Commit a18ea4f2 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Make 'undefined' have the magical type 'forall (a:OpenKind).a'

This fixes Trac #7888, where the user wanted to use 'undefined' in a
context that needed ((forall a. a->a) -> Int).  We allow OpenKind
unification variables to be instantiate with polytypes (or unboxed
types), hence the change.

'error' has always been like this; this change simply extends
the special treatment to 'undefined'.  It's still magical;
you can't define your own wrapper for 'error' and get the
same behaviour.  Really just a convenience hack.
parent a91e2304
......@@ -53,7 +53,8 @@ module MkCore (
mkRuntimeErrorApp, mkImpossibleExpr, errorIds,
rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID,
nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID,
pAT_ERROR_ID, eRROR_ID, rEC_SEL_ERROR_ID, aBSENT_ERROR_ID
pAT_ERROR_ID, eRROR_ID, rEC_SEL_ERROR_ID, aBSENT_ERROR_ID,
uNDEFINED_ID, undefinedName
) where
#include "HsVersions.h"
......@@ -659,6 +660,9 @@ errorIds
-- import its type from the interface file; we just get
-- the Id defined here. Which has an 'open-tyvar' type.
uNDEFINED_ID, -- Ditto for 'undefined'. The big deal is to give it
-- an 'open-tyvar' type.
rUNTIME_ERROR_ID,
iRREFUT_PAT_ERROR_ID,
nON_EXHAUSTIVE_GUARDS_ERROR_ID,
......@@ -700,7 +704,7 @@ nON_EXHAUSTIVE_GUARDS_ERROR_ID = mkRuntimeErrorId nonExhaustiveGuardsErrorName
aBSENT_ERROR_ID = mkRuntimeErrorId absentErrorName
mkRuntimeErrorId :: Name -> Id
mkRuntimeErrorId name = pc_bottoming_Id name runtimeErrorTy
mkRuntimeErrorId name = pc_bottoming_Id1 name runtimeErrorTy
runtimeErrorTy :: Type
-- The runtime error Ids take a UTF8-encoded string as argument
......@@ -712,15 +716,33 @@ errorName :: Name
errorName = mkWiredInIdName gHC_ERR (fsLit "error") errorIdKey eRROR_ID
eRROR_ID :: Id
eRROR_ID = pc_bottoming_Id errorName errorTy
eRROR_ID = pc_bottoming_Id1 errorName errorTy
errorTy :: Type
errorTy :: Type -- See Note [Error and friends have an "open-tyvar" forall]
errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy)
-- Notice the openAlphaTyVar. It says that "error" can be applied
-- to unboxed as well as boxed types. This is OK because it never
-- returns, so the return type is irrelevant.
undefinedName :: Name
undefinedName = mkWiredInIdName gHC_ERR (fsLit "undefined") undefinedKey uNDEFINED_ID
uNDEFINED_ID :: Id
uNDEFINED_ID = pc_bottoming_Id0 undefinedName undefinedTy
undefinedTy :: Type -- See Note [Error and friends have an "open-tyvar" forall]
undefinedTy = mkSigmaTy [openAlphaTyVar] [] openAlphaTy
\end{code}
Note [Error and friends have an "open-tyvar" forall]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'error' and 'undefined' have types
error :: forall (a::OpenKind). String -> a
undefined :: forall (a::OpenKind). a
Notice the 'OpenKind' (manifested as openAlphaTyVar in the code). This ensures that
"error" can be instantiated at
* unboxed as well as boxed types
* polymorphic types
This is OK because it never returns, so the return type is irrelevant.
See Note [OpenTypeKind accepts foralls] in TcUnify.
%************************************************************************
%* *
......@@ -729,9 +751,9 @@ errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy
%************************************************************************
\begin{code}
pc_bottoming_Id :: Name -> Type -> Id
pc_bottoming_Id1 :: Name -> Type -> Id
-- Function of arity 1, which diverges after being given one argument
pc_bottoming_Id name ty
pc_bottoming_Id1 name ty
= mkVanillaGlobalWithInfo name ty bottoming_info
where
bottoming_info = vanillaIdInfo `setStrictnessInfo` strict_sig
......@@ -749,5 +771,13 @@ pc_bottoming_Id name ty
strict_sig = mkStrictSig (mkTopDmdType [evalDmd] botRes)
-- These "bottom" out, no matter what their arguments
pc_bottoming_Id0 :: Name -> Type -> Id
-- Same but arity zero
pc_bottoming_Id0 name ty
= mkVanillaGlobalWithInfo name ty bottoming_info
where
bottoming_info = vanillaIdInfo `setStrictnessInfo` strict_sig
strict_sig = mkStrictSig (mkTopDmdType [] botRes)
\end{code}
......@@ -798,10 +798,6 @@ stringTyConName = tcQual gHC_BASE (fsLit "String") stringTyConKey
inlineIdName :: Name
inlineIdName = varQual gHC_MAGIC (fsLit "inline") inlineIdKey
-- The 'undefined' function. Used by supercompilation.
undefinedName :: Name
undefinedName = varQual gHC_ERR (fsLit "undefined") undefinedKey
-- Base classes (Eq, Ord, Functor)
fmapName, eqClassName, eqName, ordClassName, geName, functorClassName :: Name
eqClassName = clsQual gHC_CLASSES (fsLit "Eq") eqClassKey
......@@ -1689,7 +1685,6 @@ checkDotnetResNameIdKey = mkPreludeMiscIdUnique 154
undefinedKey :: Unique
undefinedKey = mkPreludeMiscIdUnique 155
\end{code}
Certain class operations from Prelude classes. They get their own
......
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