Simon Peyton Jones pushed to branch wip/T26681 at Glasgow Haskell Compiler / GHC
Commits:
c72ddabf by Cheng Shao at 2025-12-23T16:13:23-05:00
hadrian: fix bootstrapping with ghc-9.14
This patch fixes bootstrapping GHC with ghc-9.14, tested locally with
ghc-9.14.1 release as bootstrapping GHC.
- - - - -
0fd6d8e4 by Cheng Shao at 2025-12-23T16:14:05-05:00
hadrian: pass -keep-tmp-files to test ghc when --keep-test-files is enabled
This patch makes hadrian pass `-keep-tmp-files` to test ghc when
`--keep-test-files` is enabled, so you can check the ghc intermediate
files when debugging certain test failures. Closes #26688.
- - - - -
81d10134 by Cheng Shao at 2025-12-24T06:11:52-05:00
configure: remove dead code in configure scripts
This patch removes dead code in our configure scripts, including:
- Variables and auto-detected programs that are not used
- autoconf functions that are not used, or export a variable that's
not used
- `AC_CHECK_HEADERS` invocations that don't have actual corresponding
`HAVE_XXX_H` usage
- Other dead code (e.g. stray `AC_DEFUN()`)
Co-authored-by: Codex
- - - - -
fb1381c3 by Wolfgang Jeltsch at 2025-12-24T06:12:34-05:00
Remove unused known keys and names for list operations
This removes the known-key and corresponding name variables for
`concat`, `filter`, `zip`, and `(++)`, as they are apparently nowhere
used in GHC’s source code.
- - - - -
cbd234a7 by Simon Peyton Jones at 2025-12-24T11:52:09+00:00
Add missing InVar->OutVar lookup in SetLevels
As #26681 showed, the SetLevels pass was failing to map an InVar to
an OutVar. Very silly! I'm amazed it hasn't broken before now.
I have improved the type singatures (to mention InVar and OutVar)
so it's more obvious what needs to happen.
- - - - -
15 changed files:
- .gitlab/ci.sh
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- configure.ac
- hadrian/cabal.project
- hadrian/src/Settings/Builders/RunTest.hs
- libraries/ghc-internal/configure.ac
- − m4/find_ghc_bootstrap_prog.m4
- − m4/fp_copy_shellvar.m4
- − m4/fp_prog_ld_flag.m4
- − m4/fp_prog_sort.m4
- m4/prep_target_file.m4
- rts/configure.ac
- + testsuite/tests/simplCore/should_compile/T26681.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
.gitlab/ci.sh
=====================================
@@ -8,7 +8,7 @@ set -Eeuo pipefail
# Configuration:
# N.B. You may want to also update the index-state in hadrian/cabal.project.
-HACKAGE_INDEX_STATE="2025-01-27T17:45:32Z"
+HACKAGE_INDEX_STATE="2025-12-19T19:24:24Z"
MIN_HAPPY_VERSION="1.20"
MIN_ALEX_VERSION="3.2.6"
=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -339,8 +339,7 @@ basicKnownKeyNames
getFieldName, setFieldName,
-- List operations
- concatName, filterName, mapName,
- zipName, foldrName, buildName, augmentName, appendName,
+ mapName, foldrName, buildName, augmentName,
-- FFI primitive types that are not wired-in.
stablePtrTyConName, ptrTyConName, funPtrTyConName, constPtrConName,
@@ -694,9 +693,8 @@ ltTag_RDR = nameRdrName ordLTDataConName
eqTag_RDR = nameRdrName ordEQDataConName
gtTag_RDR = nameRdrName ordGTDataConName
-map_RDR, append_RDR :: RdrName
+map_RDR :: RdrName
map_RDR = nameRdrName mapName
-append_RDR = nameRdrName appendName
foldr_RDR, build_RDR, returnM_RDR, bindM_RDR, failM_RDR
:: RdrName
@@ -1068,7 +1066,7 @@ considerAccessibleName = varQual gHC_INTERNAL_EXTS (fsLit "considerAccessible")
-- Random GHC.Internal.Base functions
fromStringName, otherwiseIdName, foldrName, buildName, augmentName,
- mapName, appendName, assertName,
+ mapName, assertName,
dollarName :: Name
dollarName = varQual gHC_INTERNAL_BASE (fsLit "$") dollarIdKey
otherwiseIdName = varQual gHC_INTERNAL_BASE (fsLit "otherwise") otherwiseIdKey
@@ -1076,7 +1074,6 @@ foldrName = varQual gHC_INTERNAL_BASE (fsLit "foldr") foldrIdKey
buildName = varQual gHC_INTERNAL_BASE (fsLit "build") buildIdKey
augmentName = varQual gHC_INTERNAL_BASE (fsLit "augment") augmentIdKey
mapName = varQual gHC_INTERNAL_BASE (fsLit "map") mapIdKey
-appendName = varQual gHC_INTERNAL_BASE (fsLit "++") appendIdKey
assertName = varQual gHC_INTERNAL_BASE (fsLit "assert") assertIdKey
fromStringName = varQual gHC_INTERNAL_DATA_STRING (fsLit "fromString") fromStringClassOpKey
@@ -1409,12 +1406,6 @@ enumFromThenName = varQual gHC_INTERNAL_ENUM (fsLit "enumFromThen") enumFrom
enumFromThenToName = varQual gHC_INTERNAL_ENUM (fsLit "enumFromThenTo") enumFromThenToClassOpKey
boundedClassName = clsQual gHC_INTERNAL_ENUM (fsLit "Bounded") boundedClassKey
--- List functions
-concatName, filterName, zipName :: Name
-concatName = varQual gHC_INTERNAL_LIST (fsLit "concat") concatIdKey
-filterName = varQual gHC_INTERNAL_LIST (fsLit "filter") filterIdKey
-zipName = varQual gHC_INTERNAL_LIST (fsLit "zip") zipIdKey
-
-- Overloaded lists
isListClassName, fromListName, fromListNName, toListName :: Name
isListClassName = clsQual gHC_INTERNAL_IS_LIST (fsLit "IsList") isListClassKey
@@ -2201,7 +2192,7 @@ naturalNBDataConKey = mkPreludeDataConUnique 124
************************************************************************
-}
-wildCardKey, absentErrorIdKey, absentConstraintErrorIdKey, augmentIdKey, appendIdKey,
+wildCardKey, absentErrorIdKey, absentConstraintErrorIdKey, augmentIdKey,
buildIdKey, foldrIdKey, recSelErrorIdKey,
seqIdKey, eqStringIdKey,
noMethodBindingErrorIdKey, nonExhaustiveGuardsErrorIdKey,
@@ -2218,7 +2209,6 @@ wildCardKey = mkPreludeMiscIdUnique 0 -- See Note [WildCard
absentErrorIdKey = mkPreludeMiscIdUnique 1
absentConstraintErrorIdKey = mkPreludeMiscIdUnique 2
augmentIdKey = mkPreludeMiscIdUnique 3
-appendIdKey = mkPreludeMiscIdUnique 4
buildIdKey = mkPreludeMiscIdUnique 5
foldrIdKey = mkPreludeMiscIdUnique 6
recSelErrorIdKey = mkPreludeMiscIdUnique 7
@@ -2247,13 +2237,9 @@ divIntIdKey = mkPreludeMiscIdUnique 26
modIntIdKey = mkPreludeMiscIdUnique 27
cstringLengthIdKey = mkPreludeMiscIdUnique 28
-concatIdKey, filterIdKey, zipIdKey,
- bindIOIdKey, returnIOIdKey, newStablePtrIdKey,
+bindIOIdKey, returnIOIdKey, newStablePtrIdKey,
printIdKey, nullAddrIdKey, voidArgIdKey,
otherwiseIdKey, assertIdKey :: Unique
-concatIdKey = mkPreludeMiscIdUnique 31
-filterIdKey = mkPreludeMiscIdUnique 32
-zipIdKey = mkPreludeMiscIdUnique 33
bindIOIdKey = mkPreludeMiscIdUnique 34
returnIOIdKey = mkPreludeMiscIdUnique 35
newStablePtrIdKey = mkPreludeMiscIdUnique 36
=====================================
compiler/GHC/Core/Opt/SetLevels.hs
=====================================
@@ -91,6 +91,7 @@ import GHC.Core.Utils
import GHC.Core.Opt.Arity ( exprBotStrictness_maybe, isOneShotBndr )
import GHC.Core.FVs -- all of it
import GHC.Core.Subst
+import GHC.Core.TyCo.Subst( lookupTyVar )
import GHC.Core.Make ( sortQuantVars )
import GHC.Core.Type ( Type, tyCoVarsOfType
, mightBeUnliftedType, closeOverKindsDSet
@@ -466,8 +467,8 @@ lvlCase env scrut_fvs scrut' case_bndr ty alts
ty' = substTyUnchecked (le_subst env) ty
incd_lvl = incMinorLvl (le_ctxt_lvl env)
- dest_lvl = maxFvLevel (const True) env scrut_fvs
- -- Don't abstract over type variables, hence const True
+ dest_lvl = maxFvLevel includeTyVars env scrut_fvs
+ -- Don't abstract over type variables, hence includeTyVars
lvl_alt alts_env (AnnAlt con bs rhs)
= do { rhs' <- lvlMFE new_env True rhs
@@ -719,8 +720,11 @@ hasFreeJoin :: LevelEnv -> DVarSet -> Bool
-- (In the latter case it won't be a join point any more.)
-- Not treating top-level ones specially had a massive effect
-- on nofib/minimax/Prog.prog
-hasFreeJoin env fvs
- = not (maxFvLevel isJoinId env fvs == tOP_LEVEL)
+hasFreeJoin env fvs = anyDVarSet bad_join fvs
+ where
+ bad_join v = isJoinId v &&
+ maxIn True env v tOP_LEVEL /= tOP_LEVEL
+
{- Note [Saving work]
~~~~~~~~~~~~~~~~~~~~~
@@ -1607,10 +1611,10 @@ destLevel env fvs fvs_ty is_function is_bot
| otherwise = max_fv_id_level
where
- max_fv_id_level = maxFvLevel isId env fvs -- Max over Ids only; the
- -- tyvars will be abstracted
+ max_fv_id_level = maxFvLevel idsOnly env fvs -- Max over Ids only; the
+ -- tyvars will be abstracted
- as_far_as_poss = maxFvLevel' isId env fvs_ty
+ as_far_as_poss = maxFvLevel' idsOnly env fvs_ty
-- See Note [Floating and kind casts]
{- Note [Floating and kind casts]
@@ -1768,28 +1772,48 @@ extendCaseBndrEnv le@(LE { le_subst = subst, le_env = id_env })
, le_env = add_id id_env (case_bndr, scrut_var) }
extendCaseBndrEnv env _ _ = env
-maxFvLevel :: (Var -> Bool) -> LevelEnv -> DVarSet -> Level
-maxFvLevel max_me env var_set
- = nonDetStrictFoldDVarSet (maxIn max_me env) tOP_LEVEL var_set
+includeTyVars, idsOnly :: Bool
+idsOnly = False
+includeTyVars = True
+
+maxFvLevel :: Bool -> LevelEnv -> DVarSet -> Level
+maxFvLevel include_tyvars env var_set
+ = nonDetStrictFoldDVarSet (maxIn include_tyvars env) tOP_LEVEL var_set
-- It's OK to use a non-deterministic fold here because maxIn commutes.
-maxFvLevel' :: (Var -> Bool) -> LevelEnv -> TyCoVarSet -> Level
+maxFvLevel' :: Bool -> LevelEnv -> TyCoVarSet -> Level
-- Same but for TyCoVarSet
-maxFvLevel' max_me env var_set
- = nonDetStrictFoldUniqSet (maxIn max_me env) tOP_LEVEL var_set
+maxFvLevel' include_tyvars env var_set
+ = nonDetStrictFoldUniqSet (maxIn include_tyvars env) tOP_LEVEL var_set
-- It's OK to use a non-deterministic fold here because maxIn commutes.
-maxIn :: (Var -> Bool) -> LevelEnv -> InVar -> Level -> Level
-maxIn max_me (LE { le_lvl_env = lvl_env, le_env = id_env }) in_var lvl
+maxIn :: Bool -> LevelEnv -> InVar -> Level -> Level
+-- True <=> include tyvars
+maxIn include_tyvars env@(LE { le_subst = subst, le_env = id_env }) in_var lvl
+ | isId in_var
= case lookupVarEnv id_env in_var of
+ Nothing -> maxOut env in_var lvl
Just (abs_vars, _) -> foldr max_out lvl abs_vars
- Nothing -> max_out in_var lvl
- where
- max_out out_var lvl
- | max_me out_var = case lookupVarEnv lvl_env out_var of
- Just lvl' -> maxLvl lvl' lvl
- Nothing -> lvl
- | otherwise = lvl -- Ignore some vars depending on max_me
+ where
+ max_out out_var lvl
+ | isTyVar out_var = if include_tyvars
+ then maxOut env out_var lvl
+ else lvl
+ | otherwise = maxOut env out_var lvl
+
+ | include_tyvars -- TyVars
+ = case lookupTyVar subst in_var of
+ Just ty -> nonDetStrictFoldVarSet (maxOut env) lvl (tyCoVarsOfType ty)
+ Nothing -> maxOut env in_var lvl
+
+ | otherwise -- Ignore free tyvars
+ = lvl
+
+maxOut :: LevelEnv -> OutVar -> Level -> Level
+maxOut (LE { le_lvl_env = lvl_env }) out_var lvl
+ = case lookupVarEnv lvl_env out_var of
+ Just lvl' -> maxLvl lvl' lvl
+ Nothing -> lvl
lookupVar :: LevelEnv -> Id -> LevelledExpr
lookupVar le v = case lookupVarEnv (le_env le) v of
=====================================
configure.ac
=====================================
@@ -57,14 +57,10 @@ dnl ** which are needed by FP_SETUP_PROJECT_VERSION
dnl ** Find find command (for Win32's benefit)
FP_PROG_FIND
-FP_PROG_SORT
dnl ----------------------------------------------------------
FP_SETUP_PROJECT_VERSION
-# Hmmm, we fix the RPM release number to 1 here... Is this convenient?
-AC_SUBST([release], [1])
-
dnl * We require autoconf version 2.69 due to
dnl https://bugs.ruby-lang.org/issues/8179. Also see #14910.
dnl * We need 2.50 due to the use of AC_SYS_LARGEFILE and AC_MSG_NOTICE.
@@ -249,9 +245,6 @@ then
fi
AC_SUBST([WithGhc])
-dnl ** Without optimization some INLINE trickery fails for GHCi
-SRC_CC_OPTS="-O"
-
dnl--------------------------------------------------------------------
dnl * Choose host(/target/build) platform
dnl--------------------------------------------------------------------
@@ -753,10 +746,6 @@ AC_PROG_LN_S
dnl ** Find the path to sed
AC_PATH_PROGS(SedCmd,gsed sed,sed)
-
-dnl ** check for time command
-AC_PATH_PROG(TimeCmd,time)
-
dnl ** check for tar
dnl if GNU tar is named gtar, look for it first.
AC_PATH_PROGS(TarCmd,gnutar gtar tar,tar)
=====================================
hadrian/cabal.project
=====================================
@@ -4,11 +4,11 @@ packages: ./
-- This essentially freezes the build plan for hadrian
-- It would be wise to keep this up to date with the state set in .gitlab/ci.sh.
-index-state: 2025-01-27T17:45:32Z
+index-state: 2025-12-19T19:24:24Z
--- unordered-containers-0.2.20-r1 requires template-haskell < 2.22
--- ghc-9.10 has template-haskell-2.22.0.0
-allow-newer: unordered-containers:template-haskell
+-- Fixes bootstrapping with ghc-9.14
+allow-newer: all:base, all:ghc-bignum, all:template-haskell
+constraints: hashable >= 1.5.0.0
-- N.B. Compile with -O0 since this is not a performance-critical executable
-- and the Cabal takes nearly twice as long to build with -O1. See #16817.
=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -47,12 +47,20 @@ runTestGhcFlags = do
then "-optc-fno-builtin"
else ""
+ -- Also pass -keep-tmp-files to GHC when --keep-test-files is
+ -- passed to hadrian for debugging purpose (#26688)
+ keepFiles <- testKeepFiles <$> userSetting defaultTestArgs
+ let keepTmpFilesFlag
+ | keepFiles = "-keep-tmp-files"
+ | otherwise = ""
+
-- Take flags to send to the Haskell compiler from test.mk.
-- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L37
unwords <$> sequence
[ pure " -dcore-lint -dstg-lint -dcmm-lint -no-user-package-db -fno-dump-with-ways -fprint-error-index-links=never -rtsopts"
, pure ghcOpts
, pure ghcExtraFlags
+ , pure keepTmpFilesFlag
, ifMinGhcVer "711" "-fno-warn-missed-specialisations"
, ifMinGhcVer "711" "-fshow-warning-groups"
, ifMinGhcVer "801" "-fdiagnostics-color=never"
=====================================
libraries/ghc-internal/configure.ac
=====================================
@@ -23,7 +23,7 @@ AC_MSG_RESULT($WINDOWS)
AC_CHECK_TYPES([long long])
# check for specific header (.h) files that we are interested in
-AC_CHECK_HEADERS([ctype.h errno.h fcntl.h inttypes.h limits.h signal.h sys/file.h sys/resource.h sys/select.h sys/stat.h sys/syscall.h sys/time.h sys/timeb.h sys/timers.h sys/times.h sys/types.h sys/utsname.h sys/wait.h termios.h time.h unistd.h utime.h windows.h winsock.h langinfo.h poll.h sys/epoll.h sys/event.h sys/eventfd.h sys/socket.h])
+AC_CHECK_HEADERS([ctype.h errno.h fcntl.h inttypes.h limits.h signal.h sys/resource.h sys/select.h sys/stat.h sys/syscall.h sys/time.h sys/timeb.h sys/timers.h sys/times.h sys/types.h sys/utsname.h sys/wait.h termios.h unistd.h utime.h windows.h winsock.h langinfo.h poll.h sys/epoll.h sys/event.h sys/eventfd.h sys/socket.h])
# Enable large file support. Do this before testing the types ino_t, off_t, and
# rlim_t, because it will affect the result of that test.
=====================================
m4/find_ghc_bootstrap_prog.m4 deleted
=====================================
@@ -1,17 +0,0 @@
-# FIND_GHC_BOOTSTRAP_PROG()
-# --------------------------------
-# Parse the bootstrap GHC's compiler settings file for the location of things
-# like the `llc` and `opt` commands.
-#
-# $1 = the variable to set
-# $2 = The bootstrap compiler.
-# $3 = The string to grep for to find the correct line.
-#
-AC_DEFUN([FIND_GHC_BOOTSTRAP_PROG],[
- BootstrapTmpCmd=`grep $3 $($2 --print-libdir)/settings 2>/dev/null | sed 's/.*", "//;s/".*//'`
- if test -n "$BootstrapTmpCmd" && test `basename $BootstrapTmpCmd` = $BootstrapTmpCmd ; then
- AC_PATH_PROG([$1], [$BootstrapTmpCmd], "")
- else
- $1=$BootstrapTmpCmd
- fi
-])
=====================================
m4/fp_copy_shellvar.m4 deleted
=====================================
@@ -1,3 +0,0 @@
-# Helper for cloning a shell variable's state
-AC_DEFUN([FP_COPY_SHELLVAR],
-[if test -n "${$1+set}"; then $2="$$1"; else unset $2; fi ])
=====================================
m4/fp_prog_ld_flag.m4 deleted
=====================================
@@ -1,17 +0,0 @@
-# FP_PROG_LD_FLAG
-# ---------------
-# Sets the output variable $2 to $1 if ld supports the $1 flag.
-# Otherwise the variable's value is empty.
-AC_DEFUN([FP_PROG_LD_FLAG],
-[
-AC_CACHE_CHECK([whether ld understands $1], [fp_cv_$2],
-[echo 'int foo() { return 0; }' > conftest.c
-${CC-cc} -c conftest.c
-if $LD -r $1 -o conftest2.o conftest.o > /dev/null 2>&1; then
- fp_cv_$2=$1
-else
- fp_cv_$2=
-fi
-rm -rf conftest*])
-$2=$fp_cv_$2
-])# FP_PROG_LD_FLAG
=====================================
m4/fp_prog_sort.m4 deleted
=====================================
@@ -1,18 +0,0 @@
-# FP_PROG_SORT
-# ------------
-# Find a Unix-like sort
-AC_DEFUN([FP_PROG_SORT],
-[AC_PATH_PROG([fp_prog_sort], [sort])
-echo conwip > conftest.txt
-$fp_prog_sort -f conftest.txt > conftest.out 2>&1
-if grep 'conwip' conftest.out > /dev/null 2>&1 ; then
- # The goods
- SortCmd="$fp_prog_sort"
-else
- # Summink else..pick next one.
- AC_MSG_WARN([$fp_prog_sort looks like a non-*nix sort, ignoring it])
- FP_CHECK_PROG([SortCmd], [sort], [], [], [$fp_prog_sort])
-fi
-rm -f conftest.txt conftest.out
-AC_SUBST([SortCmd])[]dnl
-])# FP_PROG_SORT
=====================================
m4/prep_target_file.m4
=====================================
@@ -229,5 +229,3 @@ AC_DEFUN([PREP_TARGET_FILE],[
esac
AC_SUBST([TargetEndianness])
])
-
-AC_DEFUN()
=====================================
rts/configure.ac
=====================================
@@ -96,7 +96,7 @@ dnl off_t, because it will affect the result of that test.
AC_SYS_LARGEFILE
dnl ** check for specific header (.h) files that we are interested in
-AC_CHECK_HEADERS([ctype.h dirent.h dlfcn.h errno.h fcntl.h grp.h limits.h locale.h nlist.h pthread.h pwd.h signal.h sys/param.h sys/mman.h sys/resource.h sys/select.h sys/time.h sys/timeb.h sys/timerfd.h sys/timers.h sys/times.h sys/utsname.h sys/wait.h termios.h utime.h windows.h winsock.h sched.h])
+AC_CHECK_HEADERS([ctype.h dlfcn.h errno.h fcntl.h limits.h locale.h nlist.h pthread.h signal.h sys/param.h sys/mman.h sys/resource.h sys/select.h sys/time.h sys/timeb.h sys/timerfd.h sys/timers.h sys/times.h sys/utsname.h sys/wait.h termios.h utime.h windows.h winsock.h sched.h])
dnl sys/cpuset.h needs sys/param.h to be included first on FreeBSD 9.1; #7708
AC_CHECK_HEADERS([sys/cpuset.h], [], [],
@@ -148,7 +148,7 @@ FP_CHECK_FUNC([GetModuleFileName],
dnl ** check for more functions
dnl ** The following have been verified to be used in ghc/, but might be used somewhere else, too.
-AC_CHECK_FUNCS([getclock getrusage gettimeofday setitimer siginterrupt sysconf times ctime_r sched_setaffinity sched_getaffinity setlocale uselocale])
+AC_CHECK_FUNCS([getclock getrusage gettimeofday sysconf times ctime_r sched_setaffinity sched_getaffinity uselocale])
dnl ** On OS X 10.4 (at least), time.h doesn't declare ctime_r if
dnl ** _POSIX_C_SOURCE is defined
@@ -488,5 +488,3 @@ cat ghcautoconf.h.autoconf | sed \
>> include/ghcautoconf.h
echo "#endif /* __GHCAUTOCONF_H__ */" >> include/ghcautoconf.h
]
-
-
=====================================
testsuite/tests/simplCore/should_compile/T26681.hs
=====================================
@@ -0,0 +1,47 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+
+module T26681 where
+
+import Data.Kind (Type)
+import Data.Type.Equality
+import GHC.TypeLits
+import qualified Unsafe.Coerce
+
+
+{-# NOINLINE unsafeCoerceRefl #-}
+unsafeCoerceRefl :: a :~: b
+unsafeCoerceRefl = Unsafe.Coerce.unsafeCoerce Refl
+
+type family MapJust l where
+ MapJust '[] = '[]
+ MapJust (x : xs) = Just x : MapJust xs
+
+type family Tail l where
+ Tail (_ : xs) = xs
+
+lemMapJustCons :: MapJust sh :~: Just n : sh' -> sh :~: n : Tail sh
+lemMapJustCons Refl = unsafeCoerceRefl
+
+
+type ListX :: [Maybe Nat] -> (Maybe Nat -> Type) -> Type
+data ListX sh f where
+ ConsX :: !(f n) -> ListX (n : sh) f
+
+
+data JustN n where
+ JustN :: JustN (Just n)
+
+data UnconsListSRes f sh1 = forall n sh. (n : sh ~ sh1) => UnconsListSRes
+
+listsUncons :: forall sh1 f. ListX (MapJust sh1) JustN -> UnconsListSRes f sh1
+listsUncons (ConsX JustN)
+ | Refl <- lemMapJustCons @sh1 Refl
+ = UnconsListSRes
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -563,3 +563,4 @@ test('T26115', [grep_errmsg(r'DFun')], compile, ['-O -ddump-simpl -dsuppress-uni
test('T26116', normal, compile, ['-O -ddump-rules'])
test('T26117', [grep_errmsg(r'==')], compile, ['-O -ddump-simpl -dsuppress-uniques'])
test('T26349', normal, compile, ['-O -ddump-rules'])
+test('T26681', normal, compile, ['-O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/55e131c15508afed87bf065b3e66181...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/55e131c15508afed87bf065b3e66181...
You're receiving this email because of your account on gitlab.haskell.org.