From 47778c38eb4334de60dc3daaf0ab65a916b2043e Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Wed, 27 Oct 2010 16:29:22 +0000 Subject: [PATCH] Warn (not error) for SPECIALISE pragmas without INLINE See Note [SPECIALISE pragmas] in TcBinds. Fixes Trac #444. --- compiler/typecheck/TcBinds.lhs | 25 +++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index 638f692..3aaa58a 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -542,8 +542,9 @@ tcSpec poly_id prag@(SpecSig _ hs_ty inl) -- for the selector Id, but the poly_id is something like $cop = addErrCtxt (spec_ctxt prag) $ do { spec_ty <- tcHsSigType sig_ctxt hs_ty - ; checkTc (isOverloadedTy poly_ty) - (ptext (sLit "Discarding pragma for non-overloaded function") <+> quotes (ppr poly_id)) + ; warnIf (not (isOverloadedTy poly_ty || isInlinePragma inl)) + (ptext (sLit "SPECIALISE pragma for non-overloaded function") <+> quotes (ppr poly_id)) + -- Note [SPECIALISE pragmas] ; wrap <- tcSubType origin skol_info (idType poly_id) spec_ty ; return (SpecPrag poly_id wrap inl) } where @@ -602,6 +603,26 @@ forall_a_a :: TcType forall_a_a = mkForAllTy openAlphaTyVar (mkTyVarTy openAlphaTyVar) \end{code} +Note [SPECIALISE pragmas] +~~~~~~~~~~~~~~~~~~~~~~~~~ +There is no point in a SPECIALISE pragma for a non-overloaded function: + reverse :: [a] -> [a] + {-# SPECIALISE reverse :: [Int] -> [Int] #-} + +But SPECIALISE INLINE *can* make sense for GADTS: + data Arr e where + ArrInt :: !Int -> ByteArray# -> Arr Int + ArrPair :: !Int -> Arr e1 -> Arr e2 -> Arr (e1, e2) + + (!:) :: Arr e -> Int -> e + {-# SPECIALISE INLINE (!:) :: Arr Int -> Int -> Int #-} + {-# SPECIALISE INLINE (!:) :: Arr (a, b) -> Int -> (a, b) #-} + (ArrInt _ ba) !: (I# i) = I# (indexIntArray# ba i) + (ArrPair _ a1 a2) !: i = (a1 !: i, a2 !: i) + +When (!:) is specialised it becomes non-recursive, and can usefully +be inlined. Scary! So we only warn for SPECIALISE *without* INLINE +for a non-overloaded function. %************************************************************************ %* * -- 1.7.10.4