#2775: Type Family panic
-----------------------+----------------------------------------------------
    Reporter:  camio   |       Owner:          
        Type:  bug     |      Status:  new     
    Priority:  normal  |   Component:  Compiler
     Version:  6.10.1  |    Severity:  blocker 
    Keywords:          |    Testcase:          
Architecture:  x86     |          Os:  Windows 
-----------------------+----------------------------------------------------
 The following code produces the ghc panic below.
 {{{
 {-# LANGUAGE RankNTypes, TypeFamilies #-}
 import Data.VectorSpace

 data I  = I { integral :: (VectorSpace v, Scalar v ~ Double) => v
             }

 -- This works
 -- integral :: (VectorSpace v, Scalar v ~ Double) => v
 -- integral = undefined

 -- type BallAnim = Input -> Behavior Ball

 followMouse i = integral undefined undefined
 }}}

 {{{
 ff>ghci GhcBug.hs
 GHCi, version 6.10.1: http://www.haskell.org/ghc/  :? for help
 Loading package ghc-prim ... linking ... done.
 Loading package integer ... linking ... done.
 Loading package base ... linking ... done.
 [1 of 1] Compiling Main             ( GhcBug.hs, interpreted )
 : panic! (the 'impossible' happened)
   (GHC version 6.10.1 for i386-unknown-mingw32):
         applyTypeToArgs
     ipv{v B4} [lid]
       @ (a{tv arL} [sk] -> t_arM{tv} [sk])
       $dVectorSpace{v arP} [lid]
       (base:GHC.Err.undefined{v rdH} [gid] @ a{tv arL} [sk])
     (vector-space-0.5:Data.VectorSpace.Scalar{tc rgl}
        (a{tv arL} [sk] -> t_arM{tv} [sk])
        ~
      ghc-prim:GHC.Types.Double{(w) tc 3u}) =>
     a{tv arL} [sk] -> t_arM{tv} [sk]

 Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug
 }}}

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/2775>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

Reply via email to