--- /dev/null
+{-# OPTIONS -fglasgow-exts #-}
+
+-- !!! A simple FFI test
+
+-- This one provoked a bogus renamer error in 4.08.1:
+-- panic: tcLookupGlobalValue: <THIS>.PrelIOBase.returnIO{-0B,s-}
+-- (the error was actually in DsMonad.dsLookupGlobalValue!)
+
+module Main where
+
+import Foreign
+
+foreign export ccall "gccd" mygcd :: Int -> Int -> Int
+
+main = putStrLn "No bug"
+
+mygcd a b = if (a==b) then a
+ else if (a<b) then mygcd a (b-a)
+ else mygcd (a-b) a
--- /dev/null
+{-# OPTIONS -fglasgow-exts #-}
+
+-- !!! A simple FFI test
+-- This one provoked a bogus renamer error in 4.08.1:
+--
+module Main where
+
+import Foreign
+
+foreign export ccall "gccd" mygcd :: Int -> Int -> Int
+
+main = putStrLn "No bug"
+
+mygcd a b = if (a==b) then a
+ else if (a<b) then mygcd a (b-a)
+ else mygcd (a-b) a
import PrelGHC
import PrelErr
+main :: IO ()
main = seq (error "hello world!" :: Int) (return ())
myseq :: a -> b -> b
= C1 a Int
| C2 b Double
deriving Ord
+
--- /dev/null
+{-# OPTIONS -fglasgow-exts #-}
+
+-- This one made ghc-4.08 crash
+-- rename/RnEnv.lhs:239: Non-exhaustive patterns in function get_tycon_key
+-- The type in the Monad instance is utterly bogus, of course
+
+module ShouldCompile ( Set ) where
+
+
+data Set a = Set [a]
+ deriving (Eq, Ord, Read, Show)
+
+instance Functor Set where
+ f `fmap` (Set xs) = Set $ f `fmap` xs
+
+instance Monad (forall a. Eq a => Set a) where
+ return x = Set [x]
+
+instance Eq (forall a. [a]) where
tcfail036.hs:6: {Num NUM}
tcfail036.hs:8: {Num NUM}
-tcfail036.hs:8:
- No instance for `Eq NUM'
- arising from an instance declaration at tcfail036.hs:8
-
-tcfail036.hs:8:
- No instance for `Show NUM'
- arising from an instance declaration at tcfail036.hs:8
-
tcfail036.hs:9:
Class `Num' used as a type
When checking kinds in `Eq Num'
--- /dev/null
+{-# OPTIONS -fglasgow-exts #-}
+
+-- !!! Functional dependencies
+
+module Main where
+
+class Foo a b | a -> b where
+ foo :: a -> b
+
+instance Foo [a] (Maybe a) where
+ foo [] = Nothing
+ foo (x:_) = Just x
+
+instance Foo (Maybe a) [a] where
+ foo Nothing = []
+ foo (Just x) = [x]
+
+test3:: [a] -> [b]
+test3 = foo . foo
+-- First foo must use the first instance,
+-- second must use the second. So we should
+-- get in effect: test3 (x:xs) = [x]
+
+main:: IO ()
+main = print (test3 "foo" :: [Int])
--- /dev/null
+{-# OPTIONS -fglasgow-exts #-}
+
+-- !!! Functional dependencies
+-- This one gave "zonkIdOcc: FunDep_a11w" in earlier days
+
+module Main (main) where
+
+data ERR a b = EOK a | ERR b deriving (Show)
+data Error = No | Notatall deriving (Show, Eq)
+
+
+class MonadErr m e | m -> e where
+ aerturn :: e -> m a
+ areturn :: a -> m a
+ acatch :: a -> (a -> m b) -> (e -> m b) -> m b
+ (>>>=) :: m a -> (a -> m b) -> m b
+ (>>>) :: m a -> m b -> m b
+
+data BP a = BP (Int -> (ERR a Error, Int))
+
+instance MonadErr BP Error where
+ aerturn k = BP $ \s -> (ERR k, s)
+ areturn k = BP $ \s -> (EOK k, s)
+ acatch k try handler = BP $ \s -> let BP try' = try k
+ (r,s1) = try' s
+ (BP c2, s2) = case r of
+ EOK r -> (areturn r, s1)
+ ERR r -> (handler r, s)
+ in c2 s2
+ a >>> b = a >>>= \_ -> b
+
+ (BP c1) >>>= fc2 = BP $ \s0 -> let (r,s1) = c1 s0
+ BP c2 = case r of
+ EOK r -> fc2 r
+ ERR r -> BP (\s -> (ERR r, s))
+ in c2 s1
+
+run_BP :: Int -> BP a -> (ERR a Error, Int)
+run_BP st (BP bp) = bp st
+
+foo :: (ERR Int Error, Int)
+foo = run_BP 111 (aerturn No)
+
+main = print (show foo)
projects / ghc-hetmet.git / commitdiff