The following program can be compiled using
ghc-5.02 --make test.lhs -fglasgow-exts
but segfaults.

> ./a.out 
"foo"
Segmentation fault

\begin{code}
module Main where

import IO

data DS = forall a. C (a -> IO ())

main = do
  let (li:st:[]) = [C (print :: String -> IO ()), C (print :: Int -> IO ())]
  call li "foo"
  call st 3

call (C f) arg = do
  f arg
\end{code}
-- 
Volker Stolz * [EMAIL PROTECTED] * PGP + S/MIME

_______________________________________________
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

Reply via email to