[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Add Note [Typechecking overloaded literals]
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Dec 17 14:21:47 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
8ef2dad6 by Simon Peyton Jones at 2024-12-17T02:48:09-05:00
Add Note [Typechecking overloaded literals]
See #25494.
- - - - -
abd27d2d by Ben Gamari at 2024-12-17T09:21:31-05:00
testsuite: Use math.inf instead of division-by-zero
This both more directly captures the intent and also fixes #25580.
- - - - -
06d48131 by Ben Gamari at 2024-12-17T09:21:31-05:00
rts: Fix incorrect format specifiers in era profiling
Fixes #25581.
- - - - -
5 changed files:
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Utils/Unify.hs
- rts/ProfHeap.c
- testsuite/driver/perf_notes.py
Changes:
=====================================
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
=====================================
rts/ProfHeap.c
=====================================
@@ -958,9 +958,9 @@ dumpCensus( Census *census )
count * sizeof(W_));
break;
case HEAP_BY_ERA:
- fprintf(hp_file, "%lu", (StgWord)ctr->identity);
+ fprintf(hp_file, "%" FMT_Word, (StgWord)ctr->identity);
char str_era[100];
- sprintf(str_era, "%lu", (StgWord)ctr->identity);
+ sprintf(str_era, "%" FMT_Word, (StgWord)ctr->identity);
traceHeapProfSampleString(0, str_era, count * sizeof(W_));
break;
case HEAP_BY_MOD:
=====================================
testsuite/driver/perf_notes.py
=====================================
@@ -21,6 +21,7 @@ import sys
from collections import namedtuple, defaultdict
from math import ceil, trunc
+import math
from testutil import passed, failBecause, testing_metrics, print_table
from term_color import Color, colored
@@ -140,7 +141,7 @@ class MetricAcceptanceWindow:
class AlwaysAccept(MetricAcceptanceWindow):
def get_bounds(self, baseline: float) -> Tuple[float, float]:
- return (-1/0, +1/0)
+ return (-math.inf, +math.inf)
def describe(self) -> str:
raise NotImplemented
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/03a8158bc65b0f19ad9b950c3b911c2e93ecea28...06d48131dd77e38675071ad46bc4f5e579a56681
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/03a8158bc65b0f19ad9b950c3b911c2e93ecea28...06d48131dd77e38675071ad46bc4f5e579a56681
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/20241217/b88eb29d/attachment-0001.html>
More information about the ghc-commits
mailing list