[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: -Wunused-pattern-binds: Recurse into patterns to check whether there's a splice
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Sep 16 09:37:02 UTC 2022
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
8168ada7 by Matthew Pickering at 2022-09-16T05:36:22-04:00
-Wunused-pattern-binds: Recurse into patterns to check whether there's a splice
See the examples in #22057 which show we have to traverse deeply into a
pattern to determine whether it contains a splice or not. The original
implementation pointed this out but deemed this very shallow traversal
"too expensive".
Fixes #22057
I also fixed an oversight in !7821 which meant we lost a warning which
was present in 9.2.2.
Fixes #22067
- - - - -
e119cb77 by Cheng Shao at 2022-09-16T05:36:24-04:00
hadrian: enable -fprof-late only for profiling ways
- - - - -
a9dc679e by Cheng Shao at 2022-09-16T05:36:24-04:00
hadrian: add late_ccs flavour transformer
- - - - -
b0f18e9c by Cheng Shao at 2022-09-16T05:36:27-04:00
configure: remove unused program checks
- - - - -
75c9598f by Pierre Le Marre at 2022-09-16T05:36:30-04:00
Update to Unicode 15.0
- - - - -
4bc423f2 by Bodigrim at 2022-09-16T05:36:33-04:00
Avoid partial head and tail in ghc-heap; replace with total pattern-matching
- - - - -
4b993759 by Cheng Shao at 2022-09-16T05:36:35-04:00
hadrian: relax Cabal upper bound to allow building with Cabal-3.8
A follow up of !8910.
- - - - -
cc2edced by Alexis King at 2022-09-16T05:36:37-04:00
Add links to the continuations haddocks in the docs for each primop
fixes #22176
- - - - -
23 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/Rename/Bind.hs
- configure.ac
- docs/users_guide/9.6.1-notes.rst
- hadrian/hadrian.cabal
- hadrian/src/Flavour.hs
- libraries/base/GHC/Unicode/Internal/Char/UnicodeData/GeneralCategory.hs
- libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleLowerCaseMapping.hs
- libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleTitleCaseMapping.hs
- libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleUpperCaseMapping.hs
- libraries/base/GHC/Unicode/Internal/Version.hs
- libraries/base/changelog.md
- libraries/base/tests/unicode001.hs
- libraries/base/tests/unicode002.stdout
- libraries/base/tests/unicode003.stdout
- libraries/base/tools/ucd2haskell/README.md
- libraries/base/tools/ucd2haskell/unicode_version
- libraries/ghc-heap/GHC/Exts/Heap.hs
- libraries/ghc-heap/GHC/Exts/Heap/Utils.hsc
- + testsuite/tests/rename/should_compile/T22057.hs
- + testsuite/tests/rename/should_compile/T22067.hs
- + testsuite/tests/rename/should_compile/T22067.stderr
- testsuite/tests/rename/should_compile/all.T
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -2634,7 +2634,9 @@ primop MaskStatus "getMaskingState#" GenPrimOp
------------------------------------------------------------------------
section "Continuations"
- { These operations provide access to first-class delimited continuations,
+ { #continuations#
+
+ These operations provide access to first-class delimited continuations,
which allow a computation to access and manipulate portions of its
/current continuation/. Operationally, they are implemented by direct
manipulation of the RTS call stack, which may provide significant
@@ -2791,9 +2793,11 @@ section "Continuations"
------------------------------------------------------------------------
primtype PromptTag# a
+ { See "GHC.Prim#continuations". }
primop NewPromptTagOp "newPromptTag#" GenPrimOp
State# RealWorld -> (# State# RealWorld, PromptTag# a #)
+ { See "GHC.Prim#continuations". }
with
out_of_line = True
has_side_effects = True
@@ -2802,6 +2806,7 @@ primop PromptOp "prompt#" GenPrimOp
PromptTag# a
-> (State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
+ { See "GHC.Prim#continuations". }
with
strictness = { \ _arity -> mkClosedDmdSig [topDmd, strictOnceApply1Dmd, topDmd] topDiv }
out_of_line = True
@@ -2813,6 +2818,7 @@ primop Control0Op "control0#" GenPrimOp
-> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, a #))
-> State# RealWorld -> (# State# RealWorld, p #)
+ { See "GHC.Prim#continuations". }
with
strictness = { \ _arity -> mkClosedDmdSig [topDmd, lazyApply2Dmd, topDmd] topDiv }
out_of_line = True
=====================================
compiler/GHC/Rename/Bind.hs
=====================================
@@ -493,18 +493,10 @@ rnBind _ bind@(PatBind { pat_lhs = pat
bind' = bind { pat_rhs = grhss'
, pat_ext = fvs' }
- ok_nobind_pat
- = -- See Note [Pattern bindings that bind no variables]
- case unLoc pat of
- WildPat {} -> True
- BangPat {} -> True -- #9127, #13646
- SplicePat {} -> True
- _ -> False
-
-- Warn if the pattern binds no variables
-- See Note [Pattern bindings that bind no variables]
; whenWOptM Opt_WarnUnusedPatternBinds $
- when (null bndrs && not ok_nobind_pat) $
+ when (null bndrs && not (isOkNoBindPattern pat)) $
addTcRnDiagnostic (TcRnUnusedPatternBinds bind')
; fvs' `seq` -- See Note [Free-variable space leak]
@@ -540,29 +532,66 @@ rnBind sig_fn (PatSynBind x bind)
rnBind _ b = pprPanic "rnBind" (ppr b)
+ -- See Note [Pattern bindings that bind no variables]
+isOkNoBindPattern :: LPat GhcRn -> Bool
+isOkNoBindPattern (L _ pat) =
+ case pat of
+ WildPat{} -> True -- Exception (1)
+ BangPat {} -> True -- Exception (2) #9127, #13646
+ p -> patternContainsSplice p -- Exception (3)
+
+ where
+ lpatternContainsSplice :: LPat GhcRn -> Bool
+ lpatternContainsSplice (L _ p) = patternContainsSplice p
+ patternContainsSplice :: Pat GhcRn -> Bool
+ patternContainsSplice p =
+ case p of
+ -- A top-level splice has been evaluated by this point, so we know the pattern it is evaluated to
+ SplicePat (HsUntypedSpliceTop _ p) _ -> patternContainsSplice p
+ -- A nested splice isn't evaluated so we can't guess what it will expand to
+ SplicePat (HsUntypedSpliceNested {}) _ -> True
+ -- The base cases
+ VarPat {} -> False
+ WildPat {} -> False
+ LitPat {} -> False
+ NPat {} -> False
+ NPlusKPat {} -> False
+ -- Recursive cases
+ BangPat _ lp -> lpatternContainsSplice lp
+ LazyPat _ lp -> lpatternContainsSplice lp
+ AsPat _ _ _ lp -> lpatternContainsSplice lp
+ ParPat _ _ lp _ -> lpatternContainsSplice lp
+ ViewPat _ _ lp -> lpatternContainsSplice lp
+ SigPat _ lp _ -> lpatternContainsSplice lp
+ ListPat _ lps -> any lpatternContainsSplice lps
+ TuplePat _ lps _ -> any lpatternContainsSplice lps
+ SumPat _ lp _ _ -> lpatternContainsSplice lp
+ ConPat _ _ cpd -> any lpatternContainsSplice (hsConPatArgs cpd)
+ XPat (HsPatExpanded _orig new) -> patternContainsSplice new
+
{- Note [Pattern bindings that bind no variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Generally, we want to warn about pattern bindings like
Just _ = e
because they don't do anything! But we have three exceptions:
-* A wildcard pattern
+(1) A wildcard pattern
_ = rhs
which (a) is not that different from _v = rhs
(b) is sometimes used to give a type sig for,
or an occurrence of, a variable on the RHS
-* A strict pattern binding; that is, one with an outermost bang
+(2) A strict pattern binding; that is, one with an outermost bang
!Just _ = e
This can fail, so unlike the lazy variant, it is not a no-op.
Moreover, #13646 argues that even for single constructor
types, you might want to write the constructor. See also #9127.
-* A splice pattern
+(3) A splice pattern
$(th-lhs) = rhs
It is impossible to determine whether or not th-lhs really
- binds any variable. We should disable the warning for any pattern
- which contain splices, but that is a more expensive check.
+ binds any variable. You have to recurse all the way into the pattern to check
+ it doesn't contain any splices like this. See #22057.
Note [Free-variable space leak]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
configure.ac
=====================================
@@ -745,11 +745,6 @@ dnl ** check for tar
dnl if GNU tar is named gtar, look for it first.
AC_PATH_PROGS(TarCmd,gnutar gtar tar,tar)
-dnl ** check for compressors
-AC_PATH_PROGS(Bzip2Cmd,bzip2, bzip2)
-AC_PATH_PROGS(GzipCmd,gzip, gzip)
-AC_PATH_PROGS(XzCmd,pxz xz, xz)
-
dnl ** check for patch
dnl if GNU patch is named gpatch, look for it first
AC_PATH_PROGS(PatchCmd,gpatch patch, patch)
=====================================
docs/users_guide/9.6.1-notes.rst
=====================================
@@ -91,7 +91,7 @@ Runtime system
no safe API to access this functionality is provided anywhere in ``base``.
Instead, the ``prompt#`` and ``control0#`` primops are intended to be consumed
by library authors directly, who may wrap them a safe API that maintains the
- necessary invariants. See the documentation in ``GHC.Exts`` for more details.
+ necessary invariants. See the documentation in ``GHC.Prim`` for more details.
``base`` library
~~~~~~~~~~~~~~~~
=====================================
hadrian/hadrian.cabal
=====================================
@@ -147,7 +147,7 @@ executable hadrian
, BangPatterns
other-extensions: MultiParamTypeClasses
, TypeFamilies
- build-depends: Cabal >= 3.2 && < 3.7
+ build-depends: Cabal >= 3.2 && < 3.9
, base >= 4.8 && < 5
, bytestring >= 0.10 && < 0.12
, containers >= 0.5 && < 0.7
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -56,6 +56,7 @@ flavourTransformers = M.fromList
, "debug_stage1_ghc" =: debugGhc stage0InTree
, "lint" =: enableLinting
, "haddock" =: enableHaddock
+ , "late_ccs" =: enableLateCCS
]
where (=:) = (,)
@@ -237,6 +238,7 @@ enableIPE = addArgs
enableLateCCS :: Flavour -> Flavour
enableLateCCS = addArgs
$ notStage0 ? builder (Ghc CompileHs)
+ ? ((Profiling `wayUnit`) <$> getWay)
? arg "-fprof-late"
-- | Enable assertions for the stage2 compiler
@@ -525,4 +527,3 @@ builderSetting =
stages = map (\stg -> (stageString stg, stg)) allStages
pkgs = map (\pkg -> (pkgName pkg, pkg)) (ghcPackages ++ userPackages)
-
=====================================
libraries/base/GHC/Unicode/Internal/Char/UnicodeData/GeneralCategory.hs
=====================================
The diff for this file was not included because it is too large.
=====================================
libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleLowerCaseMapping.hs
=====================================
@@ -1,5 +1,5 @@
-- DO NOT EDIT: This file is automatically generated by the internal tool ucd2haskell,
--- with data from: https://www.unicode.org/Public/14.0.0/ucd/UnicodeData.txt.
+-- with data from: https://www.unicode.org/Public/15.0.0/ucd/UnicodeData.txt.
{-# LANGUAGE NoImplicitPrelude, LambdaCase #-}
{-# OPTIONS_HADDOCK hide #-}
=====================================
libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleTitleCaseMapping.hs
=====================================
@@ -1,5 +1,5 @@
-- DO NOT EDIT: This file is automatically generated by the internal tool ucd2haskell,
--- with data from: https://www.unicode.org/Public/14.0.0/ucd/UnicodeData.txt.
+-- with data from: https://www.unicode.org/Public/15.0.0/ucd/UnicodeData.txt.
{-# LANGUAGE NoImplicitPrelude, LambdaCase #-}
{-# OPTIONS_HADDOCK hide #-}
=====================================
libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleUpperCaseMapping.hs
=====================================
@@ -1,5 +1,5 @@
-- DO NOT EDIT: This file is automatically generated by the internal tool ucd2haskell,
--- with data from: https://www.unicode.org/Public/14.0.0/ucd/UnicodeData.txt.
+-- with data from: https://www.unicode.org/Public/15.0.0/ucd/UnicodeData.txt.
{-# LANGUAGE NoImplicitPrelude, LambdaCase #-}
{-# OPTIONS_HADDOCK hide #-}
=====================================
libraries/base/GHC/Unicode/Internal/Version.hs
=====================================
@@ -19,8 +19,8 @@ where
import {-# SOURCE #-} Data.Version
-- | Version of Unicode standard used by @base@:
--- [14.0.0](https://www.unicode.org/versions/Unicode14.0.0/).
+-- [15.0.0](https://www.unicode.org/versions/Unicode15.0.0/).
--
-- @since 4.15.0.0
unicodeVersion :: Version
-unicodeVersion = makeVersion [14, 0, 0]
+unicodeVersion = makeVersion [15, 0, 0]
=====================================
libraries/base/changelog.md
=====================================
@@ -29,6 +29,7 @@
is now exported from `Prelude`. See [CLC #50](https://github.com/haskell/core-libraries-committee/issues/50)
for the related discussion,
as well as [the migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides/export-lifta2-prelude.md)
+ * Update to Unicode 15.0.0.
## 4.17.0.0 *August 2022*
=====================================
libraries/base/tests/unicode001.hs
=====================================
@@ -12,7 +12,7 @@ main = do
do_char char = s ++ (take (12-length s) (repeat ' ')) ++ concat (map f bs)
where
s = show char
- bs = map ($char) functions
+ bs = map ($ char) functions
f True = "X "
f False = " "
=====================================
libraries/base/tests/unicode002.stdout
=====================================
@@ -3314,7 +3314,7 @@ Code C P S U L A D
3312 F F F F F F F
3313 F T F F F T F
3314 F T F F F T F
-3315 F F F F F F F
+3315 F T F F F F F
3316 F F F F F F F
3317 F F F F F F F
3318 F F F F F F F
@@ -3789,7 +3789,7 @@ Code C P S U L A D
3787 F T F F F F F
3788 F T F F F F F
3789 F T F F F F F
-3790 F F F F F F F
+3790 F T F F F F F
3791 F F F F F F F
3792 F T F F F F F
3793 F T F F F F F
=====================================
libraries/base/tests/unicode003.stdout
=====================================
@@ -32,11 +32,11 @@ b54,-1748855834,-1637297928
bb8,-1397865929,883567028
c1c,-264170711,891256304
c80,2137024553,478728044
-ce4,-991366506,1583915976
+ce4,-1660460875,1583915976
d48,-651373686,-1004871068
dac,-1169615531,-988897408
e10,1814409961,155596444
-e74,135711270,-609427496
+e74,963650286,-609427496
ed8,-1416017146,-1439222892
f3c,1403902424,1433030608
fa0,299354809,273668620
@@ -692,7 +692,7 @@ ffdc,-2015459986,1906523440
10d88,-847508383,-1808919772
10dec,-847508383,538515008
10e50,-188198045,1503265372
-10eb4,-1034104055,-491064168
+10eb4,-1370226063,-491064168
10f18,-350286230,-1694282284
10f7c,1484313900,856053392
10fe0,-723679588,-588754868
@@ -701,7 +701,7 @@ ffdc,-2015459986,1906523440
1110c,1655903282,449049760
11170,-1051595,32149756
111d4,2109886511,1120445560
-11238,-337373458,1455451956
+11238,-659711824,1455451956
1129c,-1148635252,-368614032
11300,696218094,-2068618516
11364,-686461423,208748104
@@ -723,7 +723,7 @@ ffdc,-2015459986,1906523440
119a4,-1139814714,593543304
11a08,1795222972,-262351708
11a6c,307339100,1598197440
-11ad0,1613469971,-1283076388
+11ad0,-1522264485,-1283076388
11b34,-847508383,-177855464
11b98,-847508383,487104084
11bfc,-2065396652,888655120
@@ -733,8 +733,8 @@ ffdc,-2015459986,1906523440
11d8c,1348516795,1770597664
11df0,-847508383,1176409468
11e54,-847508383,-1707561992
-11eb8,-1502831374,1494051508
-11f1c,-847508383,367208176
+11eb8,2081578339,1494051508
+11f1c,-1149259987,367208176
11f80,1106256227,1888008812
11fe4,757618445,-1421783352
12048,657752308,332029284
@@ -787,8 +787,8 @@ ffdc,-2015459986,1906523440
132a4,657752308,-302543992
13308,657752308,-1755701852
1336c,657752308,-1080401472
-133d0,622961565,1547985372
-13434,1770698299,-189064936
+133d0,1375666284,1547985372
+13434,934320124,-189064936
13498,-847508383,-366597292
134fc,-847508383,-1290482672
13560,-847508383,410098124
@@ -1107,8 +1107,8 @@ ffdc,-2015459986,1906523440
1afa4,-826749161,1555287688
1b008,657752308,-1636146524
1b06c,657752308,-2023206720
-1b0d0,-993675331,-289721124
-1b134,-1949537464,1982839320
+1b0d0,-574234906,-289721124
+1b134,-1242452955,1982839320
1b198,657752308,1394012244
1b1fc,657752308,-1653165296
1b260,657752308,-137343284
@@ -1193,8 +1193,8 @@ ffdc,-2015459986,1906523440
1d13c,-898907559,-872375856
1d1a0,-1152492591,-1201120244
1d204,-1459916519,-1252799320
-1d268,-847508383,-14303932
-1d2cc,143940813,-646470432
+1d268,1804045749,-14303932
+1d2cc,-640919574,-646470432
1d330,-329414484,1932561468
1d394,-847508383,-1734110024
1d3f8,170379721,-333552908
@@ -1225,11 +1225,11 @@ ffdc,-2015459986,1906523440
1ddbc,-847508383,-868111280
1de20,-847508383,1044035212
1de84,-847508383,-1630701272
-1dee8,574970994,-117287484
+1dee8,1239944610,-117287484
1df4c,-847508383,387643232
1dfb0,-62539639,-1756483396
-1e014,906881201,-65223112
-1e078,-847508383,-1946563980
+1e014,702354581,-65223112
+1e078,1024183577,-1946563980
1e0dc,885955124,-210392528
1e140,590739849,1173406764
1e1a4,-847508383,644941960
@@ -1240,7 +1240,7 @@ ffdc,-2015459986,1906523440
1e398,-847508383,-478480812
1e3fc,-847508383,-503630576
1e460,-847508383,1606163660
-1e4c4,-847508383,180346728
+1e4c4,1412498216,180346728
1e528,-847508383,-1797992572
1e58c,-847508383,2096370976
1e5f0,-847508383,-2094838404
@@ -1286,17 +1286,17 @@ ffdc,-2015459986,1906523440
1f590,-1105473175,328132636
1f5f4,-1105473175,2066842712
1f658,-1105473175,-1920516332
-1f6bc,-439945135,1904745808
-1f720,-270299271,2006428044
-1f784,-1856991071,-343818712
+1f6bc,1645245961,1904745808
+1f720,-1162559895,2006428044
+1f784,-702101815,-343818712
1f7e8,1976628113,-898518844
1f84c,471140881,282876512
1f8b0,-10438759,-395554372
1f914,-1105473175,-679784648
1f978,-1105473175,1183875956
1f9dc,-1105473175,1885428528
-1fa40,-1534740639,2004332332
-1faa4,-1131042383,2017661832
+1fa40,923756505,2004332332
+1faa4,467344305,2017661832
1fb08,-1105473175,1091204516
1fb6c,1120513513,-117061184
1fbd0,1887269219,1232484828
@@ -1778,7 +1778,7 @@ ffdc,-2015459986,1906523440
2b5c0,657752308,1930785196
2b624,657752308,-149225208
2b688,657752308,-88958940
-2b6ec,-1998519121,728275264
+2b6ec,-324656038,728275264
2b750,657752308,-1891904164
2b7b4,657752308,58192280
2b818,-276965978,1939972820
@@ -2014,49 +2014,49 @@ ffdc,-2015459986,1906523440
311f0,657752308,360595836
31254,657752308,-488110088
312b8,657752308,-889624908
-3131c,-56393871,2019611376
-31380,-847508383,-1213041044
-313e4,-847508383,-1135936824
-31448,-847508383,1696461156
-314ac,-847508383,1125471872
-31510,-847508383,680032156
-31574,-847508383,1996493528
-315d8,-847508383,283544724
-3163c,-847508383,-1902150960
-316a0,-847508383,-962983156
-31704,-847508383,872440232
-31768,-847508383,212618308
-317cc,-847508383,-1056997408
-31830,-847508383,-296270532
-31894,-847508383,-1547695688
-318f8,-847508383,1004955636
-3195c,-847508383,621756848
-319c0,-847508383,1650466220
-31a24,-847508383,-408089336
-31a88,-847508383,-1063437276
-31aec,-847508383,1314628928
-31b50,-847508383,-807380644
-31bb4,-847508383,-1248342632
-31c18,-847508383,-319457580
-31c7c,-847508383,-1276547696
-31ce0,-847508383,1954980172
-31d44,-847508383,-1819820568
-31da8,-847508383,333403140
-31e0c,-847508383,-2025999968
-31e70,-847508383,1747736060
-31ed4,-847508383,-1470334600
-31f38,-847508383,-1433450956
-31f9c,-847508383,1476839536
-32000,-847508383,120898540
-32064,-847508383,-679398584
-320c8,-847508383,-782284572
-3212c,-847508383,1594699520
-32190,-847508383,562228252
-321f4,-847508383,1176514648
-32258,-847508383,-461262060
-322bc,-847508383,922315088
-32320,-847508383,-238903924
-32384,-847508383,-2021244376
+3131c,-15536511,2019611376
+31380,657752308,-1213041044
+313e4,657752308,-1135936824
+31448,657752308,1696461156
+314ac,657752308,1125471872
+31510,657752308,680032156
+31574,657752308,1996493528
+315d8,657752308,283544724
+3163c,657752308,-1902150960
+316a0,657752308,-962983156
+31704,657752308,872440232
+31768,657752308,212618308
+317cc,657752308,-1056997408
+31830,657752308,-296270532
+31894,657752308,-1547695688
+318f8,657752308,1004955636
+3195c,657752308,621756848
+319c0,657752308,1650466220
+31a24,657752308,-408089336
+31a88,657752308,-1063437276
+31aec,657752308,1314628928
+31b50,657752308,-807380644
+31bb4,657752308,-1248342632
+31c18,657752308,-319457580
+31c7c,657752308,-1276547696
+31ce0,657752308,1954980172
+31d44,657752308,-1819820568
+31da8,657752308,333403140
+31e0c,657752308,-2025999968
+31e70,657752308,1747736060
+31ed4,657752308,-1470334600
+31f38,657752308,-1433450956
+31f9c,657752308,1476839536
+32000,657752308,120898540
+32064,657752308,-679398584
+320c8,657752308,-782284572
+3212c,657752308,1594699520
+32190,657752308,562228252
+321f4,657752308,1176514648
+32258,657752308,-461262060
+322bc,657752308,922315088
+32320,657752308,-238903924
+32384,-696549012,-2021244376
323e8,-847508383,1145582788
3244c,-847508383,1664085600
324b0,-847508383,-2133158468
=====================================
libraries/base/tools/ucd2haskell/README.md
=====================================
@@ -27,7 +27,7 @@ with Python.
__Warning:__ A Python version with the _exact same Unicode version_ is required.
-# GHC
+## GHC
Check the properties of all the characters.
@@ -37,7 +37,7 @@ ghc -O2 tests/export_all_chars.hs
python3 tests/check_all_chars.py tests/all_chars.csv
```
-# GHC tests data
+## GHC tests data
Check the Unicode test data (`unicodeNNN.stdout`).
=====================================
libraries/base/tools/ucd2haskell/unicode_version
=====================================
@@ -1 +1 @@
-VERSION="14.0.0"
+VERSION="15.0.0"
=====================================
libraries/ghc-heap/GHC/Exts/Heap.hs
=====================================
@@ -71,7 +71,6 @@ import GHC.Exts.Heap.Utils
import qualified GHC.Exts.Heap.FFIClosures as FFIClosures
import qualified GHC.Exts.Heap.ProfInfo.PeekProfInfo as PPI
-import Control.Monad
import Data.Bits
import Foreign
import GHC.Exts
@@ -221,135 +220,119 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do
t | t >= THUNK && t <= THUNK_STATIC -> do
pure $ ThunkClosure itbl pts npts
- THUNK_SELECTOR -> do
- unless (length pts >= 1) $
- fail "Expected at least 1 ptr argument to THUNK_SELECTOR"
- pure $ SelectorClosure itbl (head pts)
+ THUNK_SELECTOR -> case pts of
+ [] -> fail "Expected at least 1 ptr argument to THUNK_SELECTOR"
+ hd : _ -> pure $ SelectorClosure itbl hd
t | t >= FUN && t <= FUN_STATIC -> do
pure $ FunClosure itbl pts npts
- AP -> do
- unless (length pts >= 1) $
- fail "Expected at least 1 ptr argument to AP"
- -- We expect at least the arity, n_args, and fun fields
- unless (length payloadWords >= 2) $
- fail "Expected at least 2 raw words to AP"
- let splitWord = payloadWords !! 0
- pure $ APClosure itbl
+ AP -> case pts of
+ [] -> fail "Expected at least 1 ptr argument to AP"
+ hd : tl -> case payloadWords of
+ -- We expect at least the arity, n_args, and fun fields
+ splitWord : _ : _ ->
+ pure $ APClosure itbl
#if defined(WORDS_BIGENDIAN)
- (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
- (fromIntegral splitWord)
+ (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
+ (fromIntegral splitWord)
#else
- (fromIntegral splitWord)
- (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
+ (fromIntegral splitWord)
+ (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
#endif
- (head pts) (tail pts)
-
- PAP -> do
- unless (length pts >= 1) $
- fail "Expected at least 1 ptr argument to PAP"
- -- We expect at least the arity, n_args, and fun fields
- unless (length payloadWords >= 2) $
- fail "Expected at least 2 raw words to PAP"
- let splitWord = payloadWords !! 0
- pure $ PAPClosure itbl
+ hd tl
+ _ -> fail "Expected at least 2 raw words to AP"
+
+ PAP -> case pts of
+ [] -> fail "Expected at least 1 ptr argument to PAP"
+ hd : tl -> case payloadWords of
+ -- We expect at least the arity, n_args, and fun fields
+ splitWord : _ : _ ->
+ pure $ PAPClosure itbl
#if defined(WORDS_BIGENDIAN)
- (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
- (fromIntegral splitWord)
+ (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
+ (fromIntegral splitWord)
#else
- (fromIntegral splitWord)
- (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
+ (fromIntegral splitWord)
+ (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
#endif
- (head pts) (tail pts)
-
- AP_STACK -> do
- unless (length pts >= 1) $
- fail "Expected at least 1 ptr argument to AP_STACK"
- pure $ APStackClosure itbl (head pts) (tail pts)
-
- IND -> do
- unless (length pts >= 1) $
- fail "Expected at least 1 ptr argument to IND"
- pure $ IndClosure itbl (head pts)
-
- IND_STATIC -> do
- unless (length pts >= 1) $
- fail "Expected at least 1 ptr argument to IND_STATIC"
- pure $ IndClosure itbl (head pts)
-
- BLACKHOLE -> do
- unless (length pts >= 1) $
- fail "Expected at least 1 ptr argument to BLACKHOLE"
- pure $ BlackholeClosure itbl (head pts)
-
- BCO -> do
- unless (length pts >= 3) $
- fail $ "Expected at least 3 ptr argument to BCO, found "
- ++ show (length pts)
- unless (length payloadWords >= 4) $
- fail $ "Expected at least 4 words to BCO, found "
- ++ show (length payloadWords)
- let splitWord = payloadWords !! 3
- pure $ BCOClosure itbl (pts !! 0) (pts !! 1) (pts !! 2)
+ hd tl
+ _ -> fail "Expected at least 2 raw words to PAP"
+
+ AP_STACK -> case pts of
+ [] -> fail "Expected at least 1 ptr argument to AP_STACK"
+ hd : tl -> pure $ APStackClosure itbl hd tl
+
+ IND -> case pts of
+ [] -> fail "Expected at least 1 ptr argument to IND"
+ hd : _ -> pure $ IndClosure itbl hd
+
+ IND_STATIC -> case pts of
+ [] -> fail "Expected at least 1 ptr argument to IND_STATIC"
+ hd : _ -> pure $ IndClosure itbl hd
+
+ BLACKHOLE -> case pts of
+ [] -> fail "Expected at least 1 ptr argument to BLACKHOLE"
+ hd : _ -> pure $ BlackholeClosure itbl hd
+
+ BCO -> case pts of
+ pts0 : pts1 : pts2 : _ -> case payloadWords of
+ _ : _ : _ : splitWord : payloadRest ->
+ pure $ BCOClosure itbl pts0 pts1 pts2
#if defined(WORDS_BIGENDIAN)
- (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
- (fromIntegral splitWord)
+ (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
+ (fromIntegral splitWord)
#else
- (fromIntegral splitWord)
- (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
+ (fromIntegral splitWord)
+ (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
#endif
- (drop 4 payloadWords)
+ payloadRest
+ _ -> fail $ "Expected at least 4 words to BCO, found "
+ ++ show (length payloadWords)
+ _ -> fail $ "Expected at least 3 ptr argument to BCO, found "
+ ++ show (length pts)
- ARR_WORDS -> do
- unless (length payloadWords >= 1) $
- fail $ "Expected at least 1 words to ARR_WORDS, found "
+ ARR_WORDS -> case payloadWords of
+ [] -> fail $ "Expected at least 1 words to ARR_WORDS, found "
++ show (length payloadWords)
- pure $ ArrWordsClosure itbl (head payloadWords) (tail payloadWords)
+ hd : tl -> pure $ ArrWordsClosure itbl hd tl
- t | t >= MUT_ARR_PTRS_CLEAN && t <= MUT_ARR_PTRS_FROZEN_CLEAN -> do
- unless (length payloadWords >= 2) $
- fail $ "Expected at least 2 words to MUT_ARR_PTRS_* "
+ t | t >= MUT_ARR_PTRS_CLEAN && t <= MUT_ARR_PTRS_FROZEN_CLEAN -> case payloadWords of
+ p0 : p1 : _ -> pure $ MutArrClosure itbl p0 p1 pts
+ _ -> fail $ "Expected at least 2 words to MUT_ARR_PTRS_* "
++ "found " ++ show (length payloadWords)
- pure $ MutArrClosure itbl (payloadWords !! 0) (payloadWords !! 1) pts
- t | t >= SMALL_MUT_ARR_PTRS_CLEAN && t <= SMALL_MUT_ARR_PTRS_FROZEN_CLEAN -> do
- unless (length payloadWords >= 1) $
- fail $ "Expected at least 1 word to SMALL_MUT_ARR_PTRS_* "
+ t | t >= SMALL_MUT_ARR_PTRS_CLEAN && t <= SMALL_MUT_ARR_PTRS_FROZEN_CLEAN -> case payloadWords of
+ [] -> fail $ "Expected at least 1 word to SMALL_MUT_ARR_PTRS_* "
++ "found " ++ show (length payloadWords)
- pure $ SmallMutArrClosure itbl (payloadWords !! 0) pts
+ hd : _ -> pure $ SmallMutArrClosure itbl hd pts
- t | t == MUT_VAR_CLEAN || t == MUT_VAR_DIRTY -> do
- unless (length pts >= 1) $
- fail $ "Expected at least 1 words to MUT_VAR, found "
+ t | t == MUT_VAR_CLEAN || t == MUT_VAR_DIRTY -> case pts of
+ [] -> fail $ "Expected at least 1 words to MUT_VAR, found "
++ show (length pts)
- pure $ MutVarClosure itbl (head pts)
+ hd : _ -> pure $ MutVarClosure itbl hd
- t | t == MVAR_CLEAN || t == MVAR_DIRTY -> do
- unless (length pts >= 3) $
- fail $ "Expected at least 3 ptrs to MVAR, found "
+ t | t == MVAR_CLEAN || t == MVAR_DIRTY -> case pts of
+ pts0 : pts1 : pts2 : _ -> pure $ MVarClosure itbl pts0 pts1 pts2
+ _ -> fail $ "Expected at least 3 ptrs to MVAR, found "
++ show (length pts)
- pure $ MVarClosure itbl (pts !! 0) (pts !! 1) (pts !! 2)
BLOCKING_QUEUE ->
pure $ OtherClosure itbl pts rawHeapWords
- -- pure $ BlockingQueueClosure itbl
- -- (pts !! 0) (pts !! 1) (pts !! 2) (pts !! 3)
- -- pure $ OtherClosure itbl pts rawHeapWords
- --
- WEAK -> do
- pure $ WeakClosure
+ WEAK -> case pts of
+ pts0 : pts1 : pts2 : pts3 : rest -> pure $ WeakClosure
{ info = itbl
- , cfinalizers = pts !! 0
- , key = pts !! 1
- , value = pts !! 2
- , finalizer = pts !! 3
- , weakLink = case drop 4 pts of
+ , cfinalizers = pts0
+ , key = pts1
+ , value = pts2
+ , finalizer = pts3
+ , weakLink = case rest of
[] -> Nothing
[p] -> Just p
- _ -> error $ "Expected 4 or 5 words in WEAK, found " ++ show (length pts)
+ _ -> error $ "Expected 4 or 5 words in WEAK, but found more: " ++ show (length pts)
}
+ _ -> error $ "Expected 4 or 5 words in WEAK, but found less: " ++ show (length pts)
TSO | ( u_lnk : u_gbl_lnk : tso_stack : u_trec : u_blk_ex : u_bq : other) <- pts
-> withArray rawHeapWords (\ptr -> do
fields <- FFIClosures.peekTSOFields decodeCCS ptr
=====================================
libraries/ghc-heap/GHC/Exts/Heap/Utils.hsc
=====================================
@@ -110,11 +110,7 @@ parse (Ptr addr) = if not . all (>0) . fmap length $ [p,m,occ]
(m, occ)
= (intercalate "." $ reverse modWords, occWord)
where
- (modWords, occWord) =
- if length rest1 < 1 -- XXXXXXXXx YUKX
- --then error "getConDescAddress:parse:length rest1 < 1"
- then parseModOcc [] []
- else parseModOcc [] (tail rest1)
+ (modWords, occWord) = parseModOcc [] (drop 1 rest1)
-- We only look for dots if str could start with a module name,
-- i.e. if it starts with an upper case character.
-- Otherwise we might think that "X.:->" is the module name in
=====================================
testsuite/tests/rename/should_compile/T22057.hs
=====================================
@@ -0,0 +1,16 @@
+{-# LANGUAGE TemplateHaskellQuotes #-}
+{-# OPTIONS -Wall #-}
+module Thing (thing) where
+
+import Language.Haskell.TH
+
+thing :: Q ()
+thing = do
+ name <- newName "x"
+ -- warning:
+ _ <- [| let ($(pure (VarP name)), _) = (3.0, 4.0) in $(pure (VarE name)) |]
+ -- warning:
+ _ <- [| let ($(pure (VarP name)) ) = 3.0 in $(pure (VarE name)) |]
+ -- no warning:
+ _ <- [| let $(pure (VarP name)) = 3.0 in $(pure (VarE name)) |]
+ return ()
=====================================
testsuite/tests/rename/should_compile/T22067.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+module TTT where
+
+a :: ()
+a = let () = () in ()
+
+b :: ()
+b = let $([p|()|]) = () in ()
+
=====================================
testsuite/tests/rename/should_compile/T22067.stderr
=====================================
@@ -0,0 +1,6 @@
+
+T22067.hs:5:9: warning: [-Wunused-pattern-binds (in -Wextra, -Wunused-binds)]
+ This pattern-binding binds no variables: () = ()
+
+T22067.hs:8:9: warning: [-Wunused-pattern-binds (in -Wextra, -Wunused-binds)]
+ This pattern-binding binds no variables: (()) = ()
=====================================
testsuite/tests/rename/should_compile/all.T
=====================================
@@ -188,3 +188,5 @@ test('T18862', normal, compile, [''])
test('unused_haddock', normal, compile, ['-haddock -Wall'])
test('T19984', normal, compile, ['-fwarn-unticked-promoted-constructors'])
test('T21654', normal, compile, ['-Wunused-top-binds'])
+test('T22057', normal, compile, ['-Wall'])
+test('T22067', normal, compile, ['-Wall'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fb0a14fe6dcd7324f5c292ffcb180b629fdc8980...cc2edced40854e169bd55b04e21470e0bb447bb5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fb0a14fe6dcd7324f5c292ffcb180b629fdc8980...cc2edced40854e169bd55b04e21470e0bb447bb5
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/20220916/d5b2441d/attachment-0001.html>
More information about the ghc-commits
mailing list