ImplicitParams in GHC 9.0.1

Hi, I have the following code that builds successfully with "stack build" under GHC 8.10.7 but fails to build under GHC 9.0.1: https://github.com/jchia/ip-bug The compiler is switched by commenting/uncommenting the compiler line in stack.yaml. GHC 9.0.1 gives me the error I paste at the end. Is this expected (maybe as part of "simplified subsumtion" in https://gitlab.haskell.org/ghc/ghc/-/wikis/migration/9.0#compiler-changes)? If so, how can the code be fixed? If not, is it a compiler bug? (This problem came up while using gi-gtk-3.0.38, where implicit params are used a lot). Josh /home/jchia/gh/ip-bug/src/Lib.hs:10:28: error: • Couldn't match type ‘(?self::Int) => Char’ with ‘Char’ Expected: Int -> Char -> Char Actual: Int -> ((?self::Int) => Char) -> Char • In the expression: foo In the expression: (let ?self = x in foo) :: Int -> Char -> Char In the expression: ((let ?self = x in foo) :: Int -> Char -> Char) x | 10 | bar x = ((let ?self = x in foo) :: Int -> Char -> Char) x | ^^^ /home/jchia/gh/ip-bug/src/Lib.hs:13:26: error: • Couldn't match type ‘(?self::Int) => Char’ with ‘Char’ Expected: Char -> Char Actual: ((?self::Int) => Char) -> Char • In the expression: foo x In the expression: let ?self = x in foo x In an equation for ‘baz’: baz x = let ?self = x in foo x | 13 | baz x = let ?self = x in foo x | ^^^^^

Hey!
I'd say 'yes' seeing as how eta expanding the function works:
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE RankNTypes #-}
module Lib where
foo :: Int -> ((?self :: Int) => Char) -> Char
foo x y = undefined
bar :: Int -> (Char -> Char)
bar x = (let ?self = x in (\u v -> foo u v)) x
baz :: Int -> (Char -> Char)
baz x c = let ?self = x in foo x c
However, I think it's still worth issuing a ghc bug report for this, as it
seems to really hurt implicit param usability in this case
Cheers,
Georgi
On Mon, Dec 13, 2021 at 5:57 PM ☂Josh Chia (謝任中)
Hi,
I have the following code that builds successfully with "stack build" under GHC 8.10.7 but fails to build under GHC 9.0.1:
https://github.com/jchia/ip-bug
The compiler is switched by commenting/uncommenting the compiler line in stack.yaml.
GHC 9.0.1 gives me the error I paste at the end. Is this expected (maybe as part of "simplified subsumtion" in https://gitlab.haskell.org/ghc/ghc/-/wikis/migration/9.0#compiler-changes)? If so, how can the code be fixed? If not, is it a compiler bug?
(This problem came up while using gi-gtk-3.0.38, where implicit params are used a lot).
Josh
/home/jchia/gh/ip-bug/src/Lib.hs:10:28: error: • Couldn't match type ‘(?self::Int) => Char’ with ‘Char’ Expected: Int -> Char -> Char Actual: Int -> ((?self::Int) => Char) -> Char • In the expression: foo In the expression: (let ?self = x in foo) :: Int -> Char -> Char In the expression: ((let ?self = x in foo) :: Int -> Char -> Char) x | 10 | bar x = ((let ?self = x in foo) :: Int -> Char -> Char) x | ^^^
/home/jchia/gh/ip-bug/src/Lib.hs:13:26: error: • Couldn't match type ‘(?self::Int) => Char’ with ‘Char’ Expected: Char -> Char Actual: ((?self::Int) => Char) -> Char • In the expression: foo x In the expression: let ?self = x in foo x In an equation for ‘baz’: baz x = let ?self = x in foo x | 13 | baz x = let ?self = x in foo x | ^^^^^ _______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.

It's also really bad for the (new!) LinearTypes extension, since we can't
pass x %1-> y where it expects x -> y. We have to eta expand. Ugh.
On Mon, Dec 13, 2021, 11:14 AM Georgi Lyubenov
Hey!
I'd say 'yes' seeing as how eta expanding the function works:
{-# LANGUAGE ImplicitParams #-} {-# LANGUAGE RankNTypes #-}
module Lib where
foo :: Int -> ((?self :: Int) => Char) -> Char foo x y = undefined
bar :: Int -> (Char -> Char) bar x = (let ?self = x in (\u v -> foo u v)) x
baz :: Int -> (Char -> Char) baz x c = let ?self = x in foo x c
However, I think it's still worth issuing a ghc bug report for this, as it seems to really hurt implicit param usability in this case
Cheers,
Georgi
On Mon, Dec 13, 2021 at 5:57 PM ☂Josh Chia (謝任中)
wrote: Hi,
I have the following code that builds successfully with "stack build" under GHC 8.10.7 but fails to build under GHC 9.0.1:
https://github.com/jchia/ip-bug
The compiler is switched by commenting/uncommenting the compiler line in stack.yaml.
GHC 9.0.1 gives me the error I paste at the end. Is this expected (maybe as part of "simplified subsumtion" in https://gitlab.haskell.org/ghc/ghc/-/wikis/migration/9.0#compiler-changes)? If so, how can the code be fixed? If not, is it a compiler bug?
(This problem came up while using gi-gtk-3.0.38, where implicit params are used a lot).
Josh
/home/jchia/gh/ip-bug/src/Lib.hs:10:28: error: • Couldn't match type ‘(?self::Int) => Char’ with ‘Char’ Expected: Int -> Char -> Char Actual: Int -> ((?self::Int) => Char) -> Char • In the expression: foo In the expression: (let ?self = x in foo) :: Int -> Char -> Char In the expression: ((let ?self = x in foo) :: Int -> Char -> Char) x | 10 | bar x = ((let ?self = x in foo) :: Int -> Char -> Char) x | ^^^
/home/jchia/gh/ip-bug/src/Lib.hs:13:26: error: • Couldn't match type ‘(?self::Int) => Char’ with ‘Char’ Expected: Char -> Char Actual: ((?self::Int) => Char) -> Char • In the expression: foo x In the expression: let ?self = x in foo x In an equation for ‘baz’: baz x = let ?self = x in foo x | 13 | baz x = let ?self = x in foo x | ^^^^^ _______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.

I just file a feature request issue:
https://gitlab.haskell.org/ghc/ghc/-/issues/20818
On Tue, Dec 14, 2021 at 12:24 AM David Feuer
It's also really bad for the (new!) LinearTypes extension, since we can't pass x %1-> y where it expects x -> y. We have to eta expand. Ugh.
On Mon, Dec 13, 2021, 11:14 AM Georgi Lyubenov
wrote: Hey!
I'd say 'yes' seeing as how eta expanding the function works:
{-# LANGUAGE ImplicitParams #-} {-# LANGUAGE RankNTypes #-}
module Lib where
foo :: Int -> ((?self :: Int) => Char) -> Char foo x y = undefined
bar :: Int -> (Char -> Char) bar x = (let ?self = x in (\u v -> foo u v)) x
baz :: Int -> (Char -> Char) baz x c = let ?self = x in foo x c
However, I think it's still worth issuing a ghc bug report for this, as it seems to really hurt implicit param usability in this case
Cheers,
Georgi
On Mon, Dec 13, 2021 at 5:57 PM ☂Josh Chia (謝任中)
wrote: Hi,
I have the following code that builds successfully with "stack build" under GHC 8.10.7 but fails to build under GHC 9.0.1:
https://github.com/jchia/ip-bug
The compiler is switched by commenting/uncommenting the compiler line in stack.yaml.
GHC 9.0.1 gives me the error I paste at the end. Is this expected (maybe as part of "simplified subsumtion" in https://gitlab.haskell.org/ghc/ghc/-/wikis/migration/9.0#compiler-changes)? If so, how can the code be fixed? If not, is it a compiler bug?
(This problem came up while using gi-gtk-3.0.38, where implicit params are used a lot).
Josh
/home/jchia/gh/ip-bug/src/Lib.hs:10:28: error: • Couldn't match type ‘(?self::Int) => Char’ with ‘Char’ Expected: Int -> Char -> Char Actual: Int -> ((?self::Int) => Char) -> Char • In the expression: foo In the expression: (let ?self = x in foo) :: Int -> Char -> Char In the expression: ((let ?self = x in foo) :: Int -> Char -> Char) x | 10 | bar x = ((let ?self = x in foo) :: Int -> Char -> Char) x | ^^^
/home/jchia/gh/ip-bug/src/Lib.hs:13:26: error: • Couldn't match type ‘(?self::Int) => Char’ with ‘Char’ Expected: Char -> Char Actual: ((?self::Int) => Char) -> Char • In the expression: foo x In the expression: let ?self = x in foo x In an equation for ‘baz’: baz x = let ?self = x in foo x | 13 | baz x = let ?self = x in foo x | ^^^^^ _______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
participants (3)
-
David Feuer
-
Georgi Lyubenov
-
☂Josh Chia (謝任中)