From 3d88a73157a15627dcc2385148d9af66a80157ac Mon Sep 17 00:00:00 2001
From: simonm <unknown>
Date: Thu, 12 Feb 1998 14:10:58 +0000
Subject: [PATCH] [project @ 1998-02-12 14:10:58 by simonm] Make it an error
for a newtype constructor field to be unboxed (this would undoubtedly cause
problems later on, better to catch it early).
While I'm here, report the context properly for newtype declarations,
it was previously being reported as a 'data' declaration.
---
ghc/compiler/typecheck/TcTyDecls.lhs | 17 ++++++++++++++---
1 file changed, 14 insertions(+), 3 deletions(-)
diff --git a/ghc/compiler/typecheck/TcTyDecls.lhs b/ghc/compiler/typecheck/TcTyDecls.lhs
index bf34c9ce2ac9..b7c891039dfe 100644
--- a/ghc/compiler/typecheck/TcTyDecls.lhs
+++ b/ghc/compiler/typecheck/TcTyDecls.lhs
@@ -21,7 +21,7 @@ import RnHsSyn ( RenamedTyDecl(..), RenamedConDecl(..) )
import TcHsSyn ( mkHsTyLam, mkHsDictLam, tcIdType,
TcHsBinds, TcMonoBinds
)
-import BasicTypes ( RecFlag(..) )
+import BasicTypes ( RecFlag(..), NewOrData(..) )
import Inst ( newDicts, InstOrigin(..), Inst )
import TcMonoType ( tcHsTypeKind, tcHsType, tcContext )
@@ -54,7 +54,7 @@ import TyCon ( TyCon, mkSynTyCon, mkDataTyCon, isAlgTyCon,
import Type ( typeKind, getTyVar, tyVarsOfTypes, splitSigmaTy,
mkTyConApp, mkTyVarTys, mkForAllTys, mkFunTy,
splitFunTys, mkTyVarTy, getTyVar_maybe,
- Type, ThetaType
+ isUnboxedType, Type, ThetaType
)
import TyVar ( tyVarKind, elementOfTyVarSet, intersectTyVarSets, isEmptyTyVarSet,
TyVar )
@@ -113,7 +113,11 @@ Algebraic data and newtype decls
\begin{code}
tcTyDecl is_rec (TyData data_or_new context tycon_name tyvar_names con_decls derivings pragmas src_loc)
= tcAddSrcLoc src_loc $
- tcAddErrCtxt (tyDataCtxt tycon_name) $
+ let ctxt = case data_or_new of
+ NewType -> tyNewCtxt tycon_name
+ DataType -> tyDataCtxt tycon_name
+ in
+ tcAddErrCtxt ctxt $
-- Lookup the pieces
tcLookupTyCon tycon_name `thenTc` \ (tycon_kind, _, rec_tycon) ->
@@ -259,6 +263,9 @@ tcConDecl tycon tyvars ctxt (ConDecl op ex_ctxt (InfixCon bty1 bty2) src_loc)
tcConDecl tycon tyvars ctxt (ConDecl name ex_ctxt (NewCon ty) src_loc)
= tcAddSrcLoc src_loc $
tcHsType ty `thenTc` \ arg_ty ->
+ -- can't allow an unboxed type here, because we're effectively
+ -- going to remove the constructor while coercing it to a boxed type.
+ checkTc (not (isUnboxedType arg_ty)) (newTypeUnboxedField ty) `thenTc_`
let
data_con = mkDataCon (getName name)
[NotMarkedStrict]
@@ -349,6 +356,10 @@ tyNewCtxt tycon_name
fieldTypeMisMatch field_name
= sep [ptext SLIT("Declared types differ for field"), quotes (ppr field_name)]
+newTypeUnboxedField ty
+ = sep [ptext SLIT("Newtype constructor field has an unboxed type:"),
+ quotes (ppr ty)]
+
evalCtxt con eval_theta
= hsep [ptext SLIT("When checking the Eval context for constructor:"),
ppr con,
--
GitLab