Here is the modularity bug in  ghc-4:

-----------------------------------------------------
module T1 where
type Z = Integer
toZ    = toInteger  :: Integral a => a -> Z

-- the idea is to switch Z, toZ between Integer, Int
-----------------------------------------------------
module Main where
import List (genericTake)
import T1   (Z, toZ     )

f :: Z -> Z -> [Z] 
f    n    i =  case  toZ i  of  j -> genericTake (n+j) (repeat n)

main = let  ns = f 2 3  in   putStr (shows ns "\n")
-----------------------------------------------------------------


After   ghc -c T1.hs,  ghc -c Main.hs   

the compiler derives a contradiction for  i :: Int,  Z.

After moving the definition of toZ  to Main.hs the compiler solves
the types differently.


------------------
Sergey Mechveliani
[EMAIL PROTECTED]

Reply via email to