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 | a7160faafd44d64c2b20a4cc65e80136a93e1aaa (patch) | |
| tree | c0fa999a4696a5a05e861b0eacfcd92358d77a48 /testsuite | |
| parent | 5b03dc69389dc387b922c589ab9a8b92079e6a96 (diff) | |
| download | haskell-a7160faafd44d64c2b20a4cc65e80136a93e1aaa.tar.gz | |
Testsuite: tabs -> spaces [skip ci]
Diffstat (limited to 'testsuite')
81 files changed, 676 insertions, 676 deletions
diff --git a/testsuite/tests/array/should_run/arr013.hs b/testsuite/tests/array/should_run/arr013.hs index f9e63aa5ba..def2113416 100644 --- a/testsuite/tests/array/should_run/arr013.hs +++ b/testsuite/tests/array/should_run/arr013.hs @@ -5,13 +5,13 @@ infix 1 =: main = putStr (shows sub_b "\n") where - sub_b :: Array Int Double - sub_b = ixmap (102, 113) id b + sub_b :: Array Int Double + sub_b = ixmap (102, 113) id b - b :: Array Int Double - b = fmap ( \ r -> fromRational r / pi ) - (ixmap (101,200) (\ i -> toInteger i - 100) a) + b :: Array Int Double + b = fmap ( \ r -> fromRational r / pi ) + (ixmap (101,200) (\ i -> toInteger i - 100) a) - a :: Array Integer (Ratio Integer) - a = array (1,100) ((1 =: 1) : [i =: fromInteger i * a!(i-1) - | i <- [2..100]]) + a :: Array Integer (Ratio Integer) + a = array (1,100) ((1 =: 1) : [i =: fromInteger i * a!(i-1) + | i <- [2..100]]) diff --git a/testsuite/tests/array/should_run/arr014.hs b/testsuite/tests/array/should_run/arr014.hs index 59541c09ff..a646a2d72e 100644 --- a/testsuite/tests/array/should_run/arr014.hs +++ b/testsuite/tests/array/should_run/arr014.hs @@ -8,19 +8,19 @@ type TwoD s = STArray s Int (STArray s Int Int) setup :: ST s (TwoD s) setup = let isz = 10 - imax = isz - 1 + imax = isz - 1 osz = 2 omax = osz - 1 in - do + do -- gives : undefined reference to `IOBase_error_closure' --- x <- newArray (0, omax) (error "uninitialised") - dmy <- newArray (0, imax) 0 - x <- newArray (0, omax) dmy - as <- (sequence . replicate osz) (newArray (0, imax) 6) - mapM_ (\(i,v) -> writeArray x i v) (zip [0..omax] as) - return x +-- x <- newArray (0, omax) (error "uninitialised") + dmy <- newArray (0, imax) 0 + x <- newArray (0, omax) dmy + as <- (sequence . replicate osz) (newArray (0, imax) 6) + mapM_ (\(i,v) -> writeArray x i v) (zip [0..omax] as) + return x main :: IO () main = do a <- stToIO setup - return () + return () diff --git a/testsuite/tests/array/should_run/arr015.hs b/testsuite/tests/array/should_run/arr015.hs index 4a6e8c431a..7975e5d3ca 100644 --- a/testsuite/tests/array/should_run/arr015.hs +++ b/testsuite/tests/array/should_run/arr015.hs @@ -6,26 +6,26 @@ module Main where import Data.Array -- All in main is only to show the strange behaviour. --- +-- -- arrS is the array that foo (NB (1.0,1)) shows in Hugs. -- But (foo (NB (1.0,1)))==arrS is False. -- If I write NB (f,p) -> hCMt [(p,listArray ((1,1),(1,1)) [f])] instead of line 16 -- the bug disappears. That is also the reason why I have to keep the data declaration RD. -- If I put the type signature of line 18 in scope the bug also disappears. --- If I write hCMt po_arL = (accumArray (\a _-> a) ZM ((1,1),(1,2)) []) // --- (map (\(po,ar) -> ((1,po),M ar)) po_arL) --- instead of line 19 and 20 it also vanishes. +-- If I write hCMt po_arL = (accumArray (\a _-> a) ZM ((1,1),(1,2)) []) // +-- (map (\(po,ar) -> ((1,po),M ar)) po_arL) +-- instead of line 19 and 20 it also vanishes. data CM a = ZM | M (Array (Int,Int) a) deriving (Show,Eq) data RD = NB !(Double,Int) -main = do +main = do let arr = foo (NB (1.0,1)) - -- arr = { (1,1) -> M { (1,1) -> 1.0 }, (1,2) -> ZM } + -- arr = { (1,1) -> M { (1,1) -> 1.0 }, (1,2) -> ZM } - -- All these should return True + -- All these should return True putStr ("arr==arrS "++show (arr==arrS)++"\n") putStr ("arrS==arr "++show (arrS==arr)++"\n") putStr ("bnds arr arrS "++show ((bounds arr)==(bounds arrS))++"\n") @@ -36,14 +36,14 @@ main = do foo :: RD -> Array (Int,Int) (CM Double) foo rd = case rd of NB (f,p) -> h where h = hCMt [(p,listArray ((1,1),(1,1)) [f])] - -- h = { (1,p) -> M { (1,1) -> f }, other -> ZM } + -- h = { (1,p) -> M { (1,1) -> f }, other -> ZM } where --h0CMt :: Array (Int, Int) (CM Double) -- h0CMt = { (1,1) -> ZM, (1,2) -> ZM } h0CMt = accumArray (\a _-> a) ZM ((1,1),(1,2)) [] hCMt prs = h0CMt // (map (\(po,ar) -> ((1,po),M ar)) prs) - -- [ (1,p), M { (1,1) -> f } ] + -- [ (1,p), M { (1,1) -> f } ] arrS :: Array (Int,Int) (CM Double) diff --git a/testsuite/tests/array/should_run/arr016.hs b/testsuite/tests/array/should_run/arr016.hs index 0e8e2bfe2e..792db470b7 100644 --- a/testsuite/tests/array/should_run/arr016.hs +++ b/testsuite/tests/array/should_run/arr016.hs @@ -2,8 +2,8 @@ module Main where -{- - - This is a test framework for Arrays, using QuickCheck +{- + - This is a test framework for Arrays, using QuickCheck - -} @@ -20,84 +20,84 @@ infixl 9 !, // infixr 0 ==> infix 1 `classify` -prop_array = +prop_array = forAll genBounds $ \ (b :: (Int,Int)) -> forAll (genIVPs b 10) $ \ (vs :: [(Int,Int)]) -> Array.array b vs - `same_arr` + `same_arr` array b vs -prop_listArray = +prop_listArray = forAll genBounds $ \ (b :: (Int,Int)) -> forAll (vector (length [fst b..snd b])) - $ \ (vs :: [Bool]) -> + $ \ (vs :: [Bool]) -> Array.listArray b vs == Array.array b (zipWith (\ a b -> (a,b)) - (Array.range b) vs) + (Array.range b) vs) -prop_indices = +prop_indices = forAll genBounds $ \ (b :: (Int,Int)) -> forAll (genIVPs b 10) $ \ (vs :: [(Int,Int)]) -> let arr = Array.array b vs in Array.indices arr == ((Array.range . Array.bounds) arr) -prop_elems = +prop_elems = forAll genBounds $ \ (b :: (Int,Int)) -> forAll (genIVPs b 10) $ \ (vs :: [(Int,Int)]) -> let arr = Array.array b vs in Array.elems arr == [arr Array.! i | i <- Array.indices arr] -prop_assocs = +prop_assocs = forAll genBounds $ \ (b :: (Int,Int)) -> forAll (genIVPs b 10) $ \ (vs :: [(Int,Int)]) -> let arr = Array.array b vs in Array.assocs arr == [(i, arr Array.! i) | i <- Array.indices arr] -prop_slashslash = +prop_slashslash = forAll genBounds $ \ (b :: (Int,Int)) -> forAll (genIVPs b 10) $ \ (vs :: [(Int,Int)]) -> let arr = Array.array b vs us = [] in arr Array.// us == Array.array (Array.bounds arr) - ([(i,arr Array.! i) - | i <- Array.indices arr \\ [i | (i,_) <- us]] + ([(i,arr Array.! i) + | i <- Array.indices arr \\ [i | (i,_) <- us]] ++ us) -prop_accum = +prop_accum = forAll genBounds $ \ (b :: (Int,Int)) -> forAll (genIVPs b 10) $ \ (vs :: [(Int,Int)]) -> forAll (genIVPs b 10) $ \ (us :: [(Int,Int)]) -> forAll (choose (0,length us)) - $ \ n -> + $ \ n -> let us' = take n us in forAll arbitrary $ \ (fn :: Int -> Int -> Int) -> let arr = Array.array b vs - in Array.accum fn arr us' + in Array.accum fn arr us' == foldl (\a (i,v) -> a Array.// [(i,fn (a Array.! i) v)]) arr us' -prop_accumArray = +prop_accumArray = forAll arbitrary $ \ (f :: Int -> Int -> Int) -> forAll arbitrary $ \ (z :: Int) -> forAll genBounds $ \ (b :: (Int,Int)) -> forAll (genIVPs b 10) $ \ (vs :: [(Int,Int)]) -> - Array.accumArray f z b vs == Array.accum f + Array.accumArray f z b vs == Array.accum f (Array.array b [(i,z) | i <- Array.range b]) vs same_arr :: (Eq b) => Array.Array Int b -> Array Int b -> Bool same_arr a1 a2 = a == c && b == d - && all (\ n -> (a1 Array.! n) == (a2 ! n)) [a..b] + && all (\ n -> (a1 Array.! n) == (a2 ! n)) [a..b] where (a,b) = Array.bounds a1 :: (Int,Int) (c,d) = bounds a2 :: (Int,Int) genBounds :: Gen (Int,Int) genBounds = do m <- choose (0,20) - n <- choose (minBound,maxBound-m) - return (n,n+m-1) + n <- choose (minBound,maxBound-m) + return (n,n+m-1) genIVP :: Arbitrary a => (Int,Int) -> Gen (Int,a) genIVP b = do { i <- choose b - ; v <- arbitrary - ; return (i,v) - } + ; v <- arbitrary + ; return (i,v) + } genIVPs :: Arbitrary a => (Int,Int) -> Int -> Gen [(Int,a)] genIVPs b@(low,high) s @@ -114,7 +114,7 @@ prop_id = forAll genBounds $ \ (b :: (Int,Int)) -> -- and then rifts together the split lists into one. -- Think: rifting a pack of cards. rift :: Int -> [a] -> [a] -rift n xs = comb (drop n xs) (take n xs) +rift n xs = comb (drop n xs) (take n xs) where comb (a:as) (b:bs) = a : b : comb as bs comb (a:as) [] = a : as @@ -124,27 +124,27 @@ rift n xs = comb (drop n xs) (take n xs) -- suffle makes n random rifts. Typically after -- log n rifts, the list is in a pretty random order. --- (where n is the number of elements in the list) +-- (where n is the number of elements in the list) shuffle :: Int -> [a] -> Gen [a] shuffle 0 m = return m shuffle n m = do { r <- choose (1,length m) ; shuffle (n-1) (rift r m) - } -prop_shuffle = + } +prop_shuffle = forAll (shuffle 10 [1..10::Int]) $ \ lst -> label (show lst) True ------------------------------------------------------------------------------ main = do test prop_array - test prop_listArray - test prop_indices - test prop_elems - test prop_assocs - test prop_slashslash - test prop_accum - test prop_accumArray + test prop_listArray + test prop_indices + test prop_elems + test prop_assocs + test prop_slashslash + test prop_accum + test prop_accumArray instance Show (a -> b) where { show _ = "<FN>" } @@ -201,7 +201,7 @@ ixmap :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c ixmap b f a = array b [(i, a ! f i) | i <- range b] instance (Ix a) => Functor (Array a) where - fmap fn (MkArray b f) = MkArray b (fn . f) + fmap fn (MkArray b f) = MkArray b (fn . f) instance (Ix a, Eq b) => Eq (Array a b) where a == a' = assocs a == assocs a' @@ -328,11 +328,11 @@ instance Arbitrary Integer where coarbitrary n = variant (fromInteger (if n >= 0 then 2*n else 2*(-n) + 1)) instance Arbitrary Float where - arbitrary = liftM3 fraction arbitrary arbitrary arbitrary + arbitrary = liftM3 fraction arbitrary arbitrary arbitrary coarbitrary x = coarbitrary (decodeFloat x) instance Arbitrary Double where - arbitrary = liftM3 fraction arbitrary arbitrary arbitrary + arbitrary = liftM3 fraction arbitrary arbitrary arbitrary coarbitrary x = coarbitrary (decodeFloat x) fraction a b c = fromInteger a + (fromInteger b / (abs (fromInteger c) + 1)) @@ -441,7 +441,7 @@ quick = Config , configSize = (+ 3) . (`div` 2) , configEvery = \n args -> let s = show n in s ++ "," } - + verbose :: Config verbose = quick { configEvery = \n args -> show n ++ ":\n" ++ unlines args @@ -451,13 +451,13 @@ test, quickCheck, verboseCheck :: Testable a => a -> IO () test = check quick quickCheck = check quick verboseCheck = check verbose - + check :: Testable a => Config -> a -> IO () check config a = do rnd <- newStdGen tests config (evaluate a) rnd 0 0 [] -tests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO () +tests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO () tests config gen rnd0 ntest nfail stamps | ntest == configMaxTest config = do done "OK, passed" ntest stamps | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps @@ -509,7 +509,7 @@ done mesg ntest stamps = {- instance Observable StdGen where { observer = observeBase } -instance Observable a => Observable (Gen a) where +instance Observable a => Observable (Gen a) where observer (Gen a) = send "Gen" (return (Gen) << a) - + -} diff --git a/testsuite/tests/codeGen/should_compile/cg004.hs b/testsuite/tests/codeGen/should_compile/cg004.hs index fb8e3cc413..86b4a23a72 100644 --- a/testsuite/tests/codeGen/should_compile/cg004.hs +++ b/testsuite/tests/codeGen/should_compile/cg004.hs @@ -1,24 +1,24 @@ module ShouldCompile where --- Killed GHC 6.0 in isCrossDllArg +-- Killed GHC 6.0 in isCrossDllArg -- -- ghc-6.0: panic! (the `impossible' happened, GHC version 6.0): --- coreSyn/CoreUtils.lhs:1188: Non-exhaustive patterns in function isCrossDllArg +-- coreSyn/CoreUtils.lhs:1188: Non-exhaustive patterns in function isCrossDllArg -- -- The reason was that newST had the form -- newST = \ @ v -> GHC.Base.: --- @ (Environment.Scope v) --- (case $fScopeOpersScope @ v --- of tpl_B1 { Environment.:DScopeOpers tpl_B2 tpl_B3 -> --- tpl_B2 --- }) --- (GHC.Base.[] @ (Environment.Scope v)) +-- @ (Environment.Scope v) +-- (case $fScopeOpersScope @ v +-- of tpl_B1 { Environment.:DScopeOpers tpl_B2 tpl_B3 -> +-- tpl_B2 +-- }) +-- (GHC.Base.[] @ (Environment.Scope v)) class ScopeOpers s where - emptyScope :: s + emptyScope :: s op :: s -> s -data Scope v = NewScope +data Scope v = NewScope instance ScopeOpers (Scope v) where emptyScope = error "emptyScope" diff --git a/testsuite/tests/codeGen/should_compile/jmp_tbl.hs b/testsuite/tests/codeGen/should_compile/jmp_tbl.hs index 05fabf630c..9f5dbf356a 100644 --- a/testsuite/tests/codeGen/should_compile/jmp_tbl.hs +++ b/testsuite/tests/codeGen/should_compile/jmp_tbl.hs @@ -97,9 +97,9 @@ eqPhase Cc Cc = True eqPhase HCc HCc = True eqPhase SplitAs SplitAs = True eqPhase As As = True -eqPhase LlvmOpt LlvmOpt = True -eqPhase LlvmLlc LlvmLlc = True -eqPhase LlvmMangle LlvmMangle = True +eqPhase LlvmOpt LlvmOpt = True +eqPhase LlvmLlc LlvmLlc = True +eqPhase LlvmMangle LlvmMangle = True eqPhase MergeStub MergeStub = True eqPhase StopLn StopLn = True eqPhase _ _ = False diff --git a/testsuite/tests/codeGen/should_run/T2080.hs b/testsuite/tests/codeGen/should_run/T2080.hs index 13a932a2a7..924e77a30f 100644 --- a/testsuite/tests/codeGen/should_run/T2080.hs +++ b/testsuite/tests/codeGen/should_run/T2080.hs @@ -15,7 +15,7 @@ utf8DecodeChar# a# fred = -- Omitting the next line gives an ASSERT error: -- ghc-6.9: panic! (the 'impossible' happened) -- (GHC version 6.9 for x86_64-unknown-linux): --- ASSERT failed! file nativeGen/MachCodeGen.hs line 1049 +-- ASSERT failed! file nativeGen/MachCodeGen.hs line 1049 -- %MO_S_Le_I8(I8[R2], 127 :: I8) | fred -> True diff --git a/testsuite/tests/codeGen/should_run/T5900.hs b/testsuite/tests/codeGen/should_run/T5900.hs index 231edeba2c..83b0f8a36d 100644 --- a/testsuite/tests/codeGen/should_run/T5900.hs +++ b/testsuite/tests/codeGen/should_run/T5900.hs @@ -4,11 +4,11 @@ import Debug.Trace fl :: Word64 -> Word64 -> Word64 fl fin sk = - let (x1, x2) = w64tow32 fin in - let (k1, k2) = w64tow32 sk in - let y2 = x2 `xor` ((x1 .&. k1) `rotateL` 1) in - let y1 = x1 `xor` (y2 .|. k2) in - trace (show fin ++ " " ++ show sk ++ " -> " ++ show (w32tow64 (y1, y2))) $ w32tow64 (y1, y2) + let (x1, x2) = w64tow32 fin in + let (k1, k2) = w64tow32 sk in + let y2 = x2 `xor` ((x1 .&. k1) `rotateL` 1) in + let y1 = x1 `xor` (y2 .|. k2) in + trace (show fin ++ " " ++ show sk ++ " -> " ++ show (w32tow64 (y1, y2))) $ w32tow64 (y1, y2) w64tow32 :: Word64 -> (Word32, Word32) w64tow32 w = (fromIntegral (w `shiftR` 32), fromIntegral (w .&. 0xffffffff)) diff --git a/testsuite/tests/codeGen/should_run/cgrun002.hs b/testsuite/tests/codeGen/should_run/cgrun002.hs index dddaabd66f..b1dcd5e59d 100644 --- a/testsuite/tests/codeGen/should_run/cgrun002.hs +++ b/testsuite/tests/codeGen/should_run/cgrun002.hs @@ -3,8 +3,8 @@ main = print ((f id2) (10 + thirty_two)) f x = g x where g x = h x - where - h x = x + where + h x = x thirty_two :: Int thirty_two = 32 diff --git a/testsuite/tests/codeGen/should_run/cgrun003.hs b/testsuite/tests/codeGen/should_run/cgrun003.hs index 47b2d9e7bf..645a15ce0e 100644 --- a/testsuite/tests/codeGen/should_run/cgrun003.hs +++ b/testsuite/tests/codeGen/should_run/cgrun003.hs @@ -1,6 +1,6 @@ main = print (id2 (id2 id2) (42::Int)) --- where --- id2 = s k k +-- where +-- id2 = s k k -- id2 x = s k k x diff --git a/testsuite/tests/codeGen/should_run/cgrun006.hs b/testsuite/tests/codeGen/should_run/cgrun006.hs index 609c3c2b4b..bd7ad42c5f 100644 --- a/testsuite/tests/codeGen/should_run/cgrun006.hs +++ b/testsuite/tests/codeGen/should_run/cgrun006.hs @@ -1,6 +1,6 @@ main = print (length thirteen_ones) where - thirteen_ones = take (13::Int) ones + thirteen_ones = take (13::Int) ones - ones :: [Int] - ones = 1 : ones + ones :: [Int] + ones = 1 : ones diff --git a/testsuite/tests/codeGen/should_run/cgrun007.hs b/testsuite/tests/codeGen/should_run/cgrun007.hs index 317b921a42..841869524a 100644 --- a/testsuite/tests/codeGen/should_run/cgrun007.hs +++ b/testsuite/tests/codeGen/should_run/cgrun007.hs @@ -4,11 +4,11 @@ main = print (height our_tree) where our_tree :: Tree Int our_tree = - Branch (Branch (Leaf 1) (Branch (Branch (Leaf 1) (Leaf 1)) (Leaf 1))) - (Branch (Leaf 1) (Leaf 1)) + Branch (Branch (Leaf 1) (Branch (Branch (Leaf 1) (Leaf 1)) (Leaf 1))) + (Branch (Leaf 1) (Leaf 1)) height :: Tree a -> Int -height (Leaf _) = 1 -height (Branch t1 t2) = 1 + max (height t1) (height t2) +height (Leaf _) = 1 +height (Branch t1 t2) = 1 + max (height t1) (height t2) diff --git a/testsuite/tests/codeGen/should_run/cgrun008.hs b/testsuite/tests/codeGen/should_run/cgrun008.hs index 1713b4834e..f7c6b045f4 100644 --- a/testsuite/tests/codeGen/should_run/cgrun008.hs +++ b/testsuite/tests/codeGen/should_run/cgrun008.hs @@ -2,11 +2,11 @@ main = print (length comp_list) where comp_list :: [(Int,Int)] comp_list = [ (elem1,elem2) - | elem1 <- given_list, - elem2 <- given_list, - elem1 >= (4::Int), - elem2 < (3::Int) - ] + | elem1 <- given_list, + elem2 <- given_list, + elem1 >= (4::Int), + elem2 < (3::Int) + ] given_list :: [Int] given_list = [1,2,3,4,5,6,7,8,9] diff --git a/testsuite/tests/codeGen/should_run/cgrun011.hs b/testsuite/tests/codeGen/should_run/cgrun011.hs index c687e50272..5619d5a964 100644 --- a/testsuite/tests/codeGen/should_run/cgrun011.hs +++ b/testsuite/tests/codeGen/should_run/cgrun011.hs @@ -19,11 +19,11 @@ instance Bar Bool where bar a b = a < b foO = if bar (2::Int) (3::Int) then - if bar False True then - (42::Int) - else - (888::Int) + if bar False True then + (42::Int) + else + (888::Int) else - (999::Int) + (999::Int) main = print foO diff --git a/testsuite/tests/codeGen/should_run/cgrun012.hs b/testsuite/tests/codeGen/should_run/cgrun012.hs index 8fe0a869c4..2be5bed751 100644 --- a/testsuite/tests/codeGen/should_run/cgrun012.hs +++ b/testsuite/tests/codeGen/should_run/cgrun012.hs @@ -1,39 +1,39 @@ {-# LANGUAGE MagicHash #-} -- !!! move arguments around on the stacks, mainly the B stack -import GHC.Base ( Float#, Double#, Int#, Int(..) ) +import GHC.Base ( Float#, Double#, Int#, Int(..) ) main = print foo foo = I# - ( f 1.1## - 2.1# - True - 3.1## - 4.1# - 5.1## - 6.1## - 42# -- the answer! - 7.1# - 8.1# ) + ( f 1.1## + 2.1# + True + 3.1## + 4.1# + 5.1## + 6.1## + 42# -- the answer! + 7.1# + 8.1# ) where f :: Double# -> Float# -> Bool -> Double# -> Float# - -> Double# -> Double# -> Int# -> Float# -> Float# - -> Int# + -> Double# -> Double# -> Int# -> Float# -> Float# + -> Int# f b1 s2 t b3 s4 b5 b6 i42 s7 s8 - -- evens, then odds - = g s2 b3 b5 i42 s8 b1 t s4 b6 s7 + -- evens, then odds + = g s2 b3 b5 i42 s8 b1 t s4 b6 s7 g :: Float# -> Double# -> Double# -> Int# -> Float# -> Double# -> Bool -> Float# -> Double# -> Float# - -> Int# + -> Int# g s2 b3 b5 i42 s8 b1 t s4 b6 s7 - -- powers of 2 backwards, then others forwards - = h s7 b6 t b5 s2 b3 i42 s8 b1 s4 + -- powers of 2 backwards, then others forwards + = h s7 b6 t b5 s2 b3 i42 s8 b1 s4 h :: Float# -> Double# -> Bool -> Double# -> Float# -> Double# -> Int# -> Float# -> Double# -> Float# - -> Int# + -> Int# h s7 b6 t b5 s2 b3 i42 s8 b1 s4 - = i42 + = i42 diff --git a/testsuite/tests/codeGen/should_run/cgrun013.hs b/testsuite/tests/codeGen/should_run/cgrun013.hs index 4d2f06de6c..7043fe0a82 100644 --- a/testsuite/tests/codeGen/should_run/cgrun013.hs +++ b/testsuite/tests/codeGen/should_run/cgrun013.hs @@ -7,72 +7,72 @@ Date: Wed, 23 Oct 91 16:19:46 BST module Main where class Foo a where - o1 :: a -> a -> Bool - o2 :: a -> Int + o1 :: a -> a -> Bool + o2 :: a -> Int --- o2 :: Int +-- o2 :: Int -- Lennart: The type of method o2 does not contain the variable a -- (and it must according to line 1 page 29 of the manual). class Foo tyvar => Bar tyvar where - o3 :: a -> tyvar -> tyvar + o3 :: a -> tyvar -> tyvar -- class (Eq a, Foo a) => Baz a where class (Ord a, Foo a) => Baz a where - o4 :: a -> a -> (String,String,String,a) + o4 :: a -> a -> (String,String,String,a) instance (Ord a, Foo a) => Foo [a] where - o2 x = 100 - o1 a b = a < b || o1 (head a) (head b) + o2 x = 100 + o1 a b = a < b || o1 (head a) (head b) -- instance Bar [a] where instance (Ord a, Foo a) => Bar [a] where - o3 x l = [] + o3 x l = [] -- - -- Lennart: I guess the instance declaration - -- instance Bar [w] where - -- o3 x l = [] + -- Lennart: I guess the instance declaration + -- instance Bar [w] where + -- o3 x l = [] -- is wrong because to be a Bar you have to be a Foo. For [w] to -- be a Foo, w has to be Ord and Foo. But w is not Ord or Foo in -- this instance declaration so it must be wrong. (Page 31, line -- 7: The context c' must imply ...) instance Baz a => Baz [a] where - o4 [] [] = ("Nil", "Nil", "Nil", []) - o4 l1 l2 = - (if o1 l1 l2 then "Y" else "N", - if l1 == l2 then "Y" else "N", --- if o4 (head l1) (head l2) then "Y" else "N", - case o4 (head l1) (head l2) of - (_,_,_,l3) -> if (o1 (head l1) l3) then "Y" else "N", - l1 ++ l2 ) + o4 [] [] = ("Nil", "Nil", "Nil", []) + o4 l1 l2 = + (if o1 l1 l2 then "Y" else "N", + if l1 == l2 then "Y" else "N", +-- if o4 (head l1) (head l2) then "Y" else "N", + case o4 (head l1) (head l2) of + (_,_,_,l3) -> if (o1 (head l1) l3) then "Y" else "N", + l1 ++ l2 ) instance Foo Int where - o2 x = x - o1 i j = i == j + o2 x = x + o1 i j = i == j instance Bar Int where - o3 _ j = j + 1 + o3 _ j = j + 1 instance Baz Int where --- o4 i j = i > j - o4 i j = (if i>j then "Y" else "Z", "p", "q", i+j) +-- o4 i j = i > j + o4 i j = (if i>j then "Y" else "Z", "p", "q", i+j) --simpl:o4 i j = ("Z", "p", "q", i+j) {- also works w/ glhc! -} main = if o4 [1,2,3] [1,3,2::Int] /= ("Y","N","Y",[1,2,3,1,3,2]) then - (print "43\n") - else (print "144\n") + (print "43\n") + else (print "144\n") {- works: glhc main = case o4 [1,2,3] [1,3,2::Int] of - (s1,s2,s3,x) -> print s1 + (s1,s2,s3,x) -> print s1 main = case o4 ([]::[Int]) ([]::[Int]) of - (s1,s2,s3,x) -> print s1 + (s1,s2,s3,x) -> print s1 -} -{- simple main: breaks nhc, works w/ glhc +{- simple main: breaks nhc, works w/ glhc main = case o4 (3::Int) (4::Int) of (s1,s2,s3,x) -> print s1 -} diff --git a/testsuite/tests/codeGen/should_run/cgrun015.hs b/testsuite/tests/codeGen/should_run/cgrun015.hs index 4263c4b1b6..e60e46faf4 100644 --- a/testsuite/tests/codeGen/should_run/cgrun015.hs +++ b/testsuite/tests/codeGen/should_run/cgrun015.hs @@ -9,20 +9,20 @@ data CList = CNil | CCons Int# CList mk :: Int# -> CList mk n = if isTrue# (n ==# 0#) - then CNil - else CCons 1# (mk (n -# 1#)) + then CNil + else CCons 1# (mk (n -# 1#)) clen :: CList -> Int# clen CNil = 0# clen (CCons _ cl) = 1# +# (clen cl) main = case (clen list4) of - len4 -> - case (len4 +# len4) of - 8# -> finish 65# -- 'A' - _ -> finish 66# -- 'B' + len4 -> + case (len4 +# len4) of + 8# -> finish 65# -- 'A' + _ -> finish 66# -- 'B' where - list4 = mk 4# + list4 = mk 4# finish :: Int# -> IO () finish n = c_putchar (castCharToCChar (C# (chr# n))) >> return () diff --git a/testsuite/tests/codeGen/should_run/cgrun017.hs b/testsuite/tests/codeGen/should_run/cgrun017.hs index 275eb9b31b..749d20858d 100644 --- a/testsuite/tests/codeGen/should_run/cgrun017.hs +++ b/testsuite/tests/codeGen/should_run/cgrun017.hs @@ -29,5 +29,5 @@ instance Foo a => Foo [a] where -- try it: main = do putStr (show (op2 (3::Int) 3.14159)) - putStr (show (op2 'X' 3.14159)) + putStr (show (op2 'X' 3.14159)) putStr (show (op2 ([]::[Char])3.14159)) diff --git a/testsuite/tests/codeGen/should_run/cgrun018.hs b/testsuite/tests/codeGen/should_run/cgrun018.hs index 49f9800cb6..76669ec6b7 100644 --- a/testsuite/tests/codeGen/should_run/cgrun018.hs +++ b/testsuite/tests/codeGen/should_run/cgrun018.hs @@ -19,7 +19,7 @@ xxx = (Tfo (-0.8143#) (-0.5091#) (-0.2788#) (1.5227#) (6.9114#) (-7.0765#)) selectee1 = F# (case xxx of - Tfo _ _ _ _ _ _ _ x _ _ _ _ -> x) + Tfo _ _ _ _ _ _ _ x _ _ _ _ -> x) selectee2 = F# (case xxx of - Tfo _ _ y _ _ _ _ _ _ _ _ _ -> y) + Tfo _ _ y _ _ _ _ _ _ _ _ _ -> y) diff --git a/testsuite/tests/codeGen/should_run/cgrun021.hs b/testsuite/tests/codeGen/should_run/cgrun021.hs index 190f8dd155..bf7b404652 100644 --- a/testsuite/tests/codeGen/should_run/cgrun021.hs +++ b/testsuite/tests/codeGen/should_run/cgrun021.hs @@ -1,5 +1,5 @@ -- !!! Tests garbage collection in the branch of a case --- !!! alternative where the constructor is returned in the heap. +-- !!! alternative where the constructor is returned in the heap. {- This is also a rather stressful test for another reason. The mutual recursion between munch and f causes lots of @@ -10,7 +10,7 @@ As it turns out, they are mostly garbage, so the GC could eliminate them (though this isn't implemented at present), but that isn't - necessarily the case. + necessarily the case. The only correct solution is to spot that the updates are all updating with the same value (update frames stacked on top of each @@ -47,8 +47,8 @@ munch n Empty = return () -- error "this never happens!\n" munch 0 _ = putStr "I succeeded!\n" munch n s = case (f n s) of - (True, rest) -> rest - (False, _) -> error "this never happens either\n" + (True, rest) -> rest + (False, _) -> error "this never happens either\n" --f :: Int -> Stream a -> (Bool, [Request]) diff --git a/testsuite/tests/codeGen/should_run/cgrun022.hs b/testsuite/tests/codeGen/should_run/cgrun022.hs index e69675431c..d6f92bea0b 100644 --- a/testsuite/tests/codeGen/should_run/cgrun022.hs +++ b/testsuite/tests/codeGen/should_run/cgrun022.hs @@ -4,7 +4,7 @@ module Main where main = f (putStr "a") - (take 1000000 (repeat True)) - (putStr "b") + (take 1000000 (repeat True)) + (putStr "b") f a ns b = if last ns then a else b diff --git a/testsuite/tests/codeGen/should_run/cgrun026.hs b/testsuite/tests/codeGen/should_run/cgrun026.hs index a9dd570759..52dc9f43f3 100644 --- a/testsuite/tests/codeGen/should_run/cgrun026.hs +++ b/testsuite/tests/codeGen/should_run/cgrun026.hs @@ -5,7 +5,7 @@ module Main ( main ) where import GHC.Exts -import Data.Char ( chr ) +import Data.Char ( chr ) import Control.Monad.ST import Data.Array.ST @@ -14,12 +14,12 @@ import Data.Array.Unboxed import Data.Ratio main = putStr - (test_chars ++ "\n" ++ - test_ints ++ "\n" ++ - test_addrs ++ "\n" ++ - test_floats ++ "\n" ++ - test_doubles ++ "\n" ++ - test_ptrs ++ "\n") + (test_chars ++ "\n" ++ + test_ints ++ "\n" ++ + test_addrs ++ "\n" ++ + test_floats ++ "\n" ++ + test_doubles ++ "\n" ++ + test_ptrs ++ "\n") -- Arr# Char# ------------------------------------------- @@ -29,36 +29,36 @@ test_chars :: String test_chars = let arr# = f 1000 in - shows (lookup_range arr# 42# 416#) "\n" + shows (lookup_range arr# 42# 416#) "\n" where f :: Int -> UArray Int Char f size@(I# size#) = runST ( - -- allocate an array of the specified size - newArray_ (0, (size-1)) >>= \ arr# -> + -- allocate an array of the specified size + newArray_ (0, (size-1)) >>= \ arr# -> - -- fill in all elements; elem i has "i" put in it - fill_in arr# 0# (size# -# 1#) >> + -- fill in all elements; elem i has "i" put in it + fill_in arr# 0# (size# -# 1#) >> - -- freeze the puppy: - freeze arr# - ) + -- freeze the puppy: + freeze arr# + ) fill_in :: STUArray s Int Char -> Int# -> Int# -> ST s () fill_in arr_in# first# last# = if isTrue# (first# ># last#) - then return () - else writeArray arr_in# (I# first#) ((chr (I# first#))) >> - fill_in arr_in# (first# +# 1#) last# + then return () + else writeArray arr_in# (I# first#) ((chr (I# first#))) >> + fill_in arr_in# (first# +# 1#) last# lookup_range :: UArray Int Char -> Int# -> Int# -> [Char] lookup_range arr from# to# = if isTrue# (from# ># to#) - then [] - else (arr ! (I# from#)) - : (lookup_range arr (from# +# 1#) to#) + then [] + else (arr ! (I# from#)) + : (lookup_range arr (from# +# 1#) to#) -- Arr# Int# ------------------------------------------- @@ -66,36 +66,36 @@ test_ints :: String test_ints = let arr# = f 1000 in - shows (lookup_range arr# 42# 416#) "\n" + shows (lookup_range arr# 42# 416#) "\n" where f :: Int -> UArray Int Int f size@(I# size#) = runST ( - -- allocate an array of the specified size - newArray_ (0, (size-1)) >>= \ arr# -> + -- allocate an array of the specified size + newArray_ (0, (size-1)) >>= \ arr# -> - -- fill in all elements; elem i has i^2 put in it - fill_in arr# 0# (size# -# 1#) >> + -- fill in all elements; elem i has i^2 put in it + fill_in arr# 0# (size# -# 1#) >> - -- freeze the puppy: - freeze arr# - ) + -- freeze the puppy: + freeze arr# + ) fill_in :: STUArray s Int Int -> Int# -> Int# -> ST s () fill_in arr_in# first# last# = if isTrue# (first# ># last#) - then return () - else writeArray arr_in# (I# first#) (I# (first# *# first#)) >> - fill_in arr_in# (first# +# 1#) last# + then return () + else writeArray arr_in# (I# first#) (I# (first# *# first#)) >> + fill_in arr_in# (first# +# 1#) last# lookup_range :: UArray Int Int -> Int# -> Int# -> [Int] lookup_range arr from# to# = if isTrue# (from# ># to#) - then [] - else (arr ! (I# from#)) - : (lookup_range arr (from# +# 1#) to#) + then [] + else (arr ! (I# from#)) + : (lookup_range arr (from# +# 1#) to#) -- Arr# Addr# ------------------------------------------- @@ -103,40 +103,40 @@ test_addrs :: String test_addrs = let arr# = f 1000 in - shows (lookup_range arr# 42# 416#) "\n" + shows (lookup_range arr# 42# 416#) "\n" where f :: Int -> UArray Int (Ptr ()) f size@(I# size#) = runST ( - -- allocate an array of the specified size - newArray_ (0, (size-1)) >>= \ arr# -> + -- allocate an array of the specified size + newArray_ (0, (size-1)) >>= \ arr# -> - -- fill in all elements; elem i has i^2 put in it - fill_in arr# 0# (size# -# 1#) >> + -- fill in all elements; elem i has i^2 put in it + fill_in arr# 0# (size# -# 1#) >> - -- freeze the puppy: - freeze arr# - ) + -- freeze the puppy: + freeze arr# + ) fill_in :: STUArray s Int (Ptr ()) -> Int# -> Int# -> ST s () fill_in arr_in# first# last# = if isTrue# (first# ># last#) - then return () - else writeArray arr_in# (I# first#) - (Ptr (int2Addr# (first# *# first#))) >> - fill_in arr_in# (first# +# 1#) last# + then return () + else writeArray arr_in# (I# first#) + (Ptr (int2Addr# (first# *# first#))) >> + fill_in arr_in# (first# +# 1#) last# lookup_range :: UArray Int (Ptr ()) -> Int# -> Int# -> [ Int ] lookup_range arr from# to# = let - a2i (Ptr a#) = I# (addr2Int# a#) - in - if isTrue# (from# ># to#) - then [] - else (a2i (arr ! (I# from#))) - : (lookup_range arr (from# +# 1#) to#) + a2i (Ptr a#) = I# (addr2Int# a#) + in + if isTrue# (from# ># to#) + then [] + else (a2i (arr ! (I# from#))) + : (lookup_range arr (from# +# 1#) to#) -- Arr# Float# ------------------------------------------- @@ -144,40 +144,40 @@ test_floats :: String test_floats = let arr# = f 1000 in - shows (lookup_range arr# 42# 416#) "\n" + shows (lookup_range arr# 42# 416#) "\n" where f :: Int -> UArray Int Float f size@(I# size#) = runST ( - -- allocate an array of the specified size - newArray_ (0, (size-1)) >>= \ arr# -> + -- allocate an array of the specified size + newArray_ (0, (size-1)) >>= \ arr# -> - -- fill in all elements; elem i has "i * pi" put in it - fill_in arr# 0# (size# -# 1#) >> + -- fill in all elements; elem i has "i * pi" put in it + fill_in arr# 0# (size# -# 1#) >> - -- freeze the puppy: - freeze arr# - ) + -- freeze the puppy: + freeze arr# + ) fill_in :: STUArray s Int Float -> Int# -> Int# -> ST s () fill_in arr_in# first# last# = if isTrue# (first# ># last#) - then return () -{- else let e = ((fromIntegral (I# first#)) * pi) - in trace (show e) $ writeFloatArray arr_in# (I# first#) e >> - fill_in arr_in# (first# +# 1#) last# + then return () +{- else let e = ((fromIntegral (I# first#)) * pi) + in trace (show e) $ writeFloatArray arr_in# (I# first#) e >> + fill_in arr_in# (first# +# 1#) last# -} - else writeArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >> - fill_in arr_in# (first# +# 1#) last# + else writeArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >> + fill_in arr_in# (first# +# 1#) last# lookup_range :: UArray Int Float -> Int# -> Int# -> [Float] lookup_range arr from# to# = if isTrue# (from# ># to#) - then [] - else (arr ! (I# from#)) - : (lookup_range arr (from# +# 1#) to#) + then [] + else (arr ! (I# from#)) + : (lookup_range arr (from# +# 1#) to#) -- Arr# Double# ------------------------------------------- @@ -185,36 +185,36 @@ test_doubles :: String test_doubles = let arr# = f 1000 in - shows (lookup_range arr# 42# 416#) "\n" + shows (lookup_range arr# 42# 416#) "\n" where f :: Int -> UArray Int Double f size@(I# size#) = runST ( - -- allocate an array of the specified size - newArray_ (0, (size-1)) >>= \ arr# -> + -- allocate an array of the specified size + newArray_ (0, (size-1)) >>= \ arr# -> - -- fill in all elements; elem i has "i * pi" put in it - fill_in arr# 0# (size# -# 1#) >> + -- fill in all elements; elem i has "i * pi" put in it + fill_in arr# 0# (size# -# 1#) >> - -- freeze the puppy: - freeze arr# - ) + -- freeze the puppy: + freeze arr# + ) fill_in :: STUArray s Int Double -> Int# -> Int# -> ST s () fill_in arr_in# first# last# = if isTrue# (first# ># last#) - then return () - else writeArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >> - fill_in arr_in# (first# +# 1#) last# + then return () + else writeArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >> + fill_in arr_in# (first# +# 1#) last# lookup_range :: UArray Int Double -> Int# -> Int# -> [Double] lookup_range arr from# to# = if isTrue# (from# ># to#) - then [] - else (arr ! (I# from#)) - : (lookup_range arr (from# +# 1#) to#) + then [] + else (arr ! (I# from#)) + : (lookup_range arr (from# +# 1#) to#) -- Arr# (Ratio Int) (ptrs) --------------------------------- -- just like Int# test @@ -223,28 +223,28 @@ test_ptrs :: String test_ptrs = let arr# = f 1000 in - shows (lookup_range arr# 42 416) "\n" + shows (lookup_range arr# 42 416) "\n" where f :: Int -> Array Int (Ratio Int) f size = runST ( - newArray (1, size) (3 % 5) >>= \ arr# -> - -- don't fill in the whole thing - fill_in arr# 1 400 >> - freeze arr# - ) + newArray (1, size) (3 % 5) >>= \ arr# -> + -- don't fill in the whole thing + fill_in arr# 1 400 >> + freeze arr# + ) fill_in :: STArray s Int (Ratio Int) -> Int -> Int -> ST s () fill_in arr_in# first last = if (first > last) - then return () - else writeArray arr_in# first (fromIntegral (first * first)) >> - fill_in arr_in# (first + 1) last + then return () + else writeArray arr_in# first (fromIntegral (first * first)) >> + fill_in arr_in# (first + 1) last lookup_range :: Array Int (Ratio Int) -> Int -> Int -> [Ratio Int] lookup_range array from too = if (from > too) - then [] - else (array ! from) : (lookup_range array (from + 1) too) + then [] + else (array ! from) : (lookup_range array (from + 1) too) diff --git a/testsuite/tests/codeGen/should_run/cgrun027.hs b/testsuite/tests/codeGen/should_run/cgrun027.hs index 646d05c38b..bf3183e509 100644 --- a/testsuite/tests/codeGen/should_run/cgrun027.hs +++ b/testsuite/tests/codeGen/should_run/cgrun027.hs @@ -4,7 +4,7 @@ class (Num a, Integral a) => Foo a main = putStr (shows (f ((fromInteger 21)::Int) - ((fromInteger 37))) "\n") + ((fromInteger 37))) "\n") instance Foo Int diff --git a/testsuite/tests/codeGen/should_run/cgrun031.hs b/testsuite/tests/codeGen/should_run/cgrun031.hs index 2a2c7a9b64..259697d961 100644 --- a/testsuite/tests/codeGen/should_run/cgrun031.hs +++ b/testsuite/tests/codeGen/should_run/cgrun031.hs @@ -19,8 +19,8 @@ prog :: Int -> Int -> Int prog size_1 size_2 = let - list1 = static1 : (map mk_foo [1 .. size_1]) - list2 = static2 : (map mk_foo [1 .. size_2]) + list1 = static1 : (map mk_foo [1 .. size_1]) + list2 = static2 : (map mk_foo [1 .. size_2]) in I# (add_up 0# list1 (reverse list2)) diff --git a/testsuite/tests/codeGen/should_run/cgrun033.hs b/testsuite/tests/codeGen/should_run/cgrun033.hs index 6e4a0b9a9d..3cdf176c91 100644 --- a/testsuite/tests/codeGen/should_run/cgrun033.hs +++ b/testsuite/tests/codeGen/should_run/cgrun033.hs @@ -9,10 +9,10 @@ main = putStr (shows true_or_false "\n") where true_or_false = case (cmp_name True imp1 imp2) of - -1# -> False - 0# -> True - 1# -> False - + -1# -> False + 0# -> True + 1# -> False + imp1 = Imp s "Imp1" s s imp2 = Imp s "Imp2" s s @@ -36,17 +36,17 @@ cmp_name False (Imp m1 n1 _ _) (Imp m2 n2 _ _) = case cmpString n1 n2 of { -1# -> -1#; 0# -> case cmpString m1 m2 of { - 0# -> 0#; - xxx -> if null m1 || null m2 - then 0# - else xxx - }; + 0# -> 0#; + xxx -> if null m1 || null m2 + then 0# + else xxx + }; _ -> 1# } cmp_name True (Imp _ _ _ o1) (Prel nm) = let - (_, n2) = getOrigName nm + (_, n2) = getOrigName nm in cmpString o1 n2 @@ -61,15 +61,15 @@ cmp_name by_local other_p1 other_p2 _ -> -1# data ProtoName - = Unk String -- local name in module + = Unk String -- local name in module - | Imp String -- name of defining module - String -- name used in defining name - String -- name of the module whose interface told me - -- about this thing - String -- occurrence name + | Imp String -- name of defining module + String -- name used in defining name + String -- name of the module whose interface told me + -- about this thing + String -- occurrence name - | Prel String{-Name-} + | Prel String{-Name-} cmpString, cmpName :: String -> String -> Int# cmpString a b = 0# diff --git a/testsuite/tests/codeGen/should_run/cgrun034.hs b/testsuite/tests/codeGen/should_run/cgrun034.hs index 0f7f05297e..4975e8df2d 100644 --- a/testsuite/tests/codeGen/should_run/cgrun034.hs +++ b/testsuite/tests/codeGen/should_run/cgrun034.hs @@ -3,17 +3,17 @@ import Data.Ratio -- 1.3 main = putStr ( shows tinyFloat ( '\n' - : shows t_f ( '\n' + : shows t_f ( '\n' : shows hugeFloat ( '\n' - : shows h_f ( '\n' + : shows h_f ( '\n' : shows tinyDouble ( '\n' - : shows t_d ( '\n' + : shows t_d ( '\n' : shows hugeDouble ( '\n' - : shows h_d ( '\n' - : shows x_f ( '\n' - : shows x_d ( '\n' - : shows y_f ( '\n' - : shows y_d ( "\n" + : shows h_d ( '\n' + : shows x_f ( '\n' + : shows x_d ( '\n' + : shows y_f ( '\n' + : shows y_d ( "\n" ))))))))))))) where t_f :: Float @@ -35,48 +35,48 @@ main = putStr ( fromRationalX :: (RealFloat a) => Rational -> a fromRationalX r = - let - h = ceiling (huge `asTypeOf` x) - b = toInteger (floatRadix x) - x = fromRat 0 r - fromRat e0 r' = - let d = denominator r' - n = numerator r' - in if d > h then - let e = integerLogBase b (d `div` h) + 1 - in fromRat (e0-e) (n % (d `div` (b^e))) - else if abs n > h then - let e = integerLogBase b (abs n `div` h) + 1 - in fromRat (e0+e) ((n `div` (b^e)) % d) - else - scaleFloat e0 (rationalToRealFloat {-fromRational-} r') - in x + let + h = ceiling (huge `asTypeOf` x) + b = toInteger (floatRadix x) + x = fromRat 0 r + fromRat e0 r' = + let d = denominator r' + n = numerator r' + in if d > h then + let e = integerLogBase b (d `div` h) + 1 + in fromRat (e0-e) (n % (d `div` (b^e))) + else if abs n > h then + let e = integerLogBase b (abs n `div` h) + 1 + in fromRat (e0+e) ((n `div` (b^e)) % d) + else + scaleFloat e0 (rationalToRealFloat {-fromRational-} r') + in x {- fromRationalX r = rationalToRealFloat r {- Hmmm... - let - h = ceiling (huge `asTypeOf` x) - b = toInteger (floatRadix x) - x = fromRat 0 r - - fromRat e0 r' = -{--} trace (shows e0 ('/' : shows r' ('/' : shows h "\n"))) ( - let d = denominator r' - n = numerator r' - in if d > h then - let e = integerLogBase b (d `div` h) + 1 - in fromRat (e0-e) (n % (d `div` (b^e))) - else if abs n > h then - let e = integerLogBase b (abs n `div` h) + 1 - in fromRat (e0+e) ((n `div` (b^e)) % d) - else - scaleFloat e0 (rationalToRealFloat r') - -- now that we know things are in-bounds, - -- we use the "old" Prelude code. -{--} ) - in x + let + h = ceiling (huge `asTypeOf` x) + b = toInteger (floatRadix x) + x = fromRat 0 r + + fromRat e0 r' = +{--} trace (shows e0 ('/' : shows r' ('/' : shows h "\n"))) ( + let d = denominator r' + n = numerator r' + in if d > h then + let e = integerLogBase b (d `div` h) + 1 + in fromRat (e0-e) (n % (d `div` (b^e))) + else if abs n > h then + let e = integerLogBase b (abs n `div` h) + 1 + in fromRat (e0+e) ((n `div` (b^e)) % d) + else + scaleFloat e0 (rationalToRealFloat r') + -- now that we know things are in-bounds, + -- we use the "old" Prelude code. +{--} ) + in x -} -} @@ -88,11 +88,11 @@ integerLogBase b i = if i < b then 0 else - -- Try squaring the base first to cut down the number of divisions. + -- Try squaring the base first to cut down the number of divisions. let l = 2 * integerLogBase (b*b) i - doDiv :: Integer -> Int -> Int - doDiv i l = if i < b then l else doDiv (i `div` b) (l+1) - in doDiv (i `div` (b^l)) l + doDiv :: Integer -> Int -> Int + doDiv i l = if i < b then l else doDiv (i `div` b) (l+1) + in doDiv (i `div` (b^l)) l ------------ @@ -100,16 +100,16 @@ integerLogBase b i = -- Compute smallest and largest floating point values. tiny :: (RealFloat a) => a tiny = - let (l, _) = floatRange x - x = encodeFloat 1 (l-1) - in x + let (l, _) = floatRange x + x = encodeFloat 1 (l-1) + in x huge :: (RealFloat a) => a huge = - let (_, u) = floatRange x - d = floatDigits x - x = encodeFloat (floatRadix x ^ d - 1) (u - d) - in x + let (_, u) = floatRange x + d = floatDigits x + x = encodeFloat (floatRadix x ^ d - 1) (u - d) + in x tinyDouble = tiny :: Double tinyFloat = tiny :: Float @@ -122,9 +122,9 @@ hugeFloat = huge :: Float A quite reasonable request! This code was added to the Prelude just before the 1.2 release, when Lennart, working with an early version of hbi, noticed that (read . show) was not the identity for -floating-point numbers. (There was a one-bit error about half the time.) +floating-point numbers. (There was a one-bit error about half the time.) The original version of the conversion function was in fact simply -a floating-point divide, as you suggest above. The new version is, +a floating-point divide, as you suggest above. The new version is, I grant you, somewhat denser. How's this? @@ -135,27 +135,27 @@ How's this? rationalToRealFloat :: (RealFloat a) => Rational -> a -rationalToRealFloat x = x' - where x' = f e - --- If the exponent of the nearest floating-point number to x --- is e, then the significand is the integer nearest xb^(-e), --- where b is the floating-point radix. We start with a good --- guess for e, and if it is correct, the exponent of the --- floating-point number we construct will again be e. If --- not, one more iteration is needed. - - f e = if e' == e then y else f e' - where y = encodeFloat (round (x * (1%b)^^e)) e - (_,e') = decodeFloat y - b = floatRadix x' - --- We obtain a trial exponent by doing a floating-point --- division of x's numerator by its denominator. The --- result of this division may not itself be the ultimate --- result, because of an accumulation of three rounding --- errors. - - (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x' - / fromInteger (denominator x)) +rationalToRealFloat x = x' + where x' = f e + +-- If the exponent of the nearest floating-point number to x +-- is e, then the significand is the integer nearest xb^(-e), +-- where b is the floating-point radix. We start with a good +-- guess for e, and if it is correct, the exponent of the +-- floating-point number we construct will again be e. If +-- not, one more iteration is needed. + + f e = if e' == e then y else f e' + where y = encodeFloat (round (x * (1%b)^^e)) e + (_,e') = decodeFloat y + b = floatRadix x' + +-- We obtain a trial exponent by doing a floating-point +-- division of x's numerator by its denominator. The +-- result of this division may not itself be the ultimate +-- result, because of an accumulation of three rounding +-- errors. + + (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x' + / fromInteger (denominator x)) diff --git a/testsuite/tests/codeGen/should_run/cgrun036.hs b/testsuite/tests/codeGen/should_run/cgrun036.hs index 40bfa74328..09d9e32008 100644 --- a/testsuite/tests/codeGen/should_run/cgrun036.hs +++ b/testsuite/tests/codeGen/should_run/cgrun036.hs @@ -10,7 +10,7 @@ g :: Int -> Int -> Int -> [Int] g x y z = let - f a b = a + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b - g c = f c c + f a b = a + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + g c = f c c in [g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y] diff --git a/testsuite/tests/codeGen/should_run/cgrun040.hs b/testsuite/tests/codeGen/should_run/cgrun040.hs index d747d4ab8b..6f34ac3910 100644 --- a/testsuite/tests/codeGen/should_run/cgrun040.hs +++ b/testsuite/tests/codeGen/should_run/cgrun040.hs @@ -1,7 +1,7 @@ module Main(main) where data Burble a = B1 { op1 :: a -> Int, op2 :: Int -> a, op3 :: Int} - | B2 { op2 :: Int -> a, op4 :: Int -> Int } + | B2 { op2 :: Int -> a, op4 :: Int -> Int } f1 :: Int -> Burble Int diff --git a/testsuite/tests/codeGen/should_run/cgrun047.hs b/testsuite/tests/codeGen/should_run/cgrun047.hs index 234c6671b6..8880814e78 100644 --- a/testsuite/tests/codeGen/should_run/cgrun047.hs +++ b/testsuite/tests/codeGen/should_run/cgrun047.hs @@ -1,14 +1,14 @@ module Main where --- GHC 4.04 +-- GHC 4.04 -- I've been having problems getting GHC to compile some code I'm working -- on with optimisation (-O) turned on. Compilation is fine without -O -- specified. Through a process of elimination I've managed to reproduce --- the problemin the following (much simpler) piece of code: +-- the problemin the following (much simpler) piece of code: import Data.List -test es = +test es = concat (groupBy eq (zip [0..(length es) - 1] es)) where eq a b = (fst a) == (fst b) diff --git a/testsuite/tests/codeGen/should_run/cgrun049.hs b/testsuite/tests/codeGen/should_run/cgrun049.hs index d4b6a77908..f74bffef07 100644 --- a/testsuite/tests/codeGen/should_run/cgrun049.hs +++ b/testsuite/tests/codeGen/should_run/cgrun049.hs @@ -11,12 +11,12 @@ g (MkT x _ _ _) = x data T = MkT Int !Int !(Int,Int) !(S Int) -data S a = MkS a a +data S a = MkS a a {-# NOINLINE f #-} -f :: T -> T -- Takes apart the thing and puts it - -- back together differently +f :: T -> T -- Takes apart the thing and puts it + -- back together differently f (MkT x y (a,b) (MkS p q)) = MkT a b (p,q) (MkS x y) diff --git a/testsuite/tests/codeGen/should_run/cgrun050.hs b/testsuite/tests/codeGen/should_run/cgrun050.hs index 7eb2cee05f..bbc3d11960 100644 --- a/testsuite/tests/codeGen/should_run/cgrun050.hs +++ b/testsuite/tests/codeGen/should_run/cgrun050.hs @@ -1,7 +1,7 @@ -- !! Test strict, recursive newtypes -- This test made a pre-5.02 fall over -- Reason: the seq arising from the !F didn't see that --- the represtation of F is a function. +-- the represtation of F is a function. -- NB It's crucial to compile this test *without* -O -- The $ then prevents the 'F' from seeing the '\x' @@ -9,8 +9,8 @@ module Main ( main ) where -newtype F = F (Int -> Val) -- NB: F and Val are -data Val = VFn !F | VInt !Int -- mutually recursive +newtype F = F (Int -> Val) -- NB: F and Val are +data Val = VFn !F | VInt !Int -- mutually recursive f :: Val -> Val f (VFn (F f)) = f 4 diff --git a/testsuite/tests/codeGen/should_run/cgrun051.hs b/testsuite/tests/codeGen/should_run/cgrun051.hs index c8ebb7f5e3..43787b5e2c 100644 --- a/testsuite/tests/codeGen/should_run/cgrun051.hs +++ b/testsuite/tests/codeGen/should_run/cgrun051.hs @@ -1,9 +1,9 @@ module Main where -data T1 -- No constructors +data T1 -- No constructors data T2 = T2 !T1 Int main = print (case (T2 (error "OK") 1) of { T2 x y -> y }) --- We should hit the (error "OK") case
\ No newline at end of file +-- We should hit the (error "OK") case diff --git a/testsuite/tests/codeGen/should_run/cgrun052.hs b/testsuite/tests/codeGen/should_run/cgrun052.hs index cfce05442f..d59f6bba83 100644 --- a/testsuite/tests/codeGen/should_run/cgrun052.hs +++ b/testsuite/tests/codeGen/should_run/cgrun052.hs @@ -9,5 +9,5 @@ f 0 = C3 (C1 T1) 42 f n = C3 (C1 T1) n main = case f 23 of - C3 y z -> case y of - C1 T1 -> putStrLn "ok" + C3 y z -> case y of + C1 T1 -> putStrLn "ok" diff --git a/testsuite/tests/codeGen/should_run/cgrun054.hs b/testsuite/tests/codeGen/should_run/cgrun054.hs index cff967e9bb..dd4d7c8e17 100644 --- a/testsuite/tests/codeGen/should_run/cgrun054.hs +++ b/testsuite/tests/codeGen/should_run/cgrun054.hs @@ -1,7 +1,7 @@ module Main where data Y = X1 | X2 | X3 | X4 | X5 | X6 | X7 | X8 - deriving( Show ) + deriving( Show ) data X = WithY Y | A1 | A2 | A3 | A4 | A5 | A6 | A7 | A8 @@ -19,8 +19,8 @@ foo (WithY _) = X1 bar :: X -> Y bar (WithY x) = x -bar y = foobar (foo y) -- The WithY case can't occur, and in an - -- earlier version that confused the code generator +bar y = foobar (foo y) -- The WithY case can't occur, and in an + -- earlier version that confused the code generator {-# NOINLINE foobar #-} foobar x = x diff --git a/testsuite/tests/codeGen/should_run/cgrun058.hs b/testsuite/tests/codeGen/should_run/cgrun058.hs index f0001584d1..9bdd551acf 100644 --- a/testsuite/tests/codeGen/should_run/cgrun058.hs +++ b/testsuite/tests/codeGen/should_run/cgrun058.hs @@ -25,6 +25,6 @@ myMul x y = tn ((ti x) * (ti y)) test = [ (x,y,ti (myMul (tn x) (tn y)),x * y) | x<-[-100, -99, -98, -97, -2, -1, 0, 1, 2, 97, 98, 99, 100], y<-([-100..(-1)]++[1..100]), - testi myMul (*) x y ] + testi myMul (*) x y ] main = print test diff --git a/testsuite/tests/deSugar/should_run/T246.hs b/testsuite/tests/deSugar/should_run/T246.hs index 835e618b79..448141cd65 100644 --- a/testsuite/tests/deSugar/should_run/T246.hs +++ b/testsuite/tests/deSugar/should_run/T246.hs @@ -16,10 +16,10 @@ g _ = "Odd3" funny = T { x = undefined, y = False } main = do { print (f funny) -- Should work, because we test - -- y first, which fails, and falls - -- through to "OK" + -- y first, which fails, and falls + -- through to "OK" - ; Control.Exception.catch - (print (g funny)) -- Should fail, because we test - (\(_::SomeException) -> print "caught") -- x first, and hit "undefined" - } + ; Control.Exception.catch + (print (g funny)) -- Should fail, because we test + (\(_::SomeException) -> print "caught") -- x first, and hit "undefined" + } diff --git a/testsuite/tests/deSugar/should_run/dsrun001.hs b/testsuite/tests/deSugar/should_run/dsrun001.hs index e40ea2a11d..904926ca3e 100644 --- a/testsuite/tests/deSugar/should_run/dsrun001.hs +++ b/testsuite/tests/deSugar/should_run/dsrun001.hs @@ -1,6 +1,6 @@ -{- Check that list comprehensions can be written - in do-notation. This actually broke 2.02, with - a pattern match failure in dsListComp! +{- Check that list comprehensions can be written + in do-notation. This actually broke 2.02, with + a pattern match failure in dsListComp! -} module Main where diff --git a/testsuite/tests/deSugar/should_run/dsrun002.hs b/testsuite/tests/deSugar/should_run/dsrun002.hs index acad275f74..09dc52d9de 100644 --- a/testsuite/tests/deSugar/should_run/dsrun002.hs +++ b/testsuite/tests/deSugar/should_run/dsrun002.hs @@ -3,12 +3,12 @@ module Main( main ) where foo = do - putStr "a" - let x = "b" in putStr x - putStr "c" + putStr "a" + let x = "b" in putStr x + putStr "c" main = do - putStr "a" - foo - let x = "b" in putStrLn x + putStr "a" + foo + let x = "b" in putStrLn x diff --git a/testsuite/tests/deSugar/should_run/dsrun003.hs b/testsuite/tests/deSugar/should_run/dsrun003.hs index d100bff718..94ca28ccf9 100644 --- a/testsuite/tests/deSugar/should_run/dsrun003.hs +++ b/testsuite/tests/deSugar/should_run/dsrun003.hs @@ -1,10 +1,10 @@ --- Tests match on empty field lists +-- Tests match on empty field lists module Main where -data Person = Female {firstName, lastName :: String} - | Male {firstName, lastName :: String} - deriving (Show) +data Person = Female {firstName, lastName :: String} + | Male {firstName, lastName :: String} + deriving (Show) isFemale (Female{}) = True isFemale (Male{}) = False diff --git a/testsuite/tests/deSugar/should_run/dsrun004.hs b/testsuite/tests/deSugar/should_run/dsrun004.hs index 8f54e330e1..555e11bb63 100644 --- a/testsuite/tests/deSugar/should_run/dsrun004.hs +++ b/testsuite/tests/deSugar/should_run/dsrun004.hs @@ -9,5 +9,5 @@ f (n+1) = n g :: Int -> Int g (n+4) = n -main = print (f 3) >> +main = print (f 3) >> print (g 9) diff --git a/testsuite/tests/deSugar/should_run/dsrun005.hs b/testsuite/tests/deSugar/should_run/dsrun005.hs index 238a2c3410..5ec70a377d 100644 --- a/testsuite/tests/deSugar/should_run/dsrun005.hs +++ b/testsuite/tests/deSugar/should_run/dsrun005.hs @@ -1,13 +1,13 @@ -{- +{- From: Olaf Chitil <chitil@Informatik.RWTH-Aachen.DE> It is a problem with 0.29 (which we use for compiling 2.01), it is gone in 2.01. - f :: Eq a => a -> [b] -> [b] -> Bool - f a [] [] = (a==a) - main = print (f True "" "Hallo") + f :: Eq a => a -> [b] -> [b] -> Bool + f a [] [] = (a==a) + main = print (f True "" "Hallo") when run after compilation with 0.29 you get: @@ -18,9 +18,9 @@ Fail: In pattern-matching: function f{-aYw-}; at test.hs, line 6 The problem is the dictionary, because for the program - f :: a -> [b] -> [b] -> Bool - f a [] [] = True - main = print (f True "" "Hallo") + f :: a -> [b] -> [b] -> Bool + f a [] [] = True + main = print (f True "" "Hallo") 0.29 gives the function name "f" as well. diff --git a/testsuite/tests/deSugar/should_run/dsrun006.hs b/testsuite/tests/deSugar/should_run/dsrun006.hs index 759c9c542d..dc31dac6b8 100644 --- a/testsuite/tests/deSugar/should_run/dsrun006.hs +++ b/testsuite/tests/deSugar/should_run/dsrun006.hs @@ -1,23 +1,23 @@ -{- +{- Date: Tue, 20 May 1997 05:10:04 GMT From: Tomasz Cholewo <tjchol01@mecca.spd.louisville.edu> ghc-2.03 cannot compile the following code, which I think is correct according to the Report - data X = A {a :: Int} | B {a :: Int} + data X = A {a :: Int} | B {a :: Int} -The error message is: +The error message is: Conflicting definitions for: a - Defined at bug4.lhs:2 - Defined at bug4.lhs:2 + Defined at bug4.lhs:2 + Defined at bug4.lhs:2 In addition the following snippet - data X = A {a :: Int} - y = let A {a} = x - in a + data X = A {a :: Int} + y = let A {a} = x + in a fails with: diff --git a/testsuite/tests/deSugar/should_run/dsrun010.hs b/testsuite/tests/deSugar/should_run/dsrun010.hs index 99a9297f8b..4b8bf4e1bc 100644 --- a/testsuite/tests/deSugar/should_run/dsrun010.hs +++ b/testsuite/tests/deSugar/should_run/dsrun010.hs @@ -9,10 +9,10 @@ test :: (MonadPlus m) => [a] -> m Bool test xs = do (_:_) <- return xs - -- Should fail here + -- Should fail here return True `mplus` - -- Failure in LH arg should trigger RH arg + -- Failure in LH arg should trigger RH arg do return False diff --git a/testsuite/tests/deSugar/should_run/dsrun014.hs b/testsuite/tests/deSugar/should_run/dsrun014.hs index 3b08a7ebf0..8e72aaad1f 100644 --- a/testsuite/tests/deSugar/should_run/dsrun014.hs +++ b/testsuite/tests/deSugar/should_run/dsrun014.hs @@ -10,7 +10,7 @@ f x y = x `seq` y `seq` (# x,y #) g :: Int -> Int -> Int g v w = case f v w of - (# a,b #) -> a+b + (# a,b #) -> a+b main = print (g (trace "one" 1) (trace "two" 2)) -- The args should be evaluated in the right order! diff --git a/testsuite/tests/ghci/prog008/A.hs b/testsuite/tests/ghci/prog008/A.hs index d724bd2c9c..650d5accc4 100644 --- a/testsuite/tests/ghci/prog008/A.hs +++ b/testsuite/tests/ghci/prog008/A.hs @@ -3,9 +3,9 @@ -- Tests a bug spotted by Claus in which the type -- of c3 was wrongly displayed in GHCi as --- c3 :: C a b => a -> b +-- c3 :: C a b => a -> b -- Should be --- c3 :: C a b => a1 -> b +-- c3 :: C a b => a1 -> b module A where diff --git a/testsuite/tests/ghci/scripts/Defer03.hs b/testsuite/tests/ghci/scripts/Defer03.hs index b0f65fbade..b0f65fbade 100755..100644 --- a/testsuite/tests/ghci/scripts/Defer03.hs +++ b/testsuite/tests/ghci/scripts/Defer03.hs diff --git a/testsuite/tests/ghci/should_run/ghcirun001.hs b/testsuite/tests/ghci/should_run/ghcirun001.hs index af193ecb97..be893bcf47 100644 --- a/testsuite/tests/ghci/should_run/ghcirun001.hs +++ b/testsuite/tests/ghci/should_run/ghcirun001.hs @@ -4,7 +4,7 @@ module Main where -- libraries/base/GHC/Base.lhs for the fix. data FourArrow = A | B | C | D | E | ABE | AC | BD | CDE - deriving (Eq) + deriving (Eq) dom E = ABE @@ -24,7 +24,7 @@ bceFour f g | dom f == dom g && cod f == cod g = "it works" | otherwise = error ("Four.bceFour: precondition fails:" - ++ "arrows not parallel" - ++ "\n") + ++ "arrows not parallel" + ++ "\n") main = print (bceFour E E) diff --git a/testsuite/tests/haddock/haddock_examples/Test.hs b/testsuite/tests/haddock/haddock_examples/Test.hs index da149d0ac0..71744f7325 100644 --- a/testsuite/tests/haddock/haddock_examples/Test.hs +++ b/testsuite/tests/haddock/haddock_examples/Test.hs @@ -4,7 +4,7 @@ -- Module : Test -- Copyright : (c) Simon Marlow 2002 -- License : BSD-style --- +-- -- Maintainer : libraries@haskell.org -- Stability : provisional -- Portability : portable @@ -16,80 +16,80 @@ -- This is plain comment, ignored by Haddock. -module Test ( +module Test ( + + -- Section headings are introduced with '-- *': + -- * Type declarations - -- Section headings are introduced with '-- *': - -- * Type declarations + -- Subsection headings are introduced with '-- **' and so on. + -- ** Data types + T(..), T2, T3(..), T4(..), T5(..), T6(..), + N1(..), N2(..), N3(..), N4, N5(..), N6(..), N7(..), - -- Subsection headings are introduced with '-- **' and so on. - -- ** Data types - T(..), T2, T3(..), T4(..), T5(..), T6(..), - N1(..), N2(..), N3(..), N4, N5(..), N6(..), N7(..), + -- ** Records + R(..), R1(..), - -- ** Records - R(..), R1(..), + -- | test that we can export record selectors on their own: + p, q, u, - -- | test that we can export record selectors on their own: - p, q, u, + -- * Class declarations + C(a,b), D(..), E, F(..), - -- * Class declarations - C(a,b), D(..), E, F(..), - - -- | Test that we can export a class method on its own: - a, + -- | Test that we can export a class method on its own: + a, - -- * Function types - f, g, + -- * Function types + f, g, - -- * Auxiliary stuff + -- * Auxiliary stuff - -- $aux1 + -- $aux1 - -- $aux2 + -- $aux2 - -- $aux3 + -- $aux3 - -- $aux4 + -- $aux4 - -- $aux5 + -- $aux5 - -- $aux6 + -- $aux6 - -- $aux7 + -- $aux7 - -- $aux8 + -- $aux8 - -- $aux9 + -- $aux9 - -- $aux10 + -- $aux10 - -- $aux11 + -- $aux11 - -- $aux12 + -- $aux12 - -- | This is some inline documentation in the export list - -- - -- > a code block using bird-tracks - -- > each line must begin with > (which isn't significant unless it - -- > is at the beginning of the line). + -- | This is some inline documentation in the export list + -- + -- > a code block using bird-tracks + -- > each line must begin with > (which isn't significant unless it + -- > is at the beginning of the line). - -- * A hidden module - module Hidden, + -- * A hidden module + module Hidden, - -- * A visible module - module Visible, + -- * A visible module + module Visible, - {-| nested-style doc comments -} + {-| nested-style doc comments -} - -- * Existential \/ Universal types - Ex(..), + -- * Existential \/ Universal types + Ex(..), - -- * Type signatures with argument docs - k, l, m, o, + -- * Type signatures with argument docs + k, l, m, o, - -- * A section - -- and without an intervening comma: - -- ** A subsection + -- * A section + -- and without an intervening comma: + -- ** A subsection {-| > a literal line @@ -97,7 +97,7 @@ module Test ( $ a non /literal/ line $ -} - f', + f', ) where import Hidden @@ -108,7 +108,7 @@ import Visible data T a b = A Int (Maybe Float) -- ^ This comment describes the 'A' constructor | -- | This comment describes the 'B' constructor - B (T a b, T Int Float) -- ^ + B (T a b, T Int Float) -- ^ -- | An abstract data declaration data T2 a b = T2 a b @@ -141,25 +141,25 @@ newtype N1 a = N1 a newtype N2 a b = N2 {n :: a b} -- | A newtype with a fieldname, documentation on the field -newtype N3 a b = N3 {n3 :: a b -- ^ this is the 'n3' field - } +newtype N3 a b = N3 {n3 :: a b -- ^ this is the 'n3' field + } -- | An abstract newtype - we show this one as data rather than newtype because -- the difference isn\'t visible to the programmer for an abstract type. newtype N4 a b = N4 a newtype N5 a b = N5 {n5 :: a b -- ^ no docs on the datatype or the constructor - } + } newtype N6 a b = N6 {n6 :: a b - } - -- ^ docs on the constructor only + } + -- ^ docs on the constructor only -- | docs on the newtype and the constructor newtype N7 a b = N7 {n7 :: a b - } - -- ^ The 'N7' constructor - + } + -- ^ The 'N7' constructor + class (D a) => C a where -- |this is a description of the 'a' method @@ -194,7 +194,7 @@ class F a where -- | This is the documentation for the 'R' record, which has four fields, -- 'p', 'q', 'r', and 's'. -data R = +data R = -- | This is the 'C1' record constructor, with the following fields: C1 { p :: Int -- ^ This comment applies to the 'p' field , q :: forall a . a->a -- ^ This comment applies to the 'q' field @@ -207,16 +207,16 @@ data R = -- ^ This is the 'C2' record constructor, also with some fields: -- | Testing different record commenting styles -data R1 +data R1 -- | This is the 'C3' record constructor - = C3 { - -- | The 's1' record selector - s1 :: Int - -- | The 's2' record selector - , s2 :: Int - , s3 :: Int -- NOTE: In the original examples/Test.hs in Haddock, there is an extra "," here. - -- Since GHC doesn't allow that, I have removed it in this file. - -- ^ The 's3' record selector + = C3 { + -- | The 's1' record selector + s1 :: Int + -- | The 's2' record selector + , s2 :: Int + , s3 :: Int -- NOTE: In the original examples/Test.hs in Haddock, there is an extra "," here. + -- Since GHC doesn't allow that, I have removed it in this file. + -- ^ The 's3' record selector } -- These section headers are only used when there is no export list to @@ -236,7 +236,7 @@ using double quotes: "Foo". We can add emphasis /like this/. - This is the next item (different kind of bullet) (1) This is an ordered list - + 2. This is the next item (different kind of bullet) @ @@ -342,42 +342,42 @@ test2 -- $aux12 -- > foo --- +-- -- > bar --- +-- -- | A data-type using existential\/universal types -data Ex a +data Ex a = forall b . C b => Ex1 b | forall b . Ex2 b - | forall b . C a => Ex3 b -- NOTE: I have added "forall b" here make GHC accept this file + | forall b . C a => Ex3 b -- NOTE: I have added "forall b" here make GHC accept this file | Ex4 (forall a . a -> a) -- | This is a function with documentation for each argument -k :: T () () -- ^ This argument has type 'T' +k :: T () () -- ^ This argument has type 'T' -> (T2 Int Int) -- ^ This argument has type 'T2 Int Int' -> (T3 Bool Bool -> T4 Float Float) -- ^ This argument has type @T3 Bool Bool -> T4 Float Float@ - -> T5 () () -- ^ This argument has a very long description that should - -- hopefully cause some wrapping to happen when it is finally - -- rendered by Haddock in the generated HTML page. - -> IO () -- ^ This is the result type + -> T5 () () -- ^ This argument has a very long description that should + -- hopefully cause some wrapping to happen when it is finally + -- rendered by Haddock in the generated HTML page. + -> IO () -- ^ This is the result type -- This function has arg docs but no docs for the function itself l :: (Int, Int, Float) -- ^ takes a triple -> Int -- ^ returns an 'Int' --- | This function has some arg docs +-- | This function has some arg docs m :: R - -> N1 () -- ^ one of the arguments - -> IO Int -- ^ and the return value + -> N1 () -- ^ one of the arguments + -> IO Int -- ^ and the return value -- | This function has some arg docs but not a return value doc -- can't use the original name ('n') with GHC -newn :: R -- ^ one of the arguments, an 'R' - -> N1 () -- ^ one of the arguments +newn :: R -- ^ one of the arguments, an 'R' + -> N1 () -- ^ one of the arguments -> IO Int -newn = undefined +newn = undefined -- | A foreign import with argument docs @@ -387,12 +387,12 @@ foreign import ccall unsafe "header.h" -- | We should be able to escape this: \#\#\# --- p :: Int +-- p :: Int -- can't use the above original definition with GHC -newp :: Int +newp :: Int newp = undefined --- | a function with a prime can be referred to as 'f'' +-- | a function with a prime can be referred to as 'f'' -- but f' doesn't get link'd 'f\'' f' :: Int @@ -402,7 +402,7 @@ f' :: Int data T1 f = undefined f' = undefined -type CInt = Int +type CInt = Int k = undefined l = undefined m = undefined diff --git a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr index 96cafba30f..77286daf62 100644 --- a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr +++ b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr @@ -21,7 +21,7 @@ hidden a = a Module : Test Copyright : (c) Simon Marlow 2002 License : BSD-style - + Maintainer : libraries@haskell.org Stability : provisional Portability : portable @@ -77,7 +77,7 @@ newtype N1 a = N1 a <document comment> newtype N2 a b = N2 {n :: a b} <document comment> -newtype N3 a b = N3 {n3 :: a b this is the 'n3' field } +newtype N3 a b = N3 {n3 :: a b this is the 'n3' field} <document comment> newtype N4 a b = N4 a newtype N5 a b diff --git a/testsuite/tests/haddock/should_compile_noflag_haddock/haddockSimplUtilsBug.hs b/testsuite/tests/haddock/should_compile_noflag_haddock/haddockSimplUtilsBug.hs index 2f5e9ca685..0e6e871215 100644 --- a/testsuite/tests/haddock/should_compile_noflag_haddock/haddockSimplUtilsBug.hs +++ b/testsuite/tests/haddock/should_compile_noflag_haddock/haddockSimplUtilsBug.hs @@ -1,39 +1,39 @@ module ShouldCompile where -postInlineUnconditionally +postInlineUnconditionally = case Just "Hey" of - -- The point of examining occ_info here is that for *non-values* - -- that occur outside a lambda, the call-site inliner won't have - -- a chance (because it doesn't know that the thing - -- only occurs once). The pre-inliner won't have gotten - -- it either, if the thing occurs in more than one branch - -- So the main target is things like - -- let x = f y in - -- case v of - -- True -> case x of ... - -- False -> case x of ... - -- I'm not sure how important this is in practice - Just a -- OneOcc => no work-duplication issue - -> True -- Small enough to dup - -- ToDo: consider discount on smallEnoughToInline if int_cxt is true - -- - -- NB: Do NOT inline arbitrarily big things, even if one_br is True - -- Reason: doing so risks exponential behaviour. We simplify a big - -- expression, inline it, and simplify it again. But if the - -- very same thing happens in the big expression, we get - -- exponential cost! - -- PRINCIPLE: when we've already simplified an expression once, - -- make sure that we only inline it if it's reasonably small. + -- The point of examining occ_info here is that for *non-values* + -- that occur outside a lambda, the call-site inliner won't have + -- a chance (because it doesn't know that the thing + -- only occurs once). The pre-inliner won't have gotten + -- it either, if the thing occurs in more than one branch + -- So the main target is things like + -- let x = f y in + -- case v of + -- True -> case x of ... + -- False -> case x of ... + -- I'm not sure how important this is in practice + Just a -- OneOcc => no work-duplication issue + -> True -- Small enough to dup + -- ToDo: consider discount on smallEnoughToInline if int_cxt is true + -- + -- NB: Do NOT inline arbitrarily big things, even if one_br is True + -- Reason: doing so risks exponential behaviour. We simplify a big + -- expression, inline it, and simplify it again. But if the + -- very same thing happens in the big expression, we get + -- exponential cost! + -- PRINCIPLE: when we've already simplified an expression once, + -- make sure that we only inline it if it's reasonably small. _ -> False -- Here's an example that we don't handle well: --- let f = if b then Left (\x.BIG) else Right (\y.BIG) --- in \y. ....case f of {...} .... +-- let f = if b then Left (\x.BIG) else Right (\y.BIG) +-- in \y. ....case f of {...} .... -- Here f is used just once, and duplicating the case work is fine (exprIsCheap). -- But -- * We can't preInlineUnconditionally because that woud invalidate --- the occ info for b. +-- the occ info for b. -- * We can't postInlineUnconditionally because the RHS is big, and -- that risks exponential behaviour -- * We can't call-site inline, because the rhs is big diff --git a/testsuite/tests/indexed-types/should_compile/Col2.hs b/testsuite/tests/indexed-types/should_compile/Col2.hs index 97a10aef84..c763c5984a 100644 --- a/testsuite/tests/indexed-types/should_compile/Col2.hs +++ b/testsuite/tests/indexed-types/should_compile/Col2.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} -module Col where +module Col where type family Elem c @@ -11,4 +11,4 @@ class (Eq (Elem c)) => Col c where count :: Elem c -> c -> Int instance Eq e => Col [e] where - count x = length . filter (==x) + count x = length . filter (==x) diff --git a/testsuite/tests/indexed-types/should_compile/ColGivenCheck.hs b/testsuite/tests/indexed-types/should_compile/ColGivenCheck.hs index 288c6e0608..b3e3a05cb1 100644 --- a/testsuite/tests/indexed-types/should_compile/ColGivenCheck.hs +++ b/testsuite/tests/indexed-types/should_compile/ColGivenCheck.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-} -module ColInference where +module ColInference where type family Elem c @@ -12,9 +12,9 @@ class Col c where headTail :: c -> (Elem c,c) addAll :: (Col c1, Col c2, Elem c1 ~ Elem c2) => c1 -> c2 -> c2 -addAll c1 c2 - | isEmpty c1 - = c2 - | otherwise - = let (x,c1') = headTail c1 - in addAll c1' (add c2 x) +addAll c1 c2 + | isEmpty c1 + = c2 + | otherwise + = let (x,c1') = headTail c1 + in addAll c1' (add c2 x) diff --git a/testsuite/tests/indexed-types/should_compile/ColGivenCheck2.hs b/testsuite/tests/indexed-types/should_compile/ColGivenCheck2.hs index 2da7cb4117..df275d419d 100644 --- a/testsuite/tests/indexed-types/should_compile/ColGivenCheck2.hs +++ b/testsuite/tests/indexed-types/should_compile/ColGivenCheck2.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-} -module ColInference where +module ColInference where type family Elem c @@ -12,19 +12,19 @@ class Col c where headTail :: c -> (Elem c,c) -- addAll :: (Col c1, Col c2, Elem c1 ~ Elem c2) => c1 -> c2 -> c2 --- addAll c1 c2 --- | isEmpty c1 --- = c2 --- | otherwise --- = let (x,c1') = headTail c1 --- in addAll c1' (add c2 x) +-- addAll c1 c2 +-- | isEmpty c1 +-- = c2 +-- | otherwise +-- = let (x,c1') = headTail c1 +-- in addAll c1' (add c2 x) sumCol :: (Col c, Elem c ~ Int) => c -> Int sumCol c | isEmpty c - = 0 - | otherwise - = let (x,xs) = headTail c - in x + (sumCol xs) + = 0 + | otherwise + = let (x,xs) = headTail c + in x + (sumCol xs) -- data CP :: * -> * where -- CP :: (Col c1, Col c2, Elem c1 ~ Elem c2, Elem c2 ~ Int) => (c1,c2) -> CP Char diff --git a/testsuite/tests/indexed-types/should_compile/ColInference.hs b/testsuite/tests/indexed-types/should_compile/ColInference.hs index a70b7dd444..dfc92efbc5 100644 --- a/testsuite/tests/indexed-types/should_compile/ColInference.hs +++ b/testsuite/tests/indexed-types/should_compile/ColInference.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-} -module ColInference where +module ColInference where type family Elem c @@ -11,9 +11,9 @@ class Col c where add :: c -> Elem c -> c headTail :: c -> (Elem c,c) -addAll c1 c2 - | isEmpty c1 - = c2 - | otherwise - = let (x,c1') = headTail c1 - in addAll c1' (add c2 x) +addAll c1 c2 + | isEmpty c1 + = c2 + | otherwise + = let (x,c1') = headTail c1 + in addAll c1' (add c2 x) diff --git a/testsuite/tests/indexed-types/should_compile/ColInference2.hs b/testsuite/tests/indexed-types/should_compile/ColInference2.hs index 9785d717a7..87da1d2b12 100644 --- a/testsuite/tests/indexed-types/should_compile/ColInference2.hs +++ b/testsuite/tests/indexed-types/should_compile/ColInference2.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-} -module ColInference where +module ColInference where type family Elem c @@ -11,7 +11,7 @@ class Col c where add :: c -> Elem c -> c headTail :: c -> (Elem c,c) -sawpOne c1 c2 - = let (x,c1') = headTail c1 +sawpOne c1 c2 + = let (x,c1') = headTail c1 (y,c2') = headTail c2 - in (add c1' y,add c2' x) + in (add c1' y,add c2' x) diff --git a/testsuite/tests/indexed-types/should_compile/ColInference3.hs b/testsuite/tests/indexed-types/should_compile/ColInference3.hs index f946e89120..d677021e79 100644 --- a/testsuite/tests/indexed-types/should_compile/ColInference3.hs +++ b/testsuite/tests/indexed-types/should_compile/ColInference3.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-} -module Main where +module Main where type family Elem c @@ -11,8 +11,8 @@ class Col c where -- LIST instance Col [a] where - isEmpty = null - add = flip (:) + isEmpty = null + add = flip (:) headTail (x:xs) = (x,xs) type instance Elem [a] = a @@ -30,13 +30,13 @@ instance Col (Sequence a) where type instance Elem (Sequence a) = a --- -addAll c1 c2 - | isEmpty c1 - = c2 - | otherwise - = let (x,c1') = headTail c1 - in addAll c1' (add c2 x) +-- +addAll c1 c2 + | isEmpty c1 + = c2 + | otherwise + = let (x,c1') = headTail c1 + in addAll c1' (add c2 x) -- main = print $ addAll c1 c2 diff --git a/testsuite/tests/indexed-types/should_compile/ColInference4.hs b/testsuite/tests/indexed-types/should_compile/ColInference4.hs index 27675b1051..a55bdb5b87 100644 --- a/testsuite/tests/indexed-types/should_compile/ColInference4.hs +++ b/testsuite/tests/indexed-types/should_compile/ColInference4.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-} -module ColInference where +module ColInference where type family Elem c @@ -11,7 +11,7 @@ class Col c where add :: c -> Elem c -> c headTail :: c -> (Elem c,c) -sawpOne c1 c2 - = let (x,c1') = headTail c1 +sawpOne c1 c2 + = let (x,c1') = headTail c1 (y,c2') = headTail c2 - in (add c1' y,add c1' x) + in (add c1' y,add c1' x) diff --git a/testsuite/tests/indexed-types/should_compile/ColInference5.hs b/testsuite/tests/indexed-types/should_compile/ColInference5.hs index b65a90092e..1b623cb1b0 100644 --- a/testsuite/tests/indexed-types/should_compile/ColInference5.hs +++ b/testsuite/tests/indexed-types/should_compile/ColInference5.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-} -module ColInference where +module ColInference where type family Elem c @@ -11,7 +11,7 @@ class Col c where add :: c -> Elem c -> c headTail :: c -> (Elem c,c) -sawpOne c1 c2 - = let (x,c1') = headTail c1 +sawpOne c1 c2 + = let (x,c1') = headTail c1 (y,c2') = headTail c2 - in (add c1' y,add c1' y) + in (add c1' y,add c1' y) diff --git a/testsuite/tests/indexed-types/should_compile/Deriving.hs b/testsuite/tests/indexed-types/should_compile/Deriving.hs index fd0eff2016..f7360768e2 100644 --- a/testsuite/tests/indexed-types/should_compile/Deriving.hs +++ b/testsuite/tests/indexed-types/should_compile/Deriving.hs @@ -5,7 +5,7 @@ module ShouldCompile where data family T a data instance T Int = A | B - deriving Eq + deriving Eq foo :: T Int -> Bool foo x = x == x diff --git a/testsuite/tests/indexed-types/should_compile/DerivingNewType.hs b/testsuite/tests/indexed-types/should_compile/DerivingNewType.hs index 5a90aa6757..70c80579e4 100644 --- a/testsuite/tests/indexed-types/should_compile/DerivingNewType.hs +++ b/testsuite/tests/indexed-types/should_compile/DerivingNewType.hs @@ -7,10 +7,10 @@ import Control.Applicative (Applicative) data family S a newtype instance S Int = S Int - deriving Eq + deriving Eq data family S2 a b newtype instance S2 Int b = S2 (IO b) - deriving (Functor, Applicative, Monad) + deriving (Functor, Applicative, Monad) diff --git a/testsuite/tests/indexed-types/should_compile/Gentle.hs b/testsuite/tests/indexed-types/should_compile/Gentle.hs index f6038bf81e..d29db5dc79 100644 --- a/testsuite/tests/indexed-types/should_compile/Gentle.hs +++ b/testsuite/tests/indexed-types/should_compile/Gentle.hs @@ -9,12 +9,12 @@ module FooModule where class Concrete a b | a -> b where - bar :: a -> String + bar :: a -> String class Wuggle b | -> b -- To make the Concrete instance work instance (Show a, Wuggle b) => Concrete a b where - bar = error "urk" + bar = error "urk" wib :: Concrete a b => a -> String -- Weird test case: (Concrete a b) is simplifiable @@ -39,7 +39,7 @@ from (Concrete a b). OK, found that in GHC 6.6, adding - instance Concrete Bool Bool + instance Concrete Bool Bool fixed the problem. That's weird isn't it? The reason is this. When GHC looks at the instance decls, it now sees *two* instance decls matching (Concrete a q), and so it declines for now to use either of them diff --git a/testsuite/tests/indexed-types/should_compile/GivenCheck.hs b/testsuite/tests/indexed-types/should_compile/GivenCheck.hs index 20320ae1c9..ac8a0799f2 100644 --- a/testsuite/tests/indexed-types/should_compile/GivenCheck.hs +++ b/testsuite/tests/indexed-types/should_compile/GivenCheck.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-} -module GivenCheck where +module GivenCheck where type family S x @@ -8,5 +8,5 @@ f :: a -> S a f = undefined g :: S a ~ Char => a -> Char -g y | False = f y - | otherwise = 'a' +g y | False = f y + | otherwise = 'a' diff --git a/testsuite/tests/indexed-types/should_compile/GivenCheckDecomp.hs b/testsuite/tests/indexed-types/should_compile/GivenCheckDecomp.hs index 3d2492770d..7323527eb4 100644 --- a/testsuite/tests/indexed-types/should_compile/GivenCheckDecomp.hs +++ b/testsuite/tests/indexed-types/should_compile/GivenCheckDecomp.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-} -module GivenCheckDecomp where +module GivenCheckDecomp where type family S x @@ -8,4 +8,4 @@ f :: a -> S a f = undefined g :: [S a] ~ [Char] => a -> Char -g y | 'a' == 'b' = f y +g y | 'a' == 'b' = f y diff --git a/testsuite/tests/indexed-types/should_compile/GivenCheckSwap.hs b/testsuite/tests/indexed-types/should_compile/GivenCheckSwap.hs index 8d053f312a..44bb985421 100644 --- a/testsuite/tests/indexed-types/should_compile/GivenCheckSwap.hs +++ b/testsuite/tests/indexed-types/should_compile/GivenCheckSwap.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies #-} -module GivenCheckSwapMain where +module GivenCheckSwapMain where type family S x @@ -8,5 +8,5 @@ f :: a -> S a f = undefined g :: Char ~ S a => a -> Char -g y | False = f y - | otherwise = 'a' +g y | False = f y + | otherwise = 'a' diff --git a/testsuite/tests/indexed-types/should_compile/HO.hs b/testsuite/tests/indexed-types/should_compile/HO.hs index 40d597a76f..a674469518 100644 --- a/testsuite/tests/indexed-types/should_compile/HO.hs +++ b/testsuite/tests/indexed-types/should_compile/HO.hs @@ -1,18 +1,18 @@ {-# LANGUAGE TypeFamilies, TypeOperators, RankNTypes #-} -module HO where +module HO where import Data.IORef type family SMRef (m::(* -> *)) :: * -> * type family SMMonad (r::(* -> *)) :: * -> * -type instance SMRef IO = IORef -type instance SMMonad IORef = IO +type instance SMRef IO = IORef +type instance SMMonad IORef = IO class SMMonad (SMRef m) ~ m => SM m where - new :: forall a. a -> m (SMRef m a) - read :: forall a. (SMRef m a) -> m a - write :: forall a. (SMRef m a) -> a -> m () + new :: forall a. a -> m (SMRef m a) + read :: forall a. (SMRef m a) -> m a + write :: forall a. (SMRef m a) -> a -> m () diff --git a/testsuite/tests/indexed-types/should_compile/InstEqContext.hs b/testsuite/tests/indexed-types/should_compile/InstEqContext.hs index f3bf5cfb2d..ec78b50a43 100644 --- a/testsuite/tests/indexed-types/should_compile/InstEqContext.hs +++ b/testsuite/tests/indexed-types/should_compile/InstEqContext.hs @@ -1,13 +1,13 @@ {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} {-# LANGUAGE TypeFamilies #-} -module InstEqContext where +module InstEqContext where -{- encoding of - - class C a | -> a +{- encoding of + - class C a | -> a -} -class a ~ Int => C a +class a ~ Int => C a instance C Int diff --git a/testsuite/tests/indexed-types/should_compile/InstEqContext3.hs b/testsuite/tests/indexed-types/should_compile/InstEqContext3.hs index 032ef34bc1..8fbd626e9d 100644 --- a/testsuite/tests/indexed-types/should_compile/InstEqContext3.hs +++ b/testsuite/tests/indexed-types/should_compile/InstEqContext3.hs @@ -1,17 +1,17 @@ {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} {-# LANGUAGE TypeFamilies #-} -module InstEqContext where +module InstEqContext where -{- encoding of - - class C a | -> a +{- encoding of + - class C a | -> a - with extra indirection -} -class a ~ Int => D a +class a ~ Int => D a instance D Int -class D a => C a +class D a => C a instance C Int unC :: (C a) => a -> Int diff --git a/testsuite/tests/indexed-types/should_compile/Roman1.hs b/testsuite/tests/indexed-types/should_compile/Roman1.hs index 4d8fd14da5..490ea03f42 100644 --- a/testsuite/tests/indexed-types/should_compile/Roman1.hs +++ b/testsuite/tests/indexed-types/should_compile/Roman1.hs @@ -22,8 +22,8 @@ new p = runST (do --------------------------------------------- -- Here's a simpler version that also failed -type family FMut :: * -> * -- No args - -- Same thing happens with one arg +type family FMut :: * -> * -- No args + -- Same thing happens with one arg type family FState (m :: *) type instance FState Char = Int diff --git a/testsuite/tests/indexed-types/should_compile/Simple2.hs b/testsuite/tests/indexed-types/should_compile/Simple2.hs index 2dc673f58b..131532b6c1 100644 --- a/testsuite/tests/indexed-types/should_compile/Simple2.hs +++ b/testsuite/tests/indexed-types/should_compile/Simple2.hs @@ -3,8 +3,8 @@ module ShouldCompile where class C3 a where - data S3 a -- kind is optional - data S3n a -- kind is optional + data S3 a -- kind is optional + data S3n a -- kind is optional foo3 :: a -> S3 a foo3n :: a -> S3n a bar3 :: S3 a -> a diff --git a/testsuite/tests/indexed-types/should_compile/T3590.hs b/testsuite/tests/indexed-types/should_compile/T3590.hs index 1b4ba426aa..d160fc8c52 100644 --- a/testsuite/tests/indexed-types/should_compile/T3590.hs +++ b/testsuite/tests/indexed-types/should_compile/T3590.hs @@ -13,7 +13,7 @@ class Monad (ItemM l) => List l where instance Monad m => List (ListT m) where type ItemM (ListT m) = m - joinL = [ ListT . (>>= runListT) -- Right section + joinL = [ ListT . (>>= runListT) -- Right section , ListT . (runListT <<=) -- Left section ] diff --git a/testsuite/tests/indexed-types/should_compile/T4160.hs b/testsuite/tests/indexed-types/should_compile/T4160.hs index ee95e8c874..4472bf2f14 100644 --- a/testsuite/tests/indexed-types/should_compile/T4160.hs +++ b/testsuite/tests/indexed-types/should_compile/T4160.hs @@ -10,12 +10,12 @@ newtype PMap m1 (m2 :: * -> (* -> *) -> * -> *) k (a :: * -> *) ix = PMap (m1 k type instance TrieMapT (P f g) = PMap (TrieMapT f) (TrieMapT g) class TrieKeyT f m where - unionT :: (TrieMapT f ~ m) => (f k -> a ix -> a ix -> a ix) -> - m k a ix -> m k a ix -> m k a ix - sizeT :: (TrieMapT f ~ m) => m k a ix -> Int + unionT :: (TrieMapT f ~ m) => (f k -> a ix -> a ix -> a ix) -> + m k a ix -> m k a ix -> m k a ix + sizeT :: (TrieMapT f ~ m) => m k a ix -> Int instance (TrieKeyT f m1, TrieKeyT g m2) => TrieKeyT (P f g) (PMap m1 m2) where - unionT f (PMap m1) (PMap m2) = PMap (uT (\ a -> unionT (\ b -> f (a :*: b))) m1 m2) - where uT = unionT + unionT f (PMap m1) (PMap m2) = PMap (uT (\ a -> unionT (\ b -> f (a :*: b))) m1 m2) + where uT = unionT sizeT = error "urk" diff --git a/testsuite/tests/indexed-types/should_compile/T4178.hs b/testsuite/tests/indexed-types/should_compile/T4178.hs index 97dfbed328..96d339dc68 100644 --- a/testsuite/tests/indexed-types/should_compile/T4178.hs +++ b/testsuite/tests/indexed-types/should_compile/T4178.hs @@ -1,9 +1,9 @@ {-# LANGUAGE - FlexibleContexts, - RankNTypes, - TypeFamilies, - MultiParamTypeClasses, - FlexibleInstances #-} + FlexibleContexts, + RankNTypes, + TypeFamilies, + MultiParamTypeClasses, + FlexibleInstances #-} -- See Trac #4178 diff --git a/testsuite/tests/indexed-types/should_fail/NoMatchErr.hs b/testsuite/tests/indexed-types/should_fail/NoMatchErr.hs index 304e11613e..c4239c667a 100644 --- a/testsuite/tests/indexed-types/should_fail/NoMatchErr.hs +++ b/testsuite/tests/indexed-types/should_fail/NoMatchErr.hs @@ -2,7 +2,7 @@ {-# LANGUAGE TypeFamilies #-} -- Type error message looks like --- TF.hs:12:11: +-- TF.hs:12:11: -- Couldn't match expected type `Memo d' -- against inferred type `Memo d1' -- NB: `Memo' is a (non-injective) type function diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail2b.hs b/testsuite/tests/indexed-types/should_fail/SimpleFail2b.hs index 031b170a1a..31b67c28bb 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail2b.hs +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail2b.hs @@ -6,7 +6,7 @@ class C a where type St a :: * instance C Int where - data Sd Int = SdC1 Char -- must fail: conflicting - data Sd Int = SdC2 Char -- declarations + data Sd Int = SdC1 Char -- must fail: conflicting + data Sd Int = SdC2 Char -- declarations newtype Sn Int = SnC Char type St Int = Char diff --git a/testsuite/tests/indexed-types/should_run/GMapAssoc.hs b/testsuite/tests/indexed-types/should_run/GMapAssoc.hs index 404818ea55..71cd726b3f 100644 --- a/testsuite/tests/indexed-types/should_run/GMapAssoc.hs +++ b/testsuite/tests/indexed-types/should_run/GMapAssoc.hs @@ -36,11 +36,11 @@ instance GMapKey () where instance (GMapKey a, GMapKey b) => GMapKey (a, b) where data GMap (a, b) v = GMapPair (GMap a (GMap b v)) - empty = GMapPair empty - lookup (a, b) (GMapPair gm) = lookup a gm >>= lookup b + empty = GMapPair empty + lookup (a, b) (GMapPair gm) = lookup a gm >>= lookup b insert (a, b) v (GMapPair gm) = GMapPair $ case lookup a gm of - Nothing -> insert a (insert b v empty) gm - Just gm2 -> insert a (insert b v gm2 ) gm + Nothing -> insert a (insert b v empty) gm + Just gm2 -> insert a (insert b v gm2 ) gm instance (GMapKey a, GMapKey b) => GMapKey (Either a b) where data GMap (Either a b) v = GMapEither (GMap a v) (GMap b v) @@ -58,10 +58,10 @@ nonsence = undefined myGMap :: GMap (Int, Either Char ()) String myGMap = insert (5, Left 'c') "(5, Left 'c')" $ - insert (4, Right ()) "(4, Right ())" $ - insert (5, Right ()) "This is the one!" $ - insert (5, Right ()) "This is the two!" $ - insert (6, Right ()) "(6, Right ())" $ - insert (5, Left 'a') "(5, Left 'a')" $ - empty + insert (4, Right ()) "(4, Right ())" $ + insert (5, Right ()) "This is the one!" $ + insert (5, Right ()) "This is the two!" $ + insert (6, Right ()) "(6, Right ())" $ + insert (5, Left 'a') "(5, Left 'a')" $ + empty main = putStrLn $ maybe "Couldn't find key!" id $ lookup (5, Right ()) myGMap diff --git a/testsuite/tests/indexed-types/should_run/GMapTop.hs b/testsuite/tests/indexed-types/should_run/GMapTop.hs index 9ce830950b..5f817a31dc 100644 --- a/testsuite/tests/indexed-types/should_run/GMapTop.hs +++ b/testsuite/tests/indexed-types/should_run/GMapTop.hs @@ -38,11 +38,11 @@ instance GMapKey () where insert () v (GMapUnit _) = GMapUnit $ Just v instance (GMapKey a, GMapKey b) => GMapKey (a, b) where - empty = GMapPair empty - lookup (a, b) (GMapPair gm) = lookup a gm >>= lookup b + empty = GMapPair empty + lookup (a, b) (GMapPair gm) = lookup a gm >>= lookup b insert (a, b) v (GMapPair gm) = GMapPair $ case lookup a gm of - Nothing -> insert a (insert b v empty) gm - Just gm2 -> insert a (insert b v gm2 ) gm + Nothing -> insert a (insert b v empty) gm + Just gm2 -> insert a (insert b v gm2 ) gm instance (GMapKey a, GMapKey b) => GMapKey (Either a b) where empty = GMapEither empty empty @@ -60,10 +60,10 @@ nonsence = undefined myGMap :: GMap (Int, Either Char ()) String myGMap = insert (5, Left 'c') "(5, Left 'c')" $ - insert (4, Right ()) "(4, Right ())" $ - insert (5, Right ()) "This is the one!" $ - insert (5, Right ()) "This is the two!" $ - insert (6, Right ()) "(6, Right ())" $ - insert (5, Left 'a') "(5, Left 'a')" $ - empty + insert (4, Right ()) "(4, Right ())" $ + insert (5, Right ()) "This is the one!" $ + insert (5, Right ()) "This is the two!" $ + insert (6, Right ()) "(6, Right ())" $ + insert (5, Left 'a') "(5, Left 'a')" $ + empty main = putStrLn $ maybe "Couldn't find key!" id $ lookup (5, Right ()) myGMap diff --git a/testsuite/tests/stranal/should_compile/T1988.hs b/testsuite/tests/stranal/should_compile/T1988.hs index da99806ce1..a27fdd8da5 100644 --- a/testsuite/tests/stranal/should_compile/T1988.hs +++ b/testsuite/tests/stranal/should_compile/T1988.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -O2 #-} -- Trac #1988: this one killed GHC 6.8.2 --- at least with -O2 +-- at least with -O2 module ShouldCompile where diff --git a/testsuite/tests/stranal/should_compile/newtype.hs b/testsuite/tests/stranal/should_compile/newtype.hs index 4c9228c0eb..2693062c16 100644 --- a/testsuite/tests/stranal/should_compile/newtype.hs +++ b/testsuite/tests/stranal/should_compile/newtype.hs @@ -1,4 +1,4 @@ --- This one killed GHC 6.4 because it bogusly attributed +-- This one killed GHC 6.4 because it bogusly attributed -- the CPR property to the constructor T -- Result: a mkWWcpr crash -- Needs -prof -fprof-auto to show it up @@ -10,5 +10,5 @@ newtype T a = T { unT :: a } f = unT test cs = f $ case cs of - [] -> T [] - (x:xs) -> T $ test cs + [] -> T [] + (x:xs) -> T $ test cs diff --git a/testsuite/tests/stranal/should_compile/str002.hs b/testsuite/tests/stranal/should_compile/str002.hs index 65fb8a7ba2..b1c8b4c8b0 100644 --- a/testsuite/tests/stranal/should_compile/str002.hs +++ b/testsuite/tests/stranal/should_compile/str002.hs @@ -1,6 +1,6 @@ -- !!! Recursive newtypes --- Needs -O --- This one made GHC < 5.00.2 go into an +-- Needs -O +-- This one made GHC < 5.00.2 go into an -- infinite loop in the strictness analysier module Foo where diff --git a/testsuite/tests/stranal/should_run/strun002.hs b/testsuite/tests/stranal/should_run/strun002.hs index 145166964d..adbcd5020e 100644 --- a/testsuite/tests/stranal/should_run/strun002.hs +++ b/testsuite/tests/stranal/should_run/strun002.hs @@ -4,7 +4,7 @@ module Main where is_volatile :: [Int] -> (String,Int) -> Int is_volatile [] (destVarName, destPtr) - = error ("Variable not found: " ++ "(" ++ (show destPtr) ++ ") " ++ destVarName) + = error ("Variable not found: " ++ "(" ++ (show destPtr) ++ ") " ++ destVarName) is_volatile (a:allWrites) (destVarName, destPtr) | a == destPtr = a | otherwise = is_volatile allWrites (destVarName, destPtr) diff --git a/testsuite/tests/stranal/should_run/strun003.hs b/testsuite/tests/stranal/should_run/strun003.hs index eaedd59e8c..3240ab272a 100644 --- a/testsuite/tests/stranal/should_run/strun003.hs +++ b/testsuite/tests/stranal/should_run/strun003.hs @@ -1,5 +1,5 @@ -- This module should run fine with an empty argument list --- But it won't if the strictness analyser thinks that 'len' is use +-- But it won't if the strictness analyser thinks that 'len' is use -- strictly, which was the case in GHC 6.0 -- See the io_hack_reqd in DmdAnal.lhs @@ -14,8 +14,8 @@ main = do let len = read (head args) :: Int (if null args && useLazily len - then putStrLn "ok" >> exitWith ExitSuccess - else return () ) + then putStrLn "ok" >> exitWith ExitSuccess + else return () ) print len |