diff options
| author | Thomas Miedema <thomasmiedema@gmail.com> | 2016-06-18 22:44:19 +0200 |
|---|---|---|
| committer | Thomas Miedema <thomasmiedema@gmail.com> | 2016-06-20 16:22:07 +0200 |
| commit | 915e07c33b143126e3c8de1d2ec22ccc709a9a24 (patch) | |
| tree | fcde0a7ffc1466b6e53dbee6df835af07e9a7ecc | |
| parent | 46ff80f26d1892e1b50e3f10c5d3fded33da6e81 (diff) | |
| download | haskell-915e07c33b143126e3c8de1d2ec22ccc709a9a24.tar.gz | |
Testsuite: tabs -> spaces [skip ci]
59 files changed, 1132 insertions, 1134 deletions
diff --git a/testsuite/tests/gadt/Nilsson.hs b/testsuite/tests/gadt/Nilsson.hs index bb2fa1ba20..50dd3c58fc 100644 --- a/testsuite/tests/gadt/Nilsson.hs +++ b/testsuite/tests/gadt/Nilsson.hs @@ -1,6 +1,6 @@ {-# LANGUAGE GADTs, ScopedTypeVariables #-} --- Supplied by Henrik Nilsson, showed up a bug in GADTs +-- Supplied by Henrik Nilsson, showed up a bug in GADTs module Nilsson where @@ -12,7 +12,7 @@ fromEvent = undefined usrErr :: String -> String -> String -> a usrErr = undefined -type DTime = Double -- [s] +type DTime = Double -- [s] data SF a b = SF {sfTF :: a -> Transition a b} @@ -53,13 +53,13 @@ sfArr (FDG f) = sfArrG f sfId :: SF' a a sfId = sf where - sf = SFArr (\_ a -> (sf, a)) FDI + sf = SFArr (\_ a -> (sf, a)) FDI sfConst :: b -> SF' a b sfConst b = sf where - sf = SFArr (\_ _ -> (sf, b)) (FDC b) + sf = SFArr (\_ _ -> (sf, b)) (FDC b) sfNever :: SF' a (Event b) @@ -76,7 +76,7 @@ sfArrE f fne = sf sfArrG :: (a -> b) -> SF' a b sfArrG f = sf where - sf = SFArr (\_ a -> (sf, f a)) (FDG f) + sf = SFArr (\_ a -> (sf, f a)) (FDG f) sfAcc :: (c -> a -> (c, b)) -> c -> b -> SF' (Event a) b @@ -107,10 +107,10 @@ sfAcc f c bne = sf -- * We still want to be able to get hold of the original function. data FunDesc a b where - FDI :: FunDesc a a -- Identity function - FDC :: b -> FunDesc a b -- Constant function - FDE :: (Event a -> b) -> b -> FunDesc (Event a) b -- Event-processing fun - FDG :: (a -> b) -> FunDesc a b -- General function + FDI :: FunDesc a a -- Identity function + FDC :: b -> FunDesc a b -- Constant function + FDE :: (Event a -> b) -> b -> FunDesc (Event a) b -- Event-processing fun + FDG :: (a -> b) -> FunDesc a b -- General function fdFun :: FunDesc a b -> (a -> b) fdFun FDI = id @@ -142,17 +142,17 @@ vfyNoEv :: Event a -> b -> b vfyNoEv NoEvent b = b vfyNoEv _ _ = usrErr "AFRP" "vfyNoEv" "Assertion failed: Functions on events must not \ - \map NoEvent to Event." + \map NoEvent to Event." compPrim :: SF a b -> SF b c -> SF a c compPrim (SF {sfTF = tf10}) (SF {sfTF = tf20}) = SF {sfTF = tf0} where - tf0 a0 = (cpXX sf1 sf2, c0) - where - (sf1, b0) = tf10 a0 - (sf2, c0) = tf20 b0 + tf0 a0 = (cpXX sf1 sf2, c0) + where + (sf1, b0) = tf10 a0 + (sf2, c0) = tf20 b0 - -- Naming convention: cp<X><Y> where <X> and <Y> is one of: + -- Naming convention: cp<X><Y> where <X> and <Y> is one of: -- X - arbitrary signal function -- A - arbitrary pure arrow -- C - constant arrow @@ -165,35 +165,35 @@ compPrim (SF {sfTF = tf10}) (SF {sfTF = tf20}) = SF {sfTF = tf0} cpXX sf1 (SFArr _ fd2) = cpXA sf1 fd2 cpXX (SFAcc _ f1 s1 bne) (SFAcc _ f2 s2 cne) = sfAcc f (s1, s2) (vfyNoEv bne cne) - where - f (s1, s2) a = - case f1 s1 a of - (s1', NoEvent) -> ((s1', s2), cne) - (s1', Event b) -> - let (s2', c) = f2 s2 b in ((s1', s2'), c) + where + f (s1, s2) a = + case f1 s1 a of + (s1', NoEvent) -> ((s1', s2), cne) + (s1', Event b) -> + let (s2', c) = f2 s2 b in ((s1', s2'), c) cpXX (SFCpAXA _ fd11 sf12 fd13) (SFCpAXA _ fd21 sf22 fd23) = cpAXA fd11 (cpXX (cpXA sf12 (fdComp fd13 fd21)) sf22) fd23 - cpXX sf1 sf2 = SF' tf - where - tf dt a = (cpXX sf1' sf2', c) - where - (sf1', b) = (sfTF' sf1) dt a - (sf2', c) = (sfTF' sf2) dt b + cpXX sf1 sf2 = SF' tf + where + tf dt a = (cpXX sf1' sf2', c) + where + (sf1', b) = (sfTF' sf1) dt a + (sf2', c) = (sfTF' sf2) dt b cpAXA :: FunDesc a b -> SF' b c -> FunDesc c d -> SF' a d cpAXA FDI sf2 fd3 = cpXA sf2 fd3 cpAXA fd1 sf2 FDI = cpAX fd1 sf2 cpAXA (FDC b) sf2 fd3 = cpCXA b sf2 fd3 - cpAXA fd1 sf2 (FDC d) = sfConst d + cpAXA fd1 sf2 (FDC d) = sfConst d cpAXA fd1 (SFArr _ fd2) fd3 = sfArr (fdComp (fdComp fd1 fd2) fd3) - cpAX :: FunDesc a b -> SF' b c -> SF' a c + cpAX :: FunDesc a b -> SF' b c -> SF' a c cpAX FDI sf2 = sf2 cpAX (FDC b) sf2 = cpCX b sf2 cpAX (FDE f1 f1ne) sf2 = cpEX f1 f1ne sf2 cpAX (FDG f1) sf2 = cpGX f1 sf2 - cpXA :: SF' a b -> FunDesc b c -> SF' a c + cpXA :: SF' a b -> FunDesc b c -> SF' a c cpXA sf1 FDI = sf1 cpXA sf1 (FDC c) = sfConst c cpXA sf1 (FDE f2 f2ne) = cpXE sf1 f2 f2ne @@ -204,13 +204,13 @@ compPrim (SF {sfTF = tf10}) (SF {sfTF = tf20}) = SF {sfTF = tf0} cpCX b (SFAcc _ _ _ cne) = sfConst (vfyNoEv b cne) cpCX b (SFCpAXA _ fd21 sf22 fd23) = cpCXA ((fdFun fd21) b) sf22 fd23 - cpCX b sf2 = SFCpAXA tf (FDC b) sf2 FDI - where - tf dt _ = (cpCX b sf2', c) - where - (sf2', c) = (sfTF' sf2) dt b + cpCX b sf2 = SFCpAXA tf (FDC b) sf2 FDI + where + tf dt _ = (cpCX b sf2', c) + where + (sf2', c) = (sfTF' sf2) dt b --- For SPJ: The following version did not work. +-- For SPJ: The following version did not work. -- The commented out one below did work, by lambda-lifting cpCXAux cpCXA :: b -> SF' b c -> FunDesc c d -> SF' a d cpCXA b sf2 FDI = cpCX b sf2 @@ -219,7 +219,7 @@ compPrim (SF {sfTF = tf10}) (SF {sfTF = tf20}) = SF {sfTF = tf0} where f3 = fdFun fd3 - cpCXAAux :: SF' b c -> SF' a d + cpCXAAux :: SF' b c -> SF' a d cpCXAAux (SFArr _ fd2) = sfConst (f3 ((fdFun fd2) b)) cpCXAAux (SFAcc _ _ _ cne) = sfConst (vfyNoEv b (f3 cne)) cpCXAAux (SFCpAXA _ fd21 sf22 fd23) = cpCXA ((fdFun fd21) b) sf22 (fdComp fd23 fd3) @@ -231,7 +231,7 @@ compPrim (SF {sfTF = tf10}) (SF {sfTF = tf20}) = SF {sfTF = tf0} cpCXA b sf2 fd3 = cpCXAAux b fd3 (fdFun fd3) sf2 where -- f3 = fdFun fd3 - -- Really something like: cpCXAAux :: SF' b c -> SF' a d + -- Really something like: cpCXAAux :: SF' b c -> SF' a d cpCXAAux :: b -> FunDesc c d -> (c -> d) -> SF' b c -> SF' a d cpCXAAux b fd3 f3 (SFArr _ fd2) = sfConst (f3 ((fdFun fd2) b)) cpCXAAux b fd3 f3 (SFAcc _ _ _ cne) = sfConst (vfyNoEv b (f3 cne)) @@ -239,44 +239,44 @@ compPrim (SF {sfTF = tf10}) (SF {sfTF = tf20}) = SF {sfTF = tf0} -} cpGX :: (a -> b) -> SF' b c -> SF' a c - cpGX f1 (SFArr _ fd2) = sfArr (fdComp (FDG f1) fd2) + cpGX f1 (SFArr _ fd2) = sfArr (fdComp (FDG f1) fd2) cpGX f1 (SFCpAXA _ fd21 sf22 fd23) = cpAXA (fdComp (FDG f1) fd21) sf22 fd23 - cpGX f1 sf2 = SFCpAXA tf (FDG f1) sf2 FDI - where - tf dt a = (cpGX f1 sf2', c) - where - (sf2', c) = (sfTF' sf2) dt (f1 a) + cpGX f1 sf2 = SFCpAXA tf (FDG f1) sf2 FDI + where + tf dt a = (cpGX f1 sf2', c) + where + (sf2', c) = (sfTF' sf2) dt (f1 a) cpXG :: SF' a b -> (b -> c) -> SF' a c - cpXG (SFArr _ fd1) f2 = sfArr (fdComp fd1 (FDG f2)) + cpXG (SFArr _ fd1) f2 = sfArr (fdComp fd1 (FDG f2)) cpXG (SFAcc _ f1 s bne) f2 = sfAcc f s (f2 bne) where f s a = let (s', b) = f1 s a in (s', f2 b) - cpXG (SFCpAXA _ fd11 sf12 fd22) f2 = + cpXG (SFCpAXA _ fd11 sf12 fd22) f2 = cpAXA fd11 sf12 (fdComp fd22 (FDG f2)) - cpXG sf1 f2 = SFCpAXA tf FDI sf1 (FDG f2) - where - tf dt a = (cpXG sf1' f2, f2 b) - where - (sf1', b) = (sfTF' sf1) dt a + cpXG sf1 f2 = SFCpAXA tf FDI sf1 (FDG f2) + where + tf dt a = (cpXG sf1' f2, f2 b) + where + (sf1', b) = (sfTF' sf1) dt a cpEX :: (Event a -> b) -> b -> SF' b c -> SF' (Event a) c - cpEX f1 f1ne (SFArr _ fd2) = sfArr (fdComp (FDE f1 f1ne) fd2) - cpEX f1 f1ne (SFAcc _ f2 s cne) = sfAcc f s (vfyNoEv f1ne cne) + cpEX f1 f1ne (SFArr _ fd2) = sfArr (fdComp (FDE f1 f1ne) fd2) + cpEX f1 f1ne (SFAcc _ f2 s cne) = sfAcc f s (vfyNoEv f1ne cne) where f s a = f2 s (fromEvent (f1 (Event a))) - cpEX f1 f1ne (SFCpAXA _ fd21 sf22 fd23) = + cpEX f1 f1ne (SFCpAXA _ fd21 sf22 fd23) = cpAXA (fdComp (FDE f1 f1ne) fd21) sf22 fd23 - cpEX f1 f1ne sf2 = SFCpAXA tf (FDE f1 f1ne) sf2 FDI - where - tf dt ea = (cpEX f1 f1ne sf2', c) - where + cpEX f1 f1ne sf2 = SFCpAXA tf (FDE f1 f1ne) sf2 FDI + where + tf dt ea = (cpEX f1 f1ne sf2', c) + where (sf2', c) = case ea of - NoEvent -> (sfTF' sf2) dt f1ne - _ -> (sfTF' sf2) dt (f1 ea) + NoEvent -> (sfTF' sf2) dt f1ne + _ -> (sfTF' sf2) dt (f1 ea) - cpXE :: SF' a (Event b) -> (Event b -> c) -> c -> SF' a c + cpXE :: SF' a (Event b) -> (Event b -> c) -> c -> SF' a c cpXE (SFArr _ fd1) f2 f2ne = sfArr (fdComp fd1 (FDE f2 f2ne)) cpXE (SFAcc _ f1 s bne) f2 f2ne = sfAcc f s (vfyNoEv bne f2ne) where @@ -285,9 +285,9 @@ compPrim (SF {sfTF = tf10}) (SF {sfTF = tf20}) = SF {sfTF = tf0} case eb of NoEvent -> (s', f2ne); _ -> (s', f2 eb) cpXE (SFCpAXA _ fd11 sf12 fd13) f2 f2ne = cpAXA fd11 sf12 (fdComp fd13 (FDE f2 f2ne)) - cpXE sf1 f2 f2ne = SFCpAXA tf FDI sf1 (FDE f2 f2ne) - where - tf dt a = (cpXE sf1' f2 f2ne, + cpXE sf1 f2 f2ne = SFCpAXA tf FDI sf1 (FDE f2 f2ne) + where + tf dt a = (cpXE sf1' f2 f2ne, case eb of NoEvent -> f2ne; _ -> f2 eb) - where + where (sf1', eb) = (sfTF' sf1) dt a diff --git a/testsuite/tests/gadt/T3169.hs b/testsuite/tests/gadt/T3169.hs index b52ec2cf87..bc4326c8a4 100644 --- a/testsuite/tests/gadt/T3169.hs +++ b/testsuite/tests/gadt/T3169.hs @@ -9,8 +9,8 @@ class Key k where instance (Key a, Key b) => Key (a,b) where type Map (a,b) = MP a b - lookup (a,b) (m :: Map (a,b) elt) + lookup (a,b) (m :: Map (a,b) elt) = case lookup a m :: Maybe (Map b elt) of - Just (m2 :: Map b elt) -> lookup b m2 :: Maybe elt + Just (m2 :: Map b elt) -> lookup b m2 :: Maybe elt data MP a b elt = MP (Map a (Map b elt)) diff --git a/testsuite/tests/gadt/T7205.hs b/testsuite/tests/gadt/T7205.hs index e8c555972f..e6f0eb25b3 100644 --- a/testsuite/tests/gadt/T7205.hs +++ b/testsuite/tests/gadt/T7205.hs @@ -7,9 +7,9 @@ data Abs env g v where class Eval g env h v where eval :: env -> g env h v -> v -evalAbs :: Eval g2 (a2, env) h2 v2 - => env - -> Abs env (g2 (a2, env) h2 v2) (a2->v2) - -> (a2->v2) -evalAbs env (Abs e) x +evalAbs :: Eval g2 (a2, env) h2 v2 + => env + -> Abs env (g2 (a2, env) h2 v2) (a2->v2) + -> (a2->v2) +evalAbs env (Abs e) x = eval (x, env) e -- e :: g (a,env) h v diff --git a/testsuite/tests/gadt/gadt2.hs b/testsuite/tests/gadt/gadt2.hs index 886b702ce7..d1c6b4d7af 100644 --- a/testsuite/tests/gadt/gadt2.hs +++ b/testsuite/tests/gadt/gadt2.hs @@ -15,4 +15,4 @@ g (T n) | n >= 3 = if n>3 then GT else EQ g (T n) = LT main = do print [f (T 0), f (T 1)] - print [g (T 2), g (T 3), g (T 4)] + print [g (T 2), g (T 3), g (T 4)] diff --git a/testsuite/tests/gadt/gadt25.hs b/testsuite/tests/gadt/gadt25.hs index 99aecad3fb..452da8cd4a 100644 --- a/testsuite/tests/gadt/gadt25.hs +++ b/testsuite/tests/gadt/gadt25.hs @@ -5,7 +5,7 @@ module Foo where data TValue t where - TList :: [a] -> TValue [a] + TList :: [a] -> TValue [a] instance (Eq b) => Eq (TValue b) where (==) (TList p) (TList q) = (==) p q @@ -15,19 +15,19 @@ instance (Eq b) => Eq (TValue b) where Here's the reasoning (I have done a bit of renaming). * The TList constructor really has type - TList :: forall a. forall x. (a~[x]) => [x] -> TValue a + TList :: forall a. forall x. (a~[x]) => [x] -> TValue a * So in the pattern match we have - (Eq b) available from the instance header - TList p :: TValue b - x is a skolem, existentially bound by the pattern - p :: [x] - b ~ [x] available from the pattern match + (Eq b) available from the instance header + TList p :: TValue b + x is a skolem, existentially bound by the pattern + p :: [x] + b ~ [x] available from the pattern match * On the RHS we find we need (Eq [x]). * So the constraint problem we have is - (Eq b, b~[x]) => Eq [x] + (Eq b, b~[x]) => Eq [x] ["Given" => "Wanted"] Can we prove this? From the two given constraints we can see that we also have Eq [x], and that certainly proves Eq [x]. @@ -38,4 +38,4 @@ consequences of the "given" constraints, we might use the top-level Eq a => Eq [a] instance to solve the wanted Eq [x]. And now we need Eq x, which *isn't* a consequence of (Eq b, b~[x]). --}
\ No newline at end of file +-} diff --git a/testsuite/tests/gadt/gadt5.hs b/testsuite/tests/gadt/gadt5.hs index 5db3deef8c..2dce68fffa 100644 --- a/testsuite/tests/gadt/gadt5.hs +++ b/testsuite/tests/gadt/gadt5.hs @@ -3,21 +3,21 @@ module Main where data Term a where - Lit :: Int -> Term Int + Lit :: Int -> Term Int IsZero :: Term Int -> Term Bool If :: Term Bool -> Term a -> Term a -> Term a - Pr :: Term a -> Term b -> Term (a, b) - Fst :: Term (a, b) -> Term a - Snd :: Term (a, b) -> Term b + Pr :: Term a -> Term b -> Term (a, b) + Fst :: Term (a, b) -> Term a + Snd :: Term (a, b) -> Term b eval :: Term v -> v -eval (Lit n) = n +eval (Lit n) = n eval (IsZero t) = eval t == 0 eval (If t1 t2 t3) = if eval t1 then eval t2 else eval t3 eval (Pr t1 t2) = (eval t1, eval t2) -eval (Fst t) = case (eval t) of { (a,b) -> a } -eval (Snd t) = case (eval t) of { (a,b) -> b } +eval (Fst t) = case (eval t) of { (a,b) -> a } +eval (Snd t) = case (eval t) of { (a,b) -> b } term = If (IsZero (Lit 1)) (Pr (Lit 2) (Lit 3)) (Pr (Lit 3) (Lit 4)) -main = print (eval term)
\ No newline at end of file +main = print (eval term) diff --git a/testsuite/tests/gadt/gadt8.hs b/testsuite/tests/gadt/gadt8.hs index 1cad8f65cc..ebd8b04c49 100644 --- a/testsuite/tests/gadt/gadt8.hs +++ b/testsuite/tests/gadt/gadt8.hs @@ -1,15 +1,15 @@ {-# LANGUAGE GADTs, KindSignatures #-} -- Test a couple of trivial things: --- explicit layout --- trailing semicolons --- kind signatures +-- explicit layout +-- trailing semicolons +-- kind signatures module ShouldCompile where data Expr :: * -> * where { EInt :: Int -> Expr Int ; EBool :: Bool -> Expr Bool ; EIf :: (Expr Bool) -> (Expr a) -> (Expr a) -> Expr a ; - -- Note trailing semicolon, should be ok + -- Note trailing semicolon, should be ok } diff --git a/testsuite/tests/gadt/josef.hs b/testsuite/tests/gadt/josef.hs index 3be7dc28dc..34bd41ba3f 100644 --- a/testsuite/tests/gadt/josef.hs +++ b/testsuite/tests/gadt/josef.hs @@ -1,7 +1,7 @@ {-# LANGUAGE GADTs, KindSignatures, MultiParamTypeClasses, FunctionalDependencies #-} --- Program from Josef Svenningsson +-- Program from Josef Svenningsson -- Just a short explanation of the program. It contains -- some class declarations capturing some definitions from @@ -10,7 +10,7 @@ -- function defining the semantics for lambda terms called -- 'interp'. --- Made GHC 6.4 bleat +-- Made GHC 6.4 bleat -- Quantified type variable `t' is unified with -- another quantified type variable `terminal' -- When trying to generalise the type inferred for `interp' @@ -38,14 +38,14 @@ class Category arr => inRight :: arr b (coprod a b) ccase :: arr a c -> arr b c -> arr (coprod a b) c -class ProductCategory prod arr => +class ProductCategory prod arr => Exponential exp prod arr | arr -> exp where eval :: arr (prod (exp a b) a) b curryA :: arr (prod c a) b -> arr c (exp a b) -class (Exponential exp prod arr, Terminal terminal arr) => - CartesianClosed terminal exp prod arr | arr -> terminal exp prod +class (Exponential exp prod arr, Terminal terminal arr) => + CartesianClosed terminal exp prod arr | arr -> terminal exp prod data V prod env t where Z :: V prod (prod env t) t @@ -55,13 +55,13 @@ data Lambda terminal (exp :: * -> * -> *) prod env t where Unit :: Lambda foo exp prod env foo Var :: V prod env t -> Lambda terminal exp prod env t {- Lam :: Lambda terminal exp prod (prod env a) t - -> Lambda terminal exp prod env (exp a t) - App :: Lambda terminal exp prod env (exp t t') - -> Lambda terminal exp prod env t -> Lambda terminal exp prod env t' + -> Lambda terminal exp prod env (exp a t) + App :: Lambda terminal exp prod env (exp t t') + -> Lambda terminal exp prod env t -> Lambda terminal exp prod env t' -} -interp :: CartesianClosed terminal exp prod arr => - Lambda terminal exp prod s t -> arr s t +interp :: CartesianClosed terminal exp prod arr => + Lambda terminal exp prod s t -> arr s t interp (Unit) = terminal -- Terminal terminal arr => arr a terminal -- interp (Var Z) = second -- interp (Var (S v)) = first `comp` interp (Var v) diff --git a/testsuite/tests/gadt/nbe.hs b/testsuite/tests/gadt/nbe.hs index 60141291fc..103319ad1d 100644 --- a/testsuite/tests/gadt/nbe.hs +++ b/testsuite/tests/gadt/nbe.hs @@ -11,10 +11,10 @@ data Ty t where Arr :: Ty a -> Ty b -> Ty (a -> b) data Exp g t where - Var :: Var g t -> Exp g t - Lam :: Ty a -> Exp (g,a) b -> Exp g (a->b) - App :: Exp g (s -> t) -> Exp g s -> Exp g t - If :: Exp g Bool -> Exp g t -> Exp g t -> Exp g t + Var :: Var g t -> Exp g t + Lam :: Ty a -> Exp (g,a) b -> Exp g (a->b) + App :: Exp g (s -> t) -> Exp g s -> Exp g t + If :: Exp g Bool -> Exp g t -> Exp g t -> Exp g t ETrue :: Exp g Bool EFalse :: Exp g Bool @@ -72,12 +72,12 @@ data TyEnv g where Cons :: Ty t -> TyEnv h -> TyEnv (h,t) infer :: TyEnv g -> Exp g t -> Ty t -infer g (Var x) = inferVar g x -infer g (Lam t e) = Arr t (infer (Cons t g) e) -infer g (App e e') = case infer g e of Arr _ t -> t -infer g (ETrue) = Bool -infer g (EFalse) = Bool -infer g (If _ e _) = infer g e +infer g (Var x) = inferVar g x +infer g (Lam t e) = Arr t (infer (Cons t g) e) +infer g (App e e') = case infer g e of Arr _ t -> t +infer g (ETrue) = Bool +infer g (EFalse) = Bool +infer g (If _ e _) = infer g e inferVar :: TyEnv g -> Var g t -> Ty t inferVar (Cons t h) (SVar x) = inferVar h x @@ -87,8 +87,8 @@ inferVar (Cons t h) (ZVar) = t data Tree a = Val a | Choice (Tree a) (Tree a) -- doesn't yet force trees to be fully balanced: --- Val :: a -> Tree a Z --- Choice :: Tree a n -> Tree a n -> Tree a (S n) +-- Val :: a -> Tree a Z +-- Choice :: Tree a n -> Tree a n -> Tree a (S n) instance Functor Tree where fmap = liftM @@ -114,8 +114,8 @@ flatten t = flatten_ t [] -- quote & friends ------------------------------------------------------------- -- for values -------------------------- -enumV :: Ty t -> Tree t -questionsV :: Ty t -> [t -> Bool] +enumV :: Ty t -> Tree t +questionsV :: Ty t -> [t -> Bool] enumV Bool = Choice (Val True) (Val False) @@ -123,46 +123,46 @@ enumV (Arr s t) = mkEnum (questionsV s) (enumV t) where mkEnum [] t = tmap const t mkEnum (q:qs) es = do - f1 <- mkEnum qs es - f2 <- mkEnum qs es - return (\d -> if q d then f1 d else f2 d) + f1 <- mkEnum qs es + f2 <- mkEnum qs es + return (\d -> if q d then f1 d else f2 d) -questionsV Bool = return (\x -> x) -questionsV (Arr s t) = do - d <- flatten (enumV s) - q <- questionsV t - return (\f -> q (f d)) +questionsV Bool = return (\x -> x) +questionsV (Arr s t) = do + d <- flatten (enumV s) + q <- questionsV t + return (\f -> q (f d)) -- for expressions --------------------- -enumE :: Ty t -> Tree (Exp g t) -questionsE :: Ty t -> [Exp g t -> Exp g Bool] +enumE :: Ty t -> Tree (Exp g t) +questionsE :: Ty t -> [Exp g t -> Exp g Bool] enumE Bool = Choice (Val ETrue) (Val EFalse) enumE (Arr s t) = tmap (lamE s) (mkEnumE (questionsE s) (enumE t)) where mkEnumE [] t = tmap const t mkEnumE (q:qs) es = do - f1 <- mkEnumE qs es - f2 <- mkEnumE qs es - return (\d -> ifE (q d) (f1 d) (f2 d)) - -questionsE Bool = return (\x -> x) -questionsE (Arr s t) = do - d <- flatten (enumE s) - q <- questionsE t - return (\f -> q (App f d)) - --- should be --- find (List (Exp g Bool) n) -> Tree (Exp g a) n -> Exp g a + f1 <- mkEnumE qs es + f2 <- mkEnumE qs es + return (\d -> ifE (q d) (f1 d) (f2 d)) + +questionsE Bool = return (\x -> x) +questionsE (Arr s t) = do + d <- flatten (enumE s) + q <- questionsE t + return (\f -> q (App f d)) + +-- should be +-- find (List (Exp g Bool) n) -> Tree (Exp g a) n -> Exp g a find :: [Exp g Bool] -> Tree (Exp g a) -> Exp g a -find [] (Val a) = a -find (b:bs) (Choice l r) = ifE b (find bs l) (find bs r) -find _ _ = error "bad arguments to find" +find [] (Val a) = a +find (b:bs) (Choice l r) = ifE b (find bs l) (find bs r) +find _ _ = error "bad arguments to find" quote :: Ty t -> t -> Exp g t quote Bool t = case t of True -> ETrue; False -> EFalse quote (Arr s t) f = lamE s (\e -> find (do q <- questionsE s; return (q e)) - (tmap (quote t . f) (enumV s))) + (tmap (quote t . f) (enumV s))) -- normalization (by evaluation) ----------------------------------------------- data BoxExp t = Box (forall g. Exp g t) @@ -183,4 +183,4 @@ test = [ eqB (nf b22b thrice) (nf b22b once) , eqB (nf b22b twice) (nf b22b once)] where nf = normalize -main = print test
\ No newline at end of file +main = print test diff --git a/testsuite/tests/gadt/records.hs b/testsuite/tests/gadt/records.hs index e28add3fb6..eaa2fd4196 100644 --- a/testsuite/tests/gadt/records.hs +++ b/testsuite/tests/gadt/records.hs @@ -18,8 +18,7 @@ g (T1 {x=xv, y=yv}) = T2 { x = xv } h v = x v + 1 main = do { let t1 = T1 { y = "foo", x = 4 } - t2 = g t1 - ; print (h (f 8 undefined)) - ; print (h t2) - } -
\ No newline at end of file + t2 = g t1 + ; print (h (f 8 undefined)) + ; print (h t2) + } diff --git a/testsuite/tests/gadt/red-black.hs b/testsuite/tests/gadt/red-black.hs index 29bb324310..016ac83017 100644 --- a/testsuite/tests/gadt/red-black.hs +++ b/testsuite/tests/gadt/red-black.hs @@ -5,7 +5,7 @@ module ShouldCompile where -- data RBTree = forall n. Root (SubTree Black n) -- Kind Colour -data Red +data Red data Black -- Kind Nat @@ -20,12 +20,12 @@ data SubTree c n where ins :: Int -> SubTree c n -> SubTree c n -ins n Leaf = (Fix (RNode Leaf n Leaf)) +ins n Leaf = (Fix (RNode Leaf n Leaf)) ins n (BNode x m y) | n <= m = black (ins n x) m y ins n (BNode x m y) | n > m = black x m (ins n y) ins n (RNode x m y) | n <= m = RNode (ins n x) m y ins n (RNode x m y) | n > m = RNode x m (ins n y) - + black :: SubTree c n -> Int -> SubTree d n -> SubTree Black (S n) black (RNode (Fix u) v c) w (x@(RNode _ _ _)) = Fix(RNode (blacken u) v (BNode c w x)) diff --git a/testsuite/tests/gadt/scoped.hs b/testsuite/tests/gadt/scoped.hs index cafa738697..ea321a53c4 100644 --- a/testsuite/tests/gadt/scoped.hs +++ b/testsuite/tests/gadt/scoped.hs @@ -28,6 +28,6 @@ g2 (C (p :: x)) = () g3 :: forall x y . D x y -> () -- D (..) :: D x y -- C (..) :: C sk y --- sk = y +-- sk = y -- p :: sk g3 (D (C (p :: y))) = () diff --git a/testsuite/tests/gadt/set.hs b/testsuite/tests/gadt/set.hs index 3a78bbb64b..daafe8e22a 100644 --- a/testsuite/tests/gadt/set.hs +++ b/testsuite/tests/gadt/set.hs @@ -1,6 +1,6 @@ {-# LANGUAGE GADTs #-} --- Provoked by +-- Provoked by -- http://www.haskell.org/pipermail/haskell-cafe/2007-January/021086.html module ShouldCompile where @@ -29,7 +29,7 @@ unionC1 (SM1 p1 m1) (SM1 p2 m2) --------------------- data SetM2 a where SM2 :: Ord w => Teq a w -> Set.Set w -> SetM2 a - -- Different order of args in Teq + -- Different order of args in Teq unionA2 :: SetM2 a -> SetM2 a -> SetM2 a unionA2 (SM2 Teq m1) (SM2 Teq m2) @@ -40,6 +40,6 @@ unionB2 (SM2 p1 m1) (SM2 p2 m2) = case p1 of Teq -> case p2 of Teq -> SM2 Teq (m1 `Set.union` m2) unionC2 :: SetM2 a -> SetM2 a -> SetM2 a -unionC2 (SM2 p1 m1) (SM2 p2 m2) +unionC2 (SM2 p1 m1) (SM2 p2 m2) = case (p1,p2) of (Teq,Teq) -> SM2 Teq (m1 `Set.union` m2) diff --git a/testsuite/tests/gadt/termination.hs b/testsuite/tests/gadt/termination.hs index f290322fa5..920091b7f1 100644 --- a/testsuite/tests/gadt/termination.hs +++ b/testsuite/tests/gadt/termination.hs @@ -164,20 +164,20 @@ test4 :: NonTerminating test4 = NonTerminating (Apply omega omega) help3 help1 :: Reducible (Apply Omega Omega) -help1 = Reducible (ReduceSimple - (ReplaceApply (ReplaceVarEq Equal (LiftLambda - (LiftApply (LiftVarLess LessZero) (LiftVarLess LessZero)))) - (ReplaceVarEq Equal (LiftLambda (LiftApply - (LiftVarLess LessZero) (LiftVarLess LessZero)))))) +help1 = Reducible (ReduceSimple + (ReplaceApply (ReplaceVarEq Equal (LiftLambda + (LiftApply (LiftVarLess LessZero) (LiftVarLess LessZero)))) + (ReplaceVarEq Equal (LiftLambda (LiftApply + (LiftVarLess LessZero) (LiftVarLess LessZero)))))) help2 :: ReduceEventually (Apply Omega Omega) t -> Equal (Apply Omega Omega) t help2 ReduceZero = Equal -help2 (ReduceSucc (ReduceSimple (ReplaceApply - (ReplaceVarEq _ (LiftLambda (LiftApply (LiftVarLess _) (LiftVarLess _)))) - (ReplaceVarEq _ (LiftLambda (LiftApply (LiftVarLess _) (LiftVarLess _)))))) y) +help2 (ReduceSucc (ReduceSimple (ReplaceApply + (ReplaceVarEq _ (LiftLambda (LiftApply (LiftVarLess _) (LiftVarLess _)))) + (ReplaceVarEq _ (LiftLambda (LiftApply (LiftVarLess _) (LiftVarLess _)))))) y) = case help2 y of Equal -> Equal help3 :: Infinite (Apply Omega Omega) help3 x = case help2 x of - Equal -> help1 + Equal -> help1 diff --git a/testsuite/tests/gadt/ubx-records.hs b/testsuite/tests/gadt/ubx-records.hs index ab21dc65fe..c31b66ffd4 100644 --- a/testsuite/tests/gadt/ubx-records.hs +++ b/testsuite/tests/gadt/ubx-records.hs @@ -9,7 +9,7 @@ data T a where T1 :: { w :: !(Int, Int), x :: a, y :: b } -> T (a,b) T2 :: { w :: !(Int, Int), x :: a } -> T (a,b) T3 :: { z :: Int } -> T Bool - + -- T1 :: forall c a b. (c~(a,b)) => (Int,Int) -> a -> b -> T c f xv yv = T1 { w = (0,0), x = xv, y = yv } @@ -23,8 +23,8 @@ h v = x v + 1 i v = let (x,y) = w v in x + y main = do { let t1 = T1 { w = (0,0), y = "foo", x = 4 } - t2 = g t1 - ; print (h (f 8 undefined)) - ; print (h t2) + t2 = g t1 + ; print (h (f 8 undefined)) + ; print (h t2) ; print (i t1) - } + } diff --git a/testsuite/tests/gadt/while.hs b/testsuite/tests/gadt/while.hs index 2040511c0f..c5bbcde9ff 100644 --- a/testsuite/tests/gadt/while.hs +++ b/testsuite/tests/gadt/while.hs @@ -7,21 +7,21 @@ succeed = return data V s t where Z :: V (t,m) t - S :: V m t -> V (x,m) t - + S :: V m t -> V (x,m) t + data Exp s t where - IntC :: Int -> Exp s Int -- 5 - BoolC :: Bool -> Exp s Bool -- True - Plus :: Exp s Int -> Exp s Int -> Exp s Int -- x + 3 - Lteq :: Exp s Int -> Exp s Int -> Exp s Bool -- x <= 3 - Var :: V s t -> Exp s t -- x + IntC :: Int -> Exp s Int -- 5 + BoolC :: Bool -> Exp s Bool -- True + Plus :: Exp s Int -> Exp s Int -> Exp s Int -- x + 3 + Lteq :: Exp s Int -> Exp s Int -> Exp s Bool -- x <= 3 + Var :: V s t -> Exp s t -- x data Com s where - Set :: V s t -> Exp s t -> Com s -- x := e - Seq :: Com s -> Com s -> Com s -- { s1; s2; } - If :: Exp s Bool -> Com s -> Com s -> Com s -- if e then x else y - While :: Exp s Bool -> Com s -> Com s -- while e do s - Declare :: Exp s t -> Com (t,s) -> Com s -- { int x = 5; s } + Set :: V s t -> Exp s t -> Com s -- x := e + Seq :: Com s -> Com s -> Com s -- { s1; s2; } + If :: Exp s Bool -> Com s -> Com s -> Com s -- if e then x else y + While :: Exp s Bool -> Com s -> Com s -- while e do s + Declare :: Exp s t -> Com (t,s) -> Com s -- { int x = 5; s } update :: (V s t) -> t -> s -> s update Z n (x,y) = (n,y) @@ -42,8 +42,8 @@ exec (Seq x y) s = exec y (exec x s) exec (If test x1 x2) s = if (eval test s) then exec x1 s else exec x2 s exec (While test body) s = loop s - where loop s = if (eval test s) - then loop (exec body s) + where loop s = if (eval test s) + then loop (exec body s) else s exec (Declare e body) s = store where (_,store) = (exec body (eval e s,s)) @@ -54,19 +54,19 @@ v2 = S (S Z) v3 = S (S (S Z)) e2 = Lteq (Plus (Var v0)(Var v1)) (Plus (Var v0) (IntC 1)) - + sum_var = Z x = S Z prog :: Com (Int,(Int,a)) -prog = +prog = Seq (Set sum_var (IntC 0)) (Seq (Set x (IntC 1)) (While (Lteq (Var x) (IntC 5)) (Seq (Set sum_var (Plus (Var sum_var)(Var x))) (Set x (Plus (Var x) (IntC 1)))))) - -ans = exec prog (34,(12,1)) + +ans = exec prog (34,(12,1)) main = print ans {- { sum = 0 ; @@ -75,7 +75,7 @@ main = print ans { sum = sum + x; x = x + 1; } -} +} -} @@ -87,15 +87,15 @@ data TyAst = I | B | P TyAst TyAst data TypeR t where IntR :: TypeR Int BoolR :: TypeR Bool - PairR :: TypeR a -> TypeR b -> TypeR (a,b) + PairR :: TypeR a -> TypeR b -> TypeR (a,b) -- Judgments for Types -data TJudgment = forall t . TJ (TypeR t) +data TJudgment = forall t . TJ (TypeR t) checkT :: TyAst -> TJudgment checkT I = TJ IntR checkT B = TJ BoolR -checkT (P x y) = +checkT (P x y) = case (checkT x,checkT y) of (TJ a, TJ b) -> TJ(PairR a b) @@ -111,7 +111,7 @@ match (PairR a b) (PairR c d) = do { EqProof <- match a c ; EqProof <- match b d ; succeed EqProof } -match _ _ = fail "match fails" +match _ _ = fail "match fails" ---------------------------------------------- @@ -121,13 +121,13 @@ checkV :: Int -> TypeR t -> TypeR s -> Maybe(V s t) checkV 0 t1 (PairR t2 p) = do { EqProof <- match t1 t2 ; return Z } -checkV n t1 (PairR ty p) = +checkV n t1 (PairR ty p) = do { v <- checkV (n-1) t1 p; return(S v)} checkV n t1 sr = Nothing ----------------------------------------------------- -data ExpAst +data ExpAst = IntCA Int | BoolCA Bool | PlusA ExpAst ExpAst @@ -135,7 +135,7 @@ data ExpAst | VarA Int TyAst -- Judgments for Expressions -data EJudgment s = forall t . EJ (TypeR t) (Exp s t) +data EJudgment s = forall t . EJ (TypeR t) (Exp s t) checkE :: ExpAst -> TypeR s -> Maybe (EJudgment s) checkE (IntCA n) sr = succeed(EJ IntR (IntC n)) @@ -146,13 +146,13 @@ checkE (PlusA x y) sr = ; EJ t2 e2 <- checkE y sr ; EqProof <- match t2 IntR ; succeed(EJ IntR (Plus e1 e2))} -checkE (VarA n ty) sr = +checkE (VarA n ty) sr = do { TJ t <- succeed(checkT ty) - ; v <- checkV n t sr + ; v <- checkV n t sr ; return(EJ t (Var v)) } ----------------------------------------------------- -data ComAst +data ComAst = SetA Int TyAst ExpAst | SeqA ComAst ComAst | IfA ExpAst ComAst ComAst @@ -168,22 +168,22 @@ checkC (SetA n ty e) sr = ; EJ t2 e1 <- checkE e sr ; EqProof <- match t1 t2 ; return(EC (Set v e1))} -checkC (SeqA x y) sr = +checkC (SeqA x y) sr = do { EC c1 <- checkC x sr ; EC c2 <- checkC y sr ; return(EC (Seq c1 c2)) } -checkC (IfA e x y) sr = +checkC (IfA e x y) sr = do { EJ t1 e1 <- checkE e sr ; EqProof <- match t1 BoolR ; EC c1 <- checkC x sr ; EC c2 <- checkC y sr ; return(EC(If e1 c1 c2)) } -checkC (WhileA e x) sr = +checkC (WhileA e x) sr = do { EJ t1 e1 <- checkE e sr ; EqProof <- match t1 BoolR ; EC c1 <- checkC x sr ; return(EC(While e1 c1)) } -checkC (DeclareA ty e c) sr = +checkC (DeclareA ty e c) sr = do { TJ t1 <- succeed(checkT ty) ; EJ t2 e2 <- checkE e sr ; EqProof <- match t1 t2 @@ -195,7 +195,7 @@ checkC (DeclareA ty e c) sr = e1 = Lteq (Plus (Var sum_var)(Var x)) (Plus (Var x) (IntC 1)) {- -data Store s +data Store s = M (Code s) | forall a b . N (Code a) (Store b) where s = (a,b) @@ -213,4 +213,4 @@ eval2 (Var (S v)) (M x) = eval2 (Var v) (M [| snd $x |]) test e = [| \ (x,(y,z)) -> $(eval2 e (N [|x|] (N [|y|] (M [|z|])))) |] -- test e1 ---> [| \ (x,(y,z)) -> x + y <= y + 1 |] --}
\ No newline at end of file +-} diff --git a/testsuite/tests/ghci.debugger/scripts/break012.hs b/testsuite/tests/ghci.debugger/scripts/break012.hs index 7b2e2ea0fb..a48afa67e3 100644 --- a/testsuite/tests/ghci.debugger/scripts/break012.hs +++ b/testsuite/tests/ghci.debugger/scripts/break012.hs @@ -1,5 +1,5 @@ g i = let a = i + 1 - b = id + b = id c = () d = (+) in (a,b,c,d) diff --git a/testsuite/tests/ghci.debugger/scripts/break013.hs b/testsuite/tests/ghci.debugger/scripts/break013.hs index 53d8432865..69e007c917 100644 --- a/testsuite/tests/ghci.debugger/scripts/break013.hs +++ b/testsuite/tests/ghci.debugger/scripts/break013.hs @@ -1,4 +1,4 @@ g i = (a,b,c) where a = False - b = True + b = True c = () diff --git a/testsuite/tests/ghci.debugger/scripts/break014.hs b/testsuite/tests/ghci.debugger/scripts/break014.hs index 7dff7b6fc5..1f4313d75b 100644 --- a/testsuite/tests/ghci.debugger/scripts/break014.hs +++ b/testsuite/tests/ghci.debugger/scripts/break014.hs @@ -1,4 +1,4 @@ g i = let a = False - b = True + b = True c = (a,b) in c diff --git a/testsuite/tests/ghci.debugger/scripts/print021.hs b/testsuite/tests/ghci.debugger/scripts/print021.hs index 7c3962d803..ff67a0d399 100644 --- a/testsuite/tests/ghci.debugger/scripts/print021.hs +++ b/testsuite/tests/ghci.debugger/scripts/print021.hs @@ -1,18 +1,18 @@ -- Test that we can recover unicode DataCons in :print -data T - = À -- latin - | Α -- greek - | Ⴀ -- georgian - | Ϣ -- coptic - | А -- cyrillic - | Ա -- armenian +data T + = À -- latin + | Α -- greek + | Ⴀ -- georgian + | Ϣ -- coptic + | А -- cyrillic + | Ա -- armenian deriving Show test = - [ À -- latin - , Α -- greek - , Ⴀ -- georgian - , Ϣ -- coptic - , А -- cyrillic - , Ա -- armenian + [ À -- latin + , Α -- greek + , Ⴀ -- georgian + , Ϣ -- coptic + , А -- cyrillic + , Ա -- armenian ] diff --git a/testsuite/tests/mdo/should_compile/mdo001.hs b/testsuite/tests/mdo/should_compile/mdo001.hs index e193743553..576a7d0e90 100644 --- a/testsuite/tests/mdo/should_compile/mdo001.hs +++ b/testsuite/tests/mdo/should_compile/mdo001.hs @@ -3,14 +3,14 @@ -- test that we have all the promised instances module Main(main) where - -import Control.Monad.Fix + +import Control.Monad.Fix import qualified Control.Monad.ST as SST import qualified Control.Monad.ST.Lazy as LST generic :: MonadFix m => m [Int] generic = mdo xs <- return (1:xs) - return (take 4 xs) + return (take 4 xs) io :: IO [Int] io = generic @@ -20,7 +20,7 @@ sst = generic lst :: LST.ST s [Int] lst = generic - + mb :: Maybe [Int] mb = generic @@ -28,9 +28,9 @@ ls :: [[Int]] ls = generic main :: IO () -main = do - print =<< io - print $ SST.runST sst - print $ LST.runST lst - print $ mb - print $ ls +main = do + print =<< io + print $ SST.runST sst + print $ LST.runST lst + print $ mb + print $ ls diff --git a/testsuite/tests/mdo/should_compile/mdo002.hs b/testsuite/tests/mdo/should_compile/mdo002.hs index 432825749d..3f9533f247 100644 --- a/testsuite/tests/mdo/should_compile/mdo002.hs +++ b/testsuite/tests/mdo/should_compile/mdo002.hs @@ -21,11 +21,11 @@ instance Monad X where (X a) >>= f = f a instance MonadFix X where - mfix f = fix (f . unX) + mfix f = fix (f . unX) where unX ~(X x) = x z :: X [Int] z = mdo x <- return (1:x) - return (take 4 x) + return (take 4 x) main = print z diff --git a/testsuite/tests/mdo/should_compile/mdo004.hs b/testsuite/tests/mdo/should_compile/mdo004.hs index 544ee6cc66..fe405b882b 100644 --- a/testsuite/tests/mdo/should_compile/mdo004.hs +++ b/testsuite/tests/mdo/should_compile/mdo004.hs @@ -1,17 +1,17 @@ {-# OPTIONS -XRecursiveDo #-} --- test let bindings, polymorphism is ok provided they are not +-- test let bindings, polymorphism is ok provided they are not -- isolated in a recursive segment -- NB. this is not what Hugs does! module Main (main) where -import Control.Monad.Fix +import Control.Monad.Fix t :: IO (Int, Int) t = mdo let l [] = 0 l (x:xs) = 1 + l xs - return (l "1", l [1,2,3]) + return (l "1", l [1,2,3]) main :: IO () main = t >>= print diff --git a/testsuite/tests/mdo/should_compile/mdo005.hs b/testsuite/tests/mdo/should_compile/mdo005.hs index 0b6301b8a5..c712c5a01e 100644 --- a/testsuite/tests/mdo/should_compile/mdo005.hs +++ b/testsuite/tests/mdo/should_compile/mdo005.hs @@ -4,12 +4,12 @@ module Main (main) where -import Control.Monad.Fix +import Control.Monad.Fix import Data.Maybe ( fromJust ) t = mdo x <- fromJust (mdo x <- Just (1:x) - return (take 4 x)) - return x + return (take 4 x)) + return x main :: IO () -main = print t +main = print t diff --git a/testsuite/tests/mdo/should_fail/mdofail005.hs b/testsuite/tests/mdo/should_fail/mdofail005.hs index b4d52918a5..324973fece 100644 --- a/testsuite/tests/mdo/should_fail/mdofail005.hs +++ b/testsuite/tests/mdo/should_fail/mdofail005.hs @@ -9,4 +9,4 @@ import Control.Monad.Fix main :: IO () main = mdo x <- return (1:x) - return () + return () diff --git a/testsuite/tests/mdo/should_run/mdorun001.hs b/testsuite/tests/mdo/should_run/mdorun001.hs index 8527e5b2b1..cc30d12154 100644 --- a/testsuite/tests/mdo/should_run/mdorun001.hs +++ b/testsuite/tests/mdo/should_run/mdorun001.hs @@ -7,27 +7,27 @@ import Data.Array.IO import Control.Monad norm a = mdo (_, sz) <- getBounds a - s <- ioaA 1 s sz 0 - return () - where - ioaA i s sz acc - | i > sz = return acc - | True = do v <- readArray a i - writeArray a i (v / s) - ioaA (i+1) s sz $! (v + acc) + s <- ioaA 1 s sz 0 + return () + where + ioaA i s sz acc + | i > sz = return acc + | True = do v <- readArray a i + writeArray a i (v / s) + ioaA (i+1) s sz $! (v + acc) toList a = do (_, sz) <- getBounds a - mapM (\i -> readArray a i) [1..sz] + mapM (\i -> readArray a i) [1..sz] test :: Int -> IO () test sz = do - (arr :: IOArray Int Float) <- newArray (1, sz) 12 - putStrLn "Before: " - toList arr >>= print - norm arr - putStrLn "After: " - lst <- toList arr - print lst - putStrLn ("Normalized sum: " ++ show (sum lst)) + (arr :: IOArray Int Float) <- newArray (1, sz) 12 + putStrLn "Before: " + toList arr >>= print + norm arr + putStrLn "After: " + lst <- toList arr + print lst + putStrLn ("Normalized sum: " ++ show (sum lst)) main = test 10 diff --git a/testsuite/tests/module/Mod173_Aux.hs b/testsuite/tests/module/Mod173_Aux.hs index 1c947914e1..7cbd88da04 100644 --- a/testsuite/tests/module/Mod173_Aux.hs +++ b/testsuite/tests/module/Mod173_Aux.hs @@ -1,9 +1,9 @@ module Mod173_Aux( module Mod173_Aux ) where import qualified Data.List as Mod173_Aux( nub ) - -- This should not be exported + -- This should not be exported -import Data.List as Mod173_Aux( partition ) - -- This one should be exported +import Data.List as Mod173_Aux( partition ) + -- This one should be exported -frob x = Mod173_Aux.nub (x::[Int]) -- This one should +frob x = Mod173_Aux.nub (x::[Int]) -- This one should diff --git a/testsuite/tests/module/mod168.hs b/testsuite/tests/module/mod168.hs index 1c0deaa579..eb8e927afd 100644 --- a/testsuite/tests/module/mod168.hs +++ b/testsuite/tests/module/mod168.hs @@ -4,9 +4,9 @@ -- ) module M where -import Prelude hiding ( negate, enumFrom, - enumFromThen, enumFromTo, - enumFromThenTo ) +import Prelude hiding ( negate, enumFrom, + enumFromThen, enumFromTo, + enumFromThenTo ) import Data.Ix hiding ( rangeSize ) negate = undefined enumFrom = undefined diff --git a/testsuite/tests/module/mod171.hs b/testsuite/tests/module/mod171.hs index a61e886784..38a5445a28 100644 --- a/testsuite/tests/module/mod171.hs +++ b/testsuite/tests/module/mod171.hs @@ -3,8 +3,8 @@ module M (module Mod171_A, h) where -import Mod171_A -- This isn't unused... -import Mod171_B -- even though this imports all the same stuff +import Mod171_A -- This isn't unused... +import Mod171_B -- even though this imports all the same stuff h :: Int -> Int h = g diff --git a/testsuite/tests/module/mod173.hs b/testsuite/tests/module/mod173.hs index a7e185bcf6..6374557875 100644 --- a/testsuite/tests/module/mod173.hs +++ b/testsuite/tests/module/mod173.hs @@ -2,10 +2,10 @@ module ShouldCompile where import Mod173_Aux -t1 = partition -- From the import +t1 = partition -- From the import nub = True -t2 = nub -- Unambiguous; nub should not have been exported +t2 = nub -- Unambiguous; nub should not have been exported t3 = frob diff --git a/testsuite/tests/perf/should_run/MethSharing.hs b/testsuite/tests/perf/should_run/MethSharing.hs index fb69bd4509..17276a5fed 100644 --- a/testsuite/tests/perf/should_run/MethSharing.hs +++ b/testsuite/tests/perf/should_run/MethSharing.hs @@ -2,7 +2,7 @@ module Main where -- This test works efficiently because the full laziness -- pass now floats out applications --- \x -> f y (x+1) +-- \x -> f y (x+1) -- It'll float out the (f y) if that's a redex loop :: Double -> [Int] -> Double @@ -93,5 +93,5 @@ the application of (^) to the two dictionaries during full laziness (note that (^) has arity 2 so the application is oversaturated). Why doesn't that happen? SetLevels (if this is the right place to look) has this: - --}
\ No newline at end of file + +-} diff --git a/testsuite/tests/perf/should_run/T3245.hs b/testsuite/tests/perf/should_run/T3245.hs index d345fed38b..806df34879 100644 --- a/testsuite/tests/perf/should_run/T3245.hs +++ b/testsuite/tests/perf/should_run/T3245.hs @@ -7,8 +7,8 @@ import Data.Typeable import System.CPUTime size :: Int -size = 40000 -- This was big enough to take 5 seconds in - -- the bad case on my machine. +size = 40000 -- This was big enough to take 5 seconds in + -- the bad case on my machine. data Any = forall a. (Typeable a) => Any a diff --git a/testsuite/tests/rebindable/DoParamM.hs b/testsuite/tests/rebindable/DoParamM.hs index 95ff235cdd..686034fbcb 100644 --- a/testsuite/tests/rebindable/DoParamM.hs +++ b/testsuite/tests/rebindable/DoParamM.hs @@ -13,10 +13,10 @@ module DoParamM where -import Prelude (const, String, ($), (.), Maybe(..), - Int, fromInteger, succ, pred, fromEnum, toEnum, - (+), Char, (==), Bool(..), - IO, getLine, putStrLn, read, show) +import Prelude (const, String, ($), (.), Maybe(..), + Int, fromInteger, succ, pred, fromEnum, toEnum, + (+), Char, (==), Bool(..), + IO, getLine, putStrLn, read, show) import qualified Prelude import qualified Control.Monad.State as State import qualified Control.Monad.Identity as IdM @@ -38,7 +38,7 @@ instance Prelude.Monad m => Monadish (RegularM m) where fail = RegularM . Prelude.fail m >>= f = RegularM ((Prelude.>>=) (unRM m) (unRM . f)) --- As a warm-up, we write the regular State computation, with the same +-- As a warm-up, we write the regular State computation, with the same -- type of state throughout. We thus inject Monad.State into the -- parameterized monad @@ -53,9 +53,9 @@ test1 = State.runState (unRM c) (0::Int) where -- The same in the do-notation test1_do = State.runState (unRM c) (0::Int) where c = do - v <- gget - gput (succ v) - return v + v <- gget + gput (succ v) + return v gget :: (State.MonadState s m) => RegularM m s s s gget = RegularM State.get gput :: (State.MonadState s m) => s -> RegularM m s s () @@ -70,8 +70,8 @@ newtype VST m si so v = VST{runVST:: si -> m (so,v)} instance Prelude.Monad m => Monadish (VST m) where return x = VST (\si -> Prelude.return (si,x)) fail x = VST (\si -> Prelude.fail x) - m >>= f = VST (\si -> (Prelude.>>=) (runVST m si) - (\ (sm,x) -> runVST (f x) sm)) + m >>= f = VST (\si -> (Prelude.>>=) (runVST m si) + (\ (sm,x) -> runVST (f x) sm)) vsget :: Prelude.Monad m => VST m si si si vsget = VST (\si -> Prelude.return (si,si)) @@ -84,9 +84,9 @@ vsm1 () = vsget >>= (\v -> vsput (succ v) >> return v) -- The same with the do-notation vsm1_do () = do - v <- vsget - vsput (succ v) - return v + v <- vsget + vsput (succ v) + return v {- *DoParamM> :t vsm1 @@ -102,7 +102,7 @@ test2_do = IdM.runIdentity (runVST (vsm1_do ()) (0::Int)) -- Now, we vary the type of the state, from Int to a Char -vsm2 () = vsget >>= (\v -> vsput ((toEnum (65+v))::Char) >> +vsm2 () = vsget >>= (\v -> vsput ((toEnum (65+v))::Char) >> vsget >>= \v' -> return (v,v')) {- @@ -113,10 +113,10 @@ vsm2 () = vsget >>= (\v -> vsput ((toEnum (65+v))::Char) >> -- The same with the do-notation -- the following does not yet work vsm2_do () = do - v <- vsget + v <- vsget vsput ((toEnum (65+v))::Char) v' <- vsget - return (v,v') + return (v,v') test3 = IdM.runIdentity (runVST (vsm2 ()) (0::Int)) -- ('A',(0,'A')) @@ -132,7 +132,7 @@ test3_do = IdM.runIdentity (runVST (vsm2_do ()) (0::Int)) In the first argument of `return', namely `(v == v')' In the expression: return (v == v') -vsm3 () = vsget >>= (\v -> vsput ((toEnum (65+v))::Char) >> +vsm3 () = vsget >>= (\v -> vsput ((toEnum (65+v))::Char) >> vsget >>= \v' -> return (v==v')) -} @@ -140,10 +140,10 @@ vsm3 () = vsget >>= (\v -> vsput ((toEnum (65+v))::Char) >> -- The following too must report a type error -- the expression -- return (v == v') must be flagged, rather than something else vsm3_do () = do - v <- vsget + v <- vsget vsput ((toEnum (65+v))::Char) v' <- vsget - return (v==v') + return (v==v') @@ -154,7 +154,7 @@ crec1 :: (Prelude.Enum si, Prelude.Monad m) => VST m si si Int crec1 = vsget >>= (\s1 -> case fromEnum s1 of 0 -> return 0 1 -> vsput (pred s1) >> return 1 - _ -> vsput True >> + _ -> vsput True >> crec1 >>= (\v -> (vsput s1 >> -- restore state type to si return (v + 10)))) @@ -162,12 +162,12 @@ crec1 = vsget >>= (\s1 -> case fromEnum s1 of -- The same in the do-notation crec1_do :: (Prelude.Enum si, Prelude.Monad m) => VST m si si Int crec1_do = do - s1 <- vsget + s1 <- vsget case fromEnum s1 of 0 -> return 0 1 -> do {vsput (pred s1); return 1} _ -> do - vsput True + vsput True v <- crec1_do vsput s1 -- restore state type to si return (v + 10) @@ -208,17 +208,17 @@ runLIO = unLIO -- User code -tlock1 = lget >>= (\l -> - return (read l) >>= (\x -> - lput (show (x+1)))) +tlock1 = lget >>= (\l -> + return (read l) >>= (\x -> + lput (show (x+1)))) tlock1r = runLIO tlock1 -- the same in the do-notation tlock1_do = do - l <- lget - let x = read l - lput (show (x+1)) + l <- lget + let x = read l + lput (show (x+1)) {- *VarStateM> :t tlock1 @@ -228,16 +228,16 @@ tlock1_do = do -} -tlock2 = lget >>= (\l -> - lock >> ( - return (read l) >>= (\x -> - lput (show (x+1))))) +tlock2 = lget >>= (\l -> + lock >> ( + return (read l) >>= (\x -> + lput (show (x+1))))) tlock2_do = do - l <- lget - lock - let x = read l - lput (show (x+1)) + l <- lget + lock + let x = read l + lput (show (x+1)) {- *VarStateM> :t tlock2 @@ -272,7 +272,7 @@ tlock3r_do = runLIO tlock3_do {- gives a type error: Couldn't match expected type `Locked' - against inferred type `Unlocked' + against inferred type `Unlocked' Expected type: LIO Locked r b Inferred type: LIO Unlocked Locked () In the expression: tlock2 @@ -291,7 +291,7 @@ tlock4_do = do {tlock2_do; tlock2_do} {- DoParamM.hs:298:30: Couldn't match expected type `Unlocked' - against inferred type `Locked' + against inferred type `Locked' Expected type: LIO Unlocked r b Inferred type: LIO Locked Unlocked () In the second argument of `(>>)', namely `unlock' diff --git a/testsuite/tests/rebindable/T4851.hs b/testsuite/tests/rebindable/T4851.hs index 38ce45212f..b06604615e 100644 --- a/testsuite/tests/rebindable/T4851.hs +++ b/testsuite/tests/rebindable/T4851.hs @@ -3,7 +3,7 @@ module T4851 where import Prelude hiding ( id, (.) ) -import Control.Category ( Category(..) ) +import Control.Category ( Category(..) ) import Control.Arrow garbage x = diff --git a/testsuite/tests/rebindable/rebindable1.hs b/testsuite/tests/rebindable/rebindable1.hs index 4ff8ed2d4d..8fcc5d2697 100644 --- a/testsuite/tests/rebindable/rebindable1.hs +++ b/testsuite/tests/rebindable/rebindable1.hs @@ -2,55 +2,55 @@ {-# LANGUAGE RebindableSyntax, NPlusKPatterns #-} module RebindableCase1 where - { --- import Prelude; - import Prelude(String,undefined,Maybe(..), (==), (>=) ); + { +-- import Prelude; + import Prelude(String,undefined,Maybe(..), (==), (>=) ); - return :: a; - return = undefined; + return :: a; + return = undefined; - infixl 1 >>=; - (>>=) :: a; - (>>=) = undefined; + infixl 1 >>=; + (>>=) :: a; + (>>=) = undefined; - infixl 1 >>; - (>>) :: a; - (>>) = undefined; + infixl 1 >>; + (>>) :: a; + (>>) = undefined; - fail :: a; - fail = undefined; + fail :: a; + fail = undefined; - fromInteger :: a; - fromInteger = undefined; + fromInteger :: a; + fromInteger = undefined; - fromRational :: a; - fromRational = undefined; + fromRational :: a; + fromRational = undefined; - negate :: a; - negate = undefined; + negate :: a; + negate = undefined; - (-) :: a; - (-) = undefined; + (-) :: a; + (-) = undefined; - test_do f g = do - { - f; - Just a <- g; - return a; - }; + test_do f g = do + { + f; + Just a <- g; + return a; + }; - test_fromInteger = 1; + test_fromInteger = 1; - test_fromRational = 0.5; + test_fromRational = 0.5; - test_negate a = - a; + test_negate a = - a; - test_fromInteger_pattern 1 = undefined; - test_fromInteger_pattern (-1) = undefined; - test_fromInteger_pattern (a + 7) = a; + test_fromInteger_pattern 1 = undefined; + test_fromInteger_pattern (-1) = undefined; + test_fromInteger_pattern (a + 7) = a; - test_fromRational_pattern 0.5 = undefined; - test_fromRational_pattern (-0.5) = undefined; - test_fromRational_pattern _ = undefined; - } + test_fromRational_pattern 0.5 = undefined; + test_fromRational_pattern (-0.5) = undefined; + test_fromRational_pattern _ = undefined; + } diff --git a/testsuite/tests/rebindable/rebindable2.hs b/testsuite/tests/rebindable/rebindable2.hs index 2f69ac8f3f..e1f328954c 100644 --- a/testsuite/tests/rebindable/rebindable2.hs +++ b/testsuite/tests/rebindable/rebindable2.hs @@ -1,22 +1,22 @@ {-# LANGUAGE RebindableSyntax, NPlusKPatterns #-} module Main where - { --- import Prelude; - import qualified Prelude; - import Prelude(String,undefined,Maybe(..),IO,putStrLn, - Integer,(++),Rational, (==), (>=) ); - - import Prelude(Monad(..),Applicative(..),Functor(..)); + { +-- import Prelude; + import qualified Prelude; + import Prelude(String,undefined,Maybe(..),IO,putStrLn, + Integer,(++),Rational, (==), (>=) ); + + import Prelude(Monad(..),Applicative(..),Functor(..)); import Control.Monad(ap, liftM); - debugFunc :: String -> IO a -> IO a; - debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>> - (ioa Prelude.>>= (\a -> - (putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a) - )); + debugFunc :: String -> IO a -> IO a; + debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>> + (ioa Prelude.>>= (\a -> + (putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a) + )); - newtype TM a = MkTM {unTM :: IO a}; + newtype TM a = MkTM {unTM :: IO a}; instance (Functor TM) where { @@ -27,106 +27,106 @@ module Main where pure = return; (<*>) = ap; }; - instance (Monad TM) where - { - return a = MkTM (debugFunc "return" (Prelude.return a)); - - (>>=) ma amb = MkTM (debugFunc ">>=" ((Prelude.>>=) (unTM ma) (\a -> unTM (amb a)))); - - (>>) ma mb = MkTM (debugFunc ">>" ((Prelude.>>) (unTM ma) (unTM mb))); - - fail s = MkTM (debugFunc "fail" (Prelude.return undefined)); - }; - - preturn a = MkTM (Prelude.return a); - - fromInteger :: Integer -> Integer; - fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times - - fromRational :: Rational -> Rational; - fromRational a = a Prelude.+ a Prelude.+ a; -- three times - - negate :: a -> a; - negate a = a; -- don't actually negate - - (-) :: a -> a -> a; - (-) x y = y; -- changed function - - - test_do f g = do - { - f; -- >> - Just a <- g; -- >>= (and fail if g returns Nothing) - return a; -- return - }; - - test_fromInteger = 27; - - test_fromRational = 31.5; - - test_negate a = - a; - - test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a); - test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a); - test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a; - - test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a); - test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a); - test_fromRational_pattern a = "_=" ++ (Prelude.show a); - - tmPutStrLn s = MkTM (putStrLn s); - - doTest :: String -> TM a -> IO (); - doTest s ioa = - (putStrLn ("start test " ++ s)) - Prelude.>> - (unTM ioa) - Prelude.>> - (putStrLn ("end test " ++ s)); - - main :: IO (); - main = - (doTest "test_do failure" - (test_do (preturn ()) (preturn Nothing)) - ) - Prelude.>> - (doTest "test_do success" - (test_do (preturn ()) (preturn (Just ()))) - ) - Prelude.>> - (doTest "test_fromInteger" - (tmPutStrLn (Prelude.show test_fromInteger)) -- 27 * 5 = 135 - ) - Prelude.>> - (doTest "test_fromRational" - (tmPutStrLn (Prelude.show test_fromRational)) -- 31.5 * 3 = 189%2 - ) - Prelude.>> - (doTest "test_negate" - (tmPutStrLn (Prelude.show (test_negate 3))) -- 3 * 5 = 15, non-negate - ) - Prelude.>> - (doTest "test_fromInteger_pattern 1" - (tmPutStrLn (test_fromInteger_pattern 1)) -- 1 * 5 = 5, matches "1" - ) - Prelude.>> - (doTest "test_fromInteger_pattern (-2)" - (tmPutStrLn (test_fromInteger_pattern (-2))) -- "-2" = 2 * 5 = 10 - ) - Prelude.>> - (doTest "test_fromInteger_pattern 9" - (tmPutStrLn (test_fromInteger_pattern 9)) -- "9" = 45, 45 "-" "7" = "7" = 35 - ) - Prelude.>> - (doTest "test_fromRational_pattern 0.5" - (tmPutStrLn (test_fromRational_pattern 0.5)) -- "0.5" = 3%2 - ) - Prelude.>> - (doTest "test_fromRational_pattern (-0.7)" - (tmPutStrLn (test_fromRational_pattern (-0.7))) -- "-0.7" = "0.7" = 21%10 - ) - Prelude.>> - (doTest "test_fromRational_pattern 1.7" - (tmPutStrLn (test_fromRational_pattern 1.7)) -- "1.7" = 51%10 - ); - } + instance (Monad TM) where + { + return a = MkTM (debugFunc "return" (Prelude.return a)); + + (>>=) ma amb = MkTM (debugFunc ">>=" ((Prelude.>>=) (unTM ma) (\a -> unTM (amb a)))); + + (>>) ma mb = MkTM (debugFunc ">>" ((Prelude.>>) (unTM ma) (unTM mb))); + + fail s = MkTM (debugFunc "fail" (Prelude.return undefined)); + }; + + preturn a = MkTM (Prelude.return a); + + fromInteger :: Integer -> Integer; + fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times + + fromRational :: Rational -> Rational; + fromRational a = a Prelude.+ a Prelude.+ a; -- three times + + negate :: a -> a; + negate a = a; -- don't actually negate + + (-) :: a -> a -> a; + (-) x y = y; -- changed function + + + test_do f g = do + { + f; -- >> + Just a <- g; -- >>= (and fail if g returns Nothing) + return a; -- return + }; + + test_fromInteger = 27; + + test_fromRational = 31.5; + + test_negate a = - a; + + test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a); + test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a); + test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a; + + test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a); + test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a); + test_fromRational_pattern a = "_=" ++ (Prelude.show a); + + tmPutStrLn s = MkTM (putStrLn s); + + doTest :: String -> TM a -> IO (); + doTest s ioa = + (putStrLn ("start test " ++ s)) + Prelude.>> + (unTM ioa) + Prelude.>> + (putStrLn ("end test " ++ s)); + + main :: IO (); + main = + (doTest "test_do failure" + (test_do (preturn ()) (preturn Nothing)) + ) + Prelude.>> + (doTest "test_do success" + (test_do (preturn ()) (preturn (Just ()))) + ) + Prelude.>> + (doTest "test_fromInteger" + (tmPutStrLn (Prelude.show test_fromInteger)) -- 27 * 5 = 135 + ) + Prelude.>> + (doTest "test_fromRational" + (tmPutStrLn (Prelude.show test_fromRational)) -- 31.5 * 3 = 189%2 + ) + Prelude.>> + (doTest "test_negate" + (tmPutStrLn (Prelude.show (test_negate 3))) -- 3 * 5 = 15, non-negate + ) + Prelude.>> + (doTest "test_fromInteger_pattern 1" + (tmPutStrLn (test_fromInteger_pattern 1)) -- 1 * 5 = 5, matches "1" + ) + Prelude.>> + (doTest "test_fromInteger_pattern (-2)" + (tmPutStrLn (test_fromInteger_pattern (-2))) -- "-2" = 2 * 5 = 10 + ) + Prelude.>> + (doTest "test_fromInteger_pattern 9" + (tmPutStrLn (test_fromInteger_pattern 9)) -- "9" = 45, 45 "-" "7" = "7" = 35 + ) + Prelude.>> + (doTest "test_fromRational_pattern 0.5" + (tmPutStrLn (test_fromRational_pattern 0.5)) -- "0.5" = 3%2 + ) + Prelude.>> + (doTest "test_fromRational_pattern (-0.7)" + (tmPutStrLn (test_fromRational_pattern (-0.7))) -- "-0.7" = "0.7" = 21%10 + ) + Prelude.>> + (doTest "test_fromRational_pattern 1.7" + (tmPutStrLn (test_fromRational_pattern 1.7)) -- "1.7" = 51%10 + ); + } diff --git a/testsuite/tests/rebindable/rebindable3.hs b/testsuite/tests/rebindable/rebindable3.hs index 682787fced..0434c1d0fd 100644 --- a/testsuite/tests/rebindable/rebindable3.hs +++ b/testsuite/tests/rebindable/rebindable3.hs @@ -1,119 +1,119 @@ {-# LANGUAGE RebindableSyntax, NPlusKPatterns #-} module Main where - { --- import Prelude; - import qualified Prelude; - import Prelude(String,undefined,Maybe(..),IO,putStrLn, - Integer,(++),Rational, (==), (>=) ); - - debugFunc :: String -> IO a -> IO a; - debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>> - (ioa Prelude.>>= (\a -> - (putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a) - )); - - return :: a -> IO a; - return a = debugFunc "return" (Prelude.return a); - - infixl 1 >>=; - (>>=) :: IO a -> (a -> IO b) -> IO b; - (>>=) ma amb = debugFunc ">>=" ((Prelude.>>=) ma amb); - - infixl 1 >>; - (>>) :: IO a -> IO b -> IO b; - (>>) ma mb = debugFunc ">>" ((Prelude.>>) ma mb); - - fail :: String -> IO a; - fail s = debugFunc "fail" (Prelude.return undefined); --- fail s = debugFunc "fail" (Prelude.fail s); - - fromInteger :: Integer -> Integer; - fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times - - fromRational :: Rational -> Rational; - fromRational a = a Prelude.+ a Prelude.+ a; -- three times - - negate :: a -> a; - negate a = a; -- don't actually negate - - (-) :: a -> a -> a; - (-) x y = y; -- changed function - - - test_do f g = do - { - f; -- >> - Just a <- g; -- >>= (and fail if g returns Nothing) - return a; -- return - }; - - test_fromInteger = 27; - - test_fromRational = 31.5; - - test_negate a = - a; - - test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a); - test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a); - test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a; - - test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a); - test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a); - test_fromRational_pattern a = "_=" ++ (Prelude.show a); - - - doTest :: String -> IO a -> IO (); - doTest s ioa = - (putStrLn ("start test " ++ s)) - Prelude.>> - ioa - Prelude.>> - (putStrLn ("end test " ++ s)); - - main :: IO (); - main = - (doTest "test_do failure" - (test_do (Prelude.return ()) (Prelude.return Nothing)) - ) - Prelude.>> - (doTest "test_do success" - (test_do (Prelude.return ()) (Prelude.return (Just ()))) - ) - Prelude.>> - (doTest "test_fromInteger" - (putStrLn (Prelude.show test_fromInteger)) - ) - Prelude.>> - (doTest "test_fromRational" - (putStrLn (Prelude.show test_fromRational)) - ) - Prelude.>> - (doTest "test_negate" - (putStrLn (Prelude.show (test_negate 3))) - ) - Prelude.>> - (doTest "test_fromInteger_pattern 1" - (putStrLn (test_fromInteger_pattern 1)) - ) - Prelude.>> - (doTest "test_fromInteger_pattern (-2)" - (putStrLn (test_fromInteger_pattern (-2))) - ) - Prelude.>> - (doTest "test_fromInteger_pattern 9" - (putStrLn (test_fromInteger_pattern 9)) - ) - Prelude.>> - (doTest "test_fromRational_pattern 0.5" - (putStrLn (test_fromRational_pattern 0.5)) - ) - Prelude.>> - (doTest "test_fromRational_pattern (-0.7)" - (putStrLn (test_fromRational_pattern (-0.7))) - ) - Prelude.>> - (doTest "test_fromRational_pattern 1.7" - (putStrLn (test_fromRational_pattern 1.7)) - ); - } + { +-- import Prelude; + import qualified Prelude; + import Prelude(String,undefined,Maybe(..),IO,putStrLn, + Integer,(++),Rational, (==), (>=) ); + + debugFunc :: String -> IO a -> IO a; + debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>> + (ioa Prelude.>>= (\a -> + (putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a) + )); + + return :: a -> IO a; + return a = debugFunc "return" (Prelude.return a); + + infixl 1 >>=; + (>>=) :: IO a -> (a -> IO b) -> IO b; + (>>=) ma amb = debugFunc ">>=" ((Prelude.>>=) ma amb); + + infixl 1 >>; + (>>) :: IO a -> IO b -> IO b; + (>>) ma mb = debugFunc ">>" ((Prelude.>>) ma mb); + + fail :: String -> IO a; + fail s = debugFunc "fail" (Prelude.return undefined); +-- fail s = debugFunc "fail" (Prelude.fail s); + + fromInteger :: Integer -> Integer; + fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times + + fromRational :: Rational -> Rational; + fromRational a = a Prelude.+ a Prelude.+ a; -- three times + + negate :: a -> a; + negate a = a; -- don't actually negate + + (-) :: a -> a -> a; + (-) x y = y; -- changed function + + + test_do f g = do + { + f; -- >> + Just a <- g; -- >>= (and fail if g returns Nothing) + return a; -- return + }; + + test_fromInteger = 27; + + test_fromRational = 31.5; + + test_negate a = - a; + + test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a); + test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a); + test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a; + + test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a); + test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a); + test_fromRational_pattern a = "_=" ++ (Prelude.show a); + + + doTest :: String -> IO a -> IO (); + doTest s ioa = + (putStrLn ("start test " ++ s)) + Prelude.>> + ioa + Prelude.>> + (putStrLn ("end test " ++ s)); + + main :: IO (); + main = + (doTest "test_do failure" + (test_do (Prelude.return ()) (Prelude.return Nothing)) + ) + Prelude.>> + (doTest "test_do success" + (test_do (Prelude.return ()) (Prelude.return (Just ()))) + ) + Prelude.>> + (doTest "test_fromInteger" + (putStrLn (Prelude.show test_fromInteger)) + ) + Prelude.>> + (doTest "test_fromRational" + (putStrLn (Prelude.show test_fromRational)) + ) + Prelude.>> + (doTest "test_negate" + (putStrLn (Prelude.show (test_negate 3))) + ) + Prelude.>> + (doTest "test_fromInteger_pattern 1" + (putStrLn (test_fromInteger_pattern 1)) + ) + Prelude.>> + (doTest "test_fromInteger_pattern (-2)" + (putStrLn (test_fromInteger_pattern (-2))) + ) + Prelude.>> + (doTest "test_fromInteger_pattern 9" + (putStrLn (test_fromInteger_pattern 9)) + ) + Prelude.>> + (doTest "test_fromRational_pattern 0.5" + (putStrLn (test_fromRational_pattern 0.5)) + ) + Prelude.>> + (doTest "test_fromRational_pattern (-0.7)" + (putStrLn (test_fromRational_pattern (-0.7))) + ) + Prelude.>> + (doTest "test_fromRational_pattern 1.7" + (putStrLn (test_fromRational_pattern 1.7)) + ); + } diff --git a/testsuite/tests/rebindable/rebindable4.hs b/testsuite/tests/rebindable/rebindable4.hs index 2c25c9a03f..f657683a08 100644 --- a/testsuite/tests/rebindable/rebindable4.hs +++ b/testsuite/tests/rebindable/rebindable4.hs @@ -1,127 +1,127 @@ {-# LANGUAGE RebindableSyntax, NPlusKPatterns #-} module Main where - { --- import Prelude; - import qualified Prelude; - import Prelude(String,undefined,Maybe(..),IO,putStrLn, - Integer,(++),Rational, (==), (>=) ); - - debugFunc :: String -> IO a -> IO a; - debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>> - (ioa Prelude.>>= (\a -> - (putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a) - )); - - infixl 1 >>=; - infixl 1 >>; - - class MyMonad m where - { - return :: a -> m a; - (>>=) :: m a -> (a -> m b) -> m b; - (>>) :: m a -> m b -> m b; - fail :: String -> m a; - }; - - instance MyMonad IO where - { - return a = debugFunc "return" (Prelude.return a); - - (>>=) ma amb = debugFunc ">>=" ((Prelude.>>=) ma amb); - - (>>) ma mb = debugFunc ">>" ((Prelude.>>) ma mb); - - fail s = debugFunc "fail" (Prelude.return undefined); - -- fail s = debugFunc "fail" (Prelude.fail s); - }; - - fromInteger :: Integer -> Integer; - fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times - - fromRational :: Rational -> Rational; - fromRational a = a Prelude.+ a Prelude.+ a; -- three times - - negate :: a -> a; - negate a = a; -- don't actually negate - - (-) :: a -> a -> a; - (-) x y = y; -- changed function - - - test_do f g = do - { - f; -- >> - Just a <- g; -- >>= (and fail if g returns Nothing) - return a; -- return - }; - - test_fromInteger = 27; - - test_fromRational = 31.5; - - test_negate a = - a; - - test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a); - test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a); - test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a; - - test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a); - test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a); - test_fromRational_pattern a = "_=" ++ (Prelude.show a); - - - doTest :: String -> IO a -> IO (); - doTest s ioa = - (putStrLn ("start test " ++ s)) - Prelude.>> - ioa - Prelude.>> - (putStrLn ("end test " ++ s)); - - main :: IO (); - main = - (doTest "test_do failure" - (test_do (Prelude.return ()) (Prelude.return Nothing)) - ) - Prelude.>> - (doTest "test_do success" - (test_do (Prelude.return ()) (Prelude.return (Just ()))) - ) - Prelude.>> - (doTest "test_fromInteger" - (putStrLn (Prelude.show test_fromInteger)) - ) - Prelude.>> - (doTest "test_fromRational" - (putStrLn (Prelude.show test_fromRational)) - ) - Prelude.>> - (doTest "test_negate" - (putStrLn (Prelude.show (test_negate 3))) - ) - Prelude.>> - (doTest "test_fromInteger_pattern 1" - (putStrLn (test_fromInteger_pattern 1)) - ) - Prelude.>> - (doTest "test_fromInteger_pattern (-2)" - (putStrLn (test_fromInteger_pattern (-2))) - ) - Prelude.>> - (doTest "test_fromInteger_pattern 9" - (putStrLn (test_fromInteger_pattern 9)) - ) - Prelude.>> - (doTest "test_fromRational_pattern 0.5" - (putStrLn (test_fromRational_pattern 0.5)) - ) - Prelude.>> - (doTest "test_fromRational_pattern (-0.7)" - (putStrLn (test_fromRational_pattern (-0.7))) - ) - Prelude.>> - (doTest "test_fromRational_pattern 1.7" - (putStrLn (test_fromRational_pattern 1.7)) - ); - } + { +-- import Prelude; + import qualified Prelude; + import Prelude(String,undefined,Maybe(..),IO,putStrLn, + Integer,(++),Rational, (==), (>=) ); + + debugFunc :: String -> IO a -> IO a; + debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>> + (ioa Prelude.>>= (\a -> + (putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a) + )); + + infixl 1 >>=; + infixl 1 >>; + + class MyMonad m where + { + return :: a -> m a; + (>>=) :: m a -> (a -> m b) -> m b; + (>>) :: m a -> m b -> m b; + fail :: String -> m a; + }; + + instance MyMonad IO where + { + return a = debugFunc "return" (Prelude.return a); + + (>>=) ma amb = debugFunc ">>=" ((Prelude.>>=) ma amb); + + (>>) ma mb = debugFunc ">>" ((Prelude.>>) ma mb); + + fail s = debugFunc "fail" (Prelude.return undefined); + -- fail s = debugFunc "fail" (Prelude.fail s); + }; + + fromInteger :: Integer -> Integer; + fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times + + fromRational :: Rational -> Rational; + fromRational a = a Prelude.+ a Prelude.+ a; -- three times + + negate :: a -> a; + negate a = a; -- don't actually negate + + (-) :: a -> a -> a; + (-) x y = y; -- changed function + + + test_do f g = do + { + f; -- >> + Just a <- g; -- >>= (and fail if g returns Nothing) + return a; -- return + }; + + test_fromInteger = 27; + + test_fromRational = 31.5; + + test_negate a = - a; + + test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a); + test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a); + test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a; + + test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a); + test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a); + test_fromRational_pattern a = "_=" ++ (Prelude.show a); + + + doTest :: String -> IO a -> IO (); + doTest s ioa = + (putStrLn ("start test " ++ s)) + Prelude.>> + ioa + Prelude.>> + (putStrLn ("end test " ++ s)); + + main :: IO (); + main = + (doTest "test_do failure" + (test_do (Prelude.return ()) (Prelude.return Nothing)) + ) + Prelude.>> + (doTest "test_do success" + (test_do (Prelude.return ()) (Prelude.return (Just ()))) + ) + Prelude.>> + (doTest "test_fromInteger" + (putStrLn (Prelude.show test_fromInteger)) + ) + Prelude.>> + (doTest "test_fromRational" + (putStrLn (Prelude.show test_fromRational)) + ) + Prelude.>> + (doTest "test_negate" + (putStrLn (Prelude.show (test_negate 3))) + ) + Prelude.>> + (doTest "test_fromInteger_pattern 1" + (putStrLn (test_fromInteger_pattern 1)) + ) + Prelude.>> + (doTest "test_fromInteger_pattern (-2)" + (putStrLn (test_fromInteger_pattern (-2))) + ) + Prelude.>> + (doTest "test_fromInteger_pattern 9" + (putStrLn (test_fromInteger_pattern 9)) + ) + Prelude.>> + (doTest "test_fromRational_pattern 0.5" + (putStrLn (test_fromRational_pattern 0.5)) + ) + Prelude.>> + (doTest "test_fromRational_pattern (-0.7)" + (putStrLn (test_fromRational_pattern (-0.7))) + ) + Prelude.>> + (doTest "test_fromRational_pattern 1.7" + (putStrLn (test_fromRational_pattern 1.7)) + ); + } diff --git a/testsuite/tests/rebindable/rebindable5.hs b/testsuite/tests/rebindable/rebindable5.hs index 94b3f4ef7a..3120ea1a90 100644 --- a/testsuite/tests/rebindable/rebindable5.hs +++ b/testsuite/tests/rebindable/rebindable5.hs @@ -2,195 +2,195 @@ MultiParamTypeClasses, FunctionalDependencies #-} module Main where - { --- import Prelude; - import qualified Prelude; - import Prelude(String,undefined,Maybe(..),IO,putStrLn, - Integer,(++),Rational, (==), (>=) ); - - debugFunc :: String -> IO a -> IO a; - debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>> - (ioa Prelude.>>= (\a -> - (putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a) - )); - - infixl 1 >>=; - infixl 1 >>; - - returnIO :: a -> IO a; + { +-- import Prelude; + import qualified Prelude; + import Prelude(String,undefined,Maybe(..),IO,putStrLn, + Integer,(++),Rational, (==), (>=) ); + + debugFunc :: String -> IO a -> IO a; + debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>> + (ioa Prelude.>>= (\a -> + (putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a) + )); + + infixl 1 >>=; + infixl 1 >>; + + returnIO :: a -> IO a; returnIO = Prelude.return; - - class HasReturn m where - { - return :: a -> m a; - }; - - class HasBind m n mn | m n -> mn, m mn -> n where - { - (>>=) :: m a -> (a -> n b) -> mn b; - }; - - class HasSeq m n mn | m n -> mn, m mn -> n where - { - (>>) :: m a -> n b -> mn b; - }; - - class HasFail m where - { - fail :: String -> m a; - }; - - instance HasReturn IO where - { - return a = debugFunc "return" (returnIO a); - }; - - instance HasBind IO IO IO where - { - (>>=) ma amb = debugFunc ">>=" ((Prelude.>>=) ma amb); - }; - - instance HasSeq IO IO IO where - { - (>>) ma mb = debugFunc ">>" ((Prelude.>>) ma mb); - }; - - instance HasFail IO where - { - fail s = debugFunc "fail" (returnIO undefined); - -- fail s = debugFunc "fail" (Prelude.fail s); - }; - - class HasFromInteger a where - { - fromInteger :: a -> a; - }; - - instance HasFromInteger Integer where - { - fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times - }; - - class HasFromRational a where - { - fromRational :: a -> a; - }; - - instance HasFromRational Rational where - { - fromRational a = a Prelude.+ a Prelude.+ a; -- three times - }; - - class HasNegate a where - { - negate :: a -> a; - }; - - instance HasNegate Integer where - { - negate a = a; -- don't actually negate - }; - - instance HasNegate Rational where - { - negate a = a; -- don't actually negate - }; - - class HasMinus a where - { - (-) :: a -> a -> a; - }; - - instance HasMinus Rational where - { - (-) x y = y; -- changed function - }; - - instance HasMinus Integer where - { - (-) x y = y; -- changed function - }; - - - test_do f g = do - { - f; -- >> - Just a <- g; -- >>= (and fail if g returns Nothing) - return a; -- return - }; - - test_fromInteger :: Integer; - test_fromInteger = 27; - - test_fromRational :: Rational; - test_fromRational = 31.5; - - test_negate :: Integer -> Integer; - test_negate a = - a; - - test_fromInteger_pattern :: Integer -> String; - test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a); - test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a); - test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a; - - test_fromRational_pattern :: Rational -> String; - test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a); - test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a); - test_fromRational_pattern a = "_=" ++ (Prelude.show a); - - - doTest :: String -> IO a -> IO (); - doTest s ioa = - (putStrLn ("start test " ++ s)) - Prelude.>> - ioa - Prelude.>> - (putStrLn ("end test " ++ s)); - - main :: IO (); - main = - (doTest "test_do failure" - (test_do (returnIO ()) (returnIO Nothing)) - ) - Prelude.>> - (doTest "test_do success" - (test_do (returnIO ()) (returnIO (Just ()))) - ) - Prelude.>> - (doTest "test_fromInteger" - (putStrLn (Prelude.show test_fromInteger)) - ) - Prelude.>> - (doTest "test_fromRational" - (putStrLn (Prelude.show test_fromRational)) - ) - Prelude.>> - (doTest "test_negate" - (putStrLn (Prelude.show (test_negate 3))) - ) - Prelude.>> - (doTest "test_fromInteger_pattern 1" - (putStrLn (test_fromInteger_pattern 1)) - ) - Prelude.>> - (doTest "test_fromInteger_pattern (-2)" - (putStrLn (test_fromInteger_pattern (-(2::Integer)::Integer))) - ) - Prelude.>> - (doTest "test_fromInteger_pattern 9" - (putStrLn (test_fromInteger_pattern 9)) - ) - Prelude.>> - (doTest "test_fromRational_pattern 0.5" - (putStrLn (test_fromRational_pattern 0.5)) - ) - Prelude.>> - (doTest "test_fromRational_pattern (-0.7)" - (putStrLn (test_fromRational_pattern (-(0.7::Rational)::Rational))) - ) - Prelude.>> - (doTest "test_fromRational_pattern 1.7" - (putStrLn (test_fromRational_pattern 1.7)) - ) - ; - } + + class HasReturn m where + { + return :: a -> m a; + }; + + class HasBind m n mn | m n -> mn, m mn -> n where + { + (>>=) :: m a -> (a -> n b) -> mn b; + }; + + class HasSeq m n mn | m n -> mn, m mn -> n where + { + (>>) :: m a -> n b -> mn b; + }; + + class HasFail m where + { + fail :: String -> m a; + }; + + instance HasReturn IO where + { + return a = debugFunc "return" (returnIO a); + }; + + instance HasBind IO IO IO where + { + (>>=) ma amb = debugFunc ">>=" ((Prelude.>>=) ma amb); + }; + + instance HasSeq IO IO IO where + { + (>>) ma mb = debugFunc ">>" ((Prelude.>>) ma mb); + }; + + instance HasFail IO where + { + fail s = debugFunc "fail" (returnIO undefined); + -- fail s = debugFunc "fail" (Prelude.fail s); + }; + + class HasFromInteger a where + { + fromInteger :: a -> a; + }; + + instance HasFromInteger Integer where + { + fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times + }; + + class HasFromRational a where + { + fromRational :: a -> a; + }; + + instance HasFromRational Rational where + { + fromRational a = a Prelude.+ a Prelude.+ a; -- three times + }; + + class HasNegate a where + { + negate :: a -> a; + }; + + instance HasNegate Integer where + { + negate a = a; -- don't actually negate + }; + + instance HasNegate Rational where + { + negate a = a; -- don't actually negate + }; + + class HasMinus a where + { + (-) :: a -> a -> a; + }; + + instance HasMinus Rational where + { + (-) x y = y; -- changed function + }; + + instance HasMinus Integer where + { + (-) x y = y; -- changed function + }; + + + test_do f g = do + { + f; -- >> + Just a <- g; -- >>= (and fail if g returns Nothing) + return a; -- return + }; + + test_fromInteger :: Integer; + test_fromInteger = 27; + + test_fromRational :: Rational; + test_fromRational = 31.5; + + test_negate :: Integer -> Integer; + test_negate a = - a; + + test_fromInteger_pattern :: Integer -> String; + test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a); + test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a); + test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a; + + test_fromRational_pattern :: Rational -> String; + test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a); + test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a); + test_fromRational_pattern a = "_=" ++ (Prelude.show a); + + + doTest :: String -> IO a -> IO (); + doTest s ioa = + (putStrLn ("start test " ++ s)) + Prelude.>> + ioa + Prelude.>> + (putStrLn ("end test " ++ s)); + + main :: IO (); + main = + (doTest "test_do failure" + (test_do (returnIO ()) (returnIO Nothing)) + ) + Prelude.>> + (doTest "test_do success" + (test_do (returnIO ()) (returnIO (Just ()))) + ) + Prelude.>> + (doTest "test_fromInteger" + (putStrLn (Prelude.show test_fromInteger)) + ) + Prelude.>> + (doTest "test_fromRational" + (putStrLn (Prelude.show test_fromRational)) + ) + Prelude.>> + (doTest "test_negate" + (putStrLn (Prelude.show (test_negate 3))) + ) + Prelude.>> + (doTest "test_fromInteger_pattern 1" + (putStrLn (test_fromInteger_pattern 1)) + ) + Prelude.>> + (doTest "test_fromInteger_pattern (-2)" + (putStrLn (test_fromInteger_pattern (-(2::Integer)::Integer))) + ) + Prelude.>> + (doTest "test_fromInteger_pattern 9" + (putStrLn (test_fromInteger_pattern 9)) + ) + Prelude.>> + (doTest "test_fromRational_pattern 0.5" + (putStrLn (test_fromRational_pattern 0.5)) + ) + Prelude.>> + (doTest "test_fromRational_pattern (-0.7)" + (putStrLn (test_fromRational_pattern (-(0.7::Rational)::Rational))) + ) + Prelude.>> + (doTest "test_fromRational_pattern 1.7" + (putStrLn (test_fromRational_pattern 1.7)) + ) + ; + } diff --git a/testsuite/tests/rebindable/rebindable6.hs b/testsuite/tests/rebindable/rebindable6.hs index 3ec03477d2..6ed8249400 100644 --- a/testsuite/tests/rebindable/rebindable6.hs +++ b/testsuite/tests/rebindable/rebindable6.hs @@ -6,183 +6,183 @@ {-# LANGUAGE TypeFamilies #-} module Main where - { - import qualified Prelude; - import Prelude(String,undefined,Maybe(..),IO,putStrLn, - Integer,(++),Rational, (==), (>=) ); + { + import qualified Prelude; + import Prelude(String,undefined,Maybe(..),IO,putStrLn, + Integer,(++),Rational, (==), (>=) ); - debugFunc :: String -> IO a -> IO a; - debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>> - (ioa Prelude.>>= (\a -> - (putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a) - )); + debugFunc :: String -> IO a -> IO a; + debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>> + (ioa Prelude.>>= (\a -> + (putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a) + )); - infixl 1 >>=; - infixl 1 >>; + infixl 1 >>=; + infixl 1 >>; - returnIO :: a -> IO a; + returnIO :: a -> IO a; returnIO = Prelude.return; - class HasReturn a where - { - return :: a; - }; - - class HasBind a where - { - (>>=) :: a; - }; - - class HasSeq a where - { - (>>) :: a; - }; - - class HasFail a where - { - fail :: a; - }; - - instance HasReturn (a -> IO a) where - { - return a = debugFunc "return" (Prelude.return a); - }; - - instance HasBind (IO a -> (a -> IO b) -> IO b) where - { - (>>=) ma amb = debugFunc ">>=" ((Prelude.>>=) ma amb); - }; - - instance HasSeq (IO a -> IO b -> IO b) where - { - (>>) ma mb = debugFunc ">>" ((Prelude.>>) ma mb); - }; - - instance HasFail (String -> IO a) where - { - fail s = debugFunc "fail" (Prelude.return undefined); - -- fail s = debugFunc "fail" (Prelude.fail s); - }; - - class HasFromInteger a where - { - fromInteger :: a; - }; - - instance HasFromInteger (Integer -> Integer) where - { - fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times - }; - - class HasFromRational a where - { - fromRational :: a; - }; - - instance HasFromRational (Rational -> Rational) where - { - fromRational a = a Prelude.+ a Prelude.+ a; -- three times - }; - - class HasNegate a where - { - negate :: a; - }; - - instance (b ~ (a -> a)) => HasNegate b where - { - negate a = a; -- don't actually negate - }; - - class HasMinus a where - { - (-) :: a; - }; - - instance (b ~ (a -> a -> a)) => HasMinus b where - { - (-) x y = y; -- changed function - }; - - test_do :: forall a b. IO a -> IO (Maybe b) -> IO b; - test_do f g = do - { - f; -- >> - Just (b::b) <- g; -- >>= (and fail if g returns Nothing) - return b; -- return - }; - - test_fromInteger :: Integer; - test_fromInteger = 27; - - test_fromRational :: Rational; - test_fromRational = 31.5; - - test_negate :: Integer -> Integer; - test_negate a = - a; - - test_fromInteger_pattern :: Integer -> String; - test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a); - test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a); - test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a; - - test_fromRational_pattern :: Rational -> String; - test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a); - test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a); - test_fromRational_pattern a = "_=" ++ (Prelude.show a); - - - doTest :: String -> IO a -> IO (); - doTest s ioa = - (putStrLn ("start test " ++ s)) - Prelude.>> - ioa - Prelude.>> - (putStrLn ("end test " ++ s)); - - main :: IO (); - main = - (doTest "test_do failure" - (test_do (Prelude.return ()) (Prelude.return Nothing)) - ) - Prelude.>> - (doTest "test_do success" - (test_do (Prelude.return ()) (Prelude.return (Just ()))) - ) - Prelude.>> - (doTest "test_fromInteger" - (putStrLn (Prelude.show test_fromInteger)) - ) - Prelude.>> - (doTest "test_fromRational" - (putStrLn (Prelude.show test_fromRational)) - ) - Prelude.>> - (doTest "test_negate" - (putStrLn (Prelude.show (test_negate 3))) - ) - Prelude.>> - (doTest "test_fromInteger_pattern 1" - (putStrLn (test_fromInteger_pattern 1)) - ) - Prelude.>> - (doTest "test_fromInteger_pattern (-2)" - (putStrLn (test_fromInteger_pattern (-(2::Integer)::Integer))) - ) - Prelude.>> - (doTest "test_fromInteger_pattern 9" - (putStrLn (test_fromInteger_pattern 9)) - ) - Prelude.>> - (doTest "test_fromRational_pattern 0.5" - (putStrLn (test_fromRational_pattern 0.5)) - ) - Prelude.>> - (doTest "test_fromRational_pattern (-0.7)" - (putStrLn (test_fromRational_pattern (-(0.7::Rational)::Rational))) - ) - Prelude.>> - (doTest "test_fromRational_pattern 1.7" - (putStrLn (test_fromRational_pattern 1.7)) - ); - } + class HasReturn a where + { + return :: a; + }; + + class HasBind a where + { + (>>=) :: a; + }; + + class HasSeq a where + { + (>>) :: a; + }; + + class HasFail a where + { + fail :: a; + }; + + instance HasReturn (a -> IO a) where + { + return a = debugFunc "return" (Prelude.return a); + }; + + instance HasBind (IO a -> (a -> IO b) -> IO b) where + { + (>>=) ma amb = debugFunc ">>=" ((Prelude.>>=) ma amb); + }; + + instance HasSeq (IO a -> IO b -> IO b) where + { + (>>) ma mb = debugFunc ">>" ((Prelude.>>) ma mb); + }; + + instance HasFail (String -> IO a) where + { + fail s = debugFunc "fail" (Prelude.return undefined); + -- fail s = debugFunc "fail" (Prelude.fail s); + }; + + class HasFromInteger a where + { + fromInteger :: a; + }; + + instance HasFromInteger (Integer -> Integer) where + { + fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times + }; + + class HasFromRational a where + { + fromRational :: a; + }; + + instance HasFromRational (Rational -> Rational) where + { + fromRational a = a Prelude.+ a Prelude.+ a; -- three times + }; + + class HasNegate a where + { + negate :: a; + }; + + instance (b ~ (a -> a)) => HasNegate b where + { + negate a = a; -- don't actually negate + }; + + class HasMinus a where + { + (-) :: a; + }; + + instance (b ~ (a -> a -> a)) => HasMinus b where + { + (-) x y = y; -- changed function + }; + + test_do :: forall a b. IO a -> IO (Maybe b) -> IO b; + test_do f g = do + { + f; -- >> + Just (b::b) <- g; -- >>= (and fail if g returns Nothing) + return b; -- return + }; + + test_fromInteger :: Integer; + test_fromInteger = 27; + + test_fromRational :: Rational; + test_fromRational = 31.5; + + test_negate :: Integer -> Integer; + test_negate a = - a; + + test_fromInteger_pattern :: Integer -> String; + test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a); + test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a); + test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a; + + test_fromRational_pattern :: Rational -> String; + test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a); + test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a); + test_fromRational_pattern a = "_=" ++ (Prelude.show a); + + + doTest :: String -> IO a -> IO (); + doTest s ioa = + (putStrLn ("start test " ++ s)) + Prelude.>> + ioa + Prelude.>> + (putStrLn ("end test " ++ s)); + + main :: IO (); + main = + (doTest "test_do failure" + (test_do (Prelude.return ()) (Prelude.return Nothing)) + ) + Prelude.>> + (doTest "test_do success" + (test_do (Prelude.return ()) (Prelude.return (Just ()))) + ) + Prelude.>> + (doTest "test_fromInteger" + (putStrLn (Prelude.show test_fromInteger)) + ) + Prelude.>> + (doTest "test_fromRational" + (putStrLn (Prelude.show test_fromRational)) + ) + Prelude.>> + (doTest "test_negate" + (putStrLn (Prelude.show (test_negate 3))) + ) + Prelude.>> + (doTest "test_fromInteger_pattern 1" + (putStrLn (test_fromInteger_pattern 1)) + ) + Prelude.>> + (doTest "test_fromInteger_pattern (-2)" + (putStrLn (test_fromInteger_pattern (-(2::Integer)::Integer))) + ) + Prelude.>> + (doTest "test_fromInteger_pattern 9" + (putStrLn (test_fromInteger_pattern 9)) + ) + Prelude.>> + (doTest "test_fromRational_pattern 0.5" + (putStrLn (test_fromRational_pattern 0.5)) + ) + Prelude.>> + (doTest "test_fromRational_pattern (-0.7)" + (putStrLn (test_fromRational_pattern (-(0.7::Rational)::Rational))) + ) + Prelude.>> + (doTest "test_fromRational_pattern 1.7" + (putStrLn (test_fromRational_pattern 1.7)) + ); + } diff --git a/testsuite/tests/rename/prog001/rn037.hs b/testsuite/tests/rename/prog001/rn037.hs index 544de2fdd9..23a4cfa4b9 100644 --- a/testsuite/tests/rename/prog001/rn037.hs +++ b/testsuite/tests/rename/prog001/rn037.hs @@ -2,8 +2,8 @@ module ShouldCompile where import Rn037Help hiding( C ) - -- C is the constructor, but we should - -- still be able to hide it + -- C is the constructor, but we should + -- still be able to hide it -- we should still be able to refer to the type constructor, though type Foo = T diff --git a/testsuite/tests/rename/prog002/rnfail037.hs b/testsuite/tests/rename/prog002/rnfail037.hs index 0a2935c5ad..6eaa1da34b 100644 --- a/testsuite/tests/rename/prog002/rnfail037.hs +++ b/testsuite/tests/rename/prog002/rnfail037.hs @@ -2,7 +2,7 @@ module ShouldCompile where import Rn037Help hiding( C ) - -- C is the constructor, but we should - -- still be able to hide it + -- C is the constructor, but we should + -- still be able to hide it f x = Rn037Help.C diff --git a/testsuite/tests/rename/prog005/View.hs b/testsuite/tests/rename/prog005/View.hs index c14d301c3d..4bb2f66b2d 100644 --- a/testsuite/tests/rename/prog005/View.hs +++ b/testsuite/tests/rename/prog005/View.hs @@ -11,8 +11,8 @@ Compiling VersionGraphClient ( ./VersionGraphClient.hs, ./VersionGraphClient.o ) View.hs:14: Couldn't match `VersionGraphClient' against `VersionGraphClient' - Expected type: VersionGraphClient - Inferred type: VersionGraphClient + Expected type: VersionGraphClient + Inferred type: VersionGraphClient In the `graphClient1' field of a record In the record construction: View {graphClient1 = graphClient} @@ -23,9 +23,9 @@ However ghc without make has no problems. # ghc -c View.hs -} --- | This module defines the fundamental structure of the (untyped) --- objects in a repository. --- +-- | This module defines the fundamental structure of the (untyped) +-- objects in a repository. +-- -- We depend circularly on CodedValue.hs. This module is compiled -- first and uses CodedValue.hi-boot. module View( diff --git a/testsuite/tests/rename/should_compile/RnAux017.hs b/testsuite/tests/rename/should_compile/RnAux017.hs index 5514524fee..5eb076ddd1 100644 --- a/testsuite/tests/rename/should_compile/RnAux017.hs +++ b/testsuite/tests/rename/should_compile/RnAux017.hs @@ -1,6 +1,6 @@ module RnAux017 where -import Test -- Import main module so there really is a loop - -- (avoid warning message) +import Test -- Import main module so there really is a loop + -- (avoid warning message) data Wibble = Wibble data Wobble = Wobble diff --git a/testsuite/tests/rename/should_compile/T3221.hs b/testsuite/tests/rename/should_compile/T3221.hs index 5550fd3fa7..970abfb403 100644 --- a/testsuite/tests/rename/should_compile/T3221.hs +++ b/testsuite/tests/rename/should_compile/T3221.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -Werror -fwarn-unused-binds #-} -- Test Trac #3221: the constructors are used by the deriving --- clause, even though they are not exported +-- clause, even though they are not exported module T3221( Foo ) where diff --git a/testsuite/tests/rename/should_compile/rn029.hs b/testsuite/tests/rename/should_compile/rn029.hs index 76dd993dc9..20439d2ab6 100644 --- a/testsuite/tests/rename/should_compile/rn029.hs +++ b/testsuite/tests/rename/should_compile/rn029.hs @@ -3,12 +3,12 @@ module ShouldCompile where import Data.List ( reverse, sort ) -sort :: Int -- Clashes with Data.List.sort, -sort = 4 -- but never used, so OK - +sort :: Int -- Clashes with Data.List.sort, +sort = 4 -- but never used, so OK -reverse :: Int -- Clashes with Data.List.reverse, -reverse = 3 -- but the only uses are qualified + +reverse :: Int -- Clashes with Data.List.reverse, +reverse = 3 -- but the only uses are qualified x = ShouldCompile.reverse diff --git a/testsuite/tests/rename/should_compile/rn041.hs b/testsuite/tests/rename/should_compile/rn041.hs index 454227c14d..1606e537ce 100644 --- a/testsuite/tests/rename/should_compile/rn041.hs +++ b/testsuite/tests/rename/should_compile/rn041.hs @@ -4,10 +4,10 @@ module ShouldCompile( t ) where -f x = f x -- Unused +f x = f x -- Unused -g x = h x -- Unused +g x = h x -- Unused h x = g x -t x = t x -- Used by export list +t x = t x -- Used by export list diff --git a/testsuite/tests/rename/should_compile/rn043.hs b/testsuite/tests/rename/should_compile/rn043.hs index e88e8426df..e1b01135f9 100644 --- a/testsuite/tests/rename/should_compile/rn043.hs +++ b/testsuite/tests/rename/should_compile/rn043.hs @@ -2,5 +2,5 @@ module ShouldCompile (module M) where - import Rn043_A as M -- x, M.x - import Rn043_B -- x, Rn043_A.x + import Rn043_A as M -- x, M.x + import Rn043_B -- x, Rn043_A.x diff --git a/testsuite/tests/rename/should_compile/rn049.hs b/testsuite/tests/rename/should_compile/rn049.hs index 83f6c5c276..82c78b7742 100644 --- a/testsuite/tests/rename/should_compile/rn049.hs +++ b/testsuite/tests/rename/should_compile/rn049.hs @@ -1,7 +1,7 @@ -- GHC 6.4.1 said -- test.hs:1:5: --- Warning: accepting non-standard pattern guards --- (-fglasgow-exts to suppress this message) +-- Warning: accepting non-standard pattern guards +-- (-fglasgow-exts to suppress this message) -- [x <- ((1 * 2) + 3) * 4, undefined] -- Note the wrongly-parenthesised expression @@ -10,4 +10,3 @@ module ShouldCompile where main | x <- 1*2+3*4 = x -
\ No newline at end of file diff --git a/testsuite/tests/rename/should_compile/timing001.hs b/testsuite/tests/rename/should_compile/timing001.hs index b84b341f19..af4d9cc147 100644 --- a/testsuite/tests/rename/should_compile/timing001.hs +++ b/testsuite/tests/rename/should_compile/timing001.hs @@ -504,4 +504,4 @@ a495 = a496 a496 = a497 a497 = a498 a498 = a499 -a499 = [] -- !!! ta-dah!!! +a499 = [] -- !!! ta-dah!!! diff --git a/testsuite/tests/rename/should_fail/rnfail002.hs b/testsuite/tests/rename/should_fail/rnfail002.hs index ab387223fc..bb65762d45 100644 --- a/testsuite/tests/rename/should_fail/rnfail002.hs +++ b/testsuite/tests/rename/should_fail/rnfail002.hs @@ -1,5 +1,5 @@ -- !!! rn001: super-simple set of bindings, --- !!! incl wildcard pattern-bindings and *duplicates* +-- !!! incl wildcard pattern-bindings and *duplicates* x = [] y = [] diff --git a/testsuite/tests/rename/should_fail/rnfail004.hs b/testsuite/tests/rename/should_fail/rnfail004.hs index 90a97f894c..f8f01ee6ff 100644 --- a/testsuite/tests/rename/should_fail/rnfail004.hs +++ b/testsuite/tests/rename/should_fail/rnfail004.hs @@ -3,6 +3,6 @@ module Foo where f x = x where - a = [] - (b,c,a) = ([],[],d) - [d,b,_] = ([],a,[]) + a = [] + (b,c,a) = ([],[],d) + [d,b,_] = ([],a,[]) diff --git a/testsuite/tests/rename/should_fail/rnfail008.hs b/testsuite/tests/rename/should_fail/rnfail008.hs index 196214a840..f63fab5cdf 100644 --- a/testsuite/tests/rename/should_fail/rnfail008.hs +++ b/testsuite/tests/rename/should_fail/rnfail008.hs @@ -3,17 +3,17 @@ module Test where class K a where - op1 :: a -> a -> a - op2 :: Int -> a + op1 :: a -> a -> a + op2 :: Int -> a instance K Int where - op1 a b = a+b - op2 x = x + op1 a b = a+b + op2 x = x instance K Bool where - op1 a b = a - -- Pick up the default decl for op2 - + op1 a b = a + -- Pick up the default decl for op2 + instance K [a] where - op3 a = a -- Oops! Isn't a class op of K - + op3 a = a -- Oops! Isn't a class op of K + diff --git a/testsuite/tests/rename/should_fail/rnfail015.hs b/testsuite/tests/rename/should_fail/rnfail015.hs index 20f9934f4b..1f20a7efb2 100644 --- a/testsuite/tests/rename/should_fail/rnfail015.hs +++ b/testsuite/tests/rename/should_fail/rnfail015.hs @@ -11,7 +11,7 @@ data Token | TokIs | TokDeref | TokFind - | TokLiteral -- Duplicated! + | TokLiteral -- Duplicated! | TokThe deriving Show diff --git a/testsuite/tests/rename/should_fail/rnfail017.hs b/testsuite/tests/rename/should_fail/rnfail017.hs index 327a9d6abd..9090e23e3f 100644 --- a/testsuite/tests/rename/should_fail/rnfail017.hs +++ b/testsuite/tests/rename/should_fail/rnfail017.hs @@ -2,16 +2,16 @@ module ShouldFail where -- !!! Precedence of unary negation -f1 x y = x + -y -- Fails -f2 x y = x * -y -- Fails +f1 x y = x + -y -- Fails +f2 x y = x * -y -- Fails -f3 x y = -x + y -- OK: means (-x) + y - -- since - is left associative +f3 x y = -x + y -- OK: means (-x) + y + -- since - is left associative -f4 x y = - x*y -- OK: means -(x*y) - -- since - binds less tightly than * +f4 x y = - x*y -- OK: means -(x*y) + -- since - binds less tightly than * -f5 x y = x >= -y -- OK means x >= (-y) +f5 x y = x >= -y -- OK means x >= (-y) diff --git a/testsuite/tests/rename/should_fail/rnfail020.hs b/testsuite/tests/rename/should_fail/rnfail020.hs index c6efc4d5f7..c76f8924ef 100644 --- a/testsuite/tests/rename/should_fail/rnfail020.hs +++ b/testsuite/tests/rename/should_fail/rnfail020.hs @@ -17,6 +17,6 @@ unionSetB (s1 :: Set a) s2 = unionSets s1 s2 {- In GHC 4.04 this gave the terrible message: None of the type variable(s) in the constraint `Eq a' - appears in the type `Set a -> Set a -> Set a' + appears in the type `Set a -> Set a -> Set a' In the type signature for `unionSets' -} diff --git a/testsuite/tests/rename/should_fail/rnfail023.hs b/testsuite/tests/rename/should_fail/rnfail023.hs index bf7c4a2f20..07f804b731 100644 --- a/testsuite/tests/rename/should_fail/rnfail023.hs +++ b/testsuite/tests/rename/should_fail/rnfail023.hs @@ -1,4 +1,4 @@ --- !!! Check that type signatures and pragmas that +-- !!! Check that type signatures and pragmas that -- !!! don't have a "parent" are correctly reported module ShouldFail where @@ -8,8 +8,8 @@ f :: Int -> Int {-# INLINE f #-} -- Nested test -h :: Int -> Int -- This one is ok +h :: Int -> Int -- This one is ok h x = x where - g :: Int -> Int -- Bogus + g :: Int -> Int -- Bogus diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang11_B.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang11_B.hs index 2bcc5a8a84..1f0052da51 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang11_B.hs +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang11_B.hs @@ -4,13 +4,13 @@ module SafeLang11_B ( Class(..), mkSimpleClass ) where import Language.Haskell.TH class Class a where - c :: a + c :: a mkSimpleClass :: Name -> Q [Dec] mkSimpleClass name = do - TyConI (DataD [] dname [] Nothing cs _) <- reify name - ((NormalC conname []):_) <- return cs - ClassI (ClassD [] cname [_] [] [SigD mname _]) _ <- reify ''Class - return [InstanceD Nothing [] (AppT (ConT cname) (ConT dname)) [FunD mname + TyConI (DataD [] dname [] Nothing cs _) <- reify name + ((NormalC conname []):_) <- return cs + ClassI (ClassD [] cname [_] [] [SigD mname _]) _ <- reify ''Class + return [InstanceD Nothing [] (AppT (ConT cname) (ConT dname)) [FunD mname [Clause [] (NormalB (ConE conname)) []]]] diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang12_B.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang12_B.hs index 1a483dabab..7219b7a200 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang12_B.hs +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang12_B.hs @@ -5,13 +5,13 @@ module SafeLang12_B ( Class(..), mkSimpleClass ) where import Language.Haskell.TH class Class a where - c :: a + c :: a mkSimpleClass :: Name -> Q [Dec] mkSimpleClass name = do - TyConI (DataD [] dname [] Nothing cs _) <- reify name - ((NormalC conname []):_) <- return cs - ClassI (ClassD [] cname [_] [] [SigD mname _]) _ <- reify ''Class - return [InstanceD Nothing [] (AppT (ConT cname) (ConT dname)) [FunD mname + TyConI (DataD [] dname [] Nothing cs _) <- reify name + ((NormalC conname []):_) <- return cs + ClassI (ClassD [] cname [_] [] [SigD mname _]) _ <- reify ''Class + return [InstanceD Nothing [] (AppT (ConT cname) (ConT dname)) [FunD mname [Clause [] (NormalB (ConE conname)) []]]] |