[Haskell-cafe] Partially applied type synonyms

Branimir Maksimovic branimir.maksimovic at gmail.com
Fri Oct 8 07:18:49 UTC 2021


bmaxa at Branimirs-Air haskell % ghc -O2 dtchk.hs
Loaded package environment from /Users/bmaxa/.ghc/aarch64-darwin-8.10.7/environments/default
[1 of 1] Compiling Main             ( dtchk.hs, dtchk.o )
Linking dtchk ...
bmaxa at Branimirs-Air haskell % ./dtchk
dtchk: Prelude.undefined
CallStack (from HasCallStack):
  error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err
  undefined, called at dtchk.hs:10:5 in main:Main
bmaxa at Branimirs-Air haskell % cat dtchk.hs
{-# LANGUAGE FlexibleInstances, KindSignatures,
   LiberalTypeSynonyms, StandaloneDeriving,
   FlexibleContexts  #-}
data Foo sx x = Foo sx x
  deriving (Eq,Show)

data Bar (m :: * -> *) = Bar (m Int)
deriving instance Show a => Show (Bar (Foo a))
x :: Bar (Foo (Maybe Int))
x = undefined
deriving instance Eq a =>  Eq (Bar (Foo a))
main = print x

Greets, Branimir.

> On 08.10.2021., at 04:15, Ttt Mmm via Haskell-Cafe <haskell-cafe at haskell.org> wrote:
> 
> {-# LANGUAGE FlexibleInstances, KindSignatures, LiberalTypeSynonyms, StandaloneDeriving #-}
> -- This works: 
> data Foo s x = Foo (s x) x 
> deriving (Eq)
> -- This replacement doesn't: 
> {- 
> data Foo' sx x = Foo' sx x 
> deriving (Eq) 
> type Foo (s :: * -> *) (x :: *) = Foo' (s x) x 
> -}
> data Bar (m :: * -> *) = Bar (m Int)
> 
> -- Neither of these typecheck: 
> x :: Bar (Foo Maybe) 
> x = undefined 
> deriving instance Eq (Bar (Foo Maybe)) 

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20211008/7d2ba1ae/attachment.html>


More information about the Haskell-Cafe mailing list