GHC issueshttps://gitlab.haskell.org/ghc/ghc/-/issues2024-03-12T15:10:14Zhttps://gitlab.haskell.org/ghc/ghc/-/issues/24506RTS crash with 9.8.12024-03-12T15:10:14ZSophie TaylorRTS crash with 9.8.1## Summary
I'm working on implementing a production system via a rete network, using STM. When I add certain productions, I get an exception thrown due to a `lens` `Fold` folding an empty list. When trying to debug this in GHCi I added ...## Summary
I'm working on implementing a production system via a rete network, using STM. When I add certain productions, I get an exception thrown due to a `lens` `Fold` folding an empty list. When trying to debug this in GHCi I added a breakpoint to the function where the empty Fold occurs, and before the Fold even happens, about two seconds after hitting the breakpoint, GHCi crashes with the following:
```haskell
ghci> :break Rete.ReteEffect.matchFromToken
Breakpoint 0 activated at src/Rete/ReteEffect.hs:(437,34)-(470,85)
ghci> import ForTesting
ghci> testCommand "add rules {\"rule\" (state <snake> * *) (<n1> <n2> <n3>) (<c> <g> <b>) --> (<n1> <n2> <n3>) (<c> <g> <b>)}"
Stopped in Rete.ReteEffect.matchFromToken, src/Rete/ReteEffect.hs:(437,34)-(470,85)
_result :: Sem r Core.WME.RuleMatch = _
tok :: Core.WME.WMEToken ? Core.WME.IsProductionToken = _
token :: Rete.Types.Tokens.WMEToken' Core.WME.WMEMetadata = _
[src/Rete/ReteEffect.hs:(437,34)-(470,85)] ghci> <interactive>: internal error: evacuate: strange closure type 636340344
Stack trace:
0x7fffef73027f set_initial_registers (/nix/store/20m2ha1x3rq3aiwg87asapqxv2hzgzw1-ghc-9.8.1/lib/ghc-9.8.1/lib/x86_64-linux-ghc-9.8.1/libHSrts-1.0.2_thr-ghc9.8.1.so)
0x7fffee1de088 dwfl_thread_getframes (/nix/store/8hy9xdnczdpn846qpsybwlpk5l607lbj-elfutils-0.189/lib/libdw-0.189.so)
0x7fffee1ddbdb get_one_thread_cb (/nix/store/8hy9xdnczdpn846qpsybwlpk5l607lbj-elfutils-0.189/lib/libdw-0.189.so)
0x7fffee1ddeea dwfl_getthreads (/nix/store/8hy9xdnczdpn846qpsybwlpk5l607lbj-elfutils-0.189/lib/libdw-0.189.so)
0x7fffee1de417 dwfl_getthread_frames (/nix/store/8hy9xdnczdpn846qpsybwlpk5l607lbj-elfutils-0.189/lib/libdw-0.189.so)
0x7fffef730887 libdwGetBacktrace (/nix/store/20m2ha1x3rq3aiwg87asapqxv2hzgzw1-ghc-9.8.1/lib/ghc-9.8.1/lib/x86_64-linux-ghc-9.8.1/libHSrts-1.0.2_thr-ghc9.8.1.so)
0x7fffef73902d rtsFatalInternalErrorFn (/nix/store/20m2ha1x3rq3aiwg87asapqxv2hzgzw1-ghc-9.8.1/lib/ghc-9.8.1/lib/x86_64-linux-ghc-9.8.1/libHSrts-1.0.2_thr-ghc9.8.1.so)
0x7fffef739200 barf (/nix/store/20m2ha1x3rq3aiwg87asapqxv2hzgzw1-ghc-9.8.1/lib/ghc-9.8.1/lib/x86_64-linux-ghc-9.8.1/libHSrts-1.0.2_thr-ghc9.8.1.so)
0x7fffef716171 evacuate1 (/nix/store/20m2ha1x3rq3aiwg87asapqxv2hzgzw1-ghc-9.8.1/lib/ghc-9.8.1/lib/x86_64-linux-ghc-9.8.1/libHSrts-1.0.2_thr-ghc9.8.1.so)
0x7fffef71beac scavenge_block1 (/nix/store/20m2ha1x3rq3aiwg87asapqxv2hzgzw1-ghc-9.8.1/lib/ghc-9.8.1/lib/x86_64-linux-ghc-9.8.1/libHSrts-1.0.2_thr-ghc9.8.1.so)
0x7fffef7658b7 scavenge_loop1 (/nix/store/20m2ha1x3rq3aiwg87asapqxv2hzgzw1-ghc-9.8.1/lib/ghc-9.8.1/lib/x86_64-linux-ghc-9.8.1/libHSrts-1.0.2_thr-ghc9.8.1.so)
0x7fffef75a702 scavenge_until_all_done (/nix/store/20m2ha1x3rq3aiwg87asapqxv2hzgzw1-ghc-9.8.1/lib/ghc-9.8.1/lib/x86_64-linux-ghc-9.8.1/libHSrts-1.0.2_thr-ghc9.8.1.so)
0x7fffef75c193 GarbageCollect (/nix/store/20m2ha1x3rq3aiwg87asapqxv2hzgzw1-ghc-9.8.1/lib/ghc-9.8.1/lib/x86_64-linux-ghc-9.8.1/libHSrts-1.0.2_thr-ghc9.8.1.so)
0x7fffef73d320 scheduleDoGC (/nix/store/20m2ha1x3rq3aiwg87asapqxv2hzgzw1-ghc-9.8.1/lib/ghc-9.8.1/lib/x86_64-linux-ghc-9.8.1/libHSrts-1.0.2_thr-ghc9.8.1.so)
0x7fffef73e339 schedule (/nix/store/20m2ha1x3rq3aiwg87asapqxv2hzgzw1-ghc-9.8.1/lib/ghc-9.8.1/lib/x86_64-linux-ghc-9.8.1/libHSrts-1.0.2_thr-ghc9.8.1.so)
0x7fffef73ebdc scheduleWorker (/nix/store/20m2ha1x3rq3aiwg87asapqxv2hzgzw1-ghc-9.8.1/lib/ghc-9.8.1/lib/x86_64-linux-ghc-9.8.1/libHSrts-1.0.2_thr-ghc9.8.1.so)
0x7fffef7431dd workerStart (/nix/store/20m2ha1x3rq3aiwg87asapqxv2hzgzw1-ghc-9.8.1/lib/ghc-9.8.1/lib/x86_64-linux-ghc-9.8.1/libHSrts-1.0.2_thr-ghc9.8.1.so)
0x7fffee29fdd4 start_thread (/nix/store/aw2fw9ag10wr9pf0qk4nk5sxi0q0bn56-glibc-2.37-8/lib/libc.so.6)
0x7fffee3219b0 __clone3 (/nix/store/aw2fw9ag10wr9pf0qk4nk5sxi0q0bn56-glibc-2.37-8/lib/libc.so.6)
(GHC version 9.8.1 for x86_64_unknown_linux)
Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug
Error: cabal: repl failed for cosmothought-core-0.1.0.0. The build process
terminated with exit code -6
```
## Steps to reproduce
Most convenient as a Nix flake:
1. grab from https://gitlab.com/spacekitteh/cosmothought/-/tree/repro-24506?ref_type=heads, ensure the current branch is `repro-24506`
2. `nix develop`
3. `cabal repl core`
5. `ghci> import ForTesting`
6. Optionally, `ghci> :break Rete.ReteEffect.producePatternMap` for a stack trace of the segfault. Sometimes, it doesn't produce a stacktrace, but it often does.
7. `ghci> repro24506`
8. Sometimes, a single invocation of `repro24506` doesn't result in the segfault; just run `repro24506` again until it does.
~~Alternatively, it can be reproduced in `gdb` using `cosmothought-core-oneoff`; but this requires setting a breakpoint. If you run `gdb --args cosmothought-core-oneoff +RTS -DS`, and set a breakpoint on `cosmothoughtzmcorezm0zi1zi0zi0zminplace_ReteziReteBuilder_createOrShareAlphaNodes_info`, it will barf during Sanity checking.~~ Ok that's due to setting the breakpoint incorrectly, see https://gitlab.haskell.org/ghc/ghc/-/issues/24506#note_552349
The exact value for the strange closure type changes from run to run. Sometimes, it just segfaults instead of printing the backtrace.
The problem is almost certainly in the `core/src/Rete` modules, in particular, how I'm using `stm-hamt's`.
I'm trying to narrow it down in order to find a minimal test case, but it's difficult.
## Expected behavior
Not crash.
## Things tried
- `+RTS --nonmoving-gc` and `--copying-gc` both segfault
- `-O0 -fno-static-argument-transformation` still segfaults
- `+RTS -C0 -V0` with non-threaded runtime still segfaults
- Linked with `-debug`
- `+RTS -DS` doesn't produce anything immediately obvious to me
## Possibly related
~~#24443 ~~ Nope, just a coincidence, but a strange one
## Environment
* GHC version used: 9.8.1
* Operating System: NixOS
* System Architecture: x64https://gitlab.haskell.org/ghc/ghc/-/issues/22916Core lint error when compiling matrix with GHC 9.2.52023-02-07T16:43:59ZZubinCore lint error when compiling matrix with GHC 9.2.5## Summary
`matrix-0.3.6.1` fails to compile with `-dcore-lint`
## Steps to reproduce
```bash
$ cabal get matrix-0.3.6.1
$ cat > cabal.project << EOF
packages: .
package matrix
ghc-options: -dcore-lint
EOF
$ cabal build
```
<detail...## Summary
`matrix-0.3.6.1` fails to compile with `-dcore-lint`
## Steps to reproduce
```bash
$ cabal get matrix-0.3.6.1
$ cat > cabal.project << EOF
packages: .
package matrix
ghc-options: -dcore-lint
EOF
$ cabal build
```
<details><summary>Click to expand</summary>
```
*** Core Lint errors : in result of Static argument ***
Data/Matrix.hs:1307:1: warning:
Mismatch in type between binder and occurrence
Binder: recLUDecomp'_r2jm :: forall {a}.
(Ord a_a7aP, Fractional a_a7aP) =>
Matrix a_a7aP
-> Matrix a_a7aP
-> Matrix a_a7aP
-> Matrix a_a7aP
-> a_a7aP
-> a_a7aP
-> Int
-> Int
-> Maybe
(Matrix a_a7aP, Matrix a_a7aP, Matrix a_a7aP, Matrix a_a7aP,
a_a7aP, a_a7aP)
Occurrence: recLUDecomp' :: forall a.
(Ord a, Fractional a) =>
Matrix a
-> Matrix a
-> Matrix a
-> Matrix a
-> a
-> a
-> Int
-> Int
-> Maybe (Matrix a, Matrix a, Matrix a, Matrix a, a, a)
Before subst: forall a.
(Ord a, Fractional a) =>
Matrix a
-> Matrix a
-> Matrix a
-> Matrix a
-> a
-> a
-> Int
-> Int
-> Maybe (Matrix a, Matrix a, Matrix a, Matrix a, a, a)
In the RHS of recLUDecomp' :: forall a.
(Ord a, Fractional a) =>
Matrix a
-> Matrix a
-> Matrix a
-> Matrix a
-> a
-> a
-> Int
-> Int
-> Maybe (Matrix a, Matrix a, Matrix a, Matrix a, a, a)
In the body of lambda with binder a_a7aP :: *
In the body of lambda with binder $dOrd_a7aQ :: Ord a_a7aP
In the body of lambda with binder $dFractional_a7aR :: Fractional
a_a7aP
In the body of lambda with binder eta_B0 :: Matrix a_a7aP
In the body of lambda with binder eta_B1 :: Matrix a_a7aP
In the body of lambda with binder eta_B2 :: Matrix a_a7aP
In the body of lambda with binder eta_B3 :: Matrix a_a7aP
In the body of lambda with binder eta_B4 :: a_a7aP
In the body of lambda with binder eta_B5 :: a_a7aP
In the body of lambda with binder eta_B6 :: Int
In the body of lambda with binder eta_B7 :: Int
In the RHS of sat_worker_s9pN :: Matrix a_a7aP
-> Matrix a_a7aP
-> Matrix a_a7aP
-> Matrix a_a7aP
-> a_a7aP
-> a_a7aP
-> Int
-> Maybe
(Matrix a_a7aP, Matrix a_a7aP, Matrix a_a7aP,
Matrix a_a7aP, a_a7aP, a_a7aP)
In the body of lambda with binder eta_B0 :: Matrix a_a7aP
In the body of lambda with binder eta_B1 :: Matrix a_a7aP
In the body of lambda with binder eta_B2 :: Matrix a_a7aP
In the body of lambda with binder eta_B3 :: Matrix a_a7aP
In the body of lambda with binder eta_B4 :: a_a7aP
In the body of lambda with binder eta_B5 :: a_a7aP
In the body of lambda with binder eta_B6 :: Int
In the body of letrec with binders recLUDecomp'_r2jm :: forall {a}.
(Ord a_a7aP, Fractional a_a7aP) =>
Matrix a_a7aP
-> Matrix a_a7aP
-> Matrix a_a7aP
-> Matrix a_a7aP
-> a_a7aP
-> a_a7aP
-> Int
-> Int
-> Maybe
(Matrix a_a7aP, Matrix a_a7aP,
Matrix a_a7aP, Matrix a_a7aP,
a_a7aP, a_a7aP)
In the body of letrec with binders $dNum_a7HJ :: Num a_a7aP
In the body of letrec with binders $dEq_a7HI :: Eq a_a7aP
In the body of letrec with binders ds_d8gN :: (Int, Int)
In the body of letrec with binders i_a2BY :: Int
In the body of letrec with binders j_a2BZ :: Int
In the body of letrec with binders u'_a2C0 :: Matrix a_a7aP
In the body of letrec with binders ukk_a2C9 :: a_a7aP
In the body of letrec with binders ds_d8gb :: (Matrix a_a7aP,
Matrix a_a7aP)
In the body of letrec with binders u''_a2C7 :: Matrix a_a7aP
In a case alternative: (False)
In a case alternative: (False)
In an occurrence of recLUDecomp' :: forall a.
(Ord a, Fractional a) =>
Matrix a
-> Matrix a
-> Matrix a
-> Matrix a
-> a
-> a
-> Int
-> Int
-> Maybe (Matrix a, Matrix a, Matrix a, Matrix a, a, a)
Substitution: [TCvSubst
In scope: InScope {a_a7aP}
Type env: [a7aP :-> a_a7aP]
Co env: []]
*** End of Offense ***
<no location info>: error:
Compilation had errors
```
</details>
## Expected behavior
## Environment
* GHC version used: 9.2.5https://gitlab.haskell.org/ghc/ghc/-/issues/21857Core Lint errors : in result of Static argument2024-03-06T13:24:18ZIcelandjackCore Lint errors : in result of Static argumentThis gives "Core Lint errors : in result of Static argument" for 8.10.0.20191123. The log is here [log.txt](/uploads/0a4d33f6f2851a4d60db0c2a80061f9d/log.txt), it's an old version and I think it has been fixed but it can be added as a re...This gives "Core Lint errors : in result of Static argument" for 8.10.0.20191123. The log is here [log.txt](/uploads/0a4d33f6f2851a4d60db0c2a80061f9d/log.txt), it's an old version and I think it has been fixed but it can be added as a regression test.
```haskell
{-# Language DeriveFunctor #-}
{-# Options_GHC -O2 -fstatic-argument-transformation -dcore-lint -fobject-code #-}
import Control.Applicative
newtype Ok a = Ok [a]
deriving Functor
instance Applicative Ok where
pure = undefined
liftA2 (·) (Ok (a:as)) bs = liftA2 (·) (Ok as) bs
```Douglas Wilsondouglas@well-typed.comDouglas Wilsondouglas@well-typed.comhttps://gitlab.haskell.org/ghc/ghc/-/issues/21636Core Lint errors : in result of Static argument2024-03-06T13:24:18ZIcelandjackCore Lint errors : in result of Static argumentCauses a Core Lint error:
```haskell
{-# Language DeriveAnyClass #-}
{-# Language DeriveGeneric #-}
{-# Language DerivingVia #-}
{-# Language TypeFamilies #-}
{-# Options_GHC -O2 -fstatic-argument-transformation -dcore-lint -fobj...Causes a Core Lint error:
```haskell
{-# Language DeriveAnyClass #-}
{-# Language DeriveGeneric #-}
{-# Language DerivingVia #-}
{-# Language TypeFamilies #-}
{-# Options_GHC -O2 -fstatic-argument-transformation -dcore-lint -fobject-code #-}
import Data.Distributive
import Data.Functor.Rep
import GHC.Generics
data Moore a b = Moore b (a -> Moore a b)
deriving
stock Generic1
deriving (Functor, Applicative, Monad)
via Co (Moore a)
instance Representable (Moore a) where
type Rep (Moore a) = [a]
index = undefined
tabulate = undefined
instance Distributive (Moore a) where
distribute = distributeRep
```
```
Mismatch in type between binder and occurrence
Var: $cfmap_s71F
Binder type: forall a a b.
(a_a5LM -> b_a5LN)
-> Co (Moore a_a5LI) a_a5LM -> Moore a_a5LI b_a5LN
Occurrence type: forall a a b.
(a -> b) -> Co (Moore a) a -> Moore a b
Before subst: forall a a b.
(a -> b) -> Co (Moore a) a -> Moore a b
In the RHS of $cfmap_s71F :: forall a a b.
(a -> b) -> Co (Moore a) a -> Moore a b
```
Using the [adjunctions](https://hackage.haskell.org/package/adjunctions) package, using ghc 8.10.2.[log](/uploads/7f2f800036455aaf32d717696fa04257/log)https://gitlab.haskell.org/ghc/ghc/-/issues/21131Trouble specializing generic functions with extra arguments or constraints2023-03-26T03:58:54ZDavid FeuerTrouble specializing generic functions with extra arguments or constraints## Summary
Generic-derived methods for recursively defined types can't specialize to extra constraints.
## Steps to reproduce
```haskell
{-# options_ghc -O2 -ddump-simpl -dsuppress-coercions -dsuppress-type-applications #-}
{-# langua...## Summary
Generic-derived methods for recursively defined types can't specialize to extra constraints.
## Steps to reproduce
```haskell
{-# options_ghc -O2 -ddump-simpl -dsuppress-coercions -dsuppress-type-applications #-}
{-# language DeriveGeneric #-}
module Aha where
import Control.DeepSeq
import GHC.Generics
data MyList a = Nil | Cons a (MyList a)
deriving Generic
instance NFData a => NFData (MyList a)
```
Compiling this, I get
```haskell
Rec {
-- RHS size: {terms: 15, types: 13, coercions: 2, joins: 0/0}
Aha.$fNFDataMyList_$crnf [Occ=LoopBreaker]
:: forall a. NFData a => MyList a -> ()
[GblId, Arity=2, Str=<LCL(A)><1L>, Unf=OtherCon []]
Aha.$fNFDataMyList_$crnf
= \ (@a_a3bP)
($dNFData_a3bQ :: NFData a_a3bP)
(eta_B0 :: MyList a_a3bP) ->
case eta_B0 of {
Nil -> GHC.Tuple.();
Cons g1_a39r g2_a39s ->
case ($dNFData_a3bQ `cast` <Co:2>) g1_a39r of { () ->
Aha.$fNFDataMyList_$crnf $dNFData_a3bQ g2_a39s
}
}
end Rec }
```
Uh oh... this is a loop breaker with no unfolding, so it can't specialize to the underlying `NFData a` instance!
## Expected behavior
I would expect specialization (or something?) to effectively apply the static argument transformation to the `NFData a` dictionary, pulling it out of the loop. Unfortunately, that will do nothing for higher-order functions like generic versions of `traverse`; I have no clue how to approach specializing those to their arguments without a more general fix to the static argument issue.
## Environment
* GHC version used: 9.2.1
Optional:
* Operating System:
* System Architecture:https://gitlab.haskell.org/ghc/ghc/-/issues/19549"Mismatch in type between binder and occurrence"2024-03-06T13:24:17ZIcelandjack"Mismatch in type between binder and occurrence"```haskell
{-# Options_GHC -O2 -fstatic-argument-transformation -dcore-lint -fobject-code #-}
replace2_4 :: [a] -> a -> a -> [a]
replace2_4 = go 0 where
go :: Int -> [a] -> a -> a -> [a]
go 2 (a:as) two four = two:go 3 as two four
...```haskell
{-# Options_GHC -O2 -fstatic-argument-transformation -dcore-lint -fobject-code #-}
replace2_4 :: [a] -> a -> a -> [a]
replace2_4 = go 0 where
go :: Int -> [a] -> a -> a -> [a]
go 2 (a:as) two four = two:go 3 as two four
go 4 (a:as) two four = four:as
go n (a:as) two four = a:go (1+n) as two four
```
The problem seems to persist if I add `forall a.` or replace `four:as` with `four:go 5 as two four`. This is the error I get:
```
GHCi, version 8.10.0.20191123: https://www.haskell.org/ghc/ :? for help
[1 of 1] Compiling Main ( /home/baldur/hs/4203.hs, /home/baldur/hs/4203.o )
*** Core Lint errors : in result of Static argument ***
/home/baldur/hs/4203.hs:7:18: warning:
Mismatch in type between binder and occurrence
Var: go_s1pB
Binder type: forall a a.
Int -> [a_aCh] -> a_aCh -> a_aCh -> [a_aCh]
Occurrence type: forall a a. Int -> [a] -> a -> a -> [a]
Before subst: forall a a. Int -> [a] -> a -> a -> [a]
In the RHS of go_s1pB :: forall a a. Int -> [a] -> a -> a -> [a]
In the body of lambda with binder a_aC0 :: *
In the body of lambda with binder a_aCh :: *
In the body of lambda with binder ds_d1o5 :: Int
In the body of lambda with binder ds_d1o6 :: [a_aCh]
In the body of lambda with binder two_aAY :: a_aCh
In the body of lambda with binder four_aAZ :: a_aCh
In the RHS of sat_worker_s1pT :: Int -> [a_aCh] -> [a_aCh]
In the body of lambda with binder ds_d1o5 :: Int
In the body of lambda with binder ds_d1o6 :: [a_aCh]
In the body of letrec with binders go_s1pB :: forall a a.
Int -> [a_aCh] -> a_aCh -> a_aCh -> [a_aCh]
In the RHS of fail_d1pg :: Void# -> [a_aCh]
In the body of lambda with binder ds_d1ph :: Void#
In a case alternative: (: a_aB5 :: a_aCh, as_aB6 :: [a_aCh])
Substitution: [TCvSubst
In scope: InScope {wild_Xc two_aAY four_aAZ a_aB5 as_aB6 a_aC0
a_aCh ds_d1o5 ds_d1o6 ds_d1ph replace2_4 $trModule go_s1pB
replace2_4_s1pC $trModule_s1pD $trModule_s1pE $trModule_s1pF
$trModule_s1pG sat_worker_s1pT}
Type env: []
Co env: []]
*** Offending Program ***
go_s1pB [Occ=LoopBreaker]
:: forall a a. Int -> [a] -> a -> a -> [a]
[LclId,
Arity=4,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=IF_ARGS [40 179 0 0] 423 60}]
go_s1pB
= \ (@ a_aC0)
(@ a_aCh)
(ds_d1o5 :: Int)
(ds_d1o6 :: [a_aCh])
(two_aAY :: a_aCh)
(four_aAZ :: a_aCh) ->
letrec {
sat_worker_s1pT :: Int -> [a_aCh] -> [a_aCh]
[LclId]
sat_worker_s1pT
= \ (ds_d1o5 :: Int) (ds_d1o6 :: [a_aCh]) ->
let {
go_s1pB :: forall a a. Int -> [a_aCh] -> a_aCh -> a_aCh -> [a_aCh]
[LclId]
go_s1pB
= \ (@ a_s1pP)
(@ a_s1pQ)
(ds_d1o5 :: Int)
(ds_d1o6 :: [a_aCh])
(two_s1pR :: a_aCh)
(four_s1pS :: a_aCh) ->
sat_worker_s1pT ds_d1o5 ds_d1o6 } in
join {
fail_d1pg :: Void# -> [a_aCh]
[LclId[JoinId(1)],
Arity=1,
Str=<L,U>,
Unf=Unf{Src=<vanilla>, TopLvl=False, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 251 30}]
fail_d1pg _ [Occ=Dead, OS=OneShot]
= case ds_d1o6 of {
[] ->
patError
@ 'LiftedRep
@ [a_aCh]
"/home/baldur/hs/4203.hs:(7,2)-(9,46)|function go"#;
: a_aB5 as_aB6 ->
: @ a_aCh
a_aB5
(go_s1pB
@ a_aC0
@ a_aCh
(case ds_d1o5 of { I# y_a1pr -> I# (+# 1# y_a1pr) })
as_aB6
two_aAY
four_aAZ)
} } in
case ds_d1o5 of { I# ds_d1pd ->
case ds_d1pd of {
__DEFAULT -> jump fail_d1pg void#;
2# ->
case ds_d1o6 of {
[] -> jump fail_d1pg void#;
: a_aAW as_aAX ->
: @ a_aCh
two_aAY
(go_s1pB @ a_aC0 @ a_aCh (I# 3#) as_aAX two_aAY four_aAZ)
};
4# ->
case ds_d1o6 of {
[] -> jump fail_d1pg void#;
: a_aB0 as_aB1 -> : @ a_aCh four_aAZ as_aB1
}
}
}; } in
sat_worker_s1pT ds_d1o5 ds_d1o6
replace2_4_s1pC :: Int
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
replace2_4_s1pC = I# 0#
replace2_4 :: forall a. [a] -> a -> a -> [a]
[LclIdX,
Arity=3,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}]
replace2_4 = \ (@ a_aC0) -> go_s1pB @ a_aC0 @ a_aC0 replace2_4_s1pC
$trModule_s1pD :: Addr#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
$trModule_s1pD = "main"#
$trModule_s1pE :: TrName
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
$trModule_s1pE = TrNameS $trModule_s1pD
$trModule_s1pF :: Addr#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
$trModule_s1pF = "Main"#
$trModule_s1pG :: TrName
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
$trModule_s1pG = TrNameS $trModule_s1pF
$trModule :: Module
[LclIdX,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
$trModule = Module $trModule_s1pE $trModule_s1pG
*** End of Offense ***
<no location info>: error:
Compilation had errors
*** Exception: ExitFailure 1
>
```https://gitlab.haskell.org/ghc/ghc/-/issues/19285Core lint error (with flags: -O2 -fobject-code -fstatic-argument-transformati...2022-05-24T19:06:23ZIcelandjackCore lint error (with flags: -O2 -fobject-code -fstatic-argument-transformation -dcore-lint)```haskell
{-# Language KindSignatures #-}
{-# Language PolyKinds #-}
{-# Language RankNTypes #-}
{-# Options_GHC -O2 -fobject-code -fstatic-argument-transformation -dcore-lint #-}
import Control.Category
import Data.Kind
app...```haskell
{-# Language KindSignatures #-}
{-# Language PolyKinds #-}
{-# Language RankNTypes #-}
{-# Options_GHC -O2 -fobject-code -fstatic-argument-transformation -dcore-lint #-}
import Control.Category
import Data.Kind
apply :: Int -> (forall (ob :: Type) (cat :: ob -> ob -> Type) (a :: ob). Category cat => cat a a -> cat a a)
apply n = apply n
```
Gets a core lint error, I'm using GHC 9.1.0.20201202 and it seems all these flags play together. If I remove any of them it compiles fine.
```
$ ./ghc -ignore-dot-ghci --interactive ./4091_bug.hs
GHCi, version 9.1.0.20201202: https://www.haskell.org/ghc/ :? for help
[1 of 1] Compiling Main ( /home/.., /home/.. )
*** Core Lint errors : in result of Static argument ***
/home/..:11:1: warning:
Mismatch in type between binder and occurrence
Binder: apply_rzf :: Int
-> forall {ob} {cat :: ob_aF9 -> ob_aF9 -> *} {a :: ob_aF9}.
Category cat_aFa =>
cat_aFa a_aFb a_aFb -> cat_aFa a_aFb a_aFb
Occurrence: apply :: Int
-> forall ob (cat :: ob -> ob -> *) (a :: ob).
Category cat =>
cat a a -> cat a a
Before subst: Int
-> forall ob (cat :: ob -> ob -> *) (a :: ob).
Category cat =>
cat a a -> cat a a
In the RHS of apply :: Int
-> forall ob (cat :: ob -> ob -> *) (a :: ob).
Category cat =>
cat a a -> cat a a
In the body of lambda with binder ds_dFA :: Int
In the body of lambda with binder ob_aF9 :: *
In the body of lambda with binder cat_aFa :: ob_aF9 -> ob_aF9 -> *
In the body of lambda with binder a_aFb :: ob_aF9
In the body of lambda with binder $dCategory_aFc :: Category
cat_aFa
In the RHS of sat_worker_sFM :: cat_aFa a_aFb a_aFb
-> cat_aFa a_aFb a_aFb
In the body of letrec with binders apply_rzf :: Int
-> forall {ob} {cat :: ob_aF9 -> ob_aF9 -> *}
{a :: ob_aF9}.
Category cat_aFa =>
cat_aFa a_aFb a_aFb -> cat_aFa a_aFb a_aFb
In an occurrence of apply :: Int
-> forall ob (cat :: ob -> ob -> *) (a :: ob).
Category cat =>
cat a a -> cat a a
Substitution: [TCvSubst
In scope: InScope {ob_aF9 cat_aFa a_aFb}
Type env: [aF9 :-> ob_aF9, aFa :-> cat_aFa, aFb :-> a_aFb]
Co env: []]
*** Offending Program ***
apply [Occ=LoopBreaker]
:: Int
-> forall ob (cat :: ob -> ob -> *) (a :: ob).
Category cat =>
cat a a -> cat a a
[LclIdX,
Arity=2,
Str=<U><U>b,
Cpr=b,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=True)}]
apply
= \ (ds_dFA :: Int)
(@ob_aF9)
(@(cat_aFa :: ob_aF9 -> ob_aF9 -> *))
(@(a_aFb :: ob_aF9))
($dCategory_aFc :: Category cat_aFa) ->
letrec {
sat_worker_sFM :: cat_aFa a_aFb a_aFb -> cat_aFa a_aFb a_aFb
[LclId]
sat_worker_sFM
= let {
apply_rzf
:: Int
-> forall {ob} {cat :: ob_aF9 -> ob_aF9 -> *} {a :: ob_aF9}.
Category cat_aFa =>
cat_aFa a_aFb a_aFb -> cat_aFa a_aFb a_aFb
[LclId]
apply_rzf
= \ (ds_sFH :: Int)
(@ob_sFI)
(@(cat_sFJ :: ob_aF9 -> ob_aF9 -> *))
(@(a_sFK :: ob_aF9))
($dCategory_sFL :: Category cat_aFa) ->
sat_worker_sFM } in
apply ds_dFA @ob_aF9 @cat_aFa @a_aFb $dCategory_aFc; } in
sat_worker_sFM
$trModule_sFC :: Addr#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
$trModule_sFC = "main"#
$trModule_sFD :: TrName
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
$trModule_sFD = TrNameS $trModule_sFC
$trModule_sFE :: Addr#
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
$trModule_sFE = "Main"#
$trModule_sFF :: TrName
[LclId,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
$trModule_sFF = TrNameS $trModule_sFE
$trModule :: Module
[LclIdX,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
$trModule = Module $trModule_sFD $trModule_sFF
*** End of Offense ***
<no location info>: error:
Compilation had errors
*** Exception: ExitFailure 1
ghci>
```https://gitlab.haskell.org/ghc/ghc/-/issues/18962SAT should only influence the unfolding2022-06-14T16:05:54ZSebastian GrafSAT should only influence the unfoldingVarious attempts have been made in the past (see https://gitlab.haskell.org/ghc/ghc/-/issues/9374, https://gitlab.haskell.org/ghc/ghc/-/issues/9374#note_86443 in particular) to improve the static argument transformation, like only lettin...Various attempts have been made in the past (see https://gitlab.haskell.org/ghc/ghc/-/issues/9374, https://gitlab.haskell.org/ghc/ghc/-/issues/9374#note_86443 in particular) to improve the static argument transformation, like only letting it fire when there are at least n static arguments.
I argue that the value of SAT comes from when we are able to inline the SAT'd function (let's call it the wrapper), so that the nested local function that closes over static arguments (SAT worker) is specialised to the call site.
If it isn't specialised, we end up with more allocations in the generated code. It's strictly worse than the non-SAT'd function and is directly opposite to what we do in late lambda lifting, which runs "very late" for that purpose on STG where it can see whether it'll improve allocations or not.
It's a typical staging problem: If inlining succeeds, use the specialised version. If not, use the regular definition. Until we have proper staging and people exploiting it in key situations, we can instead make SAT store its result in unfoldings only!https://gitlab.haskell.org/ghc/ghc/-/issues/14649ghc panic: mergeSATInfo2021-03-26T18:16:22Ztianxiaogughc panic: mergeSATInfoghc panic with option `-O` and `-fstatic-argument-transformation`.
Affected versions include 8.2.2 and HEAD (8.5.20180108)
```hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE PolyKinds ...ghc panic with option `-O` and `-fstatic-argument-transformation`.
Affected versions include 8.2.2 and HEAD (8.5.20180108)
```hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module T12844 where
barWraper :: ('(r,r') ~ Head rngs, Foo rngs) => FooData rngs
barWraper = bar
bar :: (_) => FooData rngs
bar = barWraper
data FooData rngs
class Foo xs where foo :: (Head xs ~ '(r,r')) => FooData xs
type family Head (xs :: [k]) where Head (x ': xs) = x
```
Log:
```
ghc: panic! (the 'impossible' happened)
(GHC version 8.5.20180108 for x86_64-unknown-linux):
mergeSATInfo
Left:STSTSTSTSTSVSV, Right:STSTSTSTSTSVSC
Call stack:
CallStack (from HasCallStack):
callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in ghc:Outputable
pprPanic, called at compiler/simplCore/SAT.hs:152:20 in ghc:SAT
Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug
```
<details><summary>Trac metadata</summary>
| Trac field | Value |
| ---------------------- | ------------ |
| Version | 8.2.2 |
| Type | Bug |
| TypeOfFailure | OtherFailure |
| Priority | normal |
| Resolution | Unresolved |
| Component | Compiler |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | |
| Operating system | |
| Architecture | |
</details>
<!-- {"blocked_by":[],"summary":"ghc panic: mergeSATInfo","status":"New","operating_system":"","component":"Compiler","related":[],"milestone":"","resolution":"Unresolved","owner":{"tag":"Unowned"},"version":"8.2.2","keywords":[],"differentials":[],"test_case":"","architecture":"","cc":[""],"type":"Bug","description":"ghc panic with option `-O` and `-fstatic-argument-transformation`.\r\nAffected versions include 8.2.2 and HEAD (8.5.20180108)\r\n\r\n{{{#!hs\r\n{-# LANGUAGE DataKinds #-}\r\n{-# LANGUAGE PartialTypeSignatures #-}\r\n{-# LANGUAGE PolyKinds #-}\r\n{-# LANGUAGE TypeFamilies #-}\r\n{-# LANGUAGE TypeOperators #-}\r\n\r\nmodule T12844 where\r\n\r\nbarWraper :: ('(r,r') ~ Head rngs, Foo rngs) => FooData rngs\r\nbarWraper = bar\r\n\r\nbar :: (_) => FooData rngs\r\nbar = barWraper\r\n\r\ndata FooData rngs\r\n\r\nclass Foo xs where foo :: (Head xs ~ '(r,r')) => FooData xs\r\n\r\ntype family Head (xs :: [k]) where Head (x ': xs) = x\r\n}}}\r\n\r\nLog:\r\n\r\n{{{\r\nghc: panic! (the 'impossible' happened)\r\n (GHC version 8.5.20180108 for x86_64-unknown-linux):\r\n\tmergeSATInfo\r\n Left:STSTSTSTSTSVSV, Right:STSTSTSTSTSVSC\r\n Call stack:\r\n CallStack (from HasCallStack):\r\n callStackDoc, called at compiler/utils/Outputable.hs:1150:37 in ghc:Outputable\r\n pprPanic, called at compiler/simplCore/SAT.hs:152:20 in ghc:SAT\r\n\r\nPlease report this as a GHC bug: http://www.haskell.org/ghc/reportabug\r\n}}}","type_of_failure":"OtherFailure","blocking":[]} -->https://gitlab.haskell.org/ghc/ghc/-/issues/14231Core lint error "in result of Static argument"2024-03-06T13:24:16ZMatthew PickeringCore lint error "in result of Static argument"Whilst investigating #14211 I encountered a core lint error.
```
{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
module Async where
data AsyncT m a =
AsyncT {
runAsyncT :: forall r.
...Whilst investigating #14211 I encountered a core lint error.
```
{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
module Async where
data AsyncT m a =
AsyncT {
runAsyncT :: forall r.
Maybe Int -- state
-> m r -- stop
-> (a -> Maybe Int -> Maybe (AsyncT m a) -> m r) -- yield
-> m r
}
------------------------------------------------------------------------------
-- Monad
------------------------------------------------------------------------------
{-# INLINE bindWith #-}
bindWith
:: (forall c. AsyncT m c -> AsyncT m c -> AsyncT m c)
-> AsyncT m a
-> (a -> AsyncT m b)
-> AsyncT m b
bindWith k (AsyncT m) f = AsyncT $ \_ stp yld ->
m Nothing stp (\a _ m -> (\x -> (runAsyncT x) Nothing stp yld) $ maybe (f a) (\r -> f a `k` (bindWith k r f)) m )
```
Compile with `ghc -O2 -fno-worker-wrapper -fstatic-argument-transformation -dcore-lint`.
Error:
```
*** Core Lint errors : in result of Static argument ***
<no location info>: warning:
In the expression: bindWith @ m_aV5 @ a_aV6 @ b_aV7 k_aSU x_aX3 f_aSW
Mismatch in type between binder and occurrence
Var: bindWith_rpi
Binder type: forall (m1 :: * -> *) a1 b1 .
(forall c . AsyncT m_aV5 c -> AsyncT m_aV5 c -> AsyncT m_aV5 c)
-> AsyncT m_aV5 a_aV6 -> (a_aV6 -> AsyncT m_aV5 b_aV7) -> AsyncT m_aV5 b_aV7
Occurrence type: forall (m :: * -> *) a b .
(forall c . AsyncT m c -> AsyncT m c -> AsyncT m c)
-> AsyncT m a -> (a -> AsyncT m b) -> AsyncT m b
Before subst: forall (m :: * -> *) a b .
(forall c . AsyncT m c -> AsyncT m c -> AsyncT m c)
-> AsyncT m a -> (a -> AsyncT m b) -> AsyncT m b
*** Offending Program ***
```https://gitlab.haskell.org/ghc/ghc/-/issues/14067Static Argument Transformation for tail-recursive functions2022-10-17T12:40:37ZJoachim Breitnermail@joachim-breitner.deStatic Argument Transformation for tail-recursive functionsIn #13966 it was determined that having a variant of the Static Argument Transformation (StaticArgumentTransformation) pass that would specifically work on recursive join points, would be beneficial. This ticket tracks this task.
Consid...In #13966 it was determined that having a variant of the Static Argument Transformation (StaticArgumentTransformation) pass that would specifically work on recursive join points, would be beneficial. This ticket tracks this task.
Consider
```
joinrec $j x y = case y of
A -> $j x y'
B -> e2 x
C -> e3
in $j foo bar
```
Here the first argument to `$j` is "static"; that is, the same in every call. So we can transform like this
```
joinrec $j y = case y of
A -> $j y'
B -> e2 foo
C -> e3
in $j bar
```
Note that `x` isn't passed around in every iteration any more.https://gitlab.haskell.org/ghc/ghc/-/issues/13966Skip-less stream fusion: a missed opportunity2022-10-17T16:48:20ZGhost UserSkip-less stream fusion: a missed opportunityA simple stream chain
```hs
chain :: Int -> Int
chain = sum . filter even . enumFromTo 1
```
doesn't fuse under a Skip-less stream on GHC 8.2-rc3 -O2.
Benchmarked against a Skip stream (LLVM backend):
```
benchmarking Skip-less
time ...A simple stream chain
```hs
chain :: Int -> Int
chain = sum . filter even . enumFromTo 1
```
doesn't fuse under a Skip-less stream on GHC 8.2-rc3 -O2.
Benchmarked against a Skip stream (LLVM backend):
```
benchmarking Skip-less
time 248.9 ms (243.3 ms .. 257.3 ms)
0.998 R² (0.995 R² .. 0.999 R²)
mean 250.9 ms (248.1 ms .. 254.7 ms)
std dev 5.985 ms (4.831 ms .. 7.311 ms)
benchmarking Skip
time 61.26 ms (60.39 ms .. 62.44 ms)
0.998 R² (0.997 R² .. 0.999 R²)
mean 62.45 ms (61.96 ms .. 62.91 ms)
std dev 1.387 ms (1.190 ms .. 1.669 ms)
```
Relevant core (chain1 is Skip-less, chain2 has Skip):
```
-- RHS size: {terms: 51, types: 27, coercions: 0, joins: 1/2}
Main.$wchain1 [InlPrag=NOINLINE] :: Int# -> Int#
[GblId, Arity=1, Caf=NoCafRefs, Str=<S,U>]
Main.$wchain1
= \ (ww_s9ep :: Int#) ->
letrec {
$wloop_s9ea [InlPrag=[0], Occ=LoopBreaker] :: Int# -> Step1 Int Int
[LclId, Arity=1, Str=<S,U>, Unf=OtherCon []]
$wloop_s9ea
= \ (ww1_s9e8 :: Int#) ->
case tagToEnum# @ Bool (># ww1_s9e8 ww_s9ep) of {
False ->
case remInt# ww1_s9e8 2# of {
__DEFAULT -> $wloop_s9ea (+# ww1_s9e8 1#);
0# ->
Main.Yield1
@ Int @ Int (GHC.Types.I# (+# ww1_s9e8 1#)) (GHC.Types.I# ww1_s9e8)
};
True -> Main.Done1 @ Int @ Int
}; } in
joinrec {
$wloop1_s9el [InlPrag=[0], Occ=LoopBreaker] :: Int# -> Int# -> Int#
[LclId[JoinId(2)], Arity=2, Str=<S,U><S,U>, Unf=OtherCon []]
$wloop1_s9el (ww1_s9ef :: Int#) (ww2_s9ej :: Int#)
= case $wloop_s9ea ww2_s9ej of {
Done1 -> ww1_s9ef;
Yield1 s'_a497 x_a498 ->
case x_a498 of { GHC.Types.I# y_a66i ->
case s'_a497 of { GHC.Types.I# ww4_X9hA ->
jump $wloop1_s9el (+# ww1_s9ef y_a66i) ww4_X9hA
}
}
}; } in
jump $wloop1_s9el 0# 1#
-- RHS size: {terms: 33, types: 9, coercions: 0, joins: 1/1}
Main.$wchain2 [InlPrag=NOINLINE] :: Int# -> Int#
[GblId, Arity=1, Caf=NoCafRefs, Str=<S,U>]
Main.$wchain2
= \ (ww_s9dZ :: Int#) ->
joinrec {
$wloop_s9dV [InlPrag=[0], Occ=LoopBreaker] :: Int# -> Int# -> Int#
[LclId[JoinId(2)], Arity=2, Str=<S,U><S,U>, Unf=OtherCon []]
$wloop_s9dV (ww1_s9dP :: Int#) (ww2_s9dT :: Int#)
= case tagToEnum# @ Bool (># ww2_s9dT ww_s9dZ) of {
False ->
case remInt# ww2_s9dT 2# of {
__DEFAULT -> jump $wloop_s9dV ww1_s9dP (+# ww2_s9dT 1#);
0# -> jump $wloop_s9dV (+# ww1_s9dP ww2_s9dT) (+# ww2_s9dT 1#)
};
True -> ww1_s9dP
}; } in
jump $wloop_s9dV 0# 1#
```
The code was adapted from M. Snoyman's blog post "Iterators and Streams in Rust and Haskell".https://gitlab.haskell.org/ghc/ghc/-/issues/13502Static argument transformation should also run after specialisation2020-11-17T20:44:43ZMatthew PickeringStatic argument transformation should also run after specialisationConsider the following program where we eventually want `thepayload` to simplify to the same code as `direct`.
```hs
{-# LANGUAGE ExistentialQuantification, RankNTypes, DeriveFunctor #-}
module Foo where
newtype Q a b t = Q { getQ :: f...Consider the following program where we eventually want `thepayload` to simplify to the same code as `direct`.
```hs
{-# LANGUAGE ExistentialQuantification, RankNTypes, DeriveFunctor #-}
module Foo where
newtype Q a b t = Q { getQ :: forall f . Applicative f => (a -> f b) -> f t }
deriving Functor
instance Applicative (Q a b) where
pure a = Q (\_ -> pure a)
(Q ab) <*> (Q a) = (Q (\v -> ab v <*> a v))
singleQ :: a -> Q a b b
singleQ a = Q (\f -> f a)
data L a = Nil | L a (L a) deriving Show
traverseList :: Applicative f => (a -> f b) -> L a -> f (L b)
traverseList f Nil = pure Nil
traverseList f (L a la) = L <$> f a <*> traverseList f la
newtype Identity a = Identity { runIdentity :: a } deriving (Functor, Show)
instance Applicative Identity where
pure = Identity
(Identity f) <*> (Identity x) = Identity (f x)
thepayload :: L String -> L String
thepayload l = runIdentity $ (getQ $ (traverseList singleQ l)) Identity
direct :: L String -> L String
direct Nil = Nil
direct (L a b) = L a (direct b)
```
With `ghc-8.0.2` and `-fstatic-argument-transformation`, the specialiser will specialise the call
to `traverseList` and leave us with a definition like,
```hs
rec
(20)
$ssat_worker= λ sg sc l →
case l of
Nil→ pure sc Nil
L a la → <*> sc (fmap ($p1Applicative sc) (L a)) ($ssat_worker sg sc la)
(4) thepayload = λl→ $ssat_worker $fApplicativeIdentity l
```
`$ssat_worked` is recursive in `l` but not in the other two arguments so we can also apply SAT here.
Notice that `$ssat_worker` is called with a statically known dictionary in `thepayload` and so if we can inline `$ssat_worker`
we would get the same code as the naive `direct`, as desired.
I verified that inserting another SAT pass later in the compilation pipeline does have the desired effect but am not sure where exactly the right place would be or whether it is in general desirable. https://gitlab.haskell.org/ghc/ghc/-/issues/5059Pragma to SPECIALISE on value arguments2021-11-18T17:56:42ZbatterseapowerPragma to SPECIALISE on value argumentsI've sometimes found myself wishing for this pragma to get some "partial evaluation on the cheap". The idea is to allow something like:
```
defaultOpts :: Options
defaultOpts = ...
{-# SPECIALISE f defaultOpts :: Int -> Int #-}
f :: Op...I've sometimes found myself wishing for this pragma to get some "partial evaluation on the cheap". The idea is to allow something like:
```
defaultOpts :: Options
defaultOpts = ...
{-# SPECIALISE f defaultOpts :: Int -> Int #-}
f :: Options -> Int -> Int
f opts x = ... f opts ...
```
This would desugar into this additional code:
```
{-# RULES "f/spec" f defaultOpts = f_spec_1 #-}
f_spec_1 = (\opts x -> ... ... f opts ...) defaultOpts -- NB: body of f duplicated
```
The hope is that the simplifier and RULE matcher will tidy this up so we get a nice loop back to f_spec_1 with the body of the function specialised for the particular opts.
This is useful when functions are called often with particular arguments. An example would be where "f" is an edit-distance function which takes costs to be assigned to each edit, strings to be compared and returns an integer distance. In my library, the costs are given almost always going to be the default ones so I want to make that case fast, but I want to allow the user to supply their own set.
This pragma is somewhat subsumed by:
1. SpecConstr, if the options are algebraic data/literals that are also scrutinised by the body of f
1. Static argument transformation, except that the RULE based strategy achieves more code sharing compared to SAT
I think that pragma might be a relatively simple to implement nice-to-have feature.
<details><summary>Trac metadata</summary>
| Trac field | Value |
| ---------------------- | -------------- |
| Version | 7.0.3 |
| Type | FeatureRequest |
| TypeOfFailure | OtherFailure |
| Priority | normal |
| Resolution | Unresolved |
| Component | Compiler |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | |
| Operating system | |
| Architecture | |
</details>
<!-- {"blocked_by":[],"summary":"Pragma to SPECIALISE on value arguments","status":"New","operating_system":"","component":"Compiler","related":[],"milestone":"","resolution":"Unresolved","owner":{"tag":"Unowned"},"version":"7.0.3","keywords":[],"differentials":[],"test_case":"","architecture":"","cc":[""],"type":"FeatureRequest","description":"I've sometimes found myself wishing for this pragma to get some \"partial evaluation on the cheap\". The idea is to allow something like:\r\n\r\n{{{\r\ndefaultOpts :: Options\r\ndefaultOpts = ...\r\n\r\n{-# SPECIALISE f defaultOpts :: Int -> Int #-}\r\nf :: Options -> Int -> Int\r\nf opts x = ... f opts ...\r\n}}}\r\n\r\nThis would desugar into this additional code:\r\n\r\n{{{\r\n{-# RULES \"f/spec\" f defaultOpts = f_spec_1 #-}\r\nf_spec_1 = (\\opts x -> ... ... f opts ...) defaultOpts -- NB: body of f duplicated\r\n}}}\r\n\r\nThe hope is that the simplifier and RULE matcher will tidy this up so we get a nice loop back to f_spec_1 with the body of the function specialised for the particular opts.\r\n\r\nThis is useful when functions are called often with particular arguments. An example would be where \"f\" is an edit-distance function which takes costs to be assigned to each edit, strings to be compared and returns an integer distance. In my library, the costs are given almost always going to be the default ones so I want to make that case fast, but I want to allow the user to supply their own set.\r\n\r\nThis pragma is somewhat subsumed by:\r\n\r\n 1. SpecConstr, if the options are algebraic data/literals that are also scrutinised by the body of f\r\n\r\n 2. Static argument transformation, except that the RULE based strategy achieves more code sharing compared to SAT\r\n\r\nI think that pragma might be a relatively simple to implement nice-to-have feature.","type_of_failure":"OtherFailure","blocking":[]} -->8.0.1https://gitlab.haskell.org/ghc/ghc/-/issues/888Explore when to apply static argument transformation2020-11-17T20:44:06ZSimon Peyton JonesExplore when to apply static argument transformationThe Static Argument transformation optimises
```
f x y = ....f x' y...
```
into
```
f x y = let g x = ....g x'...
in g x
```
Instead of passing `y` along unchanged, we make it into a free variable of a local function de...The Static Argument transformation optimises
```
f x y = ....f x' y...
```
into
```
f x y = let g x = ....g x'...
in g x
```
Instead of passing `y` along unchanged, we make it into a free variable of a local function definition `g`.
Unfortunately, it's not always a win. Andre Santos gives a discussion, and quite a few numbers in [his thesis](http://research.microsoft.com/%7Esimonpj/Papers/santos-thesis.ps.gz).
But sometimes it is a pretty big win. Here's the example that recently motivated me, which Roman Leshchinskiy showed me. You need the attached file Stream.hs, and then try compiling
```
import Stream
foo :: (a -> b) -> [a] -> [c]
foo f = mapL f
```
Thus inspired, I think I have a set of criteria that would make the static arg transformation into a guaranteed win:
- there is only one (external) call to the function
- OR its RHS is small enough to inline
- OR it is marked INLINE (?)
So I'd like to try this idea out.
<details><summary>Trac metadata</summary>
| Trac field | Value |
| ---------------------- | ------------ |
| Version | 6.4.2 |
| Type | Task |
| TypeOfFailure | OtherFailure |
| Priority | normal |
| Resolution | Unresolved |
| Component | Compiler |
| Test case | |
| Differential revisions | |
| BlockedBy | |
| Related | |
| Blocking | |
| CC | |
| Operating system | Unknown |
| Architecture | Unknown |
</details>
<!-- {"blocked_by":[],"summary":"Implement the static argument transformation","status":"New","operating_system":"Unknown","component":"Compiler","related":[],"milestone":"","resolution":"Unresolved","owner":{"tag":"Unowned"},"version":"6.4.2","keywords":[],"differentials":[],"test_case":"","architecture":"Unknown","cc":[""],"type":"Task","description":"The Static Argument transformation optimises\r\n{{{ \r\n f x y = ....f x' y...\r\n}}}\r\ninto \r\n{{{\r\n f x y = let g x = ....g x'...\r\n in g x\r\n}}}\r\nInstead of passing {{{y}}} along unchanged, we make it into a free variable of a local function definition {{{g}}}. \r\n\r\nUnfortunately, it's not always a win. Andre Santos gives a discussion, and quite a few numbers in [http://research.microsoft.com/%7Esimonpj/Papers/santos-thesis.ps.gz his thesis].\r\n\r\nBut sometimes it is a pretty big win. Here's the example that recently motivated me, which Roman Leshchinskiy showed me. You need the attached file Stream.hs, and then try compiling\r\n{{{\r\n import Stream\r\n foo :: (a -> b) -> [a] -> [c]\r\n foo f = mapL f\r\n}}}\r\n\r\nThus inspired, I think I have a set of criteria that would make the static arg transformation into a guaranteed win:\r\n \r\n * there is only one (external) call to the function\r\n * OR its RHS is small enough to inline\r\n * OR it is marked INLINE (?)\r\n\r\nSo I'd like to try this idea out.","type_of_failure":"OtherFailure","blocking":[]} -->8.0.1