[commit: ghc] master: Make 'undefined' have the magical type 'forall (a:OpenKind).a' (a18ea4f)
Simon Peyton Jones
simonpj at microsoft.com
Wed May 15 15:16:23 CEST 2013
Repository : http://darcs.haskell.org/ghc.git/
On branch : master
https://github.com/ghc/ghc/commit/a18ea4f20b73e1b3ef5cda2389c713152eb9576e
>---------------------------------------------------------------
commit a18ea4f20b73e1b3ef5cda2389c713152eb9576e
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Wed May 15 09:51:25 2013 +0100
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.
>---------------------------------------------------------------
compiler/coreSyn/MkCore.lhs | 48 ++++++++++++++++++++++++++++++++++--------
compiler/prelude/PrelNames.lhs | 5 -----
2 files changed, 39 insertions(+), 14 deletions(-)
diff --git a/compiler/coreSyn/MkCore.lhs b/compiler/coreSyn/MkCore.lhs
index 4cc1998..c6fc2be 100644
--- a/compiler/coreSyn/MkCore.lhs
+++ b/compiler/coreSyn/MkCore.lhs
@@ -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}
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 19acf48..09835fb 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -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
More information about the ghc-commits
mailing list