Simon Peyton Jones pushed to branch wip/T23109a at Glasgow Haskell Compiler / GHC Commits: bcd2de99 by Simon Peyton Jones at 2025-05-01T13:56:17+01:00 Accept some error message changes * break011, break024: GHCi debugger output. Not quite so good but @alt-romes says it's fine. Very delicate tests, depend on fluky inlining. * inline-check: an improvement! After this patch we do one fewer iterations of the Simplifier. - - - - - 5b053156 by Simon Peyton Jones at 2025-05-01T13:56:30+01:00 Accept diff * T18793: good: code is simpler and better - - - - - e35271b8 by Simon Peyton Jones at 2025-05-01T13:56:42+01:00 Experminental and subtle change in OccAnal Concerns handling of join points and interaction with exitification - - - - - 5 changed files: - compiler/GHC/Core/Opt/OccurAnal.hs - testsuite/tests/arityanal/should_compile/T18793.stderr - testsuite/tests/driver/inline-check.stderr - testsuite/tests/ghci.debugger/scripts/break011.stdout - testsuite/tests/ghci.debugger/scripts/break024.stdout Changes: ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -3797,8 +3797,9 @@ lookupOccInfoByUnique (UD { ud_env = env , occ_int_cxt = int_cxt , occ_tail = mk_tail_info tail_info } where - in_lam | uniq `elemVarEnvByKey` z_in_lam = IsInsideLam - | otherwise = NotInsideLam + in_lam | uniq `elemVarEnvByKey` z_in_lam + , n_br > 0 = IsInsideLam + | otherwise = NotInsideLam Just (ManyOccL tail_info) -> ManyOccs { occ_tail = mk_tail_info tail_info } where ===================================== testsuite/tests/arityanal/should_compile/T18793.stderr ===================================== @@ -1,54 +1,44 @@ ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 64, types: 40, coercions: 0, joins: 0/0} +Result size of Tidy Core = {terms: 60, types: 34, coercions: 0, joins: 0/0} -- RHS size: {terms: 17, types: 7, coercions: 0, joins: 0/0} stuff [InlPrag=NOINLINE] :: Int -> [Int] [GblId, Arity=1, Str=<1L>, Unf=OtherCon []] -stuff = \ (i :: Int) -> case i of i1 { GHC.Types.I# ipv -> GHC.Types.: @Int i1 (GHC.Types.: @Int (GHC.Types.I# (GHC.Prim.+# ipv 1#)) (GHC.Types.: @Int (GHC.Types.I# (GHC.Prim.+# ipv 2#)) (GHC.Types.[] @Int))) } +stuff = \ (i :: Int) -> case i of i1 { GHC.Internal.Types.I# ipv -> GHC.Internal.Types.: @Int i1 (GHC.Internal.Types.: @Int (GHC.Internal.Types.I# (GHC.Internal.Prim.+# ipv 1#)) (GHC.Internal.Types.: @Int (GHC.Internal.Types.I# (GHC.Internal.Prim.+# ipv 2#)) (GHC.Internal.Types.[] @Int))) } Rec { -- RHS size: {terms: 23, types: 11, coercions: 0, joins: 0/0} -T18793.$wgo1 [InlPrag=[2], Occ=LoopBreaker] :: [Int] -> GHC.Prim.Int# -> GHC.Prim.Int# +T18793.$wgo1 [InlPrag=[2], Occ=LoopBreaker] :: [Int] -> GHC.Internal.Prim.Int# -> GHC.Internal.Prim.Int# [GblId[StrictWorker([!])], Arity=2, Str=<1L><L>, Unf=OtherCon []] T18793.$wgo1 - = \ (ds :: [Int]) (ww :: GHC.Prim.Int#) -> + = \ (ds :: [Int]) (ww :: GHC.Internal.Prim.Int#) -> case ds of { [] -> ww; : y ys -> - case y of { GHC.Types.I# x -> - case GHC.Prim.># x 42# of { + case y of { GHC.Internal.Types.I# x -> + case GHC.Internal.Prim.># x 42# of { __DEFAULT -> T18793.$wgo1 ys ww; - 1# -> T18793.$wgo1 ys (GHC.Prim.negateInt# ww) + 1# -> T18793.$wgo1 ys (GHC.Internal.Prim.negateInt# ww) } } } end Rec } --- RHS size: {terms: 12, types: 6, coercions: 0, joins: 0/0} -T18793.f_go1 [InlPrag=[2]] :: [Int] -> Int -> Int -[GblId, - Arity=2, - Str=<1L><1!P(L)>, - Cpr=1, - Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (ds [Occ=Once1] :: [Int]) (eta [Occ=Once1!, OS=OneShot] :: Int) -> case eta of { GHC.Types.I# ww [Occ=Once1] -> case T18793.$wgo1 ds ww of ww1 [Occ=Once1] { __DEFAULT -> GHC.Types.I# ww1 } }}] -T18793.f_go1 = \ (ds :: [Int]) (eta [OS=OneShot] :: Int) -> case eta of { GHC.Types.I# ww -> case T18793.$wgo1 ds ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 } } - -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T18793.f2 :: Int [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T18793.f2 = GHC.Types.I# 1# +T18793.f2 = GHC.Internal.Types.I# 1# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T18793.f1 :: [Int] [GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 20 0}] T18793.f1 = stuff T18793.f2 --- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +-- RHS size: {terms: 11, types: 4, coercions: 0, joins: 0/0} f :: Int -> Int -[GblId, Arity=1, Str=<1!P(L)>, Cpr=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}] -f = T18793.f_go1 T18793.f1 +[GblId, Arity=1, Str=<1!P(L)>, Cpr=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 60 10}] +f = \ (eta [OS=OneShot] :: Int) -> case eta of { GHC.Internal.Types.I# ww -> case T18793.$wgo1 T18793.f1 ww of ww1 { __DEFAULT -> GHC.Internal.Types.I# ww1 } } ===================================== testsuite/tests/driver/inline-check.stderr ===================================== @@ -17,7 +17,6 @@ Inactive unfolding: foo1 Inactive unfolding: foo1 Inactive unfolding: foo1 Inactive unfolding: foo1 -Inactive unfolding: foo1 Considering inlining: foo arg infos [] interesting continuation RhsCtxt(NonRecursive) ===================================== testsuite/tests/ghci.debugger/scripts/break011.stdout ===================================== @@ -29,9 +29,9 @@ HasCallStack backtrace: error, called at Test7.hs:2:18 in main:Main Stopped in <exception thrown>, <unknown> -_exception :: e = SomeException (ErrorCall "foo") +_exception :: e = _ Stopped in <exception thrown>, <unknown> -_exception :: e = SomeException (ErrorCall "foo") +_exception :: e = _ *** Exception: foo HasCallStack backtrace: ===================================== testsuite/tests/ghci.debugger/scripts/break024.stdout ===================================== @@ -17,9 +17,7 @@ _exception = SomeException Nothing GHC.Internal.IO.Exception.UserError [] "error" Nothing Nothing) Stopped in <exception thrown>, <unknown> -_exception :: e = SomeException - (GHC.Internal.IO.Exception.IOError - Nothing GHC.Internal.IO.Exception.UserError ....) +_exception :: e = _ Stopped in <exception thrown>, <unknown> _exception :: e = _ _exception = SomeException View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/680f1b6076ef87c2a7b6f0ff5fe02d6... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/680f1b6076ef87c2a7b6f0ff5fe02d6... You're receiving this email because of your account on gitlab.haskell.org.