[Git][ghc/ghc][wip/T25494] 3 commits: LLVM: When emitting a vector literal with ppTypeLit, include the type information
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Mon Dec 16 17:18:57 UTC 2024
Simon Peyton Jones pushed to branch wip/T25494 at Glasgow Haskell Compiler / GHC
Commits:
2d3a0a70 by ARATA Mizuki at 2024-12-15T18:35:30-05:00
LLVM: When emitting a vector literal with ppTypeLit, include the type information
Fixes #25561
- - - - -
bfacc086 by Simon Peyton Jones at 2024-12-15T18:36:05-05:00
Fix signature lookup in instance declarations
This fixes a bug introduced by the fix to #16610
- - - - -
101de9f5 by Simon Peyton Jones at 2024-12-16T11:10:33+00:00
Add Note [Typechecking overloaded literals]
See #25494.
- - - - -
13 changed files:
- compiler/GHC/Llvm/Ppr.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Utils/Unify.hs
- + testsuite/tests/rename/should_fail/T25437.hs
- + testsuite/tests/rename/should_fail/T25437.stderr
- testsuite/tests/rename/should_fail/T5001b.stderr
- testsuite/tests/rename/should_fail/all.T
- + testsuite/tests/simd/should_run/T25561.hs
- + testsuite/tests/simd/should_run/T25561.stdout
- testsuite/tests/simd/should_run/all.T
Changes:
=====================================
compiler/GHC/Llvm/Ppr.hs
=====================================
@@ -669,9 +669,7 @@ ppTypeLit = ppTypeLit' []
{-# SPECIALIZE ppTypeLit :: LlvmCgConfig -> LlvmLit -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
ppTypeLit' :: IsLine doc => [LlvmParamAttr] -> LlvmCgConfig -> LlvmLit -> doc
-ppTypeLit' attrs opts l = case l of
- LMVectorLit {} -> ppLit opts l
- _ -> ppLlvmType (getLitType l) <+> ppSpaceJoin ppLlvmParamAttr attrs <+> ppLit opts l
+ppTypeLit' attrs opts l = ppLlvmType (getLitType l) <+> ppSpaceJoin ppLlvmParamAttr attrs <+> ppLit opts l
{-# SPECIALIZE ppTypeLit' :: [LlvmParamAttr] -> LlvmCgConfig -> LlvmLit -> SDoc #-}
{-# SPECIALIZE ppTypeLit' :: [LlvmParamAttr] -> LlvmCgConfig -> LlvmLit -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
=====================================
compiler/GHC/Rename/Bind.hs
=====================================
@@ -956,7 +956,8 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs
; let (spec_prags, other_sigs) = partition (isSpecLSig <||> isSpecInstLSig) sigs
bound_nms = mkNameSet (collectHsBindsBinders CollNoDictBinders binds')
sig_ctxt | is_cls_decl = ClsDeclCtxt cls
- | otherwise = InstDeclCtxt bound_nms
+ | otherwise = InstDeclCtxt (mkOccEnv [ (nameOccName n, n)
+ | n <- nonDetEltsUniqSet bound_nms ])
; (spec_prags', spg_fvs) <- renameSigs sig_ctxt spec_prags
; (other_sigs', sig_fvs) <- bindLocalNamesFV ktv_names $
renameSigs sig_ctxt other_sigs
@@ -1071,18 +1072,9 @@ renameSigs ctxt sigs
; return (good_sigs, sig_fvs) }
----------------------
--- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory
--- because this won't work for:
--- instance Foo T where
--- {-# INLINE op #-}
--- Baz.op = ...
--- We'll just rename the INLINE prag to refer to whatever other 'op'
--- is in scope. (I'm assuming that Baz.op isn't in scope unqualified.)
--- Doesn't seem worth much trouble to sort this.
-
renameSig :: HsSigCtxt -> Sig GhcPs -> RnM (Sig GhcRn, FreeVars)
renameSig ctxt sig@(TypeSig _ vs ty)
- = do { new_vs <- mapM (lookupSigOccRnN ctxt sig) vs
+ = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
; let doc = TypeSigCtx (ppr_sig_bndrs vs)
; (new_ty, fvs) <- rnHsSigWcType doc ty
; return (TypeSig noAnn new_vs new_ty, fvs) }
@@ -1091,7 +1083,7 @@ renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty)
= do { defaultSigs_on <- xoptM LangExt.DefaultSignatures
; when (is_deflt && not defaultSigs_on) $
addErr (TcRnUnexpectedDefaultSig sig)
- ; new_v <- mapM (lookupSigOccRnN ctxt sig) vs
+ ; new_v <- mapM (lookupSigOccRn ctxt sig) vs
; (new_ty, fvs) <- rnHsSigType ty_ctxt TypeLevel ty
; return (ClassOpSig noAnn is_deflt new_v new_ty, fvs) }
where
@@ -1119,7 +1111,7 @@ renameSig _ (SpecInstSig (_, src) ty)
renameSig ctxt sig@(SpecSig _ v tys inl)
= do { new_v <- case ctxt of
TopSigCtxt {} -> lookupLocatedOccRn v
- _ -> lookupSigOccRnN ctxt sig v
+ _ -> lookupSigOccRn ctxt sig v
; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys
; return (SpecSig noAnn new_v new_ty inl, fvs) }
where
@@ -1130,7 +1122,7 @@ renameSig ctxt sig@(SpecSig _ v tys inl)
; return ( new_ty:tys, fvs_ty `plusFV` fvs) }
renameSig ctxt sig@(InlineSig _ v s)
- = do { new_v <- lookupSigOccRnN ctxt sig v
+ = do { new_v <- lookupSigOccRn ctxt sig v
; return (InlineSig noAnn new_v s, emptyFVs) }
renameSig ctxt (FixSig _ fsig)
@@ -1138,11 +1130,11 @@ renameSig ctxt (FixSig _ fsig)
; return (FixSig noAnn new_fsig, emptyFVs) }
renameSig ctxt sig@(MinimalSig (_, s) (L l bf))
- = do new_bf <- bfTraverse (lookupSigOccRnN ctxt sig) bf
+ = do new_bf <- bfTraverse (lookupSigOccRn ctxt sig) bf
return (MinimalSig (noAnn, s) (L l new_bf), emptyFVs)
renameSig ctxt sig@(PatSynSig _ vs ty)
- = do { new_vs <- mapM (lookupSigOccRnN ctxt sig) vs
+ = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
; (ty', fvs) <- rnHsSigType ty_ctxt TypeLevel ty
; return (PatSynSig noAnn new_vs ty', fvs) }
where
@@ -1150,7 +1142,7 @@ renameSig ctxt sig@(PatSynSig _ vs ty)
<+> ppr_sig_bndrs vs)
renameSig ctxt sig@(SCCFunSig (_, st) v s)
- = do { new_v <- lookupSigOccRnN ctxt sig v
+ = do { new_v <- lookupSigOccRn ctxt sig v
; return (SCCFunSig (noAnn, st) new_v s, emptyFVs) }
-- COMPLETE Sigs can refer to imported IDs which is why we use
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -34,7 +34,7 @@ module GHC.Rename.Env (
ChildLookupResult(..),
lookupSubBndrOcc_helper,
- HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn, lookupSigOccRnN,
+ HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn,
lookupSigCtxtOccRn,
lookupInstDeclBndr, lookupFamInstName,
@@ -2072,6 +2072,28 @@ data HsSigCtxt = ... | TopSigCtxt NameSet | ....
f :: C a => a -> a -- No, not ok
class C a where
f :: a -> a
+
+Note [Signatures in instance decls]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+ class C a where
+ op :: a -> a
+ nop :: a -> a
+
+ instance C ty where
+ bop :: [a] -> [a]
+ bop x = x
+
+ nop :: [a] -> [a]
+
+When renameing the `bop` binding we'll give it an UnboundName (still with
+OccName "bop") because `bop` is not a method of C. Then
+
+* when doing lookupSigOcc on `bop :: blah` we want to find `bop`, even though it
+ is an UnboundName (failing to do this causes #16610, and #25437)
+
+* When doing lookupSigOcc on `nop :: blah` we want to complain that there
+ is no accompanying binding, even though `nop` is a class method
-}
data HsSigCtxt
@@ -2079,8 +2101,8 @@ data HsSigCtxt
-- See Note [Signatures for top level things]
| LocalBindCtxt NameSet -- In a local binding, binding these names
| ClsDeclCtxt Name -- Class decl for this class
- | InstDeclCtxt NameSet -- Instance decl whose user-written method
- -- bindings are for these methods
+ | InstDeclCtxt (OccEnv Name) -- Instance decl whose user-written method
+ -- bindings are described by this OccEnv
| HsBootCtxt NameSet -- Top level of a hs-boot file, binding these names
| RoleAnnotCtxt NameSet -- A role annotation, with the names of all types
-- in the group
@@ -2095,14 +2117,10 @@ instance Outputable HsSigCtxt where
lookupSigOccRn :: HsSigCtxt
-> Sig GhcPs
- -> LocatedA RdrName -> RnM (LocatedA Name)
+ -> GenLocated (EpAnn ann) RdrName
+ -> RnM (GenLocated (EpAnn ann) Name)
lookupSigOccRn ctxt sig = lookupSigCtxtOccRn ctxt (hsSigDoc sig)
-lookupSigOccRnN :: HsSigCtxt
- -> Sig GhcPs
- -> LocatedN RdrName -> RnM (LocatedN Name)
-lookupSigOccRnN ctxt sig = lookupSigCtxtOccRn ctxt (hsSigDoc sig)
-
-- | Lookup a name in relation to the names in a 'HsSigCtxt'
lookupSigCtxtOccRn :: HsSigCtxt
-> SDoc -- ^ description of thing we're looking up,
@@ -2155,34 +2173,37 @@ lookupBindGroupOcc ctxt what rdr_name also_try_tycon_ns ns_spec
RoleAnnotCtxt ns -> lookup_top (elem_name_set_with_namespace ns)
LocalBindCtxt ns -> lookup_group ns
ClsDeclCtxt cls -> lookup_cls_op cls
- InstDeclCtxt ns -> if uniqSetAny isUnboundName ns -- #16610
- then return $ NE.singleton $ Right $ mkUnboundNameRdr rdr_name
- else lookup_top (elem_name_set_with_namespace ns)
+ InstDeclCtxt occ_env-> lookup_inst occ_env
where
elem_name_set_with_namespace ns n = check_namespace n && (n `elemNameSet` ns)
check_namespace = coveredByNamespaceSpecifier ns_spec . nameNameSpace
namespace = occNameSpace occ
- occ = rdrNameOcc rdr_name
- relevant_gres =
- RelevantGREs
- { includeFieldSelectors = WantBoth
- , lookupVariablesForFields = True
- , lookupTyConsAsWell = also_try_tycon_ns }
- ok_gre = greIsRelevant relevant_gres namespace
+ occ = rdrNameOcc rdr_name
+ ok_gre = greIsRelevant relevant_gres namespace
+ relevant_gres = RelevantGREs { includeFieldSelectors = WantBoth
+ , lookupVariablesForFields = True
+ , lookupTyConsAsWell = also_try_tycon_ns }
finish err gre
| ok_gre gre
- = NE.singleton (Right $ greName gre)
+ = NE.singleton (Right (greName gre))
| otherwise
= NE.singleton (Left err)
+ succeed_with n = return $ NE.singleton $ Right n
+
lookup_cls_op cls
= NE.singleton <$> lookupSubBndrOcc AllDeprecationWarnings cls doc rdr_name
where
doc = text "method of class" <+> quotes (ppr cls)
+ lookup_inst occ_env -- See Note [Signatures in instance decls]
+ = case lookupOccEnv occ_env occ of
+ Nothing -> bale_out_with []
+ Just n -> succeed_with n
+
lookup_top keep_me
= do { env <- getGlobalRdrEnv
; let occ = rdrNameOcc rdr_name
@@ -2205,7 +2226,7 @@ lookupBindGroupOcc ctxt what rdr_name also_try_tycon_ns ns_spec
; let candidates_msg = candidates $ localRdrEnvElts env
; case mname of
Just n
- | n `elemNameSet` bound_names -> return $ NE.singleton $ Right n
+ | n `elemNameSet` bound_names -> succeed_with n
| otherwise -> bale_out_with local_msg
Nothing -> bale_out_with candidates_msg }
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -296,13 +296,6 @@ tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty
tcExpr (XExpr e) res_ty = tcXExpr e res_ty
-tcExpr e@(HsOverLit _ lit) res_ty
- = do { mb_res <- tcShortCutLit lit res_ty
- -- See Note [Short cut for overloaded literals] in GHC.Tc.Zonk.Type
- ; case mb_res of
- Just lit' -> return (HsOverLit noExtField lit')
- Nothing -> tcApp e res_ty }
-
-- Typecheck an occurrence of an unbound Id
--
-- Some of these started life as a true expression hole "_".
@@ -353,6 +346,51 @@ tcExpr e@(HsLam x lam_variant matches) res_ty
= do { (wrap, matches') <- tcLambdaMatches e lam_variant matches [] res_ty
; return (mkHsWrap wrap $ HsLam x lam_variant matches') }
+{-
+************************************************************************
+* *
+ Overloaded literals
+* *
+************************************************************************
+-}
+
+tcExpr e@(HsOverLit _ lit) res_ty
+ = -- See Note [Typechecking overloaded literals]
+ do { mb_res <- tcShortCutLit lit res_ty
+ -- See Note [Short cut for overloaded literals] in GHC.Tc.Utils.TcMType
+ ; case mb_res of
+ Just lit' -> return (HsOverLit noExtField lit')
+ Nothing -> tcApp e res_ty }
+ -- Why go via tcApp? See Note [Typechecking overloaded literals]
+
+{- Note [Typechecking overloaded literals]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Generally speaking, an overloaded literal like "3" typechecks as if you
+had written (fromInteger (3 :: Integer)). But in practice it's a little
+tricky:
+
+* Rebindable syntax (see #19154 and !4981). With rebindable syntax we might have
+ fromInteger :: Integer -> forall a. Num a => a
+ and then we might hope to use a Visible Type Application (VTA) to write
+ 3 @Int
+ expecting it to expand to
+ fromInteger (3::Integer) @Int dNumInt
+ To achieve that, we need to
+ * treat the application using `tcApp` to deal with the VTA
+ * treat the overloaded literal as the "head" of an application;
+ see `GHC.Tc.Gen.Head.tcInferAppHead`.
+
+* Short-cutting. If we have
+ xs :: [Int]
+ xs = [3,4,5,6... ]
+ then it's a huge short-cut (in compile time) to just cough up the `Int` literal
+ for `3`, rather than (fromInteger @Int d), with a wanted constraint `[W] Num Int`.
+ See Note [Short cut for overloaded literals] in GHC.Tc.Utils.TcMType.
+
+ We can only take this short-cut if rebindable syntax is off; see `tcShortCutLit`.
+-}
+
+
{-
************************************************************************
* *
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -765,6 +765,8 @@ tcInferOverLit lit@(OverLit { ol_val = val
-- where fromInteger is gotten by looking up from_name, and
-- the (3 :: Integer) is returned by mkOverLit
-- Ditto the string literal "foo" to (fromString ("foo" :: String))
+ --
+ -- See Note [Typechecking overloaded literals] in GHC.Tc.Gen.Expr
do { hs_lit <- mkOverLit val
; from_id <- tcLookupId from_name
; (wrap1, from_ty) <- topInstantiate (LiteralOrigin lit) (idType from_id)
@@ -781,9 +783,10 @@ tcInferOverLit lit@(OverLit { ol_val = val
from_expr = mkHsWrap (wrap2 <.> wrap1) $
HsVar noExtField (L loc from_id)
witness = HsApp noExtField (L (l2l loc) from_expr) lit_expr
- lit' = lit { ol_ext = OverLitTc { ol_rebindable = rebindable
- , ol_witness = witness
- , ol_type = res_ty } }
+ lit' = OverLit { ol_val = val
+ , ol_ext = OverLitTc { ol_rebindable = rebindable
+ , ol_witness = witness
+ , ol_type = res_ty } }
; return (HsOverLit noExtField lit', res_ty) }
{- *********************************************************************
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -305,7 +305,7 @@ Both ultimately handled by matchExpectedFunTys.
* For the Lambda case there are two sub-cases:
* An expression with a type signature: (\ @a x y -> blah) :: hs_ty
This is handled by `GHC.Tc.Gen.Head.tcExprWithSig`, which kind-checks
- the signature and hands off to `tcExprPolyCheck` vai `tcPolyLExprSig`
+ the signature and hands off to `tcExprPolyCheck` via `tcPolyLExprSig`.
Note that the foralls at the top of hs_ty scope over the expression.
* A higher order call: h e, where h :: poly_ty -> blah
=====================================
testsuite/tests/rename/should_fail/T25437.hs
=====================================
@@ -0,0 +1,16 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module T25437 where
+
+class C a where
+ foo :: Int -> Maybe a
+
+instance C (Maybe x) where
+ foo :: Int -> Maybe [a]
+
+instance C [x] where
+ foo :: forall b. Int -> Maybe [b]
+ foo _ = Just @[b] []
+
+ something :: x -> x
+ something = ()
=====================================
testsuite/tests/rename/should_fail/T25437.stderr
=====================================
@@ -0,0 +1,5 @@
+T25437.hs:9:3: error: [GHC-44432]
+ The class method signature for ‘foo’ lacks an accompanying binding
+
+T25437.hs:16:3: error: [GHC-54721]
+ ‘something’ is not a (visible) method of class ‘C’
=====================================
testsuite/tests/rename/should_fail/T5001b.stderr
=====================================
@@ -1,5 +1,4 @@
T5001b.hs:10:17: error: [GHC-44432]
The INLINE pragma for ‘genum’ lacks an accompanying binding
- Suggested fix:
- Move the INLINE pragma to the declaration site of ‘genum’.
+
=====================================
testsuite/tests/rename/should_fail/all.T
=====================================
@@ -231,3 +231,4 @@ test('T14032c', normal, compile_fail, [''])
test('T14032f', normal, compile_fail, [''])
test('T23501_fail', normal, compile_fail, [''])
test('T23501_fail_ext', normal, compile_fail, [''])
+test('T25437', normal, compile_fail, [''])
=====================================
testsuite/tests/simd/should_run/T25561.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+import Data.Array.Base
+import Data.Array.IO.Internals
+import GHC.Exts
+import GHC.IO
+
+main :: IO ()
+main = do
+ ma@(IOUArray (STUArray l _ _ mba)) <- newListArray (0, 10) ([0..10] :: [Float])
+ IO $ \s -> (# writeFloatArrayAsFloatX4# mba 1# (broadcastFloatX4# 3.0#) s, () #)
+ print =<< getElems ma
=====================================
testsuite/tests/simd/should_run/T25561.stdout
=====================================
@@ -0,0 +1 @@
+[0.0,3.0,3.0,3.0,3.0,5.0,6.0,7.0,8.0,9.0,10.0]
=====================================
testsuite/tests/simd/should_run/all.T
=====================================
@@ -66,6 +66,7 @@ test('simd_insert_array', [], compile_and_run, [''])
test('T22187', [],compile,[''])
test('T22187_run', [],compile_and_run,[''])
test('T25062_V16', [], compile_and_run, [''])
+test('T25561', [], compile_and_run, [''])
# Even if the CPU we run on doesn't support *executing* those tests we should try to
# compile them.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80c38aef9567fcb7d8b935f0b445beaf864e6482...101de9f53e2503700958a078c7203d7223ee63db
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80c38aef9567fcb7d8b935f0b445beaf864e6482...101de9f53e2503700958a078c7203d7223ee63db
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241216/e5bcc901/attachment-0001.html>
More information about the ghc-commits
mailing list