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 | 46ff80f26d1892e1b50e3f10c5d3fded33da6e81 (patch) | |
| tree | c53fd835b689b6b64a729a42e4cc6482d8fb5215 | |
| parent | 7e7094f166b6e475a49e20b98cbca851334aedaf (diff) | |
| download | haskell-46ff80f26d1892e1b50e3f10c5d3fded33da6e81.tar.gz | |
Testsuite: tabs -> spaces [skip ci]
64 files changed, 917 insertions, 917 deletions
diff --git a/testsuite/tests/arrows/should_compile/arrowcase1.hs b/testsuite/tests/arrows/should_compile/arrowcase1.hs index 6d39b0be73..bc58315f50 100644 --- a/testsuite/tests/arrows/should_compile/arrowcase1.hs +++ b/testsuite/tests/arrows/should_compile/arrowcase1.hs @@ -6,13 +6,13 @@ import Control.Arrow h :: ArrowChoice a => Int -> a (Int,Int) Int h x = proc (y,z) -> case compare x y of - LT -> returnA -< x - EQ -> returnA -< y+z - GT -> returnA -< z+x + LT -> returnA -< x + EQ -> returnA -< y+z + GT -> returnA -< z+x g :: ArrowChoice a => Int -> a (Int,Int) Int g x = proc (y,z) -> (case compare x y of - LT -> \ a -> returnA -< x+a - EQ -> \ b -> returnA -< y+z+b - GT -> \ c -> returnA -< z+x + LT -> \ a -> returnA -< x+a + EQ -> \ b -> returnA -< y+z+b + GT -> \ c -> returnA -< z+x ) 1 diff --git a/testsuite/tests/arrows/should_compile/arrowdo1.hs b/testsuite/tests/arrows/should_compile/arrowdo1.hs index b70eedd460..ef54094af9 100644 --- a/testsuite/tests/arrows/should_compile/arrowdo1.hs +++ b/testsuite/tests/arrows/should_compile/arrowdo1.hs @@ -12,6 +12,6 @@ g x = proc y -> returnA -< x*y h :: Arrow a => Int -> a (Int,Int) Int h x = proc (y,z) -> do - a <- f -< (x,y,3) - b <- g (2+x) -< y+a - returnA -< a*b+z + a <- f -< (x,y,3) + b <- g (2+x) -< y+a + returnA -< a*b+z diff --git a/testsuite/tests/arrows/should_compile/arrowdo2.hs b/testsuite/tests/arrows/should_compile/arrowdo2.hs index 3562dc23b9..ca40f95a0a 100644 --- a/testsuite/tests/arrows/should_compile/arrowdo2.hs +++ b/testsuite/tests/arrows/should_compile/arrowdo2.hs @@ -6,5 +6,5 @@ import Control.Arrow f :: Arrow a => a (Int,Int) Int f = proc (x,y) -> do - let z = x*y - returnA -< y+z + let z = x*y + returnA -< y+z diff --git a/testsuite/tests/arrows/should_compile/arrowdo3.hs b/testsuite/tests/arrows/should_compile/arrowdo3.hs index 3b6a8c8d35..a46b06ef75 100644 --- a/testsuite/tests/arrows/should_compile/arrowdo3.hs +++ b/testsuite/tests/arrows/should_compile/arrowdo3.hs @@ -79,144 +79,144 @@ data T70 = C70 f :: Arrow a => a Int Int f = proc x0 -> do - x1 <- returnA -< C1 - x2 <- returnA -< C2 - x3 <- returnA -< C3 - x4 <- returnA -< C4 - x5 <- returnA -< C5 - x6 <- returnA -< C6 - x7 <- returnA -< C7 - x8 <- returnA -< C8 - x9 <- returnA -< C9 - x10 <- returnA -< C10 - x11 <- returnA -< C11 - x12 <- returnA -< C12 - x13 <- returnA -< C13 - x14 <- returnA -< C14 - x15 <- returnA -< C15 - x16 <- returnA -< C16 - x17 <- returnA -< C17 - x18 <- returnA -< C18 - x19 <- returnA -< C19 - x20 <- returnA -< C20 - x21 <- returnA -< C21 - x22 <- returnA -< C22 - x23 <- returnA -< C23 - x24 <- returnA -< C24 - x25 <- returnA -< C25 - x26 <- returnA -< C26 - x27 <- returnA -< C27 - x28 <- returnA -< C28 - x29 <- returnA -< C29 - x30 <- returnA -< C30 - x31 <- returnA -< C31 - x32 <- returnA -< C32 - x33 <- returnA -< C33 - x34 <- returnA -< C34 - x35 <- returnA -< C35 - x36 <- returnA -< C36 - x37 <- returnA -< C37 - x38 <- returnA -< C38 - x39 <- returnA -< C39 - x40 <- returnA -< C40 - x41 <- returnA -< C41 - x42 <- returnA -< C42 - x43 <- returnA -< C43 - x44 <- returnA -< C44 - x45 <- returnA -< C45 - x46 <- returnA -< C46 - x47 <- returnA -< C47 - x48 <- returnA -< C48 - x49 <- returnA -< C49 - x50 <- returnA -< C50 - x51 <- returnA -< C51 - x52 <- returnA -< C52 - x53 <- returnA -< C53 - x54 <- returnA -< C54 - x55 <- returnA -< C55 - x56 <- returnA -< C56 - x57 <- returnA -< C57 - x58 <- returnA -< C58 - x59 <- returnA -< C59 - x60 <- returnA -< C60 - x61 <- returnA -< C61 - x62 <- returnA -< C62 - x63 <- returnA -< C63 - x64 <- returnA -< C64 - x65 <- returnA -< C65 - x66 <- returnA -< C66 - x67 <- returnA -< C67 - x68 <- returnA -< C68 - x69 <- returnA -< C69 - x70 <- returnA -< C70 - returnA -< x70 - returnA -< x69 - returnA -< x68 - returnA -< x67 - returnA -< x66 - returnA -< x65 - returnA -< x64 - returnA -< x63 - returnA -< x62 - returnA -< x61 - returnA -< x60 - returnA -< x59 - returnA -< x58 - returnA -< x57 - returnA -< x56 - returnA -< x55 - returnA -< x54 - returnA -< x53 - returnA -< x52 - returnA -< x51 - returnA -< x50 - returnA -< x49 - returnA -< x48 - returnA -< x47 - returnA -< x46 - returnA -< x45 - returnA -< x44 - returnA -< x43 - returnA -< x42 - returnA -< x41 - returnA -< x40 - returnA -< x39 - returnA -< x38 - returnA -< x37 - returnA -< x36 - returnA -< x35 - returnA -< x34 - returnA -< x33 - returnA -< x32 - returnA -< x31 - returnA -< x30 - returnA -< x29 - returnA -< x28 - returnA -< x27 - returnA -< x26 - returnA -< x25 - returnA -< x24 - returnA -< x23 - returnA -< x22 - returnA -< x21 - returnA -< x20 - returnA -< x19 - returnA -< x18 - returnA -< x17 - returnA -< x16 - returnA -< x15 - returnA -< x14 - returnA -< x13 - returnA -< x12 - returnA -< x11 - returnA -< x10 - returnA -< x9 - returnA -< x8 - returnA -< x7 - returnA -< x6 - returnA -< x5 - returnA -< x4 - returnA -< x3 - returnA -< x2 - returnA -< x1 - returnA -< x0 + x1 <- returnA -< C1 + x2 <- returnA -< C2 + x3 <- returnA -< C3 + x4 <- returnA -< C4 + x5 <- returnA -< C5 + x6 <- returnA -< C6 + x7 <- returnA -< C7 + x8 <- returnA -< C8 + x9 <- returnA -< C9 + x10 <- returnA -< C10 + x11 <- returnA -< C11 + x12 <- returnA -< C12 + x13 <- returnA -< C13 + x14 <- returnA -< C14 + x15 <- returnA -< C15 + x16 <- returnA -< C16 + x17 <- returnA -< C17 + x18 <- returnA -< C18 + x19 <- returnA -< C19 + x20 <- returnA -< C20 + x21 <- returnA -< C21 + x22 <- returnA -< C22 + x23 <- returnA -< C23 + x24 <- returnA -< C24 + x25 <- returnA -< C25 + x26 <- returnA -< C26 + x27 <- returnA -< C27 + x28 <- returnA -< C28 + x29 <- returnA -< C29 + x30 <- returnA -< C30 + x31 <- returnA -< C31 + x32 <- returnA -< C32 + x33 <- returnA -< C33 + x34 <- returnA -< C34 + x35 <- returnA -< C35 + x36 <- returnA -< C36 + x37 <- returnA -< C37 + x38 <- returnA -< C38 + x39 <- returnA -< C39 + x40 <- returnA -< C40 + x41 <- returnA -< C41 + x42 <- returnA -< C42 + x43 <- returnA -< C43 + x44 <- returnA -< C44 + x45 <- returnA -< C45 + x46 <- returnA -< C46 + x47 <- returnA -< C47 + x48 <- returnA -< C48 + x49 <- returnA -< C49 + x50 <- returnA -< C50 + x51 <- returnA -< C51 + x52 <- returnA -< C52 + x53 <- returnA -< C53 + x54 <- returnA -< C54 + x55 <- returnA -< C55 + x56 <- returnA -< C56 + x57 <- returnA -< C57 + x58 <- returnA -< C58 + x59 <- returnA -< C59 + x60 <- returnA -< C60 + x61 <- returnA -< C61 + x62 <- returnA -< C62 + x63 <- returnA -< C63 + x64 <- returnA -< C64 + x65 <- returnA -< C65 + x66 <- returnA -< C66 + x67 <- returnA -< C67 + x68 <- returnA -< C68 + x69 <- returnA -< C69 + x70 <- returnA -< C70 + returnA -< x70 + returnA -< x69 + returnA -< x68 + returnA -< x67 + returnA -< x66 + returnA -< x65 + returnA -< x64 + returnA -< x63 + returnA -< x62 + returnA -< x61 + returnA -< x60 + returnA -< x59 + returnA -< x58 + returnA -< x57 + returnA -< x56 + returnA -< x55 + returnA -< x54 + returnA -< x53 + returnA -< x52 + returnA -< x51 + returnA -< x50 + returnA -< x49 + returnA -< x48 + returnA -< x47 + returnA -< x46 + returnA -< x45 + returnA -< x44 + returnA -< x43 + returnA -< x42 + returnA -< x41 + returnA -< x40 + returnA -< x39 + returnA -< x38 + returnA -< x37 + returnA -< x36 + returnA -< x35 + returnA -< x34 + returnA -< x33 + returnA -< x32 + returnA -< x31 + returnA -< x30 + returnA -< x29 + returnA -< x28 + returnA -< x27 + returnA -< x26 + returnA -< x25 + returnA -< x24 + returnA -< x23 + returnA -< x22 + returnA -< x21 + returnA -< x20 + returnA -< x19 + returnA -< x18 + returnA -< x17 + returnA -< x16 + returnA -< x15 + returnA -< x14 + returnA -< x13 + returnA -< x12 + returnA -< x11 + returnA -< x10 + returnA -< x9 + returnA -< x8 + returnA -< x7 + returnA -< x6 + returnA -< x5 + returnA -< x4 + returnA -< x3 + returnA -< x2 + returnA -< x1 + returnA -< x0 diff --git a/testsuite/tests/arrows/should_compile/arrowrec1.hs b/testsuite/tests/arrows/should_compile/arrowrec1.hs index 57b6de783c..b5a575ec66 100644 --- a/testsuite/tests/arrows/should_compile/arrowrec1.hs +++ b/testsuite/tests/arrows/should_compile/arrowrec1.hs @@ -7,7 +7,7 @@ import Data.Char f :: ArrowLoop a => a Char Int f = proc x -> do - a <- returnA -< ord x - rec b <- returnA -< ord c - ord x - c <- returnA -< chr a - returnA -< b + ord c + a <- returnA -< ord x + rec b <- returnA -< ord c - ord x + c <- returnA -< chr a + returnA -< b + ord c diff --git a/testsuite/tests/arrows/should_run/arrowrun001.hs b/testsuite/tests/arrows/should_run/arrowrun001.hs index c686b32546..90882b59a3 100644 --- a/testsuite/tests/arrows/should_run/arrowrun001.hs +++ b/testsuite/tests/arrows/should_run/arrowrun001.hs @@ -13,21 +13,21 @@ data Exp = Var Id | Add Exp Exp | If Exp Exp Exp | Lam Id Exp | App Exp Exp eval :: (ArrowChoice a, ArrowApply a) => Exp -> a [(Id, Val a)] (Val a) eval (Var s) = proc env -> - returnA -< fromJust (lookup s env) + returnA -< fromJust (lookup s env) eval (Add e1 e2) = proc env -> do - ~(Num u) <- eval e1 -< env - ~(Num v) <- eval e2 -< env - returnA -< Num (u + v) + ~(Num u) <- eval e1 -< env + ~(Num v) <- eval e2 -< env + returnA -< Num (u + v) eval (If e1 e2 e3) = proc env -> do - ~(Bl b) <- eval e1 -< env - if b then eval e2 -< env - else eval e3 -< env + ~(Bl b) <- eval e1 -< env + if b then eval e2 -< env + else eval e3 -< env eval (Lam x e) = proc env -> - returnA -< Fun (proc v -> eval e -< (x,v):env) + returnA -< Fun (proc v -> eval e -< (x,v):env) eval (App e1 e2) = proc env -> do - ~(Fun f) <- eval e1 -< env - v <- eval e2 -< env - f -<< v + ~(Fun f) <- eval e1 -< env + v <- eval e2 -< env + f -<< v -- some tests @@ -38,11 +38,11 @@ double = Lam "x" (Add (Var "x") (Var "x")) -- if b then k (double x) x else x + x + x text_exp = If (Var "b") - (App (App k (App double (Var "x"))) (Var "x")) - (Add (Var "x") (Add (Var "x") (Var "x"))) + (App (App k (App double (Var "x"))) (Var "x")) + (Add (Var "x") (Add (Var "x") (Var "x"))) unNum (Num n) = n main = do - print (unNum (eval text_exp [("b", Bl True), ("x", Num 5)])) - print (unNum (eval text_exp [("b", Bl False), ("x", Num 5)])) + print (unNum (eval text_exp [("b", Bl True), ("x", Num 5)])) + print (unNum (eval text_exp [("b", Bl False), ("x", Num 5)])) diff --git a/testsuite/tests/arrows/should_run/arrowrun002.hs b/testsuite/tests/arrows/should_run/arrowrun002.hs index 16f29806ac..2e606cf239 100644 --- a/testsuite/tests/arrows/should_run/arrowrun002.hs +++ b/testsuite/tests/arrows/should_run/arrowrun002.hs @@ -15,7 +15,7 @@ infixr 4 :&: -- or `powertrees' (cf Jayadev Misra's powerlists): data Pow a = Zero a | Succ (Pow (Pair a)) - deriving Show + deriving Show type Pair a = (a, a) @@ -33,7 +33,7 @@ tree3 = Succ (Succ (Succ (Zero (((1, 2), (3, 4)), ((5, 6), (7, 8)))))) -- in circuit design, eg Ruby, and descriptions of parallel algorithms.) -- And the type system will ensure that all legal programs preserve -- this structural invariant. --- +-- -- The only problem is that the type constraint is too restrictive, rejecting -- many of the standard operations on these trees. Typically you want to -- split a tree into two subtrees, do some processing on the subtrees and @@ -56,13 +56,13 @@ apply (f :&: fs) (Succ t) = Succ (apply fs t) -- programming with Hom's. Firstly, Hom is an arrow: instance Category Hom where - id = id :&: id - (f :&: fs) . (g :&: gs) = (f . g) :&: (fs . gs) + id = id :&: id + (f :&: fs) . (g :&: gs) = (f . g) :&: (fs . gs) instance Arrow Hom where - arr f = f :&: arr (f *** f) - first (f :&: fs) = - first f :&: (arr transpose >>> first fs >>> arr transpose) + arr f = f :&: arr (f *** f) + first (f :&: fs) = + first f :&: (arr transpose >>> first fs >>> arr transpose) transpose :: ((a,b), (c,d)) -> ((a,c), (b,d)) transpose ((a,b), (c,d)) = ((a,c), (b,d)) @@ -70,7 +70,7 @@ transpose ((a,b), (c,d)) = ((a,c), (b,d)) -- arr maps f over the leaves of a powertree. -- The composition >>> composes sequences of functions pairwise. --- +-- -- The *** operator unriffles a powertree of pairs into a pair of powertrees, -- applies the appropriate function to each and riffles the results. -- It defines a categorical product for this arrow category. @@ -85,9 +85,9 @@ transpose ((a,b), (c,d)) = ((a,c), (b,d)) butterfly :: (Pair a -> Pair a) -> Hom a a butterfly f = id :&: proc (x, y) -> do - x' <- butterfly f -< x - y' <- butterfly f -< y - returnA -< f (x', y') + x' <- butterfly f -< x + y' <- butterfly f -< y + returnA -< f (x', y') -- The recursive calls operate on halves of the original tree, so the -- recursion is well-defined. @@ -96,7 +96,7 @@ butterfly f = id :&: proc (x, y) -> do rev :: Hom a a rev = butterfly swap - where swap (x, y) = (y, x) + where swap (x, y) = (y, x) unriffle :: Hom (Pair a) (Pair a) unriffle = butterfly transpose @@ -105,26 +105,26 @@ unriffle = butterfly transpose bisort :: Ord a => Hom a a bisort = butterfly cmp - where cmp (x, y) = (min x y, max x y) + where cmp (x, y) = (min x y, max x y) -- This can be used (with rev) as the merge phase of a merge sort. --- +-- sort :: Ord a => Hom a a sort = id :&: proc (x, y) -> do - x' <- sort -< x - y' <- sort -< y - yr <- rev -< y' - p <- unriffle -< (x', yr) - bisort2 -< p - where _ :&: bisort2 = bisort + x' <- sort -< x + y' <- sort -< y + yr <- rev -< y' + p <- unriffle -< (x', yr) + bisort2 -< p + where _ :&: bisort2 = bisort -- Here is the scan operation, using the algorithm of Ladner and Fischer: scan :: (a -> a -> a) -> a -> Hom a a scan op b = id :&: proc (x, y) -> do - y' <- scan op b -< op x y - l <- rsh b -< y' - returnA -< (op l x, y') + y' <- scan op b -< op x y + l <- rsh b -< y' + returnA -< (op l x, y') -- The auxiliary function rsh b shifts each element in the tree one place to -- the right, placing b in the now-vacant leftmost position, and discarding @@ -132,8 +132,8 @@ scan op b = id :&: proc (x, y) -> do rsh :: a -> Hom a a rsh b = const b :&: proc (x, y) -> do - w <- rsh b -< y - returnA -< (w, x) + w <- rsh b -< y + returnA -< (w, x) -- Finally, here is the Fast Fourier Transform: @@ -141,11 +141,11 @@ type C = Complex Double fft :: Hom C C fft = id :&: proc (x, y) -> do - x' <- fft -< x - y' <- fft -< y - r <- roots (-1) -< () - let z = r*y' - unriffle -< (x' + z, x' - z) + x' <- fft -< x + y' <- fft -< y + r <- roots (-1) -< () + let z = r*y' + unriffle -< (x' + z, x' - z) -- The auxiliary function roots r (where r is typically a root of unity) -- populates a tree of size n (necessarily a power of 2) with the values @@ -153,73 +153,73 @@ fft = id :&: proc (x, y) -> do roots :: C -> Hom () C roots r = const 1 :&: proc _ -> do - x <- roots r' -< () - unriffle -< (x, x*r') - where r' = if imagPart s >= 0 then -s else s - s = sqrt r + x <- roots r' -< () + unriffle -< (x, x*r') + where r' = if imagPart s >= 0 then -s else s + s = sqrt r -- Miscellaneous functions: rrot :: Hom a a rrot = id :&: proc (x, y) -> do - w <- rrot -< y - returnA -< (w, x) + w <- rrot -< y + returnA -< (w, x) ilv :: Hom a a -> Hom (Pair a) (Pair a) ilv f = proc (x, y) -> do - x' <- f -< x - y' <- f -< y - returnA -< (x', y') + x' <- f -< x + y' <- f -< y + returnA -< (x', y') scan' :: (a -> a -> a) -> a -> Hom a a scan' op b = proc x -> do - l <- rsh b -< x - (id :&: ilv (scan' op b)) -< op l x + l <- rsh b -< x + (id :&: ilv (scan' op b)) -< op l x riffle :: Hom (Pair a) (Pair a) riffle = id :&: proc ((x1, y1), (x2, y2)) -> do - x <- riffle -< (x1, x2) - y <- riffle -< (y1, y2) - returnA -< (x, y) + x <- riffle -< (x1, x2) + y <- riffle -< (y1, y2) + returnA -< (x, y) invert :: Hom a a invert = id :&: proc (x, y) -> do - x' <- invert -< x - y' <- invert -< y - unriffle -< (x', y') + x' <- invert -< x + y' <- invert -< y + unriffle -< (x', y') carryLookaheadAdder :: Hom (Bool, Bool) Bool carryLookaheadAdder = proc (x, y) -> do - carryOut <- rsh (Just False) -< - if x == y then Just x else Nothing - Just carryIn <- scan plusMaybe Nothing -< carryOut - returnA -< x `xor` y `xor` carryIn - where plusMaybe x Nothing = x - plusMaybe x (Just y) = Just y - False `xor` b = b - True `xor` b = not b + carryOut <- rsh (Just False) -< + if x == y then Just x else Nothing + Just carryIn <- scan plusMaybe Nothing -< carryOut + returnA -< x `xor` y `xor` carryIn + where plusMaybe x Nothing = x + plusMaybe x (Just y) = Just y + False `xor` b = b + True `xor` b = not b -- Global conditional for SIMD ifAll :: Hom a b -> Hom a b -> Hom (a, Bool) b ifAll fs gs = ifAllAux snd (arr fst >>> fs) (arr fst >>> gs) - where ifAllAux :: (a -> Bool) -> Hom a b -> Hom a b -> Hom a b - ifAllAux p (f :&: fs) (g :&: gs) = - liftIf p f g :&: ifAllAux (liftAnd p) fs gs - liftIf p f g x = if p x then f x else g x - liftAnd p (x, y) = p x && p y + where ifAllAux :: (a -> Bool) -> Hom a b -> Hom a b -> Hom a b + ifAllAux p (f :&: fs) (g :&: gs) = + liftIf p f g :&: ifAllAux (liftAnd p) fs gs + liftIf p f g x = if p x then f x else g x + liftAnd p (x, y) = p x && p y maybeAll :: Hom a c -> Hom (a, b) c -> Hom (a, Maybe b) c maybeAll (n :&: ns) (j :&: js) = - choose :&: (arr dist >>> maybeAll ns (arr transpose >>> js)) - where choose (a, Nothing) = n a - choose (a, Just b) = j (a, b) - dist ((a1, b1), (a2, b2)) = ((a1, a2), zipMaybe b1 b2) - zipMaybe (Just x) (Just y) = Just (x, y) - zipMaybe _ _ = Nothing + choose :&: (arr dist >>> maybeAll ns (arr transpose >>> js)) + where choose (a, Nothing) = n a + choose (a, Just b) = j (a, b) + dist ((a1, b1), (a2, b2)) = ((a1, a2), zipMaybe b1 b2) + zipMaybe (Just x) (Just y) = Just (x, y) + zipMaybe _ _ = Nothing main = do - print (apply rev tree3) - print (apply invert tree3) - print (apply (invert >>> sort) tree3) - print (apply (scan (+) 0) tree3) + print (apply rev tree3) + print (apply invert tree3) + print (apply (invert >>> sort) tree3) + print (apply (scan (+) 0) tree3) diff --git a/testsuite/tests/arrows/should_run/arrowrun003.hs b/testsuite/tests/arrows/should_run/arrowrun003.hs index 5f4580ab87..eeab42556e 100644 --- a/testsuite/tests/arrows/should_run/arrowrun003.hs +++ b/testsuite/tests/arrows/should_run/arrowrun003.hs @@ -7,14 +7,14 @@ import Control.Category import Prelude hiding (id, (.)) class ArrowLoop a => ArrowCircuit a where - delay :: b -> a b b + delay :: b -> a b b -- stream map instance data Stream a = Cons a (Stream a) instance Functor Stream where - fmap f ~(Cons a as) = Cons (f a) (fmap f as) + fmap f ~(Cons a as) = Cons (f a) (fmap f as) zipStream :: Stream a -> Stream b -> Stream (a,b) zipStream ~(Cons a as) ~(Cons b bs) = Cons (a,b) (zipStream as bs) @@ -26,20 +26,20 @@ newtype StreamMap a b = StreamMap (Stream a -> Stream b) unStreamMap (StreamMap f) = f instance Category StreamMap where - id = StreamMap id - StreamMap f . StreamMap g = StreamMap (f . g) + id = StreamMap id + StreamMap f . StreamMap g = StreamMap (f . g) instance Arrow StreamMap where - arr f = StreamMap (fmap f) - first (StreamMap f) = - StreamMap (uncurry zipStream . first f . unzipStream) + arr f = StreamMap (fmap f) + first (StreamMap f) = + StreamMap (uncurry zipStream . first f . unzipStream) instance ArrowLoop StreamMap where - loop (StreamMap f) = - StreamMap (loop (unzipStream . f . uncurry zipStream)) + loop (StreamMap f) = + StreamMap (loop (unzipStream . f . uncurry zipStream)) instance ArrowCircuit StreamMap where - delay a = StreamMap (Cons a) + delay a = StreamMap (Cons a) listToStream :: [a] -> Stream a listToStream = foldr Cons undefined @@ -49,30 +49,30 @@ streamToList (Cons a as) = a:streamToList as runStreamMap :: StreamMap a b -> [a] -> [b] runStreamMap (StreamMap f) as = - take (length as) (streamToList (f (listToStream as))) + take (length as) (streamToList (f (listToStream as))) -- simple automaton instance data Auto a b = Auto (a -> (b, Auto a b)) instance Category Auto where - id = Auto $ \a -> (a, id) - Auto f . Auto g = Auto $ \b -> - let (c, g') = g b - (d, f') = f c - in (d, f' . g') + id = Auto $ \a -> (a, id) + Auto f . Auto g = Auto $ \b -> + let (c, g') = g b + (d, f') = f c + in (d, f' . g') instance Arrow Auto where - arr f = Auto $ \a -> (f a, arr f) - first (Auto f) = Auto $ \(b,d) -> let (c,f') = f b in ((c,d), first f') + arr f = Auto $ \a -> (f a, arr f) + first (Auto f) = Auto $ \(b,d) -> let (c,f') = f b in ((c,d), first f') instance ArrowLoop Auto where - loop (Auto f) = Auto $ \b -> - let (~(c,d), f') = f (b,d) - in (c, loop f') + loop (Auto f) = Auto $ \b -> + let (~(c,d), f') = f (b,d) + in (c, loop f') instance ArrowCircuit Auto where - delay a = Auto $ \a' -> (a, delay a') + delay a = Auto $ \a' -> (a, delay a') runAuto :: Auto a b -> [a] -> [b] runAuto (Auto f) [] = [] @@ -84,9 +84,9 @@ runAuto (Auto f) (a:as) = let (b, f') = f a in b:runAuto f' as counter :: ArrowCircuit a => a Bool Int counter = proc reset -> do - rec output <- returnA -< if reset then 0 else next - next <- delay 0 -< output+1 - returnA -< output + rec output <- returnA -< if reset then 0 else next + next <- delay 0 -< output+1 + returnA -< output -- Some other basic circuits from the Hawk library. @@ -95,18 +95,18 @@ counter = proc reset -> do flush :: ArrowCircuit a => Int -> b -> a (b, Bool) b flush n d = proc (value, reset) -> do - rec count <- returnA -< if reset then n else max (next-1) 0 - next <- delay 0 -< count - returnA -< if count > 0 then d else value + rec count <- returnA -< if reset then n else max (next-1) 0 + next <- delay 0 -< count + returnA -< if count > 0 then d else value -- latch: on each tick, return the last value for which reset was True, -- or init if there was none. --- +-- latch :: ArrowCircuit a => b -> a (b, Bool) b latch init = proc (value, reset) -> do - rec out <- returnA -< if reset then value else last - last <- delay init -< out - returnA -< out + rec out <- returnA -< if reset then value else last + last <- delay init -< out + returnA -< out -- Some tests using the counter @@ -116,18 +116,18 @@ test_input2 = zip [1..] test_input -- A test of the resettable counter. main = do - print (runStreamMap counter test_input) - print (runAuto counter test_input) - print (runStreamMap (flush 2 0) test_input2) - print (runAuto (flush 2 0) test_input2) - print (runStreamMap (latch 0) test_input2) - print (runAuto (latch 0) test_input2) + print (runStreamMap counter test_input) + print (runAuto counter test_input) + print (runStreamMap (flush 2 0) test_input2) + print (runAuto (flush 2 0) test_input2) + print (runStreamMap (latch 0) test_input2) + print (runAuto (latch 0) test_input2) -- A step function (cf current in Lustre) step :: ArrowCircuit a => b -> a (Either b c) b step b = proc x -> do - rec last_b <- delay b -< getLeft last_b x - returnA -< last_b - where getLeft _ (Left b) = b - getLeft b (Right _) = b + rec last_b <- delay b -< getLeft last_b x + returnA -< last_b + where getLeft _ (Left b) = b + getLeft b (Right _) = b diff --git a/testsuite/tests/arrows/should_run/arrowrun004.hs b/testsuite/tests/arrows/should_run/arrowrun004.hs index c0275065f2..1b22ac83b4 100644 --- a/testsuite/tests/arrows/should_run/arrowrun004.hs +++ b/testsuite/tests/arrows/should_run/arrowrun004.hs @@ -13,7 +13,7 @@ import Prelude hiding (id, (.)) -- Parsers class (Eq s, Show s, ArrowPlus a) => ArrowParser s a where - symbol :: s -> a b String + symbol :: s -> a b String data Sym s = Sym { token :: s, value :: String } @@ -22,35 +22,35 @@ data Sym s = Sym { token :: s, value :: String } newtype BTParser s a b = BTParser (a -> [Sym s] -> [(b, [Sym s])]) instance Category (BTParser s) where - id = BTParser $ \a ss -> [(a, ss)] - BTParser f . BTParser g = BTParser $ \b ss -> - [(d, ss'') | (c, ss') <- g b ss, (d, ss'') <- f c ss'] + id = BTParser $ \a ss -> [(a, ss)] + BTParser f . BTParser g = BTParser $ \b ss -> + [(d, ss'') | (c, ss') <- g b ss, (d, ss'') <- f c ss'] instance Arrow (BTParser s) where - arr f = BTParser $ \a ss -> [(f a, ss)] - first (BTParser f) = BTParser $ \(b,d) ss -> - [((c,d), ss') | (c,ss') <- f b ss] + arr f = BTParser $ \a ss -> [(f a, ss)] + first (BTParser f) = BTParser $ \(b,d) ss -> + [((c,d), ss') | (c,ss') <- f b ss] instance ArrowZero (BTParser s) where - zeroArrow = BTParser $ \b ss -> [] + zeroArrow = BTParser $ \b ss -> [] instance ArrowPlus (BTParser s) where - BTParser f <+> BTParser g = BTParser $ \b ss -> f b ss ++ g b ss + BTParser f <+> BTParser g = BTParser $ \b ss -> f b ss ++ g b ss instance (Eq s, Show s) => ArrowParser s (BTParser s) where - symbol s = BTParser $ \b ss -> - case ss of - Sym s' v:ss' | s' == s -> [(v, ss')] - _ -> [] + symbol s = BTParser $ \b ss -> + case ss of + Sym s' v:ss' | s' == s -> [(v, ss')] + _ -> [] runBTParser :: BTParser s () c -> [Sym s] -> c runBTParser (BTParser parser) syms = - head [c | (c, []) <- parser () syms] + head [c | (c, []) <- parser () syms] -- Expressions data ESym = LPar | RPar | Plus | Minus | Mult | Div | Number | Unknown - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord) type ExprParser = BTParser ESym type ExprSym = Sym ESym @@ -59,51 +59,51 @@ type ExprSym = Sym ESym expr :: ExprParser () Int expr = proc () -> do - x <- term -< () - expr' -< x + x <- term -< () + expr' -< x expr' :: ExprParser Int Int expr' = proc x -> do - returnA -< x - <+> do - (|(symbol Plus)|) - y <- term -< () - expr' -< x + y - <+> do - (|(symbol Minus)|) - y <- term -< () - expr' -< x - y + returnA -< x + <+> do + (|(symbol Plus)|) + y <- term -< () + expr' -< x + y + <+> do + (|(symbol Minus)|) + y <- term -< () + expr' -< x - y term :: ExprParser () Int term = proc () -> do - x <- factor -< () - term' -< x + x <- factor -< () + term' -< x term' :: ExprParser Int Int term' = proc x -> do - returnA -< x - <+> do - (|(symbol Mult)|) - y <- factor -< () - term' -< x * y - <+> do - (|(symbol Div)|) - y <- factor -< () - term' -< x `div` y + returnA -< x + <+> do + (|(symbol Mult)|) + y <- factor -< () + term' -< x * y + <+> do + (|(symbol Div)|) + y <- factor -< () + term' -< x `div` y factor :: ExprParser () Int factor = proc () -> do - v <- (|(symbol Number)|) - returnA -< read v::Int - <+> do - (|(symbol Minus)|) - v <- factor -< () - returnA -< -v - <+> do - (|(symbol LPar)|) - v <- expr -< () - (|(symbol RPar)|) - returnA -< v + v <- (|(symbol Number)|) + returnA -< read v::Int + <+> do + (|(symbol Minus)|) + v <- factor -< () + returnA -< -v + <+> do + (|(symbol LPar)|) + v <- expr -< () + (|(symbol RPar)|) + returnA -< v -- Lexical analysis @@ -116,13 +116,13 @@ lexer ('-':cs) = Sym Minus "-":lexer cs lexer ('*':cs) = Sym Mult "*":lexer cs lexer ('/':cs) = Sym Div "/":lexer cs lexer (c:cs) - | isSpace c = lexer cs - | isDigit c = Sym Number (c:w):lexer cs' - | otherwise = Sym Unknown [c]:lexer cs - where (w,cs') = span isDigit cs + | isSpace c = lexer cs + | isDigit c = Sym Number (c:w):lexer cs' + | otherwise = Sym Unknown [c]:lexer cs + where (w,cs') = span isDigit cs parse = runBTParser expr . lexer main = do - print (parse "1+2*(3+4)") - print (parse "3*5-17/3+4") + print (parse "1+2*(3+4)") + print (parse "3*5-17/3+4") diff --git a/testsuite/tests/cpranal/should_compile/Cpr001.hs b/testsuite/tests/cpranal/should_compile/Cpr001.hs index 0871205bb7..e94db4c49c 100644 --- a/testsuite/tests/cpranal/should_compile/Cpr001.hs +++ b/testsuite/tests/cpranal/should_compile/Cpr001.hs @@ -5,7 +5,7 @@ import Cpr001_imp -- ------------------------------------------------------------------- -intpInstr :: Instr -> MST () +intpInstr :: Instr -> MST () intpInstr (SysCall "exit") = setMTerminated diff --git a/testsuite/tests/cpranal/should_compile/Cpr001_imp.hs b/testsuite/tests/cpranal/should_compile/Cpr001_imp.hs index 22352ead05..e5175b658d 100644 --- a/testsuite/tests/cpranal/should_compile/Cpr001_imp.hs +++ b/testsuite/tests/cpranal/should_compile/Cpr001_imp.hs @@ -5,13 +5,13 @@ module Cpr001_imp where import Control.Applicative (Applicative(..)) import Control.Monad (liftM, ap) -data MS = MS { instr :: String - , pc :: Int - , mem :: String - , stack :: String - , frames :: [String] - , status :: Maybe String - } +data MS = MS { instr :: String + , pc :: Int + , mem :: String + , stack :: String + , frames :: [String] + , status :: Maybe String + } newtype StateTrans s a = ST ( s -> (s, Maybe a)) @@ -30,23 +30,23 @@ instance Applicative (StateTrans s) where instance Monad (StateTrans s) where (ST p) >>= k - = ST (\s0 -> let - (s1, r0) = p s0 - in - case r0 of - Just v -> let + = ST (\s0 -> let + (s1, r0) = p s0 + in + case r0 of + Just v -> let (ST q) = k v - in - q s1 - Nothing -> (s1, Nothing) - ) + in + q s1 + Nothing -> (s1, Nothing) + ) return v - = ST (\s -> (s, Just v)) + = ST (\s -> (s, Just v)) -- machine state transitions -type MachineStateTrans = StateTrans MS +type MachineStateTrans = StateTrans MS type MST = MachineStateTrans @@ -60,6 +60,6 @@ setMSvc call -- ------------------------------------------------------------------- data Instr - = LoadI Int -- load int const - | SysCall String -- system call (svc) + = LoadI Int -- load int const + | SysCall String -- system call (svc) diff --git a/testsuite/tests/eyeball/dmd-on-polymorphic-floatouts.hs b/testsuite/tests/eyeball/dmd-on-polymorphic-floatouts.hs index fa411e23f2..faf9f571f6 100644 --- a/testsuite/tests/eyeball/dmd-on-polymorphic-floatouts.hs +++ b/testsuite/tests/eyeball/dmd-on-polymorphic-floatouts.hs @@ -3,19 +3,19 @@ module Max(result) where foo ys = foldr (\x xs -> x : reverse xs) [] ys -result xs = +result xs = let stuff = [1, 1, 1, 1, 1, 1] in foo (reverse stuff) -- What used to happen is that foldr got expanded by main simplification --- and the resulting "go" function got floated out but because we manufactured --- a new binder for it in newPolyBndrs we would lose its demand signature! +-- and the resulting "go" function got floated out but because we manufactured +-- a new binder for it in newPolyBndrs we would lose its demand signature! -- This means that the later application of it in result did not use call by value :-( -- Eyeball test: -- Ensure that Max.poly_go has a demand signature --- Ensure that we use call by value to call Max.poly_go in result --- i.e. the call to Max.poly_go inside Max.result looks like this: +-- Ensure that we use call by value to call Max.poly_go in result +-- i.e. the call to Max.poly_go inside Max.result looks like this: -- -- case GHC.List.poly_rev @ t1_a6x sat_seb (GHC.Base.[] @ t1_a6x) -- of sat_sed { __DEFAULT -> diff --git a/testsuite/tests/eyeball/inline1.hs b/testsuite/tests/eyeball/inline1.hs index 8e58652db6..001834f477 100644 --- a/testsuite/tests/eyeball/inline1.hs +++ b/testsuite/tests/eyeball/inline1.hs @@ -8,7 +8,7 @@ newtype T s a = T { unT :: Int -> ST s a } instance Monad (T s) where return = T . const . return T p >>= f = T $ \i -> do { x <- p i - ; unT (f x) i } + ; unT (f x) i } myIndex :: T s Int {-# INLINE myIndex #-} @@ -34,4 +34,4 @@ foo = do { x <- myIndex U.foo = U.a3 `cast` ... -The point is that myIndex should be inlined, else code is bad -}
\ No newline at end of file +The point is that myIndex should be inlined, else code is bad -} diff --git a/testsuite/tests/eyeball/inline2.hs b/testsuite/tests/eyeball/inline2.hs index 45bb04bf8b..ec9b65644a 100644 --- a/testsuite/tests/eyeball/inline2.hs +++ b/testsuite/tests/eyeball/inline2.hs @@ -12,7 +12,7 @@ bar :: Int -> Int -> Int {-# INLINE [0] bar #-} bar _ n = n -{- The trouble here was +{- The trouble here was *** Simplify: Result size = 25 @@ -28,11 +28,11 @@ bar _ n = n Result size = 25 - etc. + etc. The reason was this: - x = n# +# 1# - i = I# x + x = n# +# 1# + i = I# x Being an unboxed value, we were treating the argument context of x as intersting, and hence inlining x in the arg of I#. But then we just diff --git a/testsuite/tests/eyeball/spec-constr1.hs b/testsuite/tests/eyeball/spec-constr1.hs index a14442035b..d08046c64b 100644 --- a/testsuite/tests/eyeball/spec-constr1.hs +++ b/testsuite/tests/eyeball/spec-constr1.hs @@ -1,9 +1,9 @@ {-# OPTIONS_GHC -O2 -ddump-simpl #-} module Roman where -{- From: Roman Leshchinskiy [mailto:rl@cse.unsw.edu.au] +{- From: Roman Leshchinskiy [mailto:rl@cse.unsw.edu.au] Sent: 07 February 2008 03:34 - Subject: Quadratic SpecConstr + Subject: Quadratic SpecConstr Here is a program which makes SpecConstr generate a quadratic number of iterations: @@ -23,14 +23,14 @@ bar m n = foo n (n,n) (n,n) (n,n) (n,n) {- For this particular function, I get 14 specialisations, one for each possible combination of arguments. - + However, since we can see all the call sites outside the loop, we could use that to 'seed' the specialisation, and get just one specialisation. -} --- Eyeball guidance: --- There should be just one specialisation for foo --- Indeed, the original function should disappear, --- since it isn't used - +-- Eyeball guidance: +-- There should be just one specialisation for foo +-- Indeed, the original function should disappear, +-- since it isn't used + diff --git a/testsuite/tests/ffi/should_compile/cc001.hs b/testsuite/tests/ffi/should_compile/cc001.hs index cd7318d000..b93b51cd6b 100644 --- a/testsuite/tests/ffi/should_compile/cc001.hs +++ b/testsuite/tests/ffi/should_compile/cc001.hs @@ -8,14 +8,14 @@ foreign import ccall unsafe "a" a :: IO Int foreign import ccall unsafe "b" b :: Int -> IO Int -foreign import ccall unsafe "c" +foreign import ccall unsafe "c" c :: Int -> Char -> Float -> Double -> IO Float -- simple monadic code -d = a >>= \ x -> - b x >>= \ y -> - c y 'f' 1.0 2.0 +d = a >>= \ x -> + b x >>= \ y -> + c y 'f' 1.0 2.0 + - diff --git a/testsuite/tests/ffi/should_compile/cc004.hs b/testsuite/tests/ffi/should_compile/cc004.hs index 89c2aa8319..915f054a0c 100644 --- a/testsuite/tests/ffi/should_compile/cc004.hs +++ b/testsuite/tests/ffi/should_compile/cc004.hs @@ -34,19 +34,19 @@ foreign import stdcall "dynamic" d64 :: FunPtr (IO Int64) -> IO Int64 foreign import ccall unsafe "kitchen" sink :: Ptr a -> ByteArray# - -> MutableByteArray# RealWorld - -> Int - -> Int8 - -> Int16 - -> Int32 - -> Int64 - -> Word8 - -> Word16 - -> Word32 - -> Word64 - -> Float - -> Double - -> IO () + -> MutableByteArray# RealWorld + -> Int + -> Int8 + -> Int16 + -> Int32 + -> Int64 + -> Word8 + -> Word16 + -> Word32 + -> Word64 + -> Float + -> Double + -> IO () type Sink2 b = Ptr b diff --git a/testsuite/tests/ffi/should_compile/cc005.hs b/testsuite/tests/ffi/should_compile/cc005.hs index 7086480bfe..3770d54cdf 100644 --- a/testsuite/tests/ffi/should_compile/cc005.hs +++ b/testsuite/tests/ffi/should_compile/cc005.hs @@ -66,43 +66,43 @@ d64 = undefined foreign export ccall "kitchen" - sink :: --ForeignObj --- -> ByteArray Int --- -> MutableByteArray Int RealWorld - Int - -> Int8 - -> Int16 - -> Int32 - -> Int64 - -> Word8 - -> Word16 - -> Word32 - -> Word64 - -> Float - -> Double - -> IO Int + sink :: --ForeignObj +-- -> ByteArray Int +-- -> MutableByteArray Int RealWorld + Int + -> Int8 + -> Int16 + -> Int32 + -> Int64 + -> Word8 + -> Word16 + -> Word32 + -> Word64 + -> Float + -> Double + -> IO Int sink = undefined sink2 = undefined foreign export ccall dynamic - sink2 :: (--ForeignObj --- -> ByteArray Int --- -> MutableByteArray Int RealWorld - StablePtr a - -> Int - -> Int8 - -> Int16 - -> Int32 - -> Int64 - -> Word8 - -> Word16 - -> Word32 - -> Word64 - -> Float - -> Double - -> IO ()) - -> IO Addr + sink2 :: (--ForeignObj +-- -> ByteArray Int +-- -> MutableByteArray Int RealWorld + StablePtr a + -> Int + -> Int8 + -> Int16 + -> Int32 + -> Int64 + -> Word8 + -> Word16 + -> Word32 + -> Word64 + -> Float + -> Double + -> IO ()) + -> IO Addr -} diff --git a/testsuite/tests/ffi/should_fail/ccfail002.hs b/testsuite/tests/ffi/should_fail/ccfail002.hs index 977faa2f7c..86d5e9a1ba 100644 --- a/testsuite/tests/ffi/should_fail/ccfail002.hs +++ b/testsuite/tests/ffi/should_fail/ccfail002.hs @@ -7,5 +7,5 @@ module ShouldFail where import GHC.Exts -foreign import ccall unsafe "foo" - foo :: Int# -> Int# -> Int# -> (# Int# , Int#, Int# #) +foreign import ccall unsafe "foo" + foo :: Int# -> Int# -> Int# -> (# Int# , Int#, Int# #) diff --git a/testsuite/tests/ffi/should_run/fed001.hs b/testsuite/tests/ffi/should_run/fed001.hs index a832c58ac4..8c48cc29d8 100644 --- a/testsuite/tests/ffi/should_run/fed001.hs +++ b/testsuite/tests/ffi/should_run/fed001.hs @@ -6,12 +6,12 @@ type CInt = Int32 type CSize = Word32 foreign import ccall "wrapper" - mkComparator :: (Ptr Int -> Ptr Int -> IO CInt) - -> IO (Ptr (Ptr Int -> Ptr Int -> IO CInt)) + mkComparator :: (Ptr Int -> Ptr Int -> IO CInt) + -> IO (Ptr (Ptr Int -> Ptr Int -> IO CInt)) foreign import ccall - qsort :: Ptr Int -> CSize -> CSize -> Ptr (Ptr Int -> Ptr Int -> IO CInt) - -> IO () + qsort :: Ptr Int -> CSize -> CSize -> Ptr (Ptr Int -> Ptr Int -> IO CInt) + -> IO () compareInts :: Ptr Int -> Ptr Int -> IO CInt compareInts a1 a2 = do diff --git a/testsuite/tests/ffi/should_run/ffi001.hs b/testsuite/tests/ffi/should_run/ffi001.hs index 864b0bda45..42f2b3f883 100644 --- a/testsuite/tests/ffi/should_run/ffi001.hs +++ b/testsuite/tests/ffi/should_run/ffi001.hs @@ -3,17 +3,17 @@ -- !!! A simple FFI test -- This one provoked a bogus renamer error in 4.08.1: --- panic: tcLookupGlobalValue: <THIS>.PrelIOBase.returnIO{-0B,s-} +-- panic: tcLookupGlobalValue: <THIS>.PrelIOBase.returnIO{-0B,s-} -- (the error was actually in DsMonad.dsLookupGlobalValue!) module Main where import Foreign -foreign export ccall "gccd" mygcd :: Int -> Int -> Int +foreign export ccall "gccd" mygcd :: Int -> Int -> Int main = putStrLn "No bug" -mygcd a b = if (a==b) then a - else if (a<b) then mygcd a (b-a) - else mygcd (a-b) a +mygcd a b = if (a==b) then a + else if (a<b) then mygcd a (b-a) + else mygcd (a-b) a diff --git a/testsuite/tests/ffi/should_run/ffi004.hs b/testsuite/tests/ffi/should_run/ffi004.hs index 546cd15068..c811fb3bc0 100644 --- a/testsuite/tests/ffi/should_run/ffi004.hs +++ b/testsuite/tests/ffi/should_run/ffi004.hs @@ -5,18 +5,18 @@ import Foreign.C -main = - withCString "Testing %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d\n" $ \cstr -> +main = + withCString "Testing %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d\n" $ \cstr -> printf cstr - 0 1 2 3 4 5 6 7 8 9 - 10 11 12 13 14 15 16 17 18 19 - 20 21 22 23 24 25 26 27 28 29 - 30 31 32 33 34 35 36 37 38 39 + 0 1 2 3 4 5 6 7 8 9 + 10 11 12 13 14 15 16 17 18 19 + 20 21 22 23 24 25 26 27 28 29 + 30 31 32 33 34 35 36 37 38 39 -foreign import ccall unsafe +foreign import ccall unsafe printf :: CString - -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int - -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int - -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int - -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int - -> IO () + -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int + -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int + -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int + -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int + -> IO () diff --git a/testsuite/tests/ffi/should_run/ffi013.hs b/testsuite/tests/ffi/should_run/ffi013.hs index ae38c71b10..6887a10db9 100644 --- a/testsuite/tests/ffi/should_run/ffi013.hs +++ b/testsuite/tests/ffi/should_run/ffi013.hs @@ -2,12 +2,12 @@ import Foreign import Foreign.C.Types foreign import ccall "wrapper" - mkComparator :: (Ptr Int -> Ptr Int -> IO CInt) - -> IO (FunPtr (Ptr Int -> Ptr Int -> IO CInt)) + mkComparator :: (Ptr Int -> Ptr Int -> IO CInt) + -> IO (FunPtr (Ptr Int -> Ptr Int -> IO CInt)) foreign import ccall - qsort :: Ptr Int -> CSize -> CSize -> FunPtr (Ptr Int -> Ptr Int -> IO CInt) - -> IO () + qsort :: Ptr Int -> CSize -> CSize -> FunPtr (Ptr Int -> Ptr Int -> IO CInt) + -> IO () compareInts :: Ptr Int -> Ptr Int -> IO CInt compareInts a1 a2 = do diff --git a/testsuite/tests/numeric/should_run/arith001.hs b/testsuite/tests/numeric/should_run/arith001.hs index ed9cd5febc..b22461af3f 100644 --- a/testsuite/tests/numeric/should_run/arith001.hs +++ b/testsuite/tests/numeric/should_run/arith001.hs @@ -3,15 +3,15 @@ import Data.Ratio main = putStr (show r42 ++ "\n" ++ - show nu42 ++ ", " ++ - show de42 ++ "\n" ++ - show nu42d ++ ", " ++ - show de42d ++ "\n" ++ - show s2 ++ ", " ++ - show e2 ++ "\n" ++ - show s ++ ", " ++ - show e ++ "\n" ) - where + show nu42 ++ ", " ++ + show de42 ++ "\n" ++ + show nu42d ++ ", " ++ + show de42d ++ "\n" ++ + show s2 ++ ", " ++ + show e2 ++ "\n" ++ + show s ++ ", " ++ + show e ++ "\n" ) + where d42 :: Double r42 :: Rational nu42, de42 :: Integer @@ -24,5 +24,5 @@ main = putStr (show r42 ++ "\n" ++ nu42d= fromInteger nu42 de42d= fromInteger de42 - (s,e)= decodeFloat (nu42d / de42d ) + (s,e)= decodeFloat (nu42d / de42d ) (s2,e2) = decodeFloat d42 diff --git a/testsuite/tests/numeric/should_run/arith002.hs b/testsuite/tests/numeric/should_run/arith002.hs index b7f5acf136..7d3a06438e 100644 --- a/testsuite/tests/numeric/should_run/arith002.hs +++ b/testsuite/tests/numeric/should_run/arith002.hs @@ -5,35 +5,35 @@ import Data.Ratio main = putStr (-- Ratio Ints - show [i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc] + show [i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc] ++ "\n" - -- the Ints + -- the Ints ++ show ((map numerator [i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc]) - ++(map denominator [i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc])) + ++(map denominator [i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc])) ++ "\n" - -- Booleans --- ++ show [] + -- Booleans +-- ++ show [] -- ++ "\n" - -- Rationals (Ratio Integers) - ++ show [r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc] + -- Rationals (Ratio Integers) + ++ show [r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc] ++ "\n" - -- the Integers + -- the Integers ++ show ((map numerator [r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc]) - ++(map denominator [r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc])) + ++(map denominator [r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc])) ++ "\n" - -- Booleans --- ++ show [] + -- Booleans +-- ++ show [] -- ++ "\n" - ) - where + ) + where i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc :: Ratio Int - i0a = 0 % 1 - i0b = (-0) % 1 - i0c = 0 % (-1) - i2a = 4 % 2 - i2b = (-4) % (-2) + i0a = 0 % 1 + i0b = (-0) % 1 + i0c = 0 % (-1) + i2a = 4 % 2 + i2b = (-4) % (-2) im2a = (-4) % 2 im2b = 4 % (-2) i_pi = 22 % 7 @@ -41,11 +41,11 @@ main r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc :: Rational - r0a = 0 % 1 - r0b = (-0) % 1 - r0c = 0 % (-1) - r2a = 4 % 2 - r2b = (-4) % (-2) + r0a = 0 % 1 + r0b = (-0) % 1 + r0c = 0 % (-1) + r2a = 4 % 2 + r2b = (-4) % (-2) rm2a = (-4) % 2 rm2b = 4 % (-2) r_pi = 22 % 7 diff --git a/testsuite/tests/numeric/should_run/arith003.hs b/testsuite/tests/numeric/should_run/arith003.hs index 6bacbf1dee..e08890c68f 100644 --- a/testsuite/tests/numeric/should_run/arith003.hs +++ b/testsuite/tests/numeric/should_run/arith003.hs @@ -6,9 +6,9 @@ main = putStr ( - showit (do_ops int_ops) ++ - showit (do_ops integer_ops) - ) + showit (do_ops int_ops) ++ + showit (do_ops integer_ops) + ) showit :: (Show a, Integral a) => [(String, a, a, a)] -> String showit stuff = concat @@ -17,7 +17,7 @@ showit stuff = concat ] do_ops :: Integral a => [((a -> a -> a), String, [(a,a)])] - -> [(String, a, a, a)] + -> [(String, a, a, a)] do_ops ops = [ (str, l, r, l `op` r) | (op,str,args) <- ops, (l,r) <- args ] small_operands, non_min_operands, operands, non_max_operands @@ -28,17 +28,17 @@ non_min_operands = small_operands ++ [ fromIntegral maxInt ] non_max_operands = small_operands ++ [ fromIntegral minInt ] large_operands :: [ Integer ] -large_operands = operands ++ +large_operands = operands ++ [ fromIntegral minInt - 1, fromIntegral maxInt + 1, fromIntegral minInt * 2, fromIntegral maxInt * 2, - fromIntegral minInt ^ 2, + fromIntegral minInt ^ 2, fromIntegral maxInt ^ 2 ] integer_ops :: [((Integer -> Integer -> Integer), String, [(Integer,Integer)])] -integer_ops = [ +integer_ops = [ ((+), "(+)", both_large), ((-), "(-)", both_large), (div, "div", large_non_zero_r), @@ -50,7 +50,7 @@ integer_ops = [ ] int_ops :: [((Int -> Int -> Int), String, [(Int,Int)])] -int_ops = [ +int_ops = [ ((+), "(+)", both_small), ((-), "(-)", both_small), ((^), "(^)", small_non_neg_r), @@ -71,7 +71,7 @@ both_small, non_zero_r, non_min_either_non_zero, non_min_l_or_zero_r, :: Integral a => [(a,a)] both_small = [ (l,r) | l <- operands, r <- operands ] -both_large = [ (l,r) | l <- large_operands, r <- large_operands ] +both_large = [ (l,r) | l <- large_operands, r <- large_operands ] large_non_zero_r = [ (l,r) | l <- operands, r <- large_operands, r /= 0 ] non_zero_r = [ (l,r) | l <- operands, r <- operands, r /= 0 ] non_min_either_non_zero = [ (l,r) | l <- non_min_operands, r <- non_min_operands, l /= 0 || r /= 0 ] diff --git a/testsuite/tests/numeric/should_run/arith004.hs b/testsuite/tests/numeric/should_run/arith004.hs index 68e601128e..8001b05d59 100644 --- a/testsuite/tests/numeric/should_run/arith004.hs +++ b/testsuite/tests/numeric/should_run/arith004.hs @@ -3,81 +3,81 @@ main = putStr (-- w/ Ints and Integers - show (unzipWith div ints_list) - ++ "\n" - ++ show (unzipWith div integers_list) - ++ "\n" - ++ show (unzipWith rem ints_list) - ++ "\n" - ++ show (unzipWith rem integers_list) - ++ "\n" - ++ show (unzipWith quot ints_list) - ++ "\n" - ++ show (unzipWith quot integers_list) - ++ "\n" - ++ show (unzipWith mod ints_list) - ++ "\n" - ++ show (unzipWith mod integers_list) - ++ "\n" - ++ show (unzipWith law1 ints_list) - ++ "\n" - ++ show (unzipWith law1 integers_list) - ++ "\n" - ++ show (unzipWith law2 ints_list) - ++ "\n" - ++ show (unzipWith law2 integers_list) - ++ "\n" - ) + show (unzipWith div ints_list) + ++ "\n" + ++ show (unzipWith div integers_list) + ++ "\n" + ++ show (unzipWith rem ints_list) + ++ "\n" + ++ show (unzipWith rem integers_list) + ++ "\n" + ++ show (unzipWith quot ints_list) + ++ "\n" + ++ show (unzipWith quot integers_list) + ++ "\n" + ++ show (unzipWith mod ints_list) + ++ "\n" + ++ show (unzipWith mod integers_list) + ++ "\n" + ++ show (unzipWith law1 ints_list) + ++ "\n" + ++ show (unzipWith law1 integers_list) + ++ "\n" + ++ show (unzipWith law2 ints_list) + ++ "\n" + ++ show (unzipWith law2 integers_list) + ++ "\n" + ) where ints_list :: [(Int, Int)] integers_list :: [(Integer, Integer)] ints_list = [ - (0, 4), - (0, -8), - (7, 3), - (13, 4), - (13, -4), - (-13, 4), - (-13, -4), - (12345678, 10000), - (12345678, -10000), - (-12345678, 10000), - (-12345678, -10000), - (123456,10000), - (1234567,20000), - (12345678,-10000), - (123456789,10000), - (1234567890,-10000), - (-12345,10000), - (-123456789,-10000) - ] + (0, 4), + (0, -8), + (7, 3), + (13, 4), + (13, -4), + (-13, 4), + (-13, -4), + (12345678, 10000), + (12345678, -10000), + (-12345678, 10000), + (-12345678, -10000), + (123456,10000), + (1234567,20000), + (12345678,-10000), + (123456789,10000), + (1234567890,-10000), + (-12345,10000), + (-123456789,-10000) + ] integers_list = [ - (0, 4), - (0, -8), - (7, 3), - (13, 4), - (13, -4), - (-13, 4), - (-13, -4), - (12345678, 10000), - (12345678, -10000), - (-12345678, 10000), - (-12345678, -10000), - (123456,10000), - (1234567,20000), - (12345678,-10000), - (123456789,10000), - (1234567890,-10000), - (-12345,10000), - (-123456789,-10000), - (12345678900,500000000), - (1234000000000000000000005678900,5001111111111111000000) - ] + (0, 4), + (0, -8), + (7, 3), + (13, 4), + (13, -4), + (-13, 4), + (-13, -4), + (12345678, 10000), + (12345678, -10000), + (-12345678, 10000), + (-12345678, -10000), + (123456,10000), + (1234567,20000), + (12345678,-10000), + (123456789,10000), + (1234567890,-10000), + (-12345,10000), + (-123456789,-10000), + (12345678900,500000000), + (1234000000000000000000005678900,5001111111111111000000) + ] unzipWith :: (a -> b -> c) -> [(a,b)] -> [c] -unzipWith f [] = [] +unzipWith f [] = [] unzipWith f ((x,y):zs) = f x y : unzipWith f zs law1, law2 :: Integral a => a -> a -> Bool diff --git a/testsuite/tests/numeric/should_run/arith005.hs b/testsuite/tests/numeric/should_run/arith005.hs index 179d7b33dc..e1edfd874a 100644 --- a/testsuite/tests/numeric/should_run/arith005.hs +++ b/testsuite/tests/numeric/should_run/arith005.hs @@ -1,6 +1,6 @@ -- !!! test RealFrac ops (ceiling/floor/etc.) on Floats/Doubles -- -main = +main = putStr $ unlines [ -- just for fun, we show the floats to @@ -36,25 +36,25 @@ main = -- See bug #1254 small_float_list :: [Float] small_float_list = [ - 0.0, -0.0, 1.1, 2.8, 3.5, 4.5, -1.0000000001, -2.9999995, - -3.50000000001, -4.49999999999, 1000012.0, 123.456, 100.25, - 102.5, 0.0012, -0.00000012, 1.7e4, -1.7e-4, 0.15e-6, pi + 0.0, -0.0, 1.1, 2.8, 3.5, 4.5, -1.0000000001, -2.9999995, + -3.50000000001, -4.49999999999, 1000012.0, 123.456, 100.25, + 102.5, 0.0012, -0.00000012, 1.7e4, -1.7e-4, 0.15e-6, pi ] float_list :: [Float] float_list = small_float_list ++ [ - 1.18088e+11, 1.2111e+14 + 1.18088e+11, 1.2111e+14 ] -- these fit into an Int small_double_list :: [Double] small_double_list = [ - 0.0, -0.0, 1.1, 2.8, 3.5, 4.5, -1.0000000001, -2.9999995, - -3.50000000001, -4.49999999999, 1000012.0, 123.456, 100.25, - 102.5, 0.0012, -0.00000012, 1.7e4, -1.7e-4, 0.15e-6, pi + 0.0, -0.0, 1.1, 2.8, 3.5, 4.5, -1.0000000001, -2.9999995, + -3.50000000001, -4.49999999999, 1000012.0, 123.456, 100.25, + 102.5, 0.0012, -0.00000012, 1.7e4, -1.7e-4, 0.15e-6, pi ] double_list :: [Double] double_list = small_double_list ++ [ - 1.18088e+11, 1.2111e+14 + 1.18088e+11, 1.2111e+14 ] diff --git a/testsuite/tests/numeric/should_run/arith007.hs b/testsuite/tests/numeric/should_run/arith007.hs index 3d42d1fb10..e3d36a8651 100644 --- a/testsuite/tests/numeric/should_run/arith007.hs +++ b/testsuite/tests/numeric/should_run/arith007.hs @@ -12,12 +12,12 @@ main = do int_list = (map fromInteger integer_list) integer_list = (map (* 2) - [1,3,5,7,9, - 11111111111111111111111111111, - 2222222222222222222222222222222222222, - 3333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333, - -11111111111111111111111111111, - -2222222222222222222222222222222222222, - -3333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333 - ]) + [1,3,5,7,9, + 11111111111111111111111111111, + 2222222222222222222222222222222222222, + 3333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333, + -11111111111111111111111111111, + -2222222222222222222222222222222222222, + -3333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333 + ]) diff --git a/testsuite/tests/numeric/should_run/arith010.hs b/testsuite/tests/numeric/should_run/arith010.hs index 846f76e4d1..0b2f83f7ea 100644 --- a/testsuite/tests/numeric/should_run/arith010.hs +++ b/testsuite/tests/numeric/should_run/arith010.hs @@ -1,11 +1,11 @@ --- Tests enumerations +-- Tests enumerations main = do - print [1..10] - print [10..1] -- [] - print [1,3..10] - print [10,8..1] - print ['a'..'f'] - print ['f'..'a'] -- [] - print ['a','c'..'m'] - print ['m','l'..'a'] + print [1..10] + print [10..1] -- [] + print [1,3..10] + print [10,8..1] + print ['a'..'f'] + print ['f'..'a'] -- [] + print ['a','c'..'m'] + print ['m','l'..'a'] diff --git a/testsuite/tests/numeric/should_run/arith011.hs b/testsuite/tests/numeric/should_run/arith011.hs index d1b7c08939..4e23a8d99d 100644 --- a/testsuite/tests/numeric/should_run/arith011.hs +++ b/testsuite/tests/numeric/should_run/arith011.hs @@ -83,7 +83,7 @@ testConversions zero = do samples :: (Num a) => a -> [a] samples zero = map fromInteger ([-3 .. -1]++[0 .. 3]) - + table1 :: (Show a, Show b) => String -> (a -> b) -> [a] -> IO () table1 nm f xs = do sequence [ f' x | x <- xs ] @@ -94,7 +94,7 @@ table1 nm f xs = do table2 :: (Show a, Show b, Show c) => String -> (a -> b -> c) -> [a] -> [b] -> IO () table2 nm op xs ys = do sequence [ sequence [ op' x y | y <- ys ] >> putStrLn " " - | x <- xs + | x <- xs ] putStrLn "#" where @@ -120,19 +120,19 @@ testEq zero = do testOrd zero = do putStrLn "testOrd" - table2 "<=" (<=) xs xs - table2 "< " (<) xs xs - table2 "> " (>) xs xs - table2 ">=" (>=) xs xs + table2 "<=" (<=) xs xs + table2 "< " (<) xs xs + table2 "> " (>) xs xs + table2 ">=" (>=) xs xs table2 "`compare`" compare xs xs where xs = samples zero testNum zero = do putStrLn "testNum" - table2 "+" (+) xs xs - table2 "-" (-) xs xs - table2 "*" (*) xs xs + table2 "+" (+) xs xs + table2 "-" (-) xs xs + table2 "*" (*) xs xs table1 "negate" negate xs where xs = samples zero @@ -161,7 +161,7 @@ testBits zero do_bitsize = do table2 "`xor`" xor xs xs table1 "complement" complement xs table2 "`shiftL`" shiftL xs ([0..3] ++ [32,64]) - table2 "`shiftR`" shiftR xs ([0..3] ++ [32,64]) + table2 "`shiftR`" shiftR xs ([0..3] ++ [32,64]) table2 "`rotate`" rotate xs ([-3..3] ++ [-64,-32,32,64]) table1 "bit" (\ x -> (bit x) `asTypeOf` zero) [(0::Int)..3] table2 "`setBit`" setBit xs ([0..3] ++ [32,64]) diff --git a/testsuite/tests/numeric/should_run/arith012.hs b/testsuite/tests/numeric/should_run/arith012.hs index f9f9ec778e..e23b2f72ed 100644 --- a/testsuite/tests/numeric/should_run/arith012.hs +++ b/testsuite/tests/numeric/should_run/arith012.hs @@ -18,15 +18,15 @@ tst = do ---- -- Test data: doubles :: [Double] -doubles = [ -1.2 , 0, 0.1, 0.5, 1.0, 1234.45454, +doubles = [ -1.2 , 0, 0.1, 0.5, 1.0, 1234.45454, 1.6053e4, 1.64022e12, 6.894e-4, 6.34543455634582173, - 5342413403.40540423255] + 5342413403.40540423255] ints :: [Int] ints = [ 0, 1, 255, 65513, 6029, 1024, 256, 201357245] integers :: [Integer] integers = [ 0, 1, 255, 65513, 6029, 1024, 256, - 2343243543500233, 656194962055457832] + 2343243543500233, 656194962055457832] --- test_doubleToFloat :: IO () @@ -69,7 +69,7 @@ showBin i = showIntAtBase 2 intToDigit i showList' :: [ShowS] -> String showList' [] = "[]" showList' (x:xs) = showChar '[' . x $ showl xs "" - where + where showl [] = showChar ']' showl (x:xs) = showChar ',' . x . showl xs diff --git a/testsuite/tests/numeric/should_run/arith016.hs b/testsuite/tests/numeric/should_run/arith016.hs index a219b5575e..82d76a6896 100644 --- a/testsuite/tests/numeric/should_run/arith016.hs +++ b/testsuite/tests/numeric/should_run/arith016.hs @@ -3,10 +3,10 @@ module Main where import GHC.Exts ( Float(F#), - eqFloat#, neFloat#, ltFloat#, - leFloat#, gtFloat#, geFloat#, + eqFloat#, neFloat#, ltFloat#, + leFloat#, gtFloat#, geFloat#, isTrue# - ) + ) fcmp_eq, fcmp_ne, fcmp_lt, fcmp_le, fcmp_gt, fcmp_ge :: (String, Float -> Float -> Bool) fcmp_eq = ("==", \ (F# a) (F# b) -> isTrue# (a `eqFloat#` b)) diff --git a/testsuite/tests/numeric/should_run/arith017.hs b/testsuite/tests/numeric/should_run/arith017.hs index 86048dcbe3..68b39fc979 100644 --- a/testsuite/tests/numeric/should_run/arith017.hs +++ b/testsuite/tests/numeric/should_run/arith017.hs @@ -5,6 +5,6 @@ import Data.Word main = do print (fromIntegral ((2^30 -1 + 2^30) - (2^30 + 2^30 :: Integer)) - :: Data.Int.Int64) + :: Data.Int.Int64) print (fromIntegral ((2^30 -1 + 2^30) - (2^30 + 2^30 :: Integer)) - :: Data.Word.Word64) + :: Data.Word.Word64) diff --git a/testsuite/tests/numeric/should_run/numrun009.hs b/testsuite/tests/numeric/should_run/numrun009.hs index 37d0513a39..622458143f 100644 --- a/testsuite/tests/numeric/should_run/numrun009.hs +++ b/testsuite/tests/numeric/should_run/numrun009.hs @@ -3,15 +3,15 @@ -- (not necessarily Haskell 98: relies on Int being a 32-bit type.) main = do - print (-2147483648 :: Int) -- -2147483648 - print ((-2147483647)-1 :: Int) -- -2147483648 - print (-2147483648 :: Integer) -- -2147483648 - print ((-2147483648 :: Int) >= 0) -- False - print ((-2147483648 :: Integer) >= 0) -- False - print (-(-2147483648) :: Int) -- <undefined> - print (abs (-2147483648) :: Int) -- <undefined> - print (abs ((-2147483647)-1) :: Int) -- <undefined> - print (abs (-2147483648) :: Integer) -- 2147483648 - print (abs ((-2147483647)-1) :: Integer) -- 2147483648 (wrong in 4.04) - print (fromInteger (-2147483648 :: Integer) :: Int) -- -2147483648 + print (-2147483648 :: Int) -- -2147483648 + print ((-2147483647)-1 :: Int) -- -2147483648 + print (-2147483648 :: Integer) -- -2147483648 + print ((-2147483648 :: Int) >= 0) -- False + print ((-2147483648 :: Integer) >= 0) -- False + print (-(-2147483648) :: Int) -- <undefined> + print (abs (-2147483648) :: Int) -- <undefined> + print (abs ((-2147483647)-1) :: Int) -- <undefined> + print (abs (-2147483648) :: Integer) -- 2147483648 + print (abs ((-2147483647)-1) :: Integer) -- 2147483648 (wrong in 4.04) + print (fromInteger (-2147483648 :: Integer) :: Int) -- -2147483648 print (fromInteger ((-2147483647)-1 :: Integer) :: Int) -- -2147483648 diff --git a/testsuite/tests/parser/should_compile/read026.hs b/testsuite/tests/parser/should_compile/read026.hs index 0ea695d373..0605ca054d 100644 --- a/testsuite/tests/parser/should_compile/read026.hs +++ b/testsuite/tests/parser/should_compile/read026.hs @@ -1,6 +1,6 @@ module ShouldCompile where (<>) :: (a -> Maybe b) -> (b -> Maybe c) -> (a -> Maybe c) -(m1 <> m2) a1 = case m1 a1 of +(m1 <> m2) a1 = case m1 a1 of Nothing -> Nothing Just a2 -> m2 a2 diff --git a/testsuite/tests/parser/should_compile/read029.hs b/testsuite/tests/parser/should_compile/read029.hs index 1a9e5c1c9e..191ef05877 100644 --- a/testsuite/tests/parser/should_compile/read029.hs +++ b/testsuite/tests/parser/should_compile/read029.hs @@ -1,14 +1,14 @@ -- !!! Special Ids and ops --- The special ids 'as', 'qualified' and 'hiding' should be +-- The special ids 'as', 'qualified' and 'hiding' should be -- OK in both qualified and unqualified form. -- Ditto special ops module ShouldCompile where import Prelude hiding ( (-) ) -as = ShouldCompile.as -hiding = ShouldCompile.hiding +as = ShouldCompile.as +hiding = ShouldCompile.hiding qualified = ShouldCompile.qualified -x!y = x ShouldCompile.! y -x-y = x ShouldCompile.- y +x!y = x ShouldCompile.! y +x-y = x ShouldCompile.- y diff --git a/testsuite/tests/parser/should_compile/read040.hs b/testsuite/tests/parser/should_compile/read040.hs index e6d6629744..cddd24b3fa 100644 --- a/testsuite/tests/parser/should_compile/read040.hs +++ b/testsuite/tests/parser/should_compile/read040.hs @@ -4,5 +4,5 @@ module ShouldCompile where -f () = do { x :: Bool <- return True - ; return x } +f () = do { x :: Bool <- return True + ; return x } diff --git a/testsuite/tests/parser/should_compile/read044.hs b/testsuite/tests/parser/should_compile/read044.hs index a92b48c298..f7e72fba2c 100644 --- a/testsuite/tests/parser/should_compile/read044.hs +++ b/testsuite/tests/parser/should_compile/read044.hs @@ -1,5 +1,5 @@ -- test case from #1091 main = - case True of {- | -} - True -> putStrLn "Hello World\n" - False {- | -} -> putStrLn "Goodbye Cruel World\n" + case True of {- | -} + True -> putStrLn "Hello World\n" + False {- | -} -> putStrLn "Goodbye Cruel World\n" diff --git a/testsuite/tests/parser/should_fail/readFail001.hs b/testsuite/tests/parser/should_fail/readFail001.hs index a996475efd..6b186922f3 100644 --- a/testsuite/tests/parser/should_fail/readFail001.hs +++ b/testsuite/tests/parser/should_fail/readFail001.hs @@ -3,15 +3,15 @@ -- HsImpExp stuff module OneOfEverything ( - fixn, - FooData, - FooDataB(..), - FooDataC( .. ), - Tree(Leaf, Branch), - EqClass(..), - OrdClass(orda, ordb), - module OneC , - module OneOfEverything + fixn, + FooData, + FooDataB(..), + FooDataC( .. ), + Tree(Leaf, Branch), + EqClass(..), + OrdClass(orda, ordb), + module OneC , + module OneOfEverything ) where import Prelude @@ -21,9 +21,9 @@ import Control.Monad -- HsDecls stuff -infix 6 `fixn` -infixl 7 +# -infixr 8 `fixr` +infix 6 `fixn` +infixl 7 +# +infixr 8 `fixr` fixn x y = x fixl x y = x @@ -61,19 +61,19 @@ bindwith a b = b reca a = recb a recb a = reca a -(~(a,b,c)) | nullity b = a - | nullity c = a - | otherwise = a - where - nullity = null +(~(a,b,c)) | nullity b = a + | nullity c = a + | otherwise = a + where + nullity = null -- HsMatches stuff mat a b c d | foof a b = d - | foof a c = d - | foof b c = d - where - foof a b = a == b + | foof a c = d + | foof b c = d + where + foof a b = a == b -- HsExpr stuff expr a b c d @@ -85,11 +85,11 @@ expr a b c d + (9 *) + (* 8) + (case x of - [] | null x -> 99 - | otherwise -> 98 - | True -> 97 - where - null x = False + [] | null x -> 99 + | otherwise -> 98 + | True -> 97 + where + null x = False ) + [ z | z <- c, isSpace z ] + let y = foo diff --git a/testsuite/tests/parser/should_fail/readFail003.hs b/testsuite/tests/parser/should_fail/readFail003.hs index 8a60e8eca4..95b0cf1f7b 100644 --- a/testsuite/tests/parser/should_fail/readFail003.hs +++ b/testsuite/tests/parser/should_fail/readFail003.hs @@ -1,8 +1,8 @@ -- !!! Irrefutable patterns + guards module Read003 where import GHC.List; import Prelude hiding (null) -~(a,b,c) | nullity b = a - | nullity c = a - | otherwise = a - where - nullity = null +~(a,b,c) | nullity b = a + | nullity c = a + | otherwise = a + where + nullity = null diff --git a/testsuite/tests/parser/should_fail/readFail009.hs b/testsuite/tests/parser/should_fail/readFail009.hs index 93a7b84d5b..5a98939fad 100644 --- a/testsuite/tests/parser/should_fail/readFail009.hs +++ b/testsuite/tests/parser/should_fail/readFail009.hs @@ -3,8 +3,8 @@ module ShouldFail where -- !!! Test for parse error in do/let expression foo = do let foo = True - return () - + return () + -- Note the let binding at the end! -- This gave a pattern-match failure in tcStmts in ghc-4.04proto diff --git a/testsuite/tests/parser/should_fail/readFail011.hs b/testsuite/tests/parser/should_fail/readFail011.hs index 4642061fcc..a1a89781da 100644 --- a/testsuite/tests/parser/should_fail/readFail011.hs +++ b/testsuite/tests/parser/should_fail/readFail011.hs @@ -1,7 +1,7 @@ -- !!! Test line numbers in presence of string gaps. main = print "a\ - \b\ - \c" + \b\ + \c" wibble = = -- this is a parse error on line 7 diff --git a/testsuite/tests/parser/should_fail/readFail012.hs b/testsuite/tests/parser/should_fail/readFail012.hs index 4a780885f7..ffeb6adffd 100644 --- a/testsuite/tests/parser/should_fail/readFail012.hs +++ b/testsuite/tests/parser/should_fail/readFail012.hs @@ -2,8 +2,8 @@ -- used to report "Parse error on input `'" in 4.04pl0. -main = let - f = (a, - g = 1 - in f +main = let + f = (a, + g = 1 + in f diff --git a/testsuite/tests/parser/should_fail/readFail023.hs b/testsuite/tests/parser/should_fail/readFail023.hs index 9c230f8a6a..47e84e6d66 100644 --- a/testsuite/tests/parser/should_fail/readFail023.hs +++ b/testsuite/tests/parser/should_fail/readFail023.hs @@ -8,5 +8,5 @@ module ShouldFail where k = (-3 **) where - (**) = const - infixl 7 ** + (**) = const + infixl 7 ** diff --git a/testsuite/tests/parser/unicode/T1103.hs b/testsuite/tests/parser/unicode/T1103.hs index 6d10064056..c3062e528b 100644 --- a/testsuite/tests/parser/unicode/T1103.hs +++ b/testsuite/tests/parser/unicode/T1103.hs @@ -1,6 +1,6 @@ {-# LANGUAGE UnicodeSyntax #-} {- - Three kinds of Unicode tests for our purposes. + Three kinds of Unicode tests for our purposes. -} module UniTest where @@ -9,5 +9,5 @@ module UniTest where てすと3 ∷ IO () てすと3 = do - putStrLn $ show 人間虫 where - 人間虫 = "humasect" + putStrLn $ show 人間虫 where + 人間虫 = "humasect" diff --git a/testsuite/tests/parser/unicode/utf8_024.hs b/testsuite/tests/parser/unicode/utf8_024.hs index 1e491f75ec..d77a79f8fd 100644 --- a/testsuite/tests/parser/unicode/utf8_024.hs +++ b/testsuite/tests/parser/unicode/utf8_024.hs @@ -14,172 +14,172 @@ Here's a selection of characters I pulled from UnicodeData.txt that we can use to test with: -- upper/lower case letters -À LATIN CAPITAL LETTER A WITH GRAVE;Lu;0;L;0041 0300;;;;N;LATIN CAPITAL LETTER A GRAVE;;;00E0; -à LATIN SMALL LETTER A WITH GRAVE;Ll;0;L;0061 0300;;;;N;LATIN SMALL LETTER A GRAVE;;00C0;;00C0 +À LATIN CAPITAL LETTER A WITH GRAVE;Lu;0;L;0041 0300;;;;N;LATIN CAPITAL LETTER A GRAVE;;;00E0; +à LATIN SMALL LETTER A WITH GRAVE;Ll;0;L;0061 0300;;;;N;LATIN SMALL LETTER A GRAVE;;00C0;;00C0 -Α GREEK CAPITAL LETTER ALPHA;Lu;0;L;;;;;N;;;;03B1; -α GREEK SMALL LETTER ALPHA;Ll;0;L;;;;;N;;;0391;;0391 -α GREEK SMALL LETTER ALPHA;Ll;0;L;;;;;N;;;0391;;0391 -β GREEK SMALL LETTER BETA;Ll;0;L;;;;;N;;;0392;;0392 -γ GREEK SMALL LETTER GAMMA;Ll;0;L;;;;;N;;;0393;;0393 -δ GREEK SMALL LETTER DELTA;Ll;0;L;;;;;N;;;0394;;0394 +Α GREEK CAPITAL LETTER ALPHA;Lu;0;L;;;;;N;;;;03B1; +α GREEK SMALL LETTER ALPHA;Ll;0;L;;;;;N;;;0391;;0391 +α GREEK SMALL LETTER ALPHA;Ll;0;L;;;;;N;;;0391;;0391 +β GREEK SMALL LETTER BETA;Ll;0;L;;;;;N;;;0392;;0392 +γ GREEK SMALL LETTER GAMMA;Ll;0;L;;;;;N;;;0393;;0393 +δ GREEK SMALL LETTER DELTA;Ll;0;L;;;;;N;;;0394;;0394 -Ⴀ GEORGIAN CAPITAL LETTER AN;Lu;0;L;;;;;N;;Khutsuri;;; -ა GEORGIAN LETTER AN;Lo;0;L;;;;;N;GEORGIAN SMALL LETTER AN;;;; +Ⴀ GEORGIAN CAPITAL LETTER AN;Lu;0;L;;;;;N;;Khutsuri;;; +ა GEORGIAN LETTER AN;Lo;0;L;;;;;N;GEORGIAN SMALL LETTER AN;;;; -Ϣ COPTIC CAPITAL LETTER SHEI;Lu;0;L;;;;;N;GREEK CAPITAL LETTER SHEI;;;03E3; -ϣ COPTIC SMALL LETTER SHEI;Ll;0;L;;;;;N;GREEK SMALL LETTER SHEI;;03E2;;03E2 +Ϣ COPTIC CAPITAL LETTER SHEI;Lu;0;L;;;;;N;GREEK CAPITAL LETTER SHEI;;;03E3; +ϣ COPTIC SMALL LETTER SHEI;Ll;0;L;;;;;N;GREEK SMALL LETTER SHEI;;03E2;;03E2 -А CYRILLIC CAPITAL LETTER A;Lu;0;L;;;;;N;;;;0430; -а CYRILLIC SMALL LETTER A;Ll;0;L;;;;;N;;;0410;;0410 +А CYRILLIC CAPITAL LETTER A;Lu;0;L;;;;;N;;;;0430; +а CYRILLIC SMALL LETTER A;Ll;0;L;;;;;N;;;0410;;0410 -Ա ARMENIAN CAPITAL LETTER AYB;Lu;0;L;;;;;N;;;;0561; -ա ARMENIAN SMALL LETTER AYB;Ll;0;L;;;;;N;;;0531;;0531 +Ա ARMENIAN CAPITAL LETTER AYB;Lu;0;L;;;;;N;;;;0561; +ա ARMENIAN SMALL LETTER AYB;Ll;0;L;;;;;N;;;0531;;0531 -𝐴 MATHEMATICAL ITALIC CAPITAL A;Lu;0;L;<font> 0041;;;;N;;;;; -𝑎 MATHEMATICAL ITALIC SMALL A;Ll;0;L;<font> 0061;;;;N;;;;; +𝐴 MATHEMATICAL ITALIC CAPITAL A;Lu;0;L;<font> 0041;;;;N;;;;; +𝑎 MATHEMATICAL ITALIC SMALL A;Ll;0;L;<font> 0061;;;;N;;;;; -𝔸 MATHEMATICAL DOUBLE-STRUCK CAPITAL A;Lu;0;L;<font> 0041;;;;N;;;;; -𝕒 MATHEMATICAL DOUBLE-STRUCK SMALL A;Ll;0;L;<font> 0061;;;;N;;;;; +𝔸 MATHEMATICAL DOUBLE-STRUCK CAPITAL A;Lu;0;L;<font> 0041;;;;N;;;;; +𝕒 MATHEMATICAL DOUBLE-STRUCK SMALL A;Ll;0;L;<font> 0061;;;;N;;;;; -- title case letters -Dž LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON;Lt;0;L;<compat> 0044 017E;;;;N;LATIN LETTER CAPITAL D SMALL Z HACEK;;01C4;01C6;01C5 -Lj LATIN CAPITAL LETTER L WITH SMALL LETTER J;Lt;0;L;<compat> 004C 006A;;;;N;LATIN LETTER CAPITAL L SMALL J;;01C7;01C9;01C8 +Dž LATIN CAPITAL LETTER D WITH SMALL LETTER Z WITH CARON;Lt;0;L;<compat> 0044 017E;;;;N;LATIN LETTER CAPITAL D SMALL Z HACEK;;01C4;01C6;01C5 +Lj LATIN CAPITAL LETTER L WITH SMALL LETTER J;Lt;0;L;<compat> 004C 006A;;;;N;LATIN LETTER CAPITAL L SMALL J;;01C7;01C9;01C8 -- small caps -ᴀ LATIN LETTER SMALL CAPITAL A;Ll;0;L;;;;;N;;;;; -ᴦ GREEK LETTER SMALL CAPITAL GAMMA;Ll;0;L;;;;;N;;;;; +ᴀ LATIN LETTER SMALL CAPITAL A;Ll;0;L;;;;;N;;;;; +ᴦ GREEK LETTER SMALL CAPITAL GAMMA;Ll;0;L;;;;;N;;;;; -- caseless letters -ଅ ;ORIYA LETTER A;Lo;0;L;;;;;N;;;;; -அ TAMIL LETTER A;Lo;0;L;;;;;N;;;;; -అ TELUGU LETTER A;Lo;0;L;;;;;N;;;;; -ಅ KANNADA LETTER A;Lo;0;L;;;;;N;;;;; -അ MALAYALAM LETTER A;Lo;0;L;;;;;N;;;;; -අ SINHALA LETTER AYANNA;Lo;0;L;;;;;N;;;;; -ก THAI CHARACTER KO KAI;Lo;0;L;;;;;N;THAI LETTER KO KAI;;;; -ກ LAO LETTER KO;Lo;0;L;;;;;N;;;;; -ཀ TIBETAN LETTER KA;Lo;0;L;;;;;N;;;;; -က MYANMAR LETTER KA;Lo;0;L;;;;;N;;;;; -ᄀ HANGUL CHOSEONG KIYEOK;Lo;0;L;;;;;N;;g *;;; -ሀ ETHIOPIC SYLLABLE HA;Lo;0;L;;;;;N;;;;; -Ꭰ CHEROKEE LETTER A;Lo;0;L;;;;;N;;;;; -ᐁ CANADIAN SYLLABICS E;Lo;0;L;;;;;N;;;;; -ᚁ OGHAM LETTER BEITH;Lo;0;L;;;;;N;;;;; -ᚠ RUNIC LETTER FEHU FEOH FE F;Lo;0;L;;;;;N;;;;; -ᜀ TAGALOG LETTER A;Lo;0;L;;;;;N;;;;; -ᜠ HANUNOO LETTER A;Lo;0;L;;;;;N;;;;; -ᝀ BUHID LETTER A;Lo;0;L;;;;;N;;;;; -ᝠ TAGBANWA LETTER A;Lo;0;L;;;;;N;;;;; -ក KHMER LETTER KA;Lo;0;L;;;;;N;;;;; -ᠠ MONGOLIAN LETTER A;Lo;0;L;;;;;N;;;;; -ᤁ LIMBU LETTER KA;Lo;0;L;;;;;N;;;;; -ᥐ TAI LE LETTER KA;Lo;0;L;;;;;N;;;;; -ぁ HIRAGANA LETTER SMALL A;Lo;0;L;;;;;N;;;;; -ア KATAKANA LETTER A;Lo;0;L;;;;;N;;;;; -ㄅ BOPOMOFO LETTER B;Lo;0;L;;;;;N;;;;; -ㄱ HANGUL LETTER KIYEOK;Lo;0;L;<compat> 1100;;;;N;HANGUL LETTER GIYEOG;;;; -ㆠ BOPOMOFO LETTER BU;Lo;0;L;;;;;N;;;;; -ꀀ YI SYLLABLE IT;Lo;0;L;;;;;N;;;;; +ଅ ;ORIYA LETTER A;Lo;0;L;;;;;N;;;;; +அ TAMIL LETTER A;Lo;0;L;;;;;N;;;;; +అ TELUGU LETTER A;Lo;0;L;;;;;N;;;;; +ಅ KANNADA LETTER A;Lo;0;L;;;;;N;;;;; +അ MALAYALAM LETTER A;Lo;0;L;;;;;N;;;;; +අ SINHALA LETTER AYANNA;Lo;0;L;;;;;N;;;;; +ก THAI CHARACTER KO KAI;Lo;0;L;;;;;N;THAI LETTER KO KAI;;;; +ກ LAO LETTER KO;Lo;0;L;;;;;N;;;;; +ཀ TIBETAN LETTER KA;Lo;0;L;;;;;N;;;;; +က MYANMAR LETTER KA;Lo;0;L;;;;;N;;;;; +ᄀ HANGUL CHOSEONG KIYEOK;Lo;0;L;;;;;N;;g *;;; +ሀ ETHIOPIC SYLLABLE HA;Lo;0;L;;;;;N;;;;; +Ꭰ CHEROKEE LETTER A;Lo;0;L;;;;;N;;;;; +ᐁ CANADIAN SYLLABICS E;Lo;0;L;;;;;N;;;;; +ᚁ OGHAM LETTER BEITH;Lo;0;L;;;;;N;;;;; +ᚠ RUNIC LETTER FEHU FEOH FE F;Lo;0;L;;;;;N;;;;; +ᜀ TAGALOG LETTER A;Lo;0;L;;;;;N;;;;; +ᜠ HANUNOO LETTER A;Lo;0;L;;;;;N;;;;; +ᝀ BUHID LETTER A;Lo;0;L;;;;;N;;;;; +ᝠ TAGBANWA LETTER A;Lo;0;L;;;;;N;;;;; +ក KHMER LETTER KA;Lo;0;L;;;;;N;;;;; +ᠠ MONGOLIAN LETTER A;Lo;0;L;;;;;N;;;;; +ᤁ LIMBU LETTER KA;Lo;0;L;;;;;N;;;;; +ᥐ TAI LE LETTER KA;Lo;0;L;;;;;N;;;;; +ぁ HIRAGANA LETTER SMALL A;Lo;0;L;;;;;N;;;;; +ア KATAKANA LETTER A;Lo;0;L;;;;;N;;;;; +ㄅ BOPOMOFO LETTER B;Lo;0;L;;;;;N;;;;; +ㄱ HANGUL LETTER KIYEOK;Lo;0;L;<compat> 1100;;;;N;HANGUL LETTER GIYEOG;;;; +ㆠ BOPOMOFO LETTER BU;Lo;0;L;;;;;N;;;;; +ꀀ YI SYLLABLE IT;Lo;0;L;;;;;N;;;;; -- spaces - NO-BREAK SPACE;Zs;0;CS;<noBreak> 0020;;;;N;NON-BREAKING SPACE;;;; - EN QUAD;Zs;0;WS;2002;;;;N;;;;; - EN SPACE;Zs;0;WS;<compat> 0020;;;;N;;;;; - THIN SPACE;Zs;0;WS;<compat> 0020;;;;N;;;;; - ZERO WIDTH SPACE;Zs;0;BN;;;;;N;;;;; + NO-BREAK SPACE;Zs;0;CS;<noBreak> 0020;;;;N;NON-BREAKING SPACE;;;; + EN QUAD;Zs;0;WS;2002;;;;N;;;;; + EN SPACE;Zs;0;WS;<compat> 0020;;;;N;;;;; + THIN SPACE;Zs;0;WS;<compat> 0020;;;;N;;;;; + ZERO WIDTH SPACE;Zs;0;BN;;;;;N;;;;; -- some symbols we might find useful in Haskell -← LEFTWARDS ARROW;Sm;0;ON;;;;;N;LEFT ARROW;;;; -→ RIGHTWARDS ARROW;Sm;0;ON;;;;;N;RIGHT ARROW;;;; -‖ DOUBLE VERTICAL LINE;Po;0;ON;;;;;N;DOUBLE VERTICAL BAR;;;; -∀ FOR ALL;Sm;0;ON;;;;;N;;;;; -∁ COMPLEMENT;Sm;0;ON;;;;;Y;;;;; -∃ THERE EXISTS;Sm;0;ON;;;;;Y;;;;; -∄ THERE DOES NOT EXIST;Sm;0;ON;2203 0338;;;;Y;;;;; -∅ EMPTY SET;Sm;0;ON;;;;;N;;;;; -∆ INCREMENT;Sm;0;ON;;;;;N;;;;; -∇ NABLA;Sm;0;ON;;;;;N;;;;; -∈ ELEMENT OF;Sm;0;ON;;;;;Y;;;;; -∉ NOT AN ELEMENT OF;Sm;0;ON;2208 0338;;;;Y;;;;; -∏ N-ARY PRODUCT;Sm;0;ON;;;;;N;;;;; -∑ N-ARY SUMMATION;Sm;0;ON;;;;;Y;;;;; -− MINUS SIGN;Sm;0;ET;;;;;N;;;;; -∓ MINUS-OR-PLUS SIGN;Sm;0;ET;;;;;N;;;;; -∕ DIVISION SLASH;Sm;0;ON;;;;;Y;;;;; -∘ RING OPERATOR;Sm;0;ON;;;;;N;;;;; -∙ BULLET OPERATOR;Sm;0;ON;;;;;N;;;;; -√ SQUARE ROOT;Sm;0;ON;;;;;Y;;;;; -∧ LOGICAL AND;Sm;0;ON;;;;;N;;;;; -∨ LOGICAL OR;Sm;0;ON;;;;;N;;;;; -∩ INTERSECTION;Sm;0;ON;;;;;N;;;;; -∪ UNION;Sm;0;ON;;;;;N;;;;; -≃ ASYMPTOTICALLY EQUAL TO;Sm;0;ON;;;;;Y;;;;; -≈ ALMOST EQUAL TO;Sm;0;ON;;;;;Y;;;;; -≠ NOT EQUAL TO;Sm;0;ON;003D 0338;;;;Y;;;;; -≙ ESTIMATES;Sm;0;ON;;;;;N;;;;; -≤ LESS-THAN OR EQUAL TO;Sm;0;ON;;;;;Y;LESS THAN OR EQUAL TO;;;; -≥ GREATER-THAN OR EQUAL TO;Sm;0;ON;;;;;Y;GREATER THAN OR EQUAL TO;;;; -≪ MUCH LESS-THAN;Sm;0;ON;;;;;Y;MUCH LESS THAN;;;; -≫ MUCH GREATER-THAN;Sm;0;ON;;;;;Y;MUCH GREATER THAN;;;; -⊂ SUBSET OF;Sm;0;ON;;;;;Y;;;;; -⊃ SUPERSET OF;Sm;0;ON;;;;;Y;;;;; -⊄ NOT A SUBSET OF;Sm;0;ON;2282 0338;;;;Y;;;;; -⊅ NOT A SUPERSET OF;Sm;0;ON;2283 0338;;;;Y;;;;; -⊆ SUBSET OF OR EQUAL TO;Sm;0;ON;;;;;Y;;;;; -⊇ SUPERSET OF OR EQUAL TO;Sm;0;ON;;;;;Y;;;;; -⊕ CIRCLED PLUS;Sm;0;ON;;;;;N;;;;; -⊖ CIRCLED MINUS;Sm;0;ON;;;;;N;;;;; -⊗ CIRCLED TIMES;Sm;0;ON;;;;;N;;;;; -⊘ CIRCLED DIVISION SLASH;Sm;0;ON;;;;;Y;;;;; -⊙ CIRCLED DOT OPERATOR;Sm;0;ON;;;;;N;;;;; -⊢ RIGHT TACK;Sm;0;ON;;;;;Y;;;;; -⊣ LEFT TACK;Sm;0;ON;;;;;Y;;;;; -⊤ DOWN TACK;Sm;0;ON;;;;;N;;;;; -⊥ UP TACK;Sm;0;ON;;;;;N;;;;; -⊦ ASSERTION;Sm;0;ON;;;;;Y;;;;; -⊧ MODELS;Sm;0;ON;;;;;Y;;;;; -⊨ TRUE;Sm;0;ON;;;;;Y;;;;; -⋂ N-ARY INTERSECTION;Sm;0;ON;;;;;N;;;;; -⋃ N-ARY UNION;Sm;0;ON;;;;;N;;;;; -⋅ DOT OPERATOR;Sm;0;ON;;;;;N;;;;; -⋯ MIDLINE HORIZONTAL ELLIPSIS;Sm;0;ON;;;;;N;;;;; -〈 LEFT-POINTING ANGLE BRACKET;Ps;0;ON;3008;;;;Y;BRA;;;; -〉 RIGHT-POINTING ANGLE BRACKET;Pe;0;ON;3009;;;;Y;KET;;;; -☹ WHITE FROWNING FACE;So;0;ON;;;;;N;;;;; -☺ WHITE SMILING FACE;So;0;ON;;;;;N;;;;; -⧺ DOUBLE PLUS;Sm;0;ON;;;;;N;;;;; +← LEFTWARDS ARROW;Sm;0;ON;;;;;N;LEFT ARROW;;;; +→ RIGHTWARDS ARROW;Sm;0;ON;;;;;N;RIGHT ARROW;;;; +‖ DOUBLE VERTICAL LINE;Po;0;ON;;;;;N;DOUBLE VERTICAL BAR;;;; +∀ FOR ALL;Sm;0;ON;;;;;N;;;;; +∁ COMPLEMENT;Sm;0;ON;;;;;Y;;;;; +∃ THERE EXISTS;Sm;0;ON;;;;;Y;;;;; +∄ THERE DOES NOT EXIST;Sm;0;ON;2203 0338;;;;Y;;;;; +∅ EMPTY SET;Sm;0;ON;;;;;N;;;;; +∆ INCREMENT;Sm;0;ON;;;;;N;;;;; +∇ NABLA;Sm;0;ON;;;;;N;;;;; +∈ ELEMENT OF;Sm;0;ON;;;;;Y;;;;; +∉ NOT AN ELEMENT OF;Sm;0;ON;2208 0338;;;;Y;;;;; +∏ N-ARY PRODUCT;Sm;0;ON;;;;;N;;;;; +∑ N-ARY SUMMATION;Sm;0;ON;;;;;Y;;;;; +− MINUS SIGN;Sm;0;ET;;;;;N;;;;; +∓ MINUS-OR-PLUS SIGN;Sm;0;ET;;;;;N;;;;; +∕ DIVISION SLASH;Sm;0;ON;;;;;Y;;;;; +∘ RING OPERATOR;Sm;0;ON;;;;;N;;;;; +∙ BULLET OPERATOR;Sm;0;ON;;;;;N;;;;; +√ SQUARE ROOT;Sm;0;ON;;;;;Y;;;;; +∧ LOGICAL AND;Sm;0;ON;;;;;N;;;;; +∨ LOGICAL OR;Sm;0;ON;;;;;N;;;;; +∩ INTERSECTION;Sm;0;ON;;;;;N;;;;; +∪ UNION;Sm;0;ON;;;;;N;;;;; +≃ ASYMPTOTICALLY EQUAL TO;Sm;0;ON;;;;;Y;;;;; +≈ ALMOST EQUAL TO;Sm;0;ON;;;;;Y;;;;; +≠ NOT EQUAL TO;Sm;0;ON;003D 0338;;;;Y;;;;; +≙ ESTIMATES;Sm;0;ON;;;;;N;;;;; +≤ LESS-THAN OR EQUAL TO;Sm;0;ON;;;;;Y;LESS THAN OR EQUAL TO;;;; +≥ GREATER-THAN OR EQUAL TO;Sm;0;ON;;;;;Y;GREATER THAN OR EQUAL TO;;;; +≪ MUCH LESS-THAN;Sm;0;ON;;;;;Y;MUCH LESS THAN;;;; +≫ MUCH GREATER-THAN;Sm;0;ON;;;;;Y;MUCH GREATER THAN;;;; +⊂ SUBSET OF;Sm;0;ON;;;;;Y;;;;; +⊃ SUPERSET OF;Sm;0;ON;;;;;Y;;;;; +⊄ NOT A SUBSET OF;Sm;0;ON;2282 0338;;;;Y;;;;; +⊅ NOT A SUPERSET OF;Sm;0;ON;2283 0338;;;;Y;;;;; +⊆ SUBSET OF OR EQUAL TO;Sm;0;ON;;;;;Y;;;;; +⊇ SUPERSET OF OR EQUAL TO;Sm;0;ON;;;;;Y;;;;; +⊕ CIRCLED PLUS;Sm;0;ON;;;;;N;;;;; +⊖ CIRCLED MINUS;Sm;0;ON;;;;;N;;;;; +⊗ CIRCLED TIMES;Sm;0;ON;;;;;N;;;;; +⊘ CIRCLED DIVISION SLASH;Sm;0;ON;;;;;Y;;;;; +⊙ CIRCLED DOT OPERATOR;Sm;0;ON;;;;;N;;;;; +⊢ RIGHT TACK;Sm;0;ON;;;;;Y;;;;; +⊣ LEFT TACK;Sm;0;ON;;;;;Y;;;;; +⊤ DOWN TACK;Sm;0;ON;;;;;N;;;;; +⊥ UP TACK;Sm;0;ON;;;;;N;;;;; +⊦ ASSERTION;Sm;0;ON;;;;;Y;;;;; +⊧ MODELS;Sm;0;ON;;;;;Y;;;;; +⊨ TRUE;Sm;0;ON;;;;;Y;;;;; +⋂ N-ARY INTERSECTION;Sm;0;ON;;;;;N;;;;; +⋃ N-ARY UNION;Sm;0;ON;;;;;N;;;;; +⋅ DOT OPERATOR;Sm;0;ON;;;;;N;;;;; +⋯ MIDLINE HORIZONTAL ELLIPSIS;Sm;0;ON;;;;;N;;;;; +〈 LEFT-POINTING ANGLE BRACKET;Ps;0;ON;3008;;;;Y;BRA;;;; +〉 RIGHT-POINTING ANGLE BRACKET;Pe;0;ON;3009;;;;Y;KET;;;; +☹ WHITE FROWNING FACE;So;0;ON;;;;;N;;;;; +☺ WHITE SMILING FACE;So;0;ON;;;;;N;;;;; +⧺ DOUBLE PLUS;Sm;0;ON;;;;;N;;;;; -- other random symbols -☣ BIOHAZARD SIGN;So;0;ON;;;;;N;;;;; -𝄬 MUSICAL SYMBOL FLAT UP;So;0;L;;;;;N;;;;; -𝌋 TETRAGRAM FOR CONTRARIETY;So;0;ON;;;;;N;;;;; +☣ BIOHAZARD SIGN;So;0;ON;;;;;N;;;;; +𝄬 MUSICAL SYMBOL FLAT UP;So;0;L;;;;;N;;;;; +𝌋 TETRAGRAM FOR CONTRARIETY;So;0;ON;;;;;N;;;;; -- braille -⡍ ;BRAILLE PATTERN DOTS-1347;So;0;ON;;;;;N;;;;; -⣿ ;BRAILLE PATTERN DOTS-12345678;So;0;ON;;;;;N;;;;; +⡍ ;BRAILLE PATTERN DOTS-1347;So;0;ON;;;;;N;;;;; +⣿ ;BRAILLE PATTERN DOTS-12345678;So;0;ON;;;;;N;;;;; -- numbers -Ⅰ ;ROMAN NUMERAL ONE;Nl;0;L;<compat> 0049;;;1;N;;;;2170; -Ⅼ ;ROMAN NUMERAL FIFTY;Nl;0;L;<compat> 004C;;;50;N;;;;217C; -① ;CIRCLED DIGIT ONE;No;0;EN;<circle> 0031;;1;1;N;;;;; -⑴ ;PARENTHESIZED DIGIT ONE;No;0;EN;<compat> 0028 0031 0029;;1;1;N;;;;; -⒈ ;DIGIT ONE FULL STOP;No;0;EN;<compat> 0031 002E;;1;1;N;DIGIT ONE PERIOD;;;; +Ⅰ ;ROMAN NUMERAL ONE;Nl;0;L;<compat> 0049;;;1;N;;;;2170; +Ⅼ ;ROMAN NUMERAL FIFTY;Nl;0;L;<compat> 004C;;;50;N;;;;217C; +① ;CIRCLED DIGIT ONE;No;0;EN;<circle> 0031;;1;1;N;;;;; +⑴ ;PARENTHESIZED DIGIT ONE;No;0;EN;<compat> 0028 0031 0029;;1;1;N;;;;; +⒈ ;DIGIT ONE FULL STOP;No;0;EN;<compat> 0031 002E;;1;1;N;DIGIT ONE PERIOD;;;; -} module Main where -- Test upper-case recognition: -data T - = À -- latin - | Α -- greek - | Ⴀ -- georgian - | Ϣ -- coptic - | А -- cyrillic - | Ա -- armenian - | 𝐴 -- maths italic - | 𝔸 -- maths double-struck - | Dž -- title case latin +data T + = À -- latin + | Α -- greek + | Ⴀ -- georgian + | Ϣ -- coptic + | А -- cyrillic + | Ա -- armenian + | 𝐴 -- maths italic + | 𝔸 -- maths double-struck + | Dž -- title case latin -- Test lower-case recognition: à α ϣ а ա 𝑎 𝕒 ᴀ ᴦ = undefined diff --git a/testsuite/tests/profiling/should_run/heapprof001.hs b/testsuite/tests/profiling/should_run/heapprof001.hs index 67c6a17867..2e5bf192e1 100644 --- a/testsuite/tests/profiling/should_run/heapprof001.hs +++ b/testsuite/tests/profiling/should_run/heapprof001.hs @@ -5,22 +5,22 @@ Subject: a compiler test Date: 3 Mar 1992 12:31:00 GMT Will, - One of the decisions taken at the FLARE meeting yesterday was that we -(FLARE people) should send you (GRASP people) interesting Haskell programs -to test your new compiler. So allow me to present the following program, + One of the decisions taken at the FLARE meeting yesterday was that we +(FLARE people) should send you (GRASP people) interesting Haskell programs +to test your new compiler. So allow me to present the following program, written by Colin Runciman in various functional languages over the years, -which puts propositions into clausal form. The original program was +which puts propositions into clausal form. The original program was interactive, but I've made it batch so that you can run it over night. -Here is an example run with the prototype compiler. Note the result is +Here is an example run with the prototype compiler. Note the result is "a <=". - hc clausify.hs - Haskell-0.41 (EXPERIMENTAL) - Glasgow University Haskell Compiler, version 0.41 - G-Code version - -71$ a.out - a <= - -71$ + hc clausify.hs + Haskell-0.41 (EXPERIMENTAL) + Glasgow University Haskell Compiler, version 0.41 + G-Code version + -71$ a.out + a <= + -71$ Cheers, @@ -47,7 +47,7 @@ res n = concat (map clauses xs) where xs = take n (repeat "(a = a = a) = (a = a = a) = (a = a = a)") {-# NOINLINE xs #-} -data StackFrame = Ast Formula | Lex Char +data StackFrame = Ast Formula | Lex Char data Formula = Sym Char | @@ -55,7 +55,7 @@ data Formula = Dis Formula Formula | Con Formula Formula | Imp Formula Formula | - Eqv Formula Formula + Eqv Formula Formula -- separate positive and negative literals, eliminating duplicates clause p = clause' p ([] , []) diff --git a/testsuite/tests/simplCore/should_compile/T3118.hs b/testsuite/tests/simplCore/should_compile/T3118.hs index 57b1ad0c92..8ee50b342a 100644 --- a/testsuite/tests/simplCore/should_compile/T3118.hs +++ b/testsuite/tests/simplCore/should_compile/T3118.hs @@ -3,10 +3,10 @@ -- The test is quite delicate. It aims to get 'f' to look like -- f y = case x of -- Red -> (y, y) --- _ -> let v = case x of --- Green -> 2 --- Blue -> 3 --- in (v, 5) +-- _ -> let v = case x of +-- Green -> 2 +-- Blue -> 3 +-- in (v, 5) -- -- And now float the inner case to top level -- so that it's not so obvious that the Red case @@ -33,8 +33,8 @@ x = g True f :: Int -> (Int,Int) f y = case x of Red -> (y, y) - xx -> let v = case xx of - Red -> 1 - Green -> 2 - Blue -> 3 - in (v, 5) + xx -> let v = case xx of + Red -> 1 + Green -> 2 + Blue -> 3 + in (v, 5) diff --git a/testsuite/tests/simplCore/should_compile/simpl003.hs b/testsuite/tests/simplCore/should_compile/simpl003.hs index 8bf9d6bfd1..fb42369d2a 100644 --- a/testsuite/tests/simplCore/should_compile/simpl003.hs +++ b/testsuite/tests/simplCore/should_compile/simpl003.hs @@ -11,8 +11,8 @@ type IMonad a = IMonadState -> IMonadReturn a data IMonadReturn a - = IMonadOk IMonadState a - | IMonadFail IMonadState String + = IMonadOk IMonadState a + | IMonadFail IMonadState String type IMonadState = Int @@ -26,7 +26,7 @@ thenI m k = \s0 -> case m s0 of IMonadFail s1 msg -> IMonadFail s1 msg IMonadOk s1 r1 -> k r1 s1 - + tickI n = \s0 -> IMonadOk (s0+n) () mapI f [] = returnI [] diff --git a/testsuite/tests/simplCore/should_compile/simpl004.hs b/testsuite/tests/simplCore/should_compile/simpl004.hs index 08282c69ea..60cc14571a 100644 --- a/testsuite/tests/simplCore/should_compile/simpl004.hs +++ b/testsuite/tests/simplCore/should_compile/simpl004.hs @@ -10,9 +10,9 @@ f ixs@(_, ix_end) frozen# = let !n# = case ( - if null (range ixs) - then 0 - else 1 + if null (range ixs) + then 0 + else 1 ) of { I# x -> x } in (# frozen#, False #) diff --git a/testsuite/tests/simplCore/should_compile/simpl005.hs b/testsuite/tests/simplCore/should_compile/simpl005.hs index abf98a30d2..b81fdfe5db 100644 --- a/testsuite/tests/simplCore/should_compile/simpl005.hs +++ b/testsuite/tests/simplCore/should_compile/simpl005.hs @@ -4,13 +4,13 @@ module ShouldCompile where -data StateM m s a = STM (s -> m (a,s)) +data StateM m s a = STM (s -> m (a,s)) instance Functor m => Functor (StateM m s) where - fmap f (STM xs) = STM (\s -> fmap (\ (x,s') -> (f x, s')) - (xs s) - ) -{- With GHC 4.04 (first release) this program gave: + fmap f (STM xs) = STM (\s -> fmap (\ (x,s') -> (f x, s')) + (xs s) + ) +{- With GHC 4.04 (first release) this program gave: panic! (the `impossible' happened): mk_cpr_let: not a product @@ -21,5 +21,5 @@ instance Functor m => Functor (StateM m s) where The reason: 'Functor' is a newtype, whose element is a for-all type. - newtype Functor f = Functor (forall a,b. (a->b) -> f a -> f b) + newtype Functor f = Functor (forall a,b. (a->b) -> f a -> f b) -} diff --git a/testsuite/tests/simplCore/should_compile/simpl007.hs b/testsuite/tests/simplCore/should_compile/simpl007.hs index 6980409716..96c6f882e8 100644 --- a/testsuite/tests/simplCore/should_compile/simpl007.hs +++ b/testsuite/tests/simplCore/should_compile/simpl007.hs @@ -195,20 +195,20 @@ instance AddT Formula where instance AddT FInt where addT (FInt 0) y = Just y addT (FInt x) y - | isInt y = Just (mkInt (x + intVal y)) - | otherwise = Nothing + | isInt y = Just (mkInt (x + intVal y)) + | otherwise = Nothing instance AddT FSum where addT (FSum xs) y - | isSum y = Just (mkSum (merge xs (argList y))) - | otherwise = Just (mkSum (merge xs [y])) + | isSum y = Just (mkSum (merge xs (argList y))) + | otherwise = Just (mkSum (merge xs [y])) where merge = (++) instance AddT FLog where addT (FLog x b) y - | isLog y && b == logBase y = Just (mkLog (mkPro [x,logExp y]) b) - | otherwise = Nothing + | isLog y && b == logBase y = Just (mkLog (mkPro [x,logExp y]) b) + | otherwise = Nothing where merge = (++) diff --git a/testsuite/tests/simplCore/should_compile/simpl009.hs b/testsuite/tests/simplCore/should_compile/simpl009.hs index 2ffceb6283..2b5fb401cb 100644 --- a/testsuite/tests/simplCore/should_compile/simpl009.hs +++ b/testsuite/tests/simplCore/should_compile/simpl009.hs @@ -9,4 +9,4 @@ module ShouldCompile where newtype R = R (forall a. a->a) foo = case undefined of - R f -> f () + R f -> f () diff --git a/testsuite/tests/simplCore/should_compile/simpl010.hs b/testsuite/tests/simplCore/should_compile/simpl010.hs index da2af345f2..528da5d0ec 100644 --- a/testsuite/tests/simplCore/should_compile/simpl010.hs +++ b/testsuite/tests/simplCore/should_compile/simpl010.hs @@ -16,4 +16,4 @@ f x T2 = [x] h :: a -> Bool -> T a -> T a -> [a] h x b p q = f x (case b of { True -> p; False -> q }) -
\ No newline at end of file + diff --git a/testsuite/tests/simplCore/should_compile/simpl014.hs b/testsuite/tests/simplCore/should_compile/simpl014.hs index a8bb18f440..4e03b401a8 100644 --- a/testsuite/tests/simplCore/should_compile/simpl014.hs +++ b/testsuite/tests/simplCore/should_compile/simpl014.hs @@ -10,8 +10,8 @@ module ShouldCompile where data IHandler st where IHandler :: forall st ev res. - Serialize (TxContext ev) => String -> IO ev - -> (res -> IO ()) -> Ev st ev res -> IHandler st + Serialize (TxContext ev) => String -> IO ev + -> (res -> IO ()) -> Ev st ev res -> IHandler st -- Weird test case: (Serialize (TxContext ev)) is simplifiable data Ev st ev res = Ev diff --git a/testsuite/tests/simplCore/should_compile/simpl017.hs b/testsuite/tests/simplCore/should_compile/simpl017.hs index 31ba7510d4..ecb48cce14 100644 --- a/testsuite/tests/simplCore/should_compile/simpl017.hs +++ b/testsuite/tests/simplCore/should_compile/simpl017.hs @@ -1,7 +1,7 @@ {-# OPTIONS -XImpredicativeTypes -fno-warn-deprecated-flags -XEmptyDataDecls -XGADTs -XLiberalTypeSynonyms -XFlexibleInstances -XScopedTypeVariables #-} -- See Trac #1627. The point is that we should get nice --- compact code for Foo +-- compact code for Foo -- In GHC 7.0 this fails, and rightly so. @@ -50,8 +50,8 @@ liftArray :: forall arr m a i . (Ix i, MArray arr a m) => liftArray a = E (do let ix :: [E m i] -> m i ix [i] = runE i - {-# INLINE f #-} - f is = V (ix is >>= readArray a) (\ x -> ix is >>= \ i -> writeArray a i x) + {-# INLINE f #-} + f is = V (ix is >>= readArray a) (\ x -> ix is >>= \ i -> writeArray a i x) return f ) diff --git a/testsuite/tests/simplCore/should_compile/simpl018.hs b/testsuite/tests/simplCore/should_compile/simpl018.hs index 1b7ce8ddcd..a4cb6a80b8 100644 --- a/testsuite/tests/simplCore/should_compile/simpl018.hs +++ b/testsuite/tests/simplCore/should_compile/simpl018.hs @@ -9,4 +9,4 @@ module ShouldCompile where bar :: Bool -> Int bar x = case (case x of { True -> (# 2,3 #); False -> error "urk" }) of - (# p,q #) -> p+q + (# p,q #) -> p+q diff --git a/testsuite/tests/simplCore/should_run/T3959.hs b/testsuite/tests/simplCore/should_run/T3959.hs index 725f315da8..94b7a7afb0 100644 --- a/testsuite/tests/simplCore/should_run/T3959.hs +++ b/testsuite/tests/simplCore/should_run/T3959.hs @@ -11,7 +11,7 @@ data Failure = Failure instance Exception Failure test = (E.throw Failure >> return ()) - `E.catch` + `E.catch` (\(x::Failure) -> return ()) main :: IO () @@ -23,14 +23,14 @@ f True = error "urk" {- Uderlying cause: we call - catch# thing handler + catch# thing handler and expect that (thing state-token) will - either diverge/throw an exception - or return (# x,y #) But it does neither: it returns a PAP, because thing = \p q. blah -In particular, 'thing = lvl_sxo' is +In particular, 'thing = lvl_sxo' is lvl_sxc :: IO Any lvl_sxc = error "urk" @@ -40,14 +40,14 @@ In particular, 'thing = lvl_sxo' is -- inline (>>) -- = (\(eta::S#). case lvl_sxc |> g1 eta of ...) |> g2 - where + where g1 :: IO Any ~ S# -> (# S#, Any #) g2 :: S# -> (# S#, () #) -> IO () -- case-of-bottomming function -- = (\ (eta::S#). lvl_sxc |> g1 |> ug3) |> g2 - where + where ug3(unsafe) :: S# -> (S#, Any) ~ (# S#, () #) This is all fine. But it's crucial that lvl_sxc actually diverges. @@ -64,4 +64,4 @@ In contrast, if we had False -> error "urk" we can, and must, eta-expand the error --}
\ No newline at end of file +-} diff --git a/testsuite/tests/simplCore/should_run/simplrun002.hs b/testsuite/tests/simplCore/should_run/simplrun002.hs index c6d9267d40..e6cb8d7efc 100644 --- a/testsuite/tests/simplCore/should_run/simplrun002.hs +++ b/testsuite/tests/simplCore/should_run/simplrun002.hs @@ -2,8 +2,8 @@ -- !!! A rules test -- At one time the rule got too specialised a type: -- --- _R "ffoo" forall {@ a1 v :: (a1, ((), ()))} --- fst @ a1 @ () (sndSnd @ a1 @ () @ () v) = fst @ a1 @ ((), ()) v +-- _R "ffoo" forall {@ a1 v :: (a1, ((), ()))} +-- fst @ a1 @ () (sndSnd @ a1 @ () @ () v) = fst @ a1 @ ((), ()) v module Main where diff --git a/testsuite/tests/simplCore/should_run/simplrun003.hs b/testsuite/tests/simplCore/should_run/simplrun003.hs index 45aa73578e..65d1adfa8f 100644 --- a/testsuite/tests/simplCore/should_run/simplrun003.hs +++ b/testsuite/tests/simplCore/should_run/simplrun003.hs @@ -9,15 +9,15 @@ f 0 = (# 1,2 #) f n = f (n-1) {-# NOINLINE g #-} -g x = case f x of - (# a,b #) -> if a>0 - then f x -- CSE opportunity - else (# b,a #) +g x = case f x of + (# a,b #) -> if a>0 + then f x -- CSE opportunity + else (# b,a #) -- GHC 6.2 wrongly optimised g to: --- case f x of t --- (# a,b #) -> if a>0 then --- t -- WRONG --- else (# b,a #) +-- case f x of t +-- (# a,b #) -> if a>0 then +-- t -- WRONG +-- else (# b,a #) main = case g 2 of (# a,b #) -> print a diff --git a/testsuite/tests/simplCore/should_run/simplrun005.hs b/testsuite/tests/simplCore/should_run/simplrun005.hs index d177568e4b..b72542e069 100644 --- a/testsuite/tests/simplCore/should_run/simplrun005.hs +++ b/testsuite/tests/simplCore/should_run/simplrun005.hs @@ -1,7 +1,7 @@ module Main where main = print (fib' 100) - -- This will time out unless memoing works properly + -- This will time out unless memoing works properly data Nat = Z | S Nat deriving (Show, Eq) @@ -9,11 +9,11 @@ data Nat = Z | S Nat memo f = g where fz = f Z - fs = memo (f . S) + fs = memo (f . S) g Z = fz g (S n) = fs n - -- It is a BAD BUG to inline 'fs' inside g - -- and that happened in 6.4.1, resulting in exponential behaviour + -- It is a BAD BUG to inline 'fs' inside g + -- and that happened in 6.4.1, resulting in exponential behaviour -- memo f = g (f Z) (memo (f . S)) -- = g (f Z) (g (f (S Z)) (memo (f . S . S))) diff --git a/testsuite/tests/simplCore/should_run/simplrun008.hs b/testsuite/tests/simplCore/should_run/simplrun008.hs index 782f0e40ac..a562005ad4 100644 --- a/testsuite/tests/simplCore/should_run/simplrun008.hs +++ b/testsuite/tests/simplCore/should_run/simplrun008.hs @@ -14,5 +14,5 @@ neg = negate "f" forall (c::Char->Int) (x::Char). f (c x) = "RULE FIRED" #-} -main = do { print (f (ord 'a')) -- Rule should fire - ; print (f (neg 1)) } -- Rule should not fire +main = do { print (f (ord 'a')) -- Rule should fire + ; print (f (neg 1)) } -- Rule should not fire diff --git a/testsuite/tests/simplCore/should_run/simplrun009.hs b/testsuite/tests/simplCore/should_run/simplrun009.hs index 826cdeef77..0e94012b2b 100644 --- a/testsuite/tests/simplCore/should_run/simplrun009.hs +++ b/testsuite/tests/simplCore/should_run/simplrun009.hs @@ -11,38 +11,38 @@ {- $wunfold_shU = - \ (ww_she :: [[a_abm]]) (ww1_shf :: Data.Maybe.Maybe (Stream.Stream a_abm)) -> - case ww1_shf of wild2_afo { - Data.Maybe.Nothing -> - case ww_she of wild_ad6 { - [] -> GHC.Base.[] @ a_abm; - : x_ado xs1_adp -> - $wunfold_shU - xs1_adp - (Data.Maybe.Just - @ (Stream.Stream a_abm) (Stream.Stream @ a_abm @ [a_abm] - *** lvl1_shW *** - x_ado)) - }; - Data.Maybe.Just ds3_afJ -> - case ds3_afJ of wild3_afL { Stream.Stream @ s1_afN stepb_afO sb_afP -> - case stepb_afO sb_afP of wild4_afR { - Stream.Done -> $wunfold_shU ww_she (Data.Maybe.Nothing @ (Stream.Stream a_abm)); - Stream.Yield x_afV sb'_afW -> - GHC.Base.: - @ a_abm - x_afV - ($wunfold_shU - ww_she - (Data.Maybe.Just - @ (Stream.Stream a_abm) (Stream.Stream @ a_abm @ s1_afN stepb_afO sb'_afW))); - Stream.Skip sb'_afZ -> - $wunfold_shU - ww_she - (Data.Maybe.Just - @ (Stream.Stream a_abm) (Stream.Stream @ a_abm @ s1_afN stepb_afO sb'_afZ)) - } - } + \ (ww_she :: [[a_abm]]) (ww1_shf :: Data.Maybe.Maybe (Stream.Stream a_abm)) -> + case ww1_shf of wild2_afo { + Data.Maybe.Nothing -> + case ww_she of wild_ad6 { + [] -> GHC.Base.[] @ a_abm; + : x_ado xs1_adp -> + $wunfold_shU + xs1_adp + (Data.Maybe.Just + @ (Stream.Stream a_abm) (Stream.Stream @ a_abm @ [a_abm] + *** lvl1_shW *** + x_ado)) + }; + Data.Maybe.Just ds3_afJ -> + case ds3_afJ of wild3_afL { Stream.Stream @ s1_afN stepb_afO sb_afP -> + case stepb_afO sb_afP of wild4_afR { + Stream.Done -> $wunfold_shU ww_she (Data.Maybe.Nothing @ (Stream.Stream a_abm)); + Stream.Yield x_afV sb'_afW -> + GHC.Base.: + @ a_abm + x_afV + ($wunfold_shU + ww_she + (Data.Maybe.Just + @ (Stream.Stream a_abm) (Stream.Stream @ a_abm @ s1_afN stepb_afO sb'_afW))); + Stream.Skip sb'_afZ -> + $wunfold_shU + ww_she + (Data.Maybe.Just + @ (Stream.Stream a_abm) (Stream.Stream @ a_abm @ s1_afN stepb_afO sb'_afZ)) + } + } -} @@ -50,7 +50,7 @@ module Main( main, foo ) where -- Must export foo to make the issue show up -import Prelude hiding ( concatMap, map) +import Prelude hiding ( concatMap, map) main = print (sum (foo [[1,2], [3,4,5]])) @@ -86,7 +86,7 @@ streamToList (Stream next s) = unfold s "stream/unstream" forall s. listToStream (streamToList s) = s #-} - + map :: (a -> b) -> [a] -> [b] map f = unstream . mapS f . stream {-# INLINE map #-} @@ -131,7 +131,7 @@ mapS f (Stream next s0) = Stream next' s0 Yield x s' -> Yield (f x) s' {-# INLINE [0] mapS #-} - + concatMapS :: (a -> Stream b) -> Stream a -> Stream b concatMapS f (Stream step s) = Stream step' (s, Nothing) where step' (s, Nothing) = |