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 | 3dc1202546e63b50f828a34474717b1ddcbed5c7 (patch) | |
| tree | 745fde8e9712c6d0b0507d9ae4988736c678abdb /testsuite | |
| parent | cf6e65693588cd9d40c895279f2e53d3d25a2c58 (diff) | |
| download | haskell-3dc1202546e63b50f828a34474717b1ddcbed5c7.tar.gz | |
Testsuite: tabs -> spaces [skip ci]
Diffstat (limited to 'testsuite')
163 files changed, 1129 insertions, 1129 deletions
diff --git a/testsuite/tests/deSugar/should_compile/ds002.hs b/testsuite/tests/deSugar/should_compile/ds002.hs index 280674e1fe..521e3238ff 100644 --- a/testsuite/tests/deSugar/should_compile/ds002.hs +++ b/testsuite/tests/deSugar/should_compile/ds002.hs @@ -9,8 +9,8 @@ f y = y f z = z g x y z | True = f z - | True = f z - | True = f z + | True = f z + | True = f z g x y z | True = f z - | True = f z - | True = f z + | True = f z + | True = f z diff --git a/testsuite/tests/deSugar/should_compile/ds003.hs b/testsuite/tests/deSugar/should_compile/ds003.hs index dafeac94b7..75938e3104 100644 --- a/testsuite/tests/deSugar/should_compile/ds003.hs +++ b/testsuite/tests/deSugar/should_compile/ds003.hs @@ -2,7 +2,7 @@ -- module ShouldCompile where -f [] y True = [] -f x a@(y,ys) ~z = [] -f (x:x1:x2:x3) ~(y,ys) z = [] -f x y True = [] +f [] y True = [] +f x a@(y,ys) ~z = [] +f (x:x1:x2:x3) ~(y,ys) z = [] +f x y True = [] diff --git a/testsuite/tests/deSugar/should_compile/ds004.hs b/testsuite/tests/deSugar/should_compile/ds004.hs index ebbe8e06c2..241d759bc2 100644 --- a/testsuite/tests/deSugar/should_compile/ds004.hs +++ b/testsuite/tests/deSugar/should_compile/ds004.hs @@ -6,4 +6,4 @@ module ShouldCompile where nodups [] = [] nodups [x] = [x] nodups (y:x:xs) | y == x = nodups (x:xs) - | True = y : nodups (x:xs) + | True = y : nodups (x:xs) diff --git a/testsuite/tests/deSugar/should_compile/ds010.hs b/testsuite/tests/deSugar/should_compile/ds010.hs index 268610e124..05c53b6dbc 100644 --- a/testsuite/tests/deSugar/should_compile/ds010.hs +++ b/testsuite/tests/deSugar/should_compile/ds010.hs @@ -3,13 +3,13 @@ module ShouldCompile where z = [ (a,b,c,d,e,f,g,h,i,j) | a <- "12", - b <- "12", - c <- "12", - d <- "12", - e <- "12", - f <- "12", - g <- "12", - h <- "12", - i <- "12", - j <- "12" + b <- "12", + c <- "12", + d <- "12", + e <- "12", + f <- "12", + g <- "12", + h <- "12", + i <- "12", + j <- "12" ] diff --git a/testsuite/tests/deSugar/should_compile/ds014.hs b/testsuite/tests/deSugar/should_compile/ds014.hs index 23b3709854..4ad304fc5e 100644 --- a/testsuite/tests/deSugar/should_compile/ds014.hs +++ b/testsuite/tests/deSugar/should_compile/ds014.hs @@ -8,8 +8,8 @@ b = "b" c = a:b d = b ++ b -b1 = "" -- examples from the Haskell report -b2 = "\&" -- the same thing +b1 = "" -- examples from the Haskell report +b2 = "\&" -- the same thing b3 = "\SO\&H" ++ "\137\&9" a000 = '\NUL' @@ -51,21 +51,21 @@ a134 = '\\' a177 = '\DEL' ascii = "\NUL\SOH\STX\ETX\EOT\ENQ\ACK\BEL\ - \\BS\HT\LF\VT\FF\CR\SO\SI\ - \\DLE\DC1\DC2\DC3\DC4\NAK\SYN\ETB\ - \\CAN\EM\SUB\ESC\FS\GS\RS\US\ - \\SP!\"#$%&'\ - \()*+,-./\ - \01234567\ - \89:;<=>?\ - \@ABCDEFG\ - \HIJKLMNO\ - \PQRSTUVW\ - \XYZ[\\]^_\ - \`abcdefg\ - \hijklmno\ - \pqrstuvw\ - \xyz{|}~\DEL" + \\BS\HT\LF\VT\FF\CR\SO\SI\ + \\DLE\DC1\DC2\DC3\DC4\NAK\SYN\ETB\ + \\CAN\EM\SUB\ESC\FS\GS\RS\US\ + \\SP!\"#$%&'\ + \()*+,-./\ + \01234567\ + \89:;<=>?\ + \@ABCDEFG\ + \HIJKLMNO\ + \PQRSTUVW\ + \XYZ[\\]^_\ + \`abcdefg\ + \hijklmno\ + \pqrstuvw\ + \xyz{|}~\DEL" na200 = '\o200' na250 = '\o250' diff --git a/testsuite/tests/deSugar/should_compile/ds016.hs b/testsuite/tests/deSugar/should_compile/ds016.hs index 41394e7ed9..23545aafdc 100644 --- a/testsuite/tests/deSugar/should_compile/ds016.hs +++ b/testsuite/tests/deSugar/should_compile/ds016.hs @@ -4,12 +4,12 @@ module ShouldCompile where f x y z = case ( x ++ x ++ x ++ x ++ x ) of - [] -> [] - [a] -> error "2" - [a,b,c] -> - case ( (y,z,y,z) ) of --- (True, _, False, _) | True == False -> z --- (True, _, False, _) | True == False -> z - _ -> z + [] -> [] + [a] -> error "2" + [a,b,c] -> + case ( (y,z,y,z) ) of +-- (True, _, False, _) | True == False -> z +-- (True, _, False, _) | True == False -> z + _ -> z - (a:bs) -> error "4" + (a:bs) -> error "4" diff --git a/testsuite/tests/deSugar/should_compile/ds017.hs b/testsuite/tests/deSugar/should_compile/ds017.hs index e6fd6d02f9..8f34e27320 100644 --- a/testsuite/tests/deSugar/should_compile/ds017.hs +++ b/testsuite/tests/deSugar/should_compile/ds017.hs @@ -4,9 +4,9 @@ module ShouldCompile where f x y z = let - a = x : [] - b = x : a - c = y (let d = (z, z) in d) - result = (c, b) + a = x : [] + b = x : a + c = y (let d = (z, z) in d) + result = (c, b) in - result + result diff --git a/testsuite/tests/deSugar/should_compile/ds018.hs b/testsuite/tests/deSugar/should_compile/ds018.hs index 68a9e4ce47..15edeb3006 100644 --- a/testsuite/tests/deSugar/should_compile/ds018.hs +++ b/testsuite/tests/deSugar/should_compile/ds018.hs @@ -5,7 +5,7 @@ module ShouldCompile where -- exprs f x y z = [x,y,z,x,y,z] -f2 x y = [] +f2 x y = [] g1 x y = () @@ -13,30 +13,30 @@ g1 x y = () and probably won't in the near future, so this test is only a reminder. g x y z = (x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z, - x,y,z,x,y,z) -- hey, we love big tuples + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z, + x,y,z,x,y,z) -- hey, we love big tuples -} -- pats diff --git a/testsuite/tests/deSugar/should_compile/ds020.hs b/testsuite/tests/deSugar/should_compile/ds020.hs index 184c857a8f..c6d61461c3 100644 --- a/testsuite/tests/deSugar/should_compile/ds020.hs +++ b/testsuite/tests/deSugar/should_compile/ds020.hs @@ -13,8 +13,8 @@ b ~(~x: ~xs: ~ys) = [] c ~x ~ _ ~11111 ~3.14159265 = x -d 11 = 4 -d 12 = 3 +d 11 = 4 +d 12 = 3 d ~(n+4) = 2 d ~(n+43) = 1 d ~(n+999) = 0 @@ -33,25 +33,25 @@ g ~(~(~(~([])))) = [] (~x: ~xs: ~ys) = [] (x2 : xs2: ys2) | eq2 = [] - | eq3 = [x2] - | eq4 = [x2] - | True = [] - where - eq2 = (2::Int) == (4::Int) - eq3 = (3::Int) == (3::Int) - eq4 = (4::Int) == (2::Int) + | eq3 = [x2] + | eq4 = [x2] + | True = [] + where + eq2 = (2::Int) == (4::Int) + eq3 = (3::Int) == (3::Int) + eq4 = (4::Int) == (2::Int) (x3,y3) | x3 > 3 = (4, 5) | x3 <= 3 = (2, 3) -- above: x & y should both be \bottom. (x4,(y4,(z4,a4))) | eq2 = ('a',('a',('a','a'))) - | eq3 = ('b',('b',('b','b'))) - | eq4 = ('c',('c',('c','c'))) - | True = ('d',('d',('d','d'))) - where - eq2 = (2::Int) == (4::Int) - eq3 = (3::Int) == (3::Int) - eq4 = (4::Int) == (2::Int) + | eq3 = ('b',('b',('b','b'))) + | eq4 = ('c',('c',('c','c'))) + | True = ('d',('d',('d','d'))) + where + eq2 = (2::Int) == (4::Int) + eq3 = (3::Int) == (3::Int) + eq4 = (4::Int) == (2::Int) diff --git a/testsuite/tests/deSugar/should_compile/ds021.hs b/testsuite/tests/deSugar/should_compile/ds021.hs index 4faaba53fd..9cca793600 100644 --- a/testsuite/tests/deSugar/should_compile/ds021.hs +++ b/testsuite/tests/deSugar/should_compile/ds021.hs @@ -3,6 +3,6 @@ module ShouldCompile where f x y z | x == y = [] - | x /= z = [] - | True = [] - | False = [] + | x /= z = [] + | True = [] + | False = [] diff --git a/testsuite/tests/deSugar/should_compile/ds022.hs b/testsuite/tests/deSugar/should_compile/ds022.hs index a857ef44b0..20633468aa 100644 --- a/testsuite/tests/deSugar/should_compile/ds022.hs +++ b/testsuite/tests/deSugar/should_compile/ds022.hs @@ -14,10 +14,10 @@ g 22222222222222222222222 2.22222222222222222 = [] g 33333333333333333333333 3.33333333333333333 = [] g 44444444444444444444444 4.44444444444444444 = [] -h 'a' "" = [] -h '\'' "foo" = [] -h '"' ('b':'a':'r':[]) = [] -h '\o250' blob = [] +h 'a' "" = [] +h '\'' "foo" = [] +h '"' ('b':'a':'r':[]) = [] +h '\o250' blob = [] i 1 1.1 = [] i 2 2.2 = [] @@ -27,8 +27,8 @@ i 2 2.20000 = [] {- j one@1 oneone@1.1 | ((fromFloat oneone) - (fromIntegral (fromInt one))) - /= (fromIntegral (fromInt 0)) = [] + /= (fromIntegral (fromInt 0)) = [] j two@2 twotwo@2.2 | ((fromFloat twotwo) * (fromIntegral (fromInt 2))) - == (fromIntegral (fromInt 4.4)) = [] + == (fromIntegral (fromInt 4.4)) = [] -} diff --git a/testsuite/tests/deSugar/should_compile/ds023.hs b/testsuite/tests/deSugar/should_compile/ds023.hs index 736107d979..e4cd3aa9c2 100644 --- a/testsuite/tests/deSugar/should_compile/ds023.hs +++ b/testsuite/tests/deSugar/should_compile/ds023.hs @@ -2,6 +2,6 @@ -- module ShouldCompile where -f x = g (x == x) x -g b x = abs (f x) ---g b x = (f x) + (f x) +f x = g (x == x) x +g b x = abs (f x) +--g b x = (f x) + (f x) diff --git a/testsuite/tests/deSugar/should_compile/ds028.hs b/testsuite/tests/deSugar/should_compile/ds028.hs index 4c7944aa39..bac15aece4 100644 --- a/testsuite/tests/deSugar/should_compile/ds028.hs +++ b/testsuite/tests/deSugar/should_compile/ds028.hs @@ -6,8 +6,8 @@ module ShouldCompile where -- when the first row of pats doesn't have convenient -- variables to grab... -mAp f [] = [] -mAp f (x:xs) = f x : mAp f xs +mAp f [] = [] +mAp f (x:xs) = f x : mAp f xs -True |||| _ = True -False |||| x = x +True |||| _ = True +False |||| x = x diff --git a/testsuite/tests/deSugar/should_compile/ds029.hs b/testsuite/tests/deSugar/should_compile/ds029.hs index 000052365e..1bee17bec9 100644 --- a/testsuite/tests/deSugar/should_compile/ds029.hs +++ b/testsuite/tests/deSugar/should_compile/ds029.hs @@ -5,5 +5,5 @@ module ShouldCompile where f x = y where (y,z) | y < z = (0,1) - | y > z = (1,2) - | True = (2,3) + | y > z = (1,2) + | True = (2,3) diff --git a/testsuite/tests/deSugar/should_compile/ds032.hs b/testsuite/tests/deSugar/should_compile/ds032.hs index 09e2de15a7..7f280a0ae6 100644 --- a/testsuite/tests/deSugar/should_compile/ds032.hs +++ b/testsuite/tests/deSugar/should_compile/ds032.hs @@ -3,9 +3,9 @@ module ShouldCompile where -flatten :: Int -- Indentation - -> Bool -- True => just had a newline - -> Float -- Current seq to flatten +flatten :: Int -- Indentation + -> Bool -- True => just had a newline + -> Float -- Current seq to flatten -> [(Int,Float)]-- Work list with indentation -> String diff --git a/testsuite/tests/deSugar/should_compile/ds035.hs b/testsuite/tests/deSugar/should_compile/ds035.hs index 1cf6d80b5b..8020fb174e 100644 --- a/testsuite/tests/deSugar/should_compile/ds035.hs +++ b/testsuite/tests/deSugar/should_compile/ds035.hs @@ -15,9 +15,9 @@ clen CNil = 0# clen (CCons _ cl) = 1# +# (clen cl) main = putStr (case len4_twice of - 8# -> "bingo\n" - _ -> "oops\n") + 8# -> "bingo\n" + _ -> "oops\n") where - list4 = mk 4# - !len4 = clen list4 - !len4_twice = len4 +# len4 + list4 = mk 4# + !len4 = clen list4 + !len4_twice = len4 +# len4 diff --git a/testsuite/tests/deSugar/should_compile/ds036.hs b/testsuite/tests/deSugar/should_compile/ds036.hs index 12b90ed3ab..0ab9a73767 100644 --- a/testsuite/tests/deSugar/should_compile/ds036.hs +++ b/testsuite/tests/deSugar/should_compile/ds036.hs @@ -8,8 +8,8 @@ Date: 10 Mar 1992 17:17:21 GMT Will, -I have just started using Haskell at York and have found a compilation -error in the code below which disappears when the last line is +I have just started using Haskell at York and have found a compilation +error in the code below which disappears when the last line is commented out -} @@ -33,11 +33,11 @@ Dave ----------------------------------------------------------------------- -David Cattrall Telephone +44 904 432777 -Department of Computer Science -University of York JANET: dmc@uk.ac.york.minster +David Cattrall Telephone +44 904 432777 +Department of Computer Science +University of York JANET: dmc@uk.ac.york.minster YORK Y01 5DD -United Kingdom UUNET: uucp!ukc!minster!dmc +United Kingdom UUNET: uucp!ukc!minster!dmc ----------------------------------------------------------------------- -} diff --git a/testsuite/tests/deSugar/should_compile/ds040.hs b/testsuite/tests/deSugar/should_compile/ds040.hs index c99f5fab63..cbef54794f 100644 --- a/testsuite/tests/deSugar/should_compile/ds040.hs +++ b/testsuite/tests/deSugar/should_compile/ds040.hs @@ -8,11 +8,11 @@ module ShouldCompile where main = print ((4::Int) ^^^^ (6::Int)) -(^^^^) :: (Num a, Integral b) => a -> b -> a -x ^^^^ 0 = 1 -x ^^^^ (n+1) = f x n x - where f _ 0 y = y - f x n y = g x n where - g x n | even n = g (x*x) (n `quot` 2) - | otherwise = f x (n-1) (x*y) -_ ^^^^ _ = error "(^^^^){Prelude}: negative exponent" +(^^^^) :: (Num a, Integral b) => a -> b -> a +x ^^^^ 0 = 1 +x ^^^^ (n+1) = f x n x + where f _ 0 y = y + f x n y = g x n where + g x n | even n = g (x*x) (n `quot` 2) + | otherwise = f x (n-1) (x*y) +_ ^^^^ _ = error "(^^^^){Prelude}: negative exponent" diff --git a/testsuite/tests/deSugar/should_compile/ds041.hs b/testsuite/tests/deSugar/should_compile/ds041.hs index 90c1c22b4d..c1a3f0eb60 100644 --- a/testsuite/tests/deSugar/should_compile/ds041.hs +++ b/testsuite/tests/deSugar/should_compile/ds041.hs @@ -1,11 +1,11 @@ {-# LANGUAGE DatatypeContexts #-} {- In 2.05 this one crashed with - Fail: "basicTypes/Id.lhs", line 990: incomplete pattern(s) - to match in function "dataConFieldLabels" + Fail: "basicTypes/Id.lhs", line 990: incomplete pattern(s) + to match in function "dataConFieldLabels" - Reason: dsExpr (RecordCon ...) didn't extract - the constructor properly. + Reason: dsExpr (RecordCon ...) didn't extract + the constructor properly. -} module ShouldCompile where diff --git a/testsuite/tests/deSugar/should_compile/ds056.hs b/testsuite/tests/deSugar/should_compile/ds056.hs index 77c3860112..b634f7cda5 100644 --- a/testsuite/tests/deSugar/should_compile/ds056.hs +++ b/testsuite/tests/deSugar/should_compile/ds056.hs @@ -6,9 +6,9 @@ module Foo where g :: Int -> Int g (x+1) = x -g y = y -g _ = 0 -- Overlapped +g y = y +g _ = 0 -- Overlapped h :: Int -> Int h (x+1) = x -h _ = 0 -- Not overlapped +h _ = 0 -- Not overlapped diff --git a/testsuite/tests/deSugar/should_compile/ds058.hs b/testsuite/tests/deSugar/should_compile/ds058.hs index 0b83d0bd32..c3802a0a4b 100644 --- a/testsuite/tests/deSugar/should_compile/ds058.hs +++ b/testsuite/tests/deSugar/should_compile/ds058.hs @@ -2,7 +2,7 @@ module ShouldCompile where -f x = case x of - Just (~1) -> 0 - Just _ -> 1 -- This one cannot match +f x = case x of + Just (~1) -> 0 + Just _ -> 1 -- This one cannot match Nothing -> 2 diff --git a/testsuite/tests/dph/dotp/Main.hs b/testsuite/tests/dph/dotp/Main.hs index c6d4f1e91c..04eb407fc7 100644 --- a/testsuite/tests/dph/dotp/Main.hs +++ b/testsuite/tests/dph/dotp/Main.hs @@ -25,7 +25,7 @@ generateVectorU n = k = 1000 generateVector :: Int -> IO (PArray Double) -generateVector n +generateVector n = do vec <- generateVectorU n return $ P.fromUArray vec @@ -37,18 +37,18 @@ generateVectors n = w <- generateVector n return (v,w) -main - = do -- compute dot product with NDP - vectors <- generateVectors 100000 - let resultViaNDP = (uncurry dotp) vectors - - -- compute with lists - let (aVecX, aVecY) = vectors - let vecX = P.toList aVecX - let vecY = P.toList aVecY - let resultViaList = sum $ zipWith (*) vecX vecY - - -- ignore wibbles in low order bits - putStr $ (take 12 $ show resultViaNDP) ++ "\n" - putStr $ (take 12 $ show resultViaList) ++ "\n" - +main + = do -- compute dot product with NDP + vectors <- generateVectors 100000 + let resultViaNDP = (uncurry dotp) vectors + + -- compute with lists + let (aVecX, aVecY) = vectors + let vecX = P.toList aVecX + let vecY = P.toList aVecY + let resultViaList = sum $ zipWith (*) vecX vecY + + -- ignore wibbles in low order bits + putStr $ (take 12 $ show resultViaNDP) ++ "\n" + putStr $ (take 12 $ show resultViaList) ++ "\n" + diff --git a/testsuite/tests/dph/nbody/Body.hs b/testsuite/tests/dph/nbody/Body.hs index 3ba2149533..8a116993a8 100644 --- a/testsuite/tests/dph/nbody/Body.hs +++ b/testsuite/tests/dph/nbody/Body.hs @@ -6,7 +6,7 @@ module Body , Accel , MassPoint , Body - + , unitBody , massPointOfBody , setMassOfBody @@ -43,7 +43,7 @@ unitBody x y -- | Take the MassPoint of a body. massPointOfBody :: Body -> MassPoint -massPointOfBody (mp, vel, acc) +massPointOfBody (mp, vel, acc) = mp @@ -55,10 +55,10 @@ setMassOfBody mass ((x, y, _), vel, acc) -- | Set the acceleration of a body. setAccelOfBody :: Accel -> Body -> Body -setAccelOfBody acc' (mp, vel, _) +setAccelOfBody acc' (mp, vel, _) = (mp, vel, acc') - + -- | Set the starting velocity of a body. -- It is set to rotate around the origin, with the speed proportional -- to the sqrt of the distance from it. This seems to make nice simulations. @@ -68,18 +68,18 @@ setStartVelOfBody startVel (mp@(x, y, mass), vel, acc) (x', y') = normaliseV (x, y) vel' = (y', -x') vel'' = mulSV (sqrt (magV pos) * startVel) vel' - + in (mp, vel'', acc) -- | Advance a body forwards in time. advanceBody :: Double -> Body -> Body -advanceBody time - ( (px, py, mass) - , (vx, vy) - , acc@(ax, ay)) - - = ( (px + time * vx, py + time * vy, mass) - , (vx + time * ax, vy + time * ay) - , acc) +advanceBody time + ( (px, py, mass) + , (vx, vy) + , acc@(ax, ay)) + + = ( (px + time * vx, py + time * vy, mass) + , (vx + time * ax, vy + time * ay) + , acc) diff --git a/testsuite/tests/dph/primespj/Main.hs b/testsuite/tests/dph/primespj/Main.hs index 049e6a3e04..f7a3ed1fe5 100644 --- a/testsuite/tests/dph/primespj/Main.hs +++ b/testsuite/tests/dph/primespj/Main.hs @@ -12,19 +12,19 @@ primesList :: Int -> [Int] primesList 1 = [] primesList n = sps ++ [ i | i <- [sq+1..n], multiple sps i ] where - sps = primesList sq + sps = primesList sq sq = floor $ sqrt $ fromIntegral n multiple :: [Int] -> Int -> Bool multiple ps i = and [i `mod` p /= 0 | p <- ps] -main - = do let n = 1000 - let resultViaNDP = P.toList $ primesVect n - let resultViaLists = primesList n - - print resultViaNDP - print resultViaLists - print $ resultViaNDP == resultViaLists - +main + = do let n = 1000 + let resultViaNDP = P.toList $ primesVect n + let resultViaLists = primesList n + + print resultViaNDP + print resultViaLists + print $ resultViaNDP == resultViaLists + diff --git a/testsuite/tests/dph/quickhull/Main.hs b/testsuite/tests/dph/quickhull/Main.hs index 718a1630ef..e1dc04ba24 100644 --- a/testsuite/tests/dph/quickhull/Main.hs +++ b/testsuite/tests/dph/quickhull/Main.hs @@ -2,11 +2,11 @@ import qualified Types as QH import QuickHullVect (quickhull) -import qualified Data.Array.Parallel.Unlifted as U -import qualified Data.Array.Parallel.Prelude as P +import qualified Data.Array.Parallel.Unlifted as U +import qualified Data.Array.Parallel.Prelude as P import qualified Data.Array.Parallel.PArray as P -import Data.Array.Parallel.PArray (PArray) +import Data.Array.Parallel.PArray (PArray) import System.Environment import Data.List @@ -17,7 +17,7 @@ import TestData ----- runQuickhull :: PArray QH.Point -> [(Double, Double)] -runQuickhull pts +runQuickhull pts = let result = quickhull pts resxs = P.toUArray (QH.xsOf result) resys = P.toUArray (QH.ysOf result) @@ -25,19 +25,19 @@ runQuickhull pts -- Main Program --------------------------------------------------------------- -main - = do args <- getArgs - let n = case args of - [s] -> read s - _ -> 1000 - - paInput <- toPArrayPoints - $ genPointsCombo n - - let psHull = runQuickhull paInput - psInput = P.toList paInput - - putStr - $ makeSVG - (roundPoints psInput) - (roundPoints psHull) +main + = do args <- getArgs + let n = case args of + [s] -> read s + _ -> 1000 + + paInput <- toPArrayPoints + $ genPointsCombo n + + let psHull = runQuickhull paInput + psInput = P.toList paInput + + putStr + $ makeSVG + (roundPoints psInput) + (roundPoints psHull) diff --git a/testsuite/tests/dph/quickhull/SVG.hs b/testsuite/tests/dph/quickhull/SVG.hs index f4183a77d6..c750fb06f5 100644 --- a/testsuite/tests/dph/quickhull/SVG.hs +++ b/testsuite/tests/dph/quickhull/SVG.hs @@ -4,31 +4,31 @@ module SVG where -- Making a SVG diagram of the points and hull makeSVG :: [(Int, Int)] -> [(Int, Int)] -> String makeSVG points hull - = unlines - $ [ "<svg width=\"100%\" height=\"100%\" version=\"1.1\" xmlns=\"http://www.w3.org/2000/svg\">" ] - ++ [svgPolygon hull] - ++ map svgPoint points - ++ map svgPointHull hull - ++ ["</svg>"] + = unlines + $ [ "<svg width=\"100%\" height=\"100%\" version=\"1.1\" xmlns=\"http://www.w3.org/2000/svg\">" ] + ++ [svgPolygon hull] + ++ map svgPoint points + ++ map svgPointHull hull + ++ ["</svg>"] svgPolygon :: [(Int, Int)] -> String svgPolygon points - = "<polygon" - ++ " points=\"" ++ (concat [show x ++ "," ++ show y ++ " " | (x, y) <- points]) ++ "\"" - ++ " style=\"fill:#d0d0ff;stroke:#000000;stroke-width:1\"" - ++ "/>" + = "<polygon" + ++ " points=\"" ++ (concat [show x ++ "," ++ show y ++ " " | (x, y) <- points]) ++ "\"" + ++ " style=\"fill:#d0d0ff;stroke:#000000;stroke-width:1\"" + ++ "/>" svgPoint :: (Int, Int) -> String svgPoint (x, y) - = "<circle cx=\"" ++ show x ++ "\" cy=\"" ++ show y ++ "\" r=\"0.5\"" - ++ " style=\"stroke:#000000\"" - ++ "/>" + = "<circle cx=\"" ++ show x ++ "\" cy=\"" ++ show y ++ "\" r=\"0.5\"" + ++ " style=\"stroke:#000000\"" + ++ "/>" svgPointHull :: (Int, Int) -> String svgPointHull (x, y) - = "<circle cx=\"" ++ show x ++ "\" cy=\"" ++ show y ++ "\" r=\"1\"" - ++ " style=\"stroke:#ff0000\"" - ++ "/>" - + = "<circle cx=\"" ++ show x ++ "\" cy=\"" ++ show y ++ "\" r=\"1\"" + ++ " style=\"stroke:#ff0000\"" + ++ "/>" + roundPoints :: [(Double, Double)] -> [(Int, Int)] roundPoints ps = [(round x, round y) | (x, y) <- ps] diff --git a/testsuite/tests/dph/quickhull/TestData.hs b/testsuite/tests/dph/quickhull/TestData.hs index 2d07354de7..a27cca288e 100644 --- a/testsuite/tests/dph/quickhull/TestData.hs +++ b/testsuite/tests/dph/quickhull/TestData.hs @@ -1,17 +1,17 @@ -module TestData - ( genPointsUniform - , genPointsDisc - , genPointsCombo - , toPArrayPoints ) +module TestData + ( genPointsUniform + , genPointsDisc + , genPointsCombo + , toPArrayPoints ) where import qualified Types as QH -import qualified Data.Array.Parallel.Unlifted as U -import qualified Data.Array.Parallel.Prelude as P +import qualified Data.Array.Parallel.Unlifted as U +import qualified Data.Array.Parallel.Prelude as P import qualified Data.Array.Parallel.Prelude.Double as D import qualified Data.Array.Parallel.PArray as P -import Data.Array.Parallel.PArray (PArray) +import Data.Array.Parallel.PArray (PArray) import System.Random import Control.Exception @@ -22,71 +22,71 @@ import Control.Exception -- is between O (N) and O (N^2) depending on the input. -- To compare benchmark results, they always need to use the same -- input. -seed = 42742 +seed = 42742 -- | Some uniformly distributed points -genPointsUniform - :: Int -- ^ number of points - -> Double -- ^ minimum coordinate - -> Double -- ^ maximum coordinate - -> [(Double, Double)] +genPointsUniform + :: Int -- ^ number of points + -> Double -- ^ minimum coordinate + -> Double -- ^ maximum coordinate + -> [(Double, Double)] genPointsUniform n minXY maxXY = let - pointMin = 10 - pointMax = 510 - gen = mkStdGen seed - in toPairs $ take (2*n) $ randomRs (pointMin, pointMax) gen + pointMin = 10 + pointMax = 510 + gen = mkStdGen seed + in toPairs $ take (2*n) $ randomRs (pointMin, pointMax) gen toPairs [] = [] toPairs (x:y:pts) = (x, y) : toPairs pts -- | Some points distributed as a disc -genPointsDisc - :: Int -- ^ number of points - -> (Double, Double) -- ^ center of disc - -> Double -- ^ radius of disc - -> [(Double, Double)] +genPointsDisc + :: Int -- ^ number of points + -> (Double, Double) -- ^ center of disc + -> Double -- ^ radius of disc + -> [(Double, Double)] genPointsDisc n (originX, originY) radiusMax - = let (genRadius, genAngle) - = split $ mkStdGen seed - - radius = take n $ randomRs (0, radiusMax) genRadius - angle = take n $ randomRs (- pi, pi) genAngle + = let (genRadius, genAngle) + = split $ mkStdGen seed - makeXY (r, a) - = ( originX + r * cos a - , originY + r * sin a) + radius = take n $ randomRs (0, radiusMax) genRadius + angle = take n $ randomRs (- pi, pi) genAngle - in map makeXY $ zip radius angle + makeXY (r, a) + = ( originX + r * cos a + , originY + r * sin a) + + in map makeXY $ zip radius angle -- | A point cloud with areas of high an low density -genPointsCombo - :: Int -- ^ number of points - -> [(Double, Double)] +genPointsCombo + :: Int -- ^ number of points + -> [(Double, Double)] genPointsCombo n - = genPointsDisc (n `div` 5) (250, 250) 200 - ++ genPointsDisc (n `div` 5) (100, 100) 80 - ++ genPointsDisc (n `div` 5) (150, 300) 30 - ++ genPointsDisc (n `div` 5) (500, 120) 30 - ++ genPointsDisc (n `div` 5) (300, 200) 150 + = genPointsDisc (n `div` 5) (250, 250) 200 + ++ genPointsDisc (n `div` 5) (100, 100) 80 + ++ genPointsDisc (n `div` 5) (150, 300) 30 + ++ genPointsDisc (n `div` 5) (500, 120) 30 + ++ genPointsDisc (n `div` 5) (300, 200) 150 -- | Convert a list of points to a PArray toPArrayPoints :: [(Double, Double)] -> IO (PArray QH.Point) toPArrayPoints ps - = do let pts = QH.points (P.fromList (map fst ps)) - (P.fromList (map snd ps)) - evaluate $ force pts - return pts + = do let pts = QH.points (P.fromList (map fst ps)) + (P.fromList (map snd ps)) + evaluate $ force pts + return pts -- | Force points to be evaluated -force pts - = U.index "TestData" (P.toUArray (QH.xsOf pts)) 0 D.+ +force pts + = U.index "TestData" (P.toUArray (QH.xsOf pts)) 0 D.+ U.index "TestData" (P.toUArray (QH.ysOf pts)) 0 - + diff --git a/testsuite/tests/dph/sumnats/Main.hs b/testsuite/tests/dph/sumnats/Main.hs index 9e18e335a9..7c3ee7210b 100644 --- a/testsuite/tests/dph/sumnats/Main.hs +++ b/testsuite/tests/dph/sumnats/Main.hs @@ -5,17 +5,17 @@ import SumNatsVect (sumNats) -- Add all the natural numbers below 1000 that are multiples of 3 or 5. solutionLists maxN - = let sumOnetoN n = n * (n+1) `div` 2 - sumStep s n = s * sumOnetoN (n `div` s) - in sumStep 3 (maxN - 1) + sumStep 5 (maxN - 1) - sumStep 15 (maxN - 1) + = let sumOnetoN n = n * (n+1) `div` 2 + sumStep s n = s * sumOnetoN (n `div` s) + in sumStep 3 (maxN - 1) + sumStep 5 (maxN - 1) - sumStep 15 (maxN - 1) solutionLists2 maxN - = sum [ x | x <- [0.. maxN - 1] - , (x `mod` 3 == 0) || (x `mod` 5 == 0) ] + = sum [ x | x <- [0.. maxN - 1] + , (x `mod` 3 == 0) || (x `mod` 5 == 0) ] + +main + = do let n = 1000 + print $ solutionLists n + print $ solutionLists2 n + print $ sumNats n -main - = do let n = 1000 - print $ solutionLists n - print $ solutionLists2 n - print $ sumNats n -
\ No newline at end of file diff --git a/testsuite/tests/dph/words/Main.hs b/testsuite/tests/dph/words/Main.hs index 094a2ceb7d..b7c266921f 100644 --- a/testsuite/tests/dph/words/Main.hs +++ b/testsuite/tests/dph/words/Main.hs @@ -1,37 +1,37 @@ import WordsVect import Data.Array.Parallel -import qualified Data.Array.Parallel.Prelude.Word8 as W -import qualified Data.Array.Parallel.PArray as P -import qualified Data.Array.Parallel.Unlifted as U +import qualified Data.Array.Parallel.Prelude.Word8 as W +import qualified Data.Array.Parallel.PArray as P +import qualified Data.Array.Parallel.Unlifted as U import Data.Char -main - = do -- take the filename containing the words as the first arg - let str = "When I look into the looking glass I'm always sure to see" - ++ " no matter how I dodge about, me looking back at me." - - -- convert string to a PArray - let paStr :: PArray W.Word8 - paStr = P.fromUArray $ U.map W.fromInt $ U.fromList $ map ord str - - - -- break the string into words then flatten it back - let str' :: String - str' = map chr - $ map fromIntegral - $ P.toList - $ wordsOfPArray paStr - - - -- count the number of words in the string, using the vectorised program - let wordCountVect = fromIntegral $ wordCountOfPArray paStr - - -- count the number of words with the ye'olde list way - let wordCountList = length $ words str - - -- - putStr $ show str' ++ "\n" - ++ "word count vect = " ++ show wordCountVect ++ "\n" - ++ "word count lists = " ++ show wordCountList ++ "\n" -
\ No newline at end of file +main + = do -- take the filename containing the words as the first arg + let str = "When I look into the looking glass I'm always sure to see" + ++ " no matter how I dodge about, me looking back at me." + + -- convert string to a PArray + let paStr :: PArray W.Word8 + paStr = P.fromUArray $ U.map W.fromInt $ U.fromList $ map ord str + + + -- break the string into words then flatten it back + let str' :: String + str' = map chr + $ map fromIntegral + $ P.toList + $ wordsOfPArray paStr + + + -- count the number of words in the string, using the vectorised program + let wordCountVect = fromIntegral $ wordCountOfPArray paStr + + -- count the number of words with the ye'olde list way + let wordCountList = length $ words str + + -- + putStr $ show str' ++ "\n" + ++ "word count vect = " ++ show wordCountVect ++ "\n" + ++ "word count lists = " ++ show wordCountList ++ "\n" + diff --git a/testsuite/tests/dph/words/WordsVect.hs b/testsuite/tests/dph/words/WordsVect.hs index 344442f3fb..218e885dac 100644 --- a/testsuite/tests/dph/words/WordsVect.hs +++ b/testsuite/tests/dph/words/WordsVect.hs @@ -1,7 +1,7 @@ -- Break up a string into words in parallel. --- Based on the presentation "Breaking Sequential Habits of Thought", Guy Steele. --- http://groups.csail.mit.edu/mac/users/gjs/6.945/readings/MITApril2009Steele.pdf +-- Based on the presentation "Breaking Sequential Habits of Thought", Guy Steele. +-- http://groups.csail.mit.edu/mac/users/gjs/6.945/readings/MITApril2009Steele.pdf -- -- NOTE: This is a naive implementation, and I haven't benchmarked it. -- Using parallel arrays in Seg probably isn't helpful for performance, @@ -26,10 +26,10 @@ import qualified Prelude as Prel -- We can't use the Prelude Char and String types in vectorised code yet.. -type Char = Word8 -char_space = W.fromInt 32 +type Char = Word8 +char_space = W.fromInt 32 -type String = [: Char :] +type String = [: Char :] -- | Word state @@ -50,58 +50,58 @@ plusState str1 str2 (Seg al ass ar, Seg bl bss br) -> Seg al (ass +:+ joinEmpty [:ar +:+ bl:] +:+ bss) br joinEmpty :: [:[:Word8:]:] -> [:[:Word8:]:] -joinEmpty ws - | lengthP ws I.== 1 && lengthP (ws !: 0) I.== 0 = [::] - | otherwise = ws +joinEmpty ws + | lengthP ws I.== 1 && lengthP (ws !: 0) I.== 0 = [::] + | otherwise = ws -- | Convert a single char to a wordstate. stateOfChar :: Char -> State stateOfChar c - | c W.== char_space = Seg [::] [::] [::] - | otherwise = Chunk [:c:] - - + | c W.== char_space = Seg [::] [::] [::] + | otherwise = Chunk [:c:] + + -- | Break this string into words. stateOfString :: String -> State stateOfString str - = let len = lengthP str - result - | len I.== 0 = Chunk [::] - | len I.== 1 = stateOfChar (str !: 0) - | otherwise - = let half = len `div` 2 - s1 = sliceP 0 half str - s2 = sliceP half (len I.- half) str - in plusState (stateOfString s1) (stateOfString s2) - in result + = let len = lengthP str + result + | len I.== 0 = Chunk [::] + | len I.== 1 = stateOfChar (str !: 0) + | otherwise + = let half = len `div` 2 + s1 = sliceP 0 half str + s2 = sliceP half (len I.- half) str + in plusState (stateOfString s1) (stateOfString s2) + in result -- | Count the number of words in a string. countWordsOfState :: State -> Int countWordsOfState state = case state of - Chunk c -> wordsInChunkArr c - Seg c1 ws c2 -> wordsInChunkArr c1 I.+ lengthP ws I.+ wordsInChunkArr c2 - + Chunk c -> wordsInChunkArr c + Seg c1 ws c2 -> wordsInChunkArr c1 I.+ lengthP ws I.+ wordsInChunkArr c2 + wordsInChunkArr :: [:Word8:] -> Int wordsInChunkArr arr - | lengthP arr I.== 0 = 0 - | otherwise = 1 + | lengthP arr I.== 0 = 0 + | otherwise = 1 -- | Flatten a state back to an array of Word8s, --- inserting spaces between the words. +-- inserting spaces between the words. flattenState :: State -> [:Word8:] flattenState ss = case ss of - Chunk s -> s + Chunk s -> s - Seg w1 ws w2 - -> w1 - +:+ [:char_space:] - +:+ concatP [: w +:+ [:char_space:] | w <- ws :] - +:+ w2 + Seg w1 ws w2 + -> w1 + +:+ [:char_space:] + +:+ concatP [: w +:+ [:char_space:] | w <- ws :] + +:+ w2 -- Interface ------------------------------------------------------------------ @@ -109,17 +109,17 @@ flattenState ss wordsOfPArray :: PArray Word8 -> PArray Word8 {-# NOINLINE wordsOfPArray #-} wordsOfPArray arr - = let str = fromPArrayP arr - state = stateOfString str - strOut = flattenState state - in toPArrayP strOut + = let str = fromPArrayP arr + state = stateOfString str + strOut = flattenState state + in toPArrayP strOut -- | Count the number of words in an array wordCountOfPArray :: PArray Word8 -> Int {-# NOINLINE wordCountOfPArray #-} wordCountOfPArray arr - = let str = fromPArrayP arr - state = stateOfString str - in countWordsOfState state + = let str = fromPArrayP arr + state = stateOfString str + in countWordsOfState state diff --git a/testsuite/tests/patsyn/should_compile/ex-num.hs b/testsuite/tests/patsyn/should_compile/ex-num.hs index ff0bf2c97d..9e86d4b3b8 100644 --- a/testsuite/tests/patsyn/should_compile/ex-num.hs +++ b/testsuite/tests/patsyn/should_compile/ex-num.hs @@ -4,6 +4,6 @@ module ShouldCompile where data T a where - MkT :: (Eq b) => a -> b -> T a + MkT :: (Eq b) => a -> b -> T a pattern P x <- MkT 42 x diff --git a/testsuite/tests/patsyn/should_compile/ex-prov.hs b/testsuite/tests/patsyn/should_compile/ex-prov.hs index 9225cf2e1c..6f8a7b37bf 100644 --- a/testsuite/tests/patsyn/should_compile/ex-prov.hs +++ b/testsuite/tests/patsyn/should_compile/ex-prov.hs @@ -4,7 +4,7 @@ module ShouldCompile where data T a where - MkT :: (Eq b) => a -> b -> T a + MkT :: (Eq b) => a -> b -> T a pattern P x y <- MkT x y diff --git a/testsuite/tests/patsyn/should_compile/ex-view.hs b/testsuite/tests/patsyn/should_compile/ex-view.hs index 699b070b5f..dfd771bb02 100644 --- a/testsuite/tests/patsyn/should_compile/ex-view.hs +++ b/testsuite/tests/patsyn/should_compile/ex-view.hs @@ -6,7 +6,7 @@ module ShouldCompile where data T a where - MkT :: (Eq b) => a -> b -> T a + MkT :: (Eq b) => a -> b -> T a f :: (Show a) => a -> Bool f = undefined diff --git a/testsuite/tests/patsyn/should_run/ex-prov-run.hs b/testsuite/tests/patsyn/should_run/ex-prov-run.hs index 846ca90c27..e10bd22d2b 100644 --- a/testsuite/tests/patsyn/should_run/ex-prov-run.hs +++ b/testsuite/tests/patsyn/should_run/ex-prov-run.hs @@ -4,7 +4,7 @@ module Main where data T a where - MkT :: (Eq b) => a -> b -> T a + MkT :: (Eq b) => a -> b -> T a pattern P x y <- MkT x y diff --git a/testsuite/tests/polykinds/T7238.hs b/testsuite/tests/polykinds/T7238.hs index 3639a8e089..efe0fb1674 100644 --- a/testsuite/tests/polykinds/T7238.hs +++ b/testsuite/tests/polykinds/T7238.hs @@ -4,11 +4,11 @@ module T7238 where import GHC.Exts class Pair p where - type Ctxt p a :: Constraint - l :: Ctxt p a => p a -> a + type Ctxt p a :: Constraint + l :: Ctxt p a => p a -> a data Unit a = Unit instance Pair Unit where - type Ctxt Unit a = a ~ () - l _ = ()
\ No newline at end of file + type Ctxt Unit a = a ~ () + l _ = () diff --git a/testsuite/tests/typecheck/should_compile/LoopOfTheDay1.hs b/testsuite/tests/typecheck/should_compile/LoopOfTheDay1.hs index 860b9ede24..713c6b3f29 100644 --- a/testsuite/tests/typecheck/should_compile/LoopOfTheDay1.hs +++ b/testsuite/tests/typecheck/should_compile/LoopOfTheDay1.hs @@ -19,14 +19,14 @@ class C0 x where foo :: x -> (); foo = undefined class C1 x y class C1 x y => C2 x y -instance C0 T1 => C1 () T1 -- (I1) -instance (C1 x T1) => C2 x T1 -- (I2) -instance C2 () T1 => C0 T1 -- (I3) +instance C0 T1 => C1 () T1 -- (I1) +instance (C1 x T1) => C2 x T1 -- (I2) +instance C2 () T1 => C0 T1 -- (I3) baz = foo (T1b T1a) -{- Need C0 T1 --->(I3) C2 () T1 --->(I2) C1 () T1 --->(I1) C0 T1 -- STOP because we've seen this before +{- Need C0 T1 +-->(I3) C2 () T1 +-->(I2) C1 () T1 +-->(I1) C0 T1 -- STOP because we've seen this before -} diff --git a/testsuite/tests/typecheck/should_compile/LoopOfTheDay2.hs b/testsuite/tests/typecheck/should_compile/LoopOfTheDay2.hs index 356fc728e0..db981b7c1f 100644 --- a/testsuite/tests/typecheck/should_compile/LoopOfTheDay2.hs +++ b/testsuite/tests/typecheck/should_compile/LoopOfTheDay2.hs @@ -16,24 +16,24 @@ class C0 x where foo :: x -> (); foo = undefined class C1 x y class C1 x y => C2 x y - -instance C0 Int => C1 () Int -- I1 -instance C0 T1 => C1 () T1 -- I2 -instance (C1 x T1, C1 x Int) => C2 x T1 -- I3 -instance C1 x Int => C2 x Int -- I4 -instance C2 () T1 => C0 T1 -- I5 -instance C2 () Int => C0 Int -- I6 + +instance C0 Int => C1 () Int -- I1 +instance C0 T1 => C1 () T1 -- I2 +instance (C1 x T1, C1 x Int) => C2 x T1 -- I3 +instance C1 x Int => C2 x Int -- I4 +instance C2 () T1 => C0 T1 -- I5 +instance C2 () Int => C0 Int -- I6 baz = foo (T1b (T1a 3)) {- Need - C0 T1 --->(I5) C2 () T1 --->(I3) C1 () T1, C1 () Int --->(I1,I2) C0 T1, C0 Int --->(recusive) C0 Int --->(I6) C2 () Int --->(I4) C1 () Int --->(recursive) {} --} + C0 T1 +-->(I5) C2 () T1 +-->(I3) C1 () T1, C1 () Int +-->(I1,I2) C0 T1, C0 Int +-->(recusive) C0 Int +-->(I6) C2 () Int +-->(I4) C1 () Int +-->(recursive) {} +-} diff --git a/testsuite/tests/typecheck/should_compile/T2497.hs b/testsuite/tests/typecheck/should_compile/T2497.hs index 67e313c977..6f76395fbf 100644 --- a/testsuite/tests/typecheck/should_compile/T2497.hs +++ b/testsuite/tests/typecheck/should_compile/T2497.hs @@ -6,7 +6,7 @@ foo x = x {-# NOINLINE [1] foo #-} -- Trac #2497; test should compile without language --- pragmas to swith on the forall +-- pragmas to swith on the forall {-# RULES "id" forall (x :: a). foo x = x #-} diff --git a/testsuite/tests/typecheck/should_compile/T4355.hs b/testsuite/tests/typecheck/should_compile/T4355.hs index 7aecd2ad7c..7e49dd8225 100644 --- a/testsuite/tests/typecheck/should_compile/T4355.hs +++ b/testsuite/tests/typecheck/should_compile/T4355.hs @@ -4,8 +4,8 @@ module T4355 where import Control.Arrow -import Control.Monad.Trans -- From mtl -import Control.Monad.Reader -- Ditto +import Control.Monad.Trans -- From mtl +import Control.Monad.Reader -- Ditto import Data.Typeable import Data.Maybe diff --git a/testsuite/tests/typecheck/should_compile/T4361.hs b/testsuite/tests/typecheck/should_compile/T4361.hs index 32c8cf7b77..b61e763488 100644 --- a/testsuite/tests/typecheck/should_compile/T4361.hs +++ b/testsuite/tests/typecheck/should_compile/T4361.hs @@ -9,7 +9,7 @@ class CommutativeRing a class CommutativeRing a => LinSolvRing a class LinSolvRing a => EuclideanRing a -instance EuclideanRing a => LinSolvRing (Pol a) -- XXXX +instance EuclideanRing a => LinSolvRing (Pol a) -- XXXX instance CommutativeRing a => CommutativeRing (Pol a) data Pol a = MkPol diff --git a/testsuite/tests/typecheck/should_compile/T5514.hs b/testsuite/tests/typecheck/should_compile/T5514.hs index 9b8821ecd4..539886b4c5 100644 --- a/testsuite/tests/typecheck/should_compile/T5514.hs +++ b/testsuite/tests/typecheck/should_compile/T5514.hs @@ -2,10 +2,10 @@ module T5514 where class Foo a where - foo :: a -> a + foo :: a -> a instance (Foo a, Foo b) => Foo (a, b) where - foo = foo' () + foo = foo' () -- foo' :: () -> b -> b foo' es = const id (unitId es) diff --git a/testsuite/tests/typecheck/should_compile/syn-perf.hs b/testsuite/tests/typecheck/should_compile/syn-perf.hs index c7e2a4a0eb..c44ba9f6dc 100644 --- a/testsuite/tests/typecheck/should_compile/syn-perf.hs +++ b/testsuite/tests/typecheck/should_compile/syn-perf.hs @@ -14,13 +14,13 @@ data HNil = HNil deriving (Eq,Show,Read) data HCons e l = HCons e l deriving (Eq,Show,Read) type e :*: l = HCons e l - -- In GHC 6.4 the deeply-nested use of this - -- synonym gave rise to exponential behaviour + -- In GHC 6.4 the deeply-nested use of this + -- synonym gave rise to exponential behaviour --- list endian16 -newtype Tables = Tables [TableInfo] deriving (Show, Typeable) +newtype Tables = Tables [TableInfo] deriving (Show, Typeable) -type TableInfo = +type TableInfo = AvgPot :*: NumPlayers :*: Waiting :*: @@ -31,7 +31,7 @@ type TableInfo = InfoMaxPlayers :*: RealMoneyTable :*: LowBet :*: - HighBet :*: + HighBet :*: MinStartMoney :*: MaxStartMoney :*: GamesPerHour :*: @@ -46,30 +46,30 @@ type TableInfo = LangID :*: HNil -newtype TourType = TourType TourType_ deriving (Show, Typeable) +newtype TourType = TourType TourType_ deriving (Show, Typeable) newtype AvgPot = AvgPot Word64 deriving (Show, Typeable) newtype NumPlayers = NumPlayers Word16 deriving (Show, Typeable) newtype Waiting = Waiting Word16 deriving (Show, Typeable) newtype PlayersFlop = PlayersFlop Word8 deriving (Show, Typeable) -newtype TableName = TableName String deriving (Show, Typeable) -newtype TableID = TableID Word32 deriving (Show, Typeable) -newtype OldTableID = OldTableID Word32 deriving (Show, Typeable) -newtype GameType = GameType GameType_ deriving (Show, Typeable) -newtype InfoMaxPlayers = InfoMaxPlayers Word16 deriving (Show, Typeable) -newtype RealMoneyTable = RealMoneyTable Bool deriving (Show, Typeable) -newtype LowBet = LowBet RealMoney_ deriving (Show, Typeable) -newtype HighBet = HighBet RealMoney_ deriving (Show, Typeable) -newtype MinStartMoney = MinStartMoney RealMoney_ deriving (Show, Typeable) -newtype MaxStartMoney = MaxStartMoney RealMoney_ deriving (Show, Typeable) -newtype GamesPerHour = GamesPerHour Word16 deriving (Show, Typeable) -newtype TourID = TourID Word32 deriving (Show, Typeable) -newtype BetType = BetType BetType_ deriving (Show, Typeable) -newtype CantReturnLess = CantReturnLess Word32 deriving (Show, Typeable) -newtype AffiliateID = AffiliateID [Word8] deriving (Show, Typeable) -newtype NIsResurrecting = NIsResurrecting Word32 deriving (Show, Typeable) -newtype MinutesForTimeout = MinutesForTimeout Word32 deriving (Show, Typeable) -newtype SeatsToResurrect = SeatsToResurrect Word32 deriving (Show, Typeable) -newtype LangID = LangID Word32 deriving (Show, Typeable) +newtype TableName = TableName String deriving (Show, Typeable) +newtype TableID = TableID Word32 deriving (Show, Typeable) +newtype OldTableID = OldTableID Word32 deriving (Show, Typeable) +newtype GameType = GameType GameType_ deriving (Show, Typeable) +newtype InfoMaxPlayers = InfoMaxPlayers Word16 deriving (Show, Typeable) +newtype RealMoneyTable = RealMoneyTable Bool deriving (Show, Typeable) +newtype LowBet = LowBet RealMoney_ deriving (Show, Typeable) +newtype HighBet = HighBet RealMoney_ deriving (Show, Typeable) +newtype MinStartMoney = MinStartMoney RealMoney_ deriving (Show, Typeable) +newtype MaxStartMoney = MaxStartMoney RealMoney_ deriving (Show, Typeable) +newtype GamesPerHour = GamesPerHour Word16 deriving (Show, Typeable) +newtype TourID = TourID Word32 deriving (Show, Typeable) +newtype BetType = BetType BetType_ deriving (Show, Typeable) +newtype CantReturnLess = CantReturnLess Word32 deriving (Show, Typeable) +newtype AffiliateID = AffiliateID [Word8] deriving (Show, Typeable) +newtype NIsResurrecting = NIsResurrecting Word32 deriving (Show, Typeable) +newtype MinutesForTimeout = MinutesForTimeout Word32 deriving (Show, Typeable) +newtype SeatsToResurrect = SeatsToResurrect Word32 deriving (Show, Typeable) +newtype LangID = LangID Word32 deriving (Show, Typeable) data GameType_ = EmptyGame @@ -105,4 +105,4 @@ data BetType_ | BetTeenPatti | BetTeenPattiFixed deriving (Enum, Eq, Show, Typeable) - + diff --git a/testsuite/tests/typecheck/should_compile/syn-perf2.hs b/testsuite/tests/typecheck/should_compile/syn-perf2.hs index 517fdb8a21..7a07bfa643 100644 --- a/testsuite/tests/typecheck/should_compile/syn-perf2.hs +++ b/testsuite/tests/typecheck/should_compile/syn-perf2.hs @@ -1,5 +1,5 @@ -- Another type-synonym performance test --- (Trac 323) +-- (Trac 323) -- Fails in GHC up to 6.6 module ShouldCompile where diff --git a/testsuite/tests/typecheck/should_compile/tc047.hs b/testsuite/tests/typecheck/should_compile/tc047.hs index b8c197d185..8a715ad72c 100644 --- a/testsuite/tests/typecheck/should_compile/tc047.hs +++ b/testsuite/tests/typecheck/should_compile/tc047.hs @@ -10,7 +10,7 @@ type OL a = [a] -- the following bogus type sig. was accepted by BOTH hbc and nhc f x = ranOAL where -- ranOAL :: OL (a,v) -> [a] --ranOAL :: OL (a,v) -> [v], the right sig. - ranOAL ( xs) = mp sd xs + ranOAL ( xs) = mp sd xs mp f [] = [] diff --git a/testsuite/tests/typecheck/should_compile/tc065.hs b/testsuite/tests/typecheck/should_compile/tc065.hs index 510eca6103..93edb935ee 100644 --- a/testsuite/tests/typecheck/should_compile/tc065.hs +++ b/testsuite/tests/typecheck/should_compile/tc065.hs @@ -15,9 +15,9 @@ mkDigraph = MkDigraph stronglyConnComp :: Eq vertex => [Edge vertex] -> [vertex] -> [[vertex]] stronglyConnComp es vs = snd (span_tree (new_range reversed_edges) - ([],[]) + ([],[]) ( snd (dfs (new_range es) ([],[]) vs) ) - ) + ) where reversed_edges = map swap es @@ -26,16 +26,16 @@ stronglyConnComp es vs new_range [] w = [] new_range ((x,y):xys) w - = if x==w - then (y : (new_range xys w)) - else (new_range xys w) + = if x==w + then (y : (new_range xys w)) + else (new_range xys w) span_tree r (vs,ns) [] = (vs,ns) span_tree r (vs,ns) (x:xs) - | x `elem` vs = span_tree r (vs,ns) xs - | otherwise = span_tree r (vs',(x:ns'):ns) xs - where - (vs',ns') = dfs r (x:vs,[]) (r x) + | x `elem` vs = span_tree r (vs,ns) xs + | otherwise = span_tree r (vs',(x:ns'):ns) xs + where + (vs',ns') = dfs r (x:vs,[]) (r x) dfs r (vs,ns) [] = (vs,ns) dfs r (vs,ns) (x:xs) | x `elem` vs = dfs r (vs,ns) xs @@ -55,8 +55,8 @@ topSort :: (Eq vertex) => [Edge vertex] -> [vertex] topSort edges vertices = case cycles of - [] -> Succeeded [v | [v] <- singletons] - _ -> Failed cycles + [] -> Succeeded [v | [v] <- singletons] + _ -> Failed cycles where sccs = stronglyConnComp edges vertices (cycles, singletons) = partition (isCyclic edges) sccs @@ -69,9 +69,9 @@ mkVertices :: FlattenedDependencyInfo vertex name code -> [vertex] mkVertices info = [ vertex | (vertex,_,_,_) <- info] mkEdges :: (Ord name) => - [vertex] - -> FlattenedDependencyInfo vertex name code - -> [Edge vertex] + [vertex] + -> FlattenedDependencyInfo vertex name code + -> [Edge vertex] mkEdges vertices flat_info = [ (source_vertex, target_vertex) @@ -82,13 +82,13 @@ mkEdges vertices flat_info where vertices_defining name flat_info = [ vertex | (vertex, names_defined, _, _) <- flat_info, - name `Set.member` names_defined + name `Set.member` names_defined ] lookupVertex :: (Eq vertex) => - FlattenedDependencyInfo vertex name code - -> vertex - -> code + FlattenedDependencyInfo vertex name code + -> vertex + -> code lookupVertex flat_info vertex = head code_list diff --git a/testsuite/tests/typecheck/should_compile/tc077.hs b/testsuite/tests/typecheck/should_compile/tc077.hs index c4f6c4e986..0315212341 100644 --- a/testsuite/tests/typecheck/should_compile/tc077.hs +++ b/testsuite/tests/typecheck/should_compile/tc077.hs @@ -6,4 +6,4 @@ data NUM = ONE | TWO class (Num a) => ORD a class (ORD a, Show a) => EQ a where - (===) :: a -> a -> Bool + (===) :: a -> a -> Bool diff --git a/testsuite/tests/typecheck/should_compile/tc080.hs b/testsuite/tests/typecheck/should_compile/tc080.hs index 636c5b0313..78e413ffd9 100644 --- a/testsuite/tests/typecheck/should_compile/tc080.hs +++ b/testsuite/tests/typecheck/should_compile/tc080.hs @@ -12,14 +12,14 @@ class Parse a where forced :: a -> Bool parseFile string | all forced x = x - where x = map parseLine (lines' string) + where x = map parseLine (lines' string) parseLine = pl.parse where pl (a,_) = a parse = parseType.whiteSpace forced x = True instance Parse Int where parseType str = pl (span' isDigit str) - where pl (l,r) = (strToInt l,r) + where pl (l,r) = (strToInt l,r) forced n | n>=0 = True instance Parse Char where @@ -27,14 +27,14 @@ instance Parse Char where forced n = True instance (Parse a) => Parse [a] where - parseType more = (map parseLine (seperatedBy ',' (l++",")),out) - where (l,']':out) = span' (\x->x/=']') (tail more) - forced = all forced + parseType more = (map parseLine (seperatedBy ',' (l++",")),out) + where (l,']':out) = span' (\x->x/=']') (tail more) + forced = all forced seperatedBy :: Char -> String -> [String] seperatedBy ch [] = [] seperatedBy ch xs = twaddle ch (span' (\x->x/=ch) xs) - where twaddle ch (l,_:r) = l:seperatedBy ch r + where twaddle ch (l,_:r) = l:seperatedBy ch r whiteSpace :: String -> String whiteSpace = dropWhile isSpace @@ -52,7 +52,7 @@ lines' s = plumb (span' ((/=) '\n') s) strToInt :: String -> Int strToInt x = strToInt' (length x-1) x where strToInt' _ [] = 0 - strToInt' x (a:l) = (charToInt a)*(10^x) + (strToInt' (x-1) l) + strToInt' x (a:l) = (charToInt a)*(10^x) + (strToInt' (x-1) l) charToInt :: Char -> Int charToInt x = (ord x - ord '0') diff --git a/testsuite/tests/typecheck/should_compile/tc081.hs b/testsuite/tests/typecheck/should_compile/tc081.hs index 03be25659e..360458a40f 100644 --- a/testsuite/tests/typecheck/should_compile/tc081.hs +++ b/testsuite/tests/typecheck/should_compile/tc081.hs @@ -3,8 +3,8 @@ module ShouldSucceed where f x = (x+1, x<3, g True, g 'c') - where - g y = if x>2 then [] else [y] + where + g y = if x>2 then [] else [y] {- Here the type-check of g will yield an LIE with an Ord dict for x. g still has type forall a. a -> [a]. The dictionary is @@ -14,16 +14,16 @@ It should be ok to add the signature: -} f2 x = (x+1, x<3, g2 True, g2 'c') - where - -- NB: this sig: - g2 :: a -> [a] - g2 y = if x>2 then [] else [y] + where + -- NB: this sig: + g2 :: a -> [a] + g2 y = if x>2 then [] else [y] {- or to write: -} f3 x = (x+1, x<3, g3 True, g3 'c') - where - -- NB: this line: + where + -- NB: this line: g3 :: a -> [a] - g3 = (\ y -> if x>2 then [] else [y])::(a -> [a]) + g3 = (\ y -> if x>2 then [] else [y])::(a -> [a]) diff --git a/testsuite/tests/typecheck/should_compile/tc082.hs b/testsuite/tests/typecheck/should_compile/tc082.hs index 8ef70afd01..52adb5b968 100644 --- a/testsuite/tests/typecheck/should_compile/tc082.hs +++ b/testsuite/tests/typecheck/should_compile/tc082.hs @@ -3,10 +3,10 @@ module ShouldSucceed where class Normal a - where - normal :: a -> Bool + where + normal :: a -> Bool instance Normal ( a -> b ) where - normal _ = True + normal _ = True f x = normal id diff --git a/testsuite/tests/typecheck/should_compile/tc084.hs b/testsuite/tests/typecheck/should_compile/tc084.hs index 597a296f90..664f872454 100644 --- a/testsuite/tests/typecheck/should_compile/tc084.hs +++ b/testsuite/tests/typecheck/should_compile/tc084.hs @@ -19,5 +19,5 @@ g b x y = if b then x+x else x-x f = g True h y x = f (x::Int) y - -- This use of f binds the overloaded monomorphic - -- type to Int + -- This use of f binds the overloaded monomorphic + -- type to Int diff --git a/testsuite/tests/typecheck/should_compile/tc086.hs b/testsuite/tests/typecheck/should_compile/tc086.hs index 2db3b7094c..92799b4fab 100644 --- a/testsuite/tests/typecheck/should_compile/tc086.hs +++ b/testsuite/tests/typecheck/should_compile/tc086.hs @@ -18,7 +18,7 @@ problems. SPJ note: the type signature on "multiply" should be - multiply :: Group a => a -> a -> a + multiply :: Group a => a -> a -> a -} diff --git a/testsuite/tests/typecheck/should_compile/tc087.hs b/testsuite/tests/typecheck/should_compile/tc087.hs index 8ea1901489..dd910f21a9 100644 --- a/testsuite/tests/typecheck/should_compile/tc087.hs +++ b/testsuite/tests/typecheck/should_compile/tc087.hs @@ -6,27 +6,27 @@ data SeqView t a = Null | Cons a (t a) class PriorityQueue q where - empty :: (Ord a) => q a - single :: (Ord a) => a -> q a - insert :: (Ord a) => a -> q a -> q a - meld :: (Ord a) => q a -> q a -> q a - splitMin :: (Ord a) => q a -> SeqView q a - insert a q = single a `meld` q - -toOrderedList q = case splitMin q of - Null -> [] - Cons a q -> a : toOrderedList q - -insertMany x q = foldr insert q x -pqSort q x = toOrderedList (insertMany x q) - -check :: forall q. (PriorityQueue q) => (forall a. Ord a => q a) -> IO () -check empty = do + empty :: (Ord a) => q a + single :: (Ord a) => a -> q a + insert :: (Ord a) => a -> q a -> q a + meld :: (Ord a) => q a -> q a -> q a + splitMin :: (Ord a) => q a -> SeqView q a + insert a q = single a `meld` q + +toOrderedList q = case splitMin q of + Null -> [] + Cons a q -> a : toOrderedList q + +insertMany x q = foldr insert q x +pqSort q x = toOrderedList (insertMany x q) + +check :: forall q. (PriorityQueue q) => (forall a. Ord a => q a) -> IO () +check empty = do putStr "*** sorting\n" out (pqSort empty [1 .. 99]) out (pqSort empty [1.0, 1.1 ..99.9]) -out :: (Eq a, Num a) => [a] -> IO () -out x | sum x == 0 = putStr "ok\n" - | otherwise = putStr "ok\n" +out :: (Eq a, Num a) => [a] -> IO () +out x | sum x == 0 = putStr "ok\n" + | otherwise = putStr "ok\n" diff --git a/testsuite/tests/typecheck/should_compile/tc088.hs b/testsuite/tests/typecheck/should_compile/tc088.hs index 147909e432..bf442184bc 100644 --- a/testsuite/tests/typecheck/should_compile/tc088.hs +++ b/testsuite/tests/typecheck/should_compile/tc088.hs @@ -8,10 +8,10 @@ instance Show (a->b) where show _ = error "attempt to show function" instance (Eq b) => Eq (a -> b) where - (==) f g = error "attempt to compare functions" + (==) f g = error "attempt to compare functions" - -- Since Eval is a superclass of Num this fails - -- unless -> is an instance of Eval + -- Since Eval is a superclass of Num this fails + -- unless -> is an instance of Eval instance (Num b) => Num (a -> b) where f + g = \a -> f a + g a f - g = \a -> f a - g a diff --git a/testsuite/tests/typecheck/should_compile/tc090.hs b/testsuite/tests/typecheck/should_compile/tc090.hs index f568c390a5..477cd97b00 100644 --- a/testsuite/tests/typecheck/should_compile/tc090.hs +++ b/testsuite/tests/typecheck/should_compile/tc090.hs @@ -1,22 +1,22 @@ -{- This module tests that we can ge polymorphic recursion - of overloaded functions. GHC 2.02 produced the following - bogus error: +{- This module tests that we can ge polymorphic recursion + of overloaded functions. GHC 2.02 produced the following + bogus error: - tmp.lhs:1: A group of type signatures have mismatched contexts - Abf.a :: (PrelBase.Ord f{-aX6-}) => ... - Abf.b :: (PrelBase.Ord f{-aX2-}) => ... + tmp.lhs:1: A group of type signatures have mismatched contexts + Abf.a :: (PrelBase.Ord f{-aX6-}) => ... + Abf.b :: (PrelBase.Ord f{-aX2-}) => ... - This was due to having more than one type signature for one - group of recursive functions. + This was due to having more than one type signature for one + group of recursive functions. -} module ShouldSucceed where -a :: (Ord f) => f +a :: (Ord f) => f a = b -b :: (Ord f) => f -b = a +b :: (Ord f) => f +b = a diff --git a/testsuite/tests/typecheck/should_compile/tc091.hs b/testsuite/tests/typecheck/should_compile/tc091.hs index 05937f5164..12730731c4 100644 --- a/testsuite/tests/typecheck/should_compile/tc091.hs +++ b/testsuite/tests/typecheck/should_compile/tc091.hs @@ -4,11 +4,11 @@ -- With polymorphic recursion this one becomes legal --- SLPJ June 97. +-- SLPJ June 97. {- To: Lennart Augustsson <augustss@cs.chalmers.se> -Cc: partain@dcs.gla.ac.uk, John Peterson (Yale) <peterson-john@cs.yale.edu>, +Cc: partain@dcs.gla.ac.uk, John Peterson (Yale) <peterson-john@cs.yale.edu>, simonpj@dcs.gla.ac.uk Subject: Type checking matter Date: Fri, 23 Oct 92 15:28:38 +0100 @@ -18,7 +18,7 @@ From: Simon L Peyton Jones <simonpj@dcs.gla.ac.uk> I've looked at the enclosed again. It seems to me that since "s" includes a recursive call to "sort", inside the body of "sort", then "sort" is monomorphic, and hence so is "s"; -hence the type signature (which claims full polymorphism) is +hence the type signature (which claims full polymorphism) is wrong. [Lennart says he can't see any free variables inside "s", but there @@ -47,7 +47,7 @@ which makes me believe that it can typechecked like a top level definition. And for a top level defn the signature should be all right. - -- Lennart + -- Lennart - ------- End of forwarded message ------- -} module ShouldSucceed where @@ -55,10 +55,10 @@ module ShouldSucceed where sort :: Ord a => [a] -> [a] sort xs = s xs (length xs) where - s :: Ord b => [b] -> Int -> [b] -- This signature is WRONG + s :: Ord b => [b] -> Int -> [b] -- This signature is WRONG s xs k = if k <= 1 then xs else merge (sort ys) (sort zs) - where (ys,zs) = init_last xs (k `div` (2::Int)) + where (ys,zs) = init_last xs (k `div` (2::Int)) -- Defns of merge and init_last are just dummies with the correct types merge :: Ord a => [a] -> [a] -> [a] diff --git a/testsuite/tests/typecheck/should_compile/tc092.hs b/testsuite/tests/typecheck/should_compile/tc092.hs index 4a6c893e7d..989457789b 100644 --- a/testsuite/tests/typecheck/should_compile/tc092.hs +++ b/testsuite/tests/typecheck/should_compile/tc092.hs @@ -3,10 +3,10 @@ module ShouldSucceed where -data Empty q = Empty (forall a. Ord a => q a) -q :: (Ord a) => [a] -q = [] -e0, e1, e2 :: Empty [] -e0 = Empty [] -e1 = Empty ([] :: (Ord a) => [a]) -e2 = Empty q +data Empty q = Empty (forall a. Ord a => q a) +q :: (Ord a) => [a] +q = [] +e0, e1, e2 :: Empty [] +e0 = Empty [] +e1 = Empty ([] :: (Ord a) => [a]) +e2 = Empty q diff --git a/testsuite/tests/typecheck/should_compile/tc095.hs b/testsuite/tests/typecheck/should_compile/tc095.hs index 5e0a34d912..bfdc9fc5bc 100644 --- a/testsuite/tests/typecheck/should_compile/tc095.hs +++ b/testsuite/tests/typecheck/should_compile/tc095.hs @@ -14,7 +14,7 @@ In Hugs(January 1998), one gets where line 32 is the one marked -- ## It compiles in ghc-3.00. Changing very small things, like the -line marked ---**** to +line marked ---**** to action_0 (6) = happyShift action_0 ---**** then makes ghc produce a similar message: @@ -27,11 +27,11 @@ then makes ghc produce a similar message: module ShouldSucceed where data HappyAbsSyn t1 t2 t3 - = HappyTerminal Token - | HappyErrorToken Int - | HappyAbsSyn1 t1 - | HappyAbsSyn2 t2 - | HappyAbsSyn3 t3 + = HappyTerminal Token + | HappyErrorToken Int + | HappyAbsSyn1 t1 + | HappyAbsSyn2 t2 + | HappyAbsSyn3 t3 action_0 (6) = happyShift action_3 --- ***** action_0 (1) = happyGoto action_1 @@ -56,38 +56,38 @@ action_6 _ = happyReduce_3 happyReduce_1 = happySpecReduce_1 1 reduction where { -- ## reduction - (HappyAbsSyn2 happy_var_1) - = HappyAbsSyn1 - (\p -> let q = map (\(x,y) -> (x,y p)) happy_var_1 in (10.1)) + (HappyAbsSyn2 happy_var_1) + = HappyAbsSyn1 + (\p -> let q = map (\(x,y) -> (x,y p)) happy_var_1 in (10.1)) ; reduction _ = notHappyAtAll } happyReduce_2 = happySpecReduce_3 2 reduction where { reduction - (HappyAbsSyn3 happy_var_3) - _ - (HappyTerminal (TokenVar happy_var_1)) - = HappyAbsSyn2 - ([(happy_var_1,happy_var_3)]); + (HappyAbsSyn3 happy_var_3) + _ + (HappyTerminal (TokenVar happy_var_1)) + = HappyAbsSyn2 + ([(happy_var_1,happy_var_3)]); reduction _ _ _ = notHappyAtAll } happyReduce_3 = happySpecReduce_1 3 reduction where { reduction - (HappyTerminal (TokenInt happy_var_1)) - = HappyAbsSyn3 - (\p -> happy_var_1); + (HappyTerminal (TokenInt happy_var_1)) + = HappyAbsSyn3 + (\p -> happy_var_1); reduction _ = notHappyAtAll } happyNewToken action sts stk [] = - action 7 7 (error "reading EOF!") (HappyState action) sts stk [] + action 7 7 (error "reading EOF!") (HappyState action) sts stk [] happyNewToken action sts stk (tk:tks) = - let cont i = action i i tk (HappyState action) sts stk tks in - case tk of { - TokenInt happy_dollar_dollar -> cont 4; - TokenEq -> cont 5; - TokenVar happy_dollar_dollar -> cont 6; - } + let cont i = action i i tk (HappyState action) sts stk tks in + case tk of { + TokenInt happy_dollar_dollar -> cont 4; + TokenEq -> cont 5; + TokenVar happy_dollar_dollar -> cont 6; + } happyThen = \m k -> k m happyReturn = \a tks -> a @@ -99,7 +99,7 @@ happyError ::[Token] -> a happyError _ = error "Parse error\n" --Here are our tokens -data Token = +data Token = TokenInt Int | TokenVar String | TokenEq @@ -109,14 +109,14 @@ main = print (myparser [] []) -- $Id: tc095.hs,v 1.4 2005/05/24 11:33:11 simonpj Exp $ {- - The stack is in the following order throughout the parse: - - i current token number - j another copy of this to avoid messing with the stack - tk current token semantic value - st current state - sts state stack - stk semantic stack + The stack is in the following order throughout the parse: + + i current token number + j another copy of this to avoid messing with the stack + tk current token semantic value + st current state + sts state stack + stk semantic stack -} ----------------------------------------------------------------------------- @@ -160,8 +160,8 @@ happyShift new_state i tk st sts stk = happySpecReduce_0 i fn (-1) tk _ sts stk = case sts of - st@(HappyState action):sts -> action (-1) (-1) tk st sts stk - _ -> happyError + st@(HappyState action):sts -> action (-1) (-1) tk st sts stk + _ -> happyError happySpecReduce_0 i fn j tk st@(HappyState action) sts stk = action i j tk st (st:sts) (fn : stk) @@ -181,8 +181,8 @@ happySpecReduce_2 _ _ _ _ _ _ _ happySpecReduce_3 i fn (-1) tk _ (st@(HappyState action):sts) stk = action (-1) (-1) tk st sts stk -happySpecReduce_3 i fn j tk _ (_:_:sts@(st@(HappyState action):_)) - (v1:v2:v3:stk') +happySpecReduce_3 i fn j tk _ (_:_:sts@(st@(HappyState action):_)) + (v1:v2:v3:stk') = action i j tk st sts (fn v1 v2 v3 : stk') happySpecReduce_3 _ _ _ _ _ _ _ = notHappyAtAll @@ -194,12 +194,12 @@ happyReduce k i fn j tk st sts stk = action i j tk st' sts' (fn stk) happyMonadReduce k i c fn (-1) tk _ sts stk = case sts of - (st@(HappyState action):sts) -> action (-1) (-1) tk st sts stk - [] -> happyError + (st@(HappyState action):sts) -> action (-1) (-1) tk st sts stk + [] -> happyError happyMonadReduce k i c fn j tk st sts stk = - happyThen (fn stk) (\r -> action i j tk st' sts' (c r : stk')) + happyThen (fn stk) (\r -> action i j tk st' sts' (c r : stk')) where sts'@(st'@(HappyState action):_) = drop (k::Int) (st:sts) - stk' = drop (k::Int) stk + stk' = drop (k::Int) stk ----------------------------------------------------------------------------- -- Moving to a new state after a reduction @@ -217,18 +217,18 @@ happyFail (-1) tk st' [] stk = happyError -- discard a state happyFail (-1) tk st' (st@(HappyState action):sts) stk = --- _trace "discarding state" $ - action (-1) (-1) tk st sts stk +-- _trace "discarding state" $ + action (-1) (-1) tk st sts stk -- Enter error recovery: generate an error token, --- save the old token and carry on. +-- save the old token and carry on. -- we push the error token on the stack in anticipation of a shift, -- and also because this is a convenient place to store the saved token. happyFail i tk st@(HappyState action) sts stk = --- _trace "entering error recovery" $ - action (-1) (-1) tk st sts (HappyErrorToken i : stk) +-- _trace "entering error recovery" $ + action (-1) (-1) tk st sts (HappyErrorToken i : stk) -- Internal happy errors: diff --git a/testsuite/tests/typecheck/should_compile/tc098.hs b/testsuite/tests/typecheck/should_compile/tc098.hs index f870caa0e7..467f5fadd2 100644 --- a/testsuite/tests/typecheck/should_compile/tc098.hs +++ b/testsuite/tests/typecheck/should_compile/tc098.hs @@ -5,24 +5,24 @@ module ShouldSucceed where type Cp a = a -> a -> Ordering m :: Eq a => Cp a -> [a] -> a -m _ [x,y,z] = if x==y then x else z - +m _ [x,y,z] = if x==y then x else z + cpPairs :: Cp [j] -> (a,[j]) -> (a,[j]) -> Ordering cpPairs cp (_,p) (_,q) = cp p q mp :: (Eq i,Eq j) => Cp [j] -> [(i,[j])] -> (i,[j]) -mp cp dD = +mp cp dD = let minInRow = m (cpPairs cp) in minInRow dD {- GHC 3.02 reported T.hs:24: - Ambiguous type variable(s) - `j' in the constraint `Eq (aYD, [j])' - arising from use of `m' at T.hs:24 - In an equation for function `mp': - mp cp dD = let minInRow = m (cpPairs cp) in minInRow dD + Ambiguous type variable(s) + `j' in the constraint `Eq (aYD, [j])' + arising from use of `m' at T.hs:24 + In an equation for function `mp': + mp cp dD = let minInRow = m (cpPairs cp) in minInRow dD This was because the ambiguity test in tcSimplify didn't take account of the type variables free in the environment. diff --git a/testsuite/tests/typecheck/should_compile/tc108.hs b/testsuite/tests/typecheck/should_compile/tc108.hs index 71f5f5c07f..d42a27ab02 100644 --- a/testsuite/tests/typecheck/should_compile/tc108.hs +++ b/testsuite/tests/typecheck/should_compile/tc108.hs @@ -1,11 +1,11 @@ {-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-} -- !!! Scopes in kind checking --- Exposes a bizarre bug in 4.08.1 +-- Exposes a bizarre bug in 4.08.1 -- TestSh.hs:6: --- `Shape' is not in scope --- When checking kinds in `HasConfigValue Shape nodeTypeParms' --- In the class declaration for `HasShape' +-- `Shape' is not in scope +-- When checking kinds in `HasConfigValue Shape nodeTypeParms' +-- In the class declaration for `HasShape' module ShouldCompile where diff --git a/testsuite/tests/typecheck/should_compile/tc125.hs b/testsuite/tests/typecheck/should_compile/tc125.hs index 75602edac2..81b6490f29 100644 --- a/testsuite/tests/typecheck/should_compile/tc125.hs +++ b/testsuite/tests/typecheck/should_compile/tc125.hs @@ -5,7 +5,7 @@ -- !!! Functional dependency test. Hugs [Apr 2001] fails to typecheck this -- We should infer this type for foo --- foo :: Q (S (S Z)) (S Z) +-- foo :: Q (S (S Z)) (S Z) module ShouldCompile where diff --git a/testsuite/tests/typecheck/should_compile/tc126.hs b/testsuite/tests/typecheck/should_compile/tc126.hs index 87d63dd771..9b6bf8b2bb 100644 --- a/testsuite/tests/typecheck/should_compile/tc126.hs +++ b/testsuite/tests/typecheck/should_compile/tc126.hs @@ -14,20 +14,20 @@ class Bug f a r | f a -> r where bug::f->a->r instance Bug (Int->r) Int r -instance (Bug f a r) => Bug f (c a) (c r) +instance (Bug f a r) => Bug f (c a) (c r) f:: Bug(Int->Int) a r => a->r f = bug (id::Int->Int) g1 = f (f [0::Int]) --- Inner f gives result type --- f [0::Int] :: Bug (Int->Int) [Int] r => r +-- Inner f gives result type +-- f [0::Int] :: Bug (Int->Int) [Int] r => r -- Which matches the second instance declaration, giving r = [r'] --- f [0::Int] :: Bug (Int->Int) Int r' => r' +-- f [0::Int] :: Bug (Int->Int) Int r' => r' -- Wwich matches the first instance decl giving r' = Int --- f [0::Int] :: Int +-- f [0::Int] :: Int -- The outer f now has constraint --- Bug (Int->Int) Int r +-- Bug (Int->Int) Int r -- which makes r=Int -- So g1::Int diff --git a/testsuite/tests/typecheck/should_compile/tc130.hs b/testsuite/tests/typecheck/should_compile/tc130.hs index da91273ff0..f9e65431d1 100644 --- a/testsuite/tests/typecheck/should_compile/tc130.hs +++ b/testsuite/tests/typecheck/should_compile/tc130.hs @@ -10,7 +10,7 @@ data R = R {field :: Int} test:: (?param :: R) => a -> Int test x = field (?param {field = 42}) - -- The type of the record to be updated is - -- {?param :: R} as well as plain R - -- which confused the compiler + -- The type of the record to be updated is + -- {?param :: R} as well as plain R + -- which confused the compiler diff --git a/testsuite/tests/typecheck/should_compile/tc134.hs b/testsuite/tests/typecheck/should_compile/tc134.hs index 84eb75c82f..c7b97837f8 100644 --- a/testsuite/tests/typecheck/should_compile/tc134.hs +++ b/testsuite/tests/typecheck/should_compile/tc134.hs @@ -8,4 +8,4 @@ f :: Int -> Int f x :: Int = x g :: Int -> Int -g x :: a = x :: a -- Here, a is a name for Int +g x :: a = x :: a -- Here, a is a name for Int diff --git a/testsuite/tests/typecheck/should_compile/tc136.hs b/testsuite/tests/typecheck/should_compile/tc136.hs index 044f0a75f7..f715d9ccb2 100644 --- a/testsuite/tests/typecheck/should_compile/tc136.hs +++ b/testsuite/tests/typecheck/should_compile/tc136.hs @@ -8,4 +8,4 @@ module ShouldCompile where f :: forall x. x -> x -> x f (x::x) (y::x) = x -- Two points: (a) we are using x as a term variable and as a type variable --- (b) the type variable appears twice, but that is OK +-- (b) the type variable appears twice, but that is OK diff --git a/testsuite/tests/typecheck/should_compile/tc137.hs b/testsuite/tests/typecheck/should_compile/tc137.hs index dce781d39b..351a30c0e2 100644 --- a/testsuite/tests/typecheck/should_compile/tc137.hs +++ b/testsuite/tests/typecheck/should_compile/tc137.hs @@ -2,7 +2,7 @@ FlexibleInstances #-} {-# OPTIONS -dcore-lint #-} -{- This one killed GHC 5.02 +{- This one killed GHC 5.02 The problem is that in rather obscure cases (involving functional dependencies) it is possible to get an AbsBinds [] [] (no tyvars, no diff --git a/testsuite/tests/typecheck/should_compile/tc140.hs b/testsuite/tests/typecheck/should_compile/tc140.hs index 23709fb617..f961cdb1ed 100644 --- a/testsuite/tests/typecheck/should_compile/tc140.hs +++ b/testsuite/tests/typecheck/should_compile/tc140.hs @@ -7,8 +7,8 @@ module Foo where newtype CPS1 a = CPS1 { unCPS1 :: forall ans . (a -> ans) -> ans } newtype CPS2 a = CPS2 (forall ans . (a -> ans) -> ans) - -- This one also has an interesting record selector; - -- caused an applyTypeArgs crash in 5.02.1 + -- This one also has an interesting record selector; + -- caused an applyTypeArgs crash in 5.02.1 -data CPS3 a = CPS3 { unCPS3 :: forall ans . (a -> ans) -> ans } -data CPS4 a = CPS4 (forall ans . (a -> ans) -> ans) +data CPS3 a = CPS3 { unCPS3 :: forall ans . (a -> ans) -> ans } +data CPS4 a = CPS4 (forall ans . (a -> ans) -> ans) diff --git a/testsuite/tests/typecheck/should_compile/tc141.hs b/testsuite/tests/typecheck/should_compile/tc141.hs index c5f675000d..f1b8d29b29 100644 --- a/testsuite/tests/typecheck/should_compile/tc141.hs +++ b/testsuite/tests/typecheck/should_compile/tc141.hs @@ -1,7 +1,7 @@ {-# LANGUAGE ScopedTypeVariables #-} -- Scoped type variables on pattern bindings --- This should *fail* on GHC 5.02 and lower, +-- This should *fail* on GHC 5.02 and lower, -- It's a post-5.02 enhancements to allow them. -- It's an error again in GHC 6.6! @@ -10,8 +10,8 @@ module ShouldCompile where f x = let (p::a,q::a) = x in (q::a,p) -g a b = let y::a = a in +g a b = let y::a = a in let v :: a - v = b - in v -
\ No newline at end of file + v = b + in v + diff --git a/testsuite/tests/typecheck/should_compile/tc142.hs b/testsuite/tests/typecheck/should_compile/tc142.hs index 8621710038..38f890066f 100644 --- a/testsuite/tests/typecheck/should_compile/tc142.hs +++ b/testsuite/tests/typecheck/should_compile/tc142.hs @@ -5,7 +5,7 @@ module ShouldFail where data NUM = ONE | TWO class EQ a where - (==) :: a -> a -> Bool + (==) :: a -> a -> Bool instance EQ NUM where - a == b = True + a == b = True diff --git a/testsuite/tests/typecheck/should_compile/tc145.hs b/testsuite/tests/typecheck/should_compile/tc145.hs index 31e45cd9e9..8ab4a56321 100644 --- a/testsuite/tests/typecheck/should_compile/tc145.hs +++ b/testsuite/tests/typecheck/should_compile/tc145.hs @@ -5,14 +5,14 @@ module ShouldCompile where - -- The for-all hoisting should hoist the - -- implicit parameter to give - -- r :: (?param::a) => a + -- The for-all hoisting should hoist the + -- implicit parameter to give + -- r :: (?param::a) => a r :: Int -> ((?param :: a) => a) r = error "urk" - -- The unboxed tuple is OK because it is - -- used on the right hand end of an arrow + -- The unboxed tuple is OK because it is + -- used on the right hand end of an arrow type T = (# Int, Int #) f :: Int -> T diff --git a/testsuite/tests/typecheck/should_compile/tc151.hs b/testsuite/tests/typecheck/should_compile/tc151.hs index b28900de75..5a3f8740ef 100644 --- a/testsuite/tests/typecheck/should_compile/tc151.hs +++ b/testsuite/tests/typecheck/should_compile/tc151.hs @@ -9,7 +9,7 @@ data Fork a = ForkC a a mapFork :: forall a1 a2 . (a1 -> a2) -> (Fork a1 -> Fork a2) mapFork mapA (ForkC a1 a2) = ForkC (mapA a1) (mapA a2) -data SequF s a = EmptyF | ZeroF (s (Fork a)) | OneF a (s (Fork a)) +data SequF s a = EmptyF | ZeroF (s (Fork a)) | OneF a (s (Fork a)) newtype HFix h a = HIn (h (HFix h) a) type Sequ = HFix SequF @@ -26,5 +26,5 @@ mapHFix :: forall h1 h2 . (forall f1 f2 . (forall c1 c2 . (c1 -> c2) -> (f1 c1 - mapHFix mapH mapA (HIn v) = HIn (mapH (mapHFix mapH) mapA v) mapSequ :: forall a1 a2 . (a1 -> a2) -> (Sequ a1 -> Sequ a2) -mapSequ = mapHFix mapSequF +mapSequ = mapHFix mapSequF diff --git a/testsuite/tests/typecheck/should_compile/tc153.hs b/testsuite/tests/typecheck/should_compile/tc153.hs index 14ded3531a..a127cdcb8b 100644 --- a/testsuite/tests/typecheck/should_compile/tc153.hs +++ b/testsuite/tests/typecheck/should_compile/tc153.hs @@ -6,7 +6,7 @@ data T a = T a instance Eq (T a) where (==) x y = let v :: a - v = undefined - in - v + v = undefined + in + v diff --git a/testsuite/tests/typecheck/should_compile/tc155.hs b/testsuite/tests/typecheck/should_compile/tc155.hs index 598afc94da..78e6bb6179 100644 --- a/testsuite/tests/typecheck/should_compile/tc155.hs +++ b/testsuite/tests/typecheck/should_compile/tc155.hs @@ -4,7 +4,7 @@ -- partial application of the type sig. -- But with LiberalTypeSynonyms it should be OK because when -- you expand the type synonyms it's just Int->Int --- c.f should_fail/tcfail107.hs +-- c.f should_fail/tcfail107.hs module ShouldCompile where diff --git a/testsuite/tests/typecheck/should_compile/tc157.hs b/testsuite/tests/typecheck/should_compile/tc157.hs index ae6faf95de..4baebab5fc 100644 --- a/testsuite/tests/typecheck/should_compile/tc157.hs +++ b/testsuite/tests/typecheck/should_compile/tc157.hs @@ -4,7 +4,7 @@ module ShouldCompile where -type C u a = u -- Note 'a' unused +type C u a = u -- Note 'a' unused foo :: (forall a. C u a -> C u a) -> u foo x = undefined x diff --git a/testsuite/tests/typecheck/should_compile/tc161.hs b/testsuite/tests/typecheck/should_compile/tc161.hs index 7cb1272b6e..a247e2b1be 100644 --- a/testsuite/tests/typecheck/should_compile/tc161.hs +++ b/testsuite/tests/typecheck/should_compile/tc161.hs @@ -2,8 +2,8 @@ -- Blew up GHC 5.04, with: -- Ambiguous type variable(s) `q' in the constraint `Foo q' -- arising from a function with an overloaded argument type at Foo.hs:7 --- Expected type: Int -> (forall q1. (Foo q1) => q1 -> a) -> a --- Inferred type: Int -> (q -> a) -> a +-- Expected type: Int -> (forall q1. (Foo q1) => q1 -> a) -> a +-- Inferred type: Int -> (q -> a) -> a -- In the application `GHC.Err.noMethodBindingError "Foo.hs:7|Foo.foo"#' -- -- Fix is to give wild-card args to the default methods diff --git a/testsuite/tests/typecheck/should_compile/tc162.hs b/testsuite/tests/typecheck/should_compile/tc162.hs index 88da03fe0b..bf493fcd80 100644 --- a/testsuite/tests/typecheck/should_compile/tc162.hs +++ b/testsuite/tests/typecheck/should_compile/tc162.hs @@ -4,8 +4,8 @@ -- in the pattern matching compiler, so they are a bit -- tricky. --- GHC 6.3: these are back to failures, because we no longer do --- type subsumption in pattern-matching +-- GHC 6.3: these are back to failures, because we no longer do +-- type subsumption in pattern-matching -- GHC 7.0: back to success diff --git a/testsuite/tests/typecheck/should_compile/tc164.hs b/testsuite/tests/typecheck/should_compile/tc164.hs index ed6fa429aa..0faada45be 100644 --- a/testsuite/tests/typecheck/should_compile/tc164.hs +++ b/testsuite/tests/typecheck/should_compile/tc164.hs @@ -7,6 +7,6 @@ data UniqueSupply = US Integer newUnique :: (?uniqueSupply :: UniqueSupply) => Integer newUnique = r where US r = ?uniqueSupply - -- The lazy pattern match in the where clause killed GHC 5.04 - -- because the type {?uniqueSupply::UniqueSupply} of the RHS - -- of the 'where' didn't look like a UniqueSupply + -- The lazy pattern match in the where clause killed GHC 5.04 + -- because the type {?uniqueSupply::UniqueSupply} of the RHS + -- of the 'where' didn't look like a UniqueSupply diff --git a/testsuite/tests/typecheck/should_compile/tc167.hs b/testsuite/tests/typecheck/should_compile/tc167.hs index ffce691c57..b42ceacdc8 100644 --- a/testsuite/tests/typecheck/should_compile/tc167.hs +++ b/testsuite/tests/typecheck/should_compile/tc167.hs @@ -9,12 +9,12 @@ type T = (->) Int# -- Here's the comment from TypeRep: -- --- funTyCon = mkFunTyCon funTyConName --- (mkArrowKinds [liftedTypeKind, liftedTypeKind] --- liftedTypeKind) +-- funTyCon = mkFunTyCon funTyConName +-- (mkArrowKinds [liftedTypeKind, liftedTypeKind] +-- liftedTypeKind) -- You might think that (->) should have type (? -> ? -> *), and you'd be right -- But if we do that we get kind errors when saying --- instance Control.Arrow (->) +-- instance Control.Arrow (->) -- because the expected kind is (*->*->*). The trouble is that the -- expected/actual stuff in the unifier does not go contra-variant, whereas -- the kind sub-typing does. Sigh. It really only matters if you use (->) in diff --git a/testsuite/tests/typecheck/should_compile/tc168.hs b/testsuite/tests/typecheck/should_compile/tc168.hs index bd515331c4..caa2651d6b 100644 --- a/testsuite/tests/typecheck/should_compile/tc168.hs +++ b/testsuite/tests/typecheck/should_compile/tc168.hs @@ -1,9 +1,9 @@ {-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-} -- We want to get the type --- g :: forall a b c. C a (b,c) => a -> b +-- g :: forall a b c. C a (b,c) => a -> b --but GHC 6.0 bogusly gets --- g :: forall a b. C a (b,()) => a -> b +-- g :: forall a b. C a (b,()) => a -> b -- Having done this, we reject f on the grounds -- that its type is ambiguous: adding the type diff --git a/testsuite/tests/typecheck/should_compile/tc169.hs b/testsuite/tests/typecheck/should_compile/tc169.hs index 7cb9e001f5..50ff51c929 100644 --- a/testsuite/tests/typecheck/should_compile/tc169.hs +++ b/testsuite/tests/typecheck/should_compile/tc169.hs @@ -6,22 +6,22 @@ newtype Foo x = Foo x -- data Foo x = Foo x -- this works class X a where - x :: a -> IO () + x :: a -> IO () class X a => Y a where - y :: [a] -> IO () + y :: [a] -> IO () class Z z where - z :: Y c => z c -> IO () + z :: Y c => z c -> IO () instance X Char where - x = putChar + x = putChar instance X a => X (Foo a) where - x (Foo foo) = x foo + x (Foo foo) = x foo instance Y Char where y cs = mapM_ x cs - + instance Z Foo where - z = x + z = x diff --git a/testsuite/tests/typecheck/should_compile/tc170.hs b/testsuite/tests/typecheck/should_compile/tc170.hs index 9e649b307b..32947b5124 100644 --- a/testsuite/tests/typecheck/should_compile/tc170.hs +++ b/testsuite/tests/typecheck/should_compile/tc170.hs @@ -1,6 +1,6 @@ -- This test killed GHC 6.0.2 when it read the interface file for --- Tc170_Aux, because there was a --- forall a. (# ... #) +-- Tc170_Aux, because there was a +-- forall a. (# ... #) -- in the default method for 'position' -- -- NB: only fails when compiled in batch mode. In --make mode, GHC @@ -13,4 +13,4 @@ import Tc170_Aux data Bitmap = Bitmap instance Dimensions Bitmap where - frame = error "urk"
\ No newline at end of file + frame = error "urk" diff --git a/testsuite/tests/typecheck/should_compile/tc177.hs b/testsuite/tests/typecheck/should_compile/tc177.hs index 613528fef3..c39481db90 100644 --- a/testsuite/tests/typecheck/should_compile/tc177.hs +++ b/testsuite/tests/typecheck/should_compile/tc177.hs @@ -1,7 +1,7 @@ {-# LANGUAGE FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, FunctionalDependencies #-} --- This is a rather complicated program that uses functional +-- This is a rather complicated program that uses functional -- dependencies to do Peano arithmetic. -- -- GHC 6.2 dies because tcSimplifyRestricted was trying to @@ -51,17 +51,17 @@ class Ins r l l' | r l -> l' where instance Ins ((LAB l1 r1),r1') Nil (Cons (Cons ((LAB l1 r1),r1') Nil) Nil) where ins l Nil = (Cons (Cons l Nil) Nil) - + instance ( L2N l1 n1 , L2N l2 n2 , EqR n1 n2 b , Ins1 ((LAB l1 r1),r1') (Cons (Cons ((LAB l2 r2),r2') rs) rs') b l - ) => Ins ((LAB l1 r1),r1') (Cons (Cons ((LAB l2 r2),r2') rs) rs') l + ) => Ins ((LAB l1 r1),r1') (Cons (Cons ((LAB l2 r2),r2') rs) rs') l where - ins ((LAB l1 r1),r1') (Cons (Cons ((LAB l2 r2),r2') rs) rs') - = ins1 ((LAB l1 r1),r1') (Cons (Cons ((LAB l2 r2),r2') rs) rs') - (eqR (l2n l1) (l2n l2)) + ins ((LAB l1 r1),r1') (Cons (Cons ((LAB l2 r2),r2') rs) rs') + = ins1 ((LAB l1 r1),r1') (Cons (Cons ((LAB l2 r2),r2') rs) rs') + (eqR (l2n l1) (l2n l2)) -- Note that n1 and n2 are functionally defined by l1 and l2, respectively, -- and b is functionally defined by n1 and n2. @@ -69,11 +69,11 @@ instance ( L2N l1 n1 class Ins1 r l b l' | r l b -> l' where ins1 :: r -> l -> b -> l' -instance Ins1 ((LAB l1 r1),r1') (Cons r rs) T - (Cons (Cons ((LAB l1 r1),r1') r) rs) where +instance Ins1 ((LAB l1 r1),r1') (Cons r rs) T + (Cons (Cons ((LAB l1 r1),r1') r) rs) where ins1 l (Cons r rs) _ = (Cons (Cons l r) rs) -instance ( Ins ((LAB l1 r1),r1') rs rs') +instance ( Ins ((LAB l1 r1),r1') rs rs') => Ins1 ((LAB l1 r1),r1') (Cons r rs) F (Cons r rs') where ins1 l (Cons r rs) _ = (Cons r (ins l rs)) diff --git a/testsuite/tests/typecheck/should_compile/tc179.hs b/testsuite/tests/typecheck/should_compile/tc179.hs index 62db4726a0..76fed3e764 100644 --- a/testsuite/tests/typecheck/should_compile/tc179.hs +++ b/testsuite/tests/typecheck/should_compile/tc179.hs @@ -6,17 +6,17 @@ module TestWrappedNode where class Foo a where { op :: a -> Int } -instance {-# OVERLAPPABLE #-} Foo a => Foo [a] where -- NB overlap +instance {-# OVERLAPPABLE #-} Foo a => Foo [a] where -- NB overlap op (x:xs) = op x -instance {-# OVERLAPPING #-} Foo [Int] where -- NB overlap +instance {-# OVERLAPPING #-} Foo [Int] where -- NB overlap op x = 1 data T = forall a. Foo a => MkT a f :: T -> Int f (MkT x) = op [x,x] - -- The op [x,x] means we need (Foo [a]). We used to - -- complain, saying that the choice of instance depended on - -- the instantiation of 'a'; but of course it isn't *going* - -- to be instantiated. + -- The op [x,x] means we need (Foo [a]). We used to + -- complain, saying that the choice of instance depended on + -- the instantiation of 'a'; but of course it isn't *going* + -- to be instantiated. diff --git a/testsuite/tests/typecheck/should_compile/tc180.hs b/testsuite/tests/typecheck/should_compile/tc180.hs index 6a6af407ce..205a2225f9 100644 --- a/testsuite/tests/typecheck/should_compile/tc180.hs +++ b/testsuite/tests/typecheck/should_compile/tc180.hs @@ -8,23 +8,23 @@ module ShouldCompile where -data PHI = PHI -data EMPT = EMPT -data LAB l a = LAB l a -data Phi = Phi +data PHI = PHI +data EMPT = EMPT +data LAB l a = LAB l a +data Phi = Phi -data A = A -data A_H = A_H [Char] +data A = A +data A_H = A_H [Char] class LNFyV r1 r2 h1 h2 | r1 -> r2, r1 r2 -> h1 h2 where lnfyv :: r1->r2->h1->h2 -instance ( REtoHT (LAB l c) h) - => LNFyV (LAB l c) ((LAB l c),EMPT) h (h,[Phi]) where -- (L2) +instance ( REtoHT (LAB l c) h) + => LNFyV (LAB l c) ((LAB l c),EMPT) h (h,[Phi]) where -- (L2) lnfyv = error "urk" -class REtoHT s t | s->t +class REtoHT s t | s->t instance REtoHT (LAB A [Char]) A_H -- (R4) foo = lnfyv (LAB A "") ((LAB A ""),EMPT) (A_H "1") diff --git a/testsuite/tests/typecheck/should_compile/tc181.hs b/testsuite/tests/typecheck/should_compile/tc181.hs index b3ae86651c..8f1cf8e805 100644 --- a/testsuite/tests/typecheck/should_compile/tc181.hs +++ b/testsuite/tests/typecheck/should_compile/tc181.hs @@ -6,10 +6,10 @@ module Folders where -data Folder = Folder +data Folder = Folder newtype SB x = SB x -newtype SS x = SS x +newtype SS x = SS x data NodeArcsHidden = NodeArcsHidden @@ -22,26 +22,26 @@ instance HasSS (SB x) x where class HMV option graph node where modd :: option -> graph -> node value -> IO () -instance HMV NodeArcsHidden graph node - => HMV (Maybe NodeArcsHidden) graph node +instance HMV NodeArcsHidden graph node + => HMV (Maybe NodeArcsHidden) graph node where modd = error "burk" -gn :: HMV NodeArcsHidden graph node - => graph +gn :: HMV NodeArcsHidden graph node + => graph -> SS (graph -> node Int -> IO ()) gn graph = fmapSS (\ arcsHidden -> (\ graph node -> modd arcsHidden graph node)) - (toSS (error "C" :: SB (Maybe NodeArcsHidden))) + (toSS (error "C" :: SB (Maybe NodeArcsHidden))) -- The call to modd gives rise to --- HMV option graph node +-- HMV option graph node -- The call to toSS gives rise to --- HasSS (SB (Maybe NodeArcsHidden)) x +-- HasSS (SB (Maybe NodeArcsHidden)) x -- where (toSS (error ...)) :: SS x -- and hence arcsHidden :: x -- -- Then improvement should give x = Maybe NodeArcsHidden -- and hence option=Maybe NodeArcsHidden - + fmapSS :: (a->b) -> SS a -> SS b fmapSS = error "urk" diff --git a/testsuite/tests/typecheck/should_compile/tc183.hs b/testsuite/tests/typecheck/should_compile/tc183.hs index c001dc9b5c..a6722baa55 100644 --- a/testsuite/tests/typecheck/should_compile/tc183.hs +++ b/testsuite/tests/typecheck/should_compile/tc183.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} {-# LANGUAGE ExistentialQuantification, RankNTypes #-} --- An interesting interaction of universals and existentials, prompted by +-- An interesting interaction of universals and existentials, prompted by -- http://www.haskell.org/pipermail/haskell-cafe/2004-October/007160.html -- -- Note the non-nested pattern-match in runProg; tcfail126 checks the @@ -11,17 +11,17 @@ module Foo where import Control.Monad.Trans -data Bar m - = forall t. (MonadTrans t, Monad (t m)) - => Bar (t m () -> m ()) (t m Int) +data Bar m + = forall t. (MonadTrans t, Monad (t m)) + => Bar (t m () -> m ()) (t m Int) data Foo = Foo (forall m. Monad m => Bar m) runProg :: Foo -> IO () runProg (Foo b) = case b of - Bar run op -> run (prog op) - -- You can't say runProg (Foo (Bar run op)); - -- see tcfail126 + Bar run op -> run (prog op) + -- You can't say runProg (Foo (Bar run op)); + -- see tcfail126 prog :: (MonadTrans t, Monad (t IO)) => a -> t IO () prog x = error "urk" diff --git a/testsuite/tests/typecheck/should_compile/tc189.hs b/testsuite/tests/typecheck/should_compile/tc189.hs index 3f9a2879b0..400f68dcc6 100644 --- a/testsuite/tests/typecheck/should_compile/tc189.hs +++ b/testsuite/tests/typecheck/should_compile/tc189.hs @@ -1,5 +1,5 @@ {-# LANGUAGE NoMonoPatBinds #-} - -- Disable experimetal monomorphic pattern bindings + -- Disable experimetal monomorphic pattern bindings -- Nasty test for type signatures -- In both groups of declarations below, the type variables 'a' and 'b' diff --git a/testsuite/tests/typecheck/should_compile/tc194.hs b/testsuite/tests/typecheck/should_compile/tc194.hs index 4b780e28f4..e91a8e1269 100644 --- a/testsuite/tests/typecheck/should_compile/tc194.hs +++ b/testsuite/tests/typecheck/should_compile/tc194.hs @@ -1,11 +1,11 @@ {-# LANGUAGE RankNTypes, ScopedTypeVariables #-} -- Tests the special case of --- non-recursive, function binding, --- with no type signature +-- non-recursive, function binding, +-- with no type signature module ShouldCompile where f = \ (x :: forall a. a->a) -> (x True, x 'c') -g (x :: forall a. a->a) = x
\ No newline at end of file +g (x :: forall a. a->a) = x diff --git a/testsuite/tests/typecheck/should_compile/tc195.hs b/testsuite/tests/typecheck/should_compile/tc195.hs index dd376a5d68..ad3a5f9ac6 100644 --- a/testsuite/tests/typecheck/should_compile/tc195.hs +++ b/testsuite/tests/typecheck/should_compile/tc195.hs @@ -3,9 +3,9 @@ -- This one made GHC 6.4 loop because Unify.unify -- didn't deal correctly with unifying --- a :=: Foo a +-- a :=: Foo a -- where --- type Foo a = a +-- type Foo a = a module ShouldSucceed where diff --git a/testsuite/tests/typecheck/should_compile/tc199.hs b/testsuite/tests/typecheck/should_compile/tc199.hs index dfa2c1f230..4e65358aa0 100644 --- a/testsuite/tests/typecheck/should_compile/tc199.hs +++ b/testsuite/tests/typecheck/should_compile/tc199.hs @@ -5,21 +5,21 @@ -- Hence needing AllowAmbiguousTypes -- -- However, arguably the instance declaration should be accepted, --- beause it's equivalent to --- instance Baz Int Int where { foo x = x } +-- beause it's equivalent to +-- instance Baz Int Int where { foo x = x } -- which *does* typecheck -- GHC does not actually macro-expand the instance decl. Instead, it -- defines a default method function, thus -- --- $dmfoo :: Baz v x => x -> x --- $dmfoo y = y +-- $dmfoo :: Baz v x => x -> x +-- $dmfoo y = y -- -- Notice that this is an ambiguous type: you can't call $dmfoo -- without triggering an error. And when you write an instance decl, -- it calls the default method: -- --- instance Baz Int Int where foo = $dmfoo +-- instance Baz Int Int where foo = $dmfoo -- -- I'd never thought of that. You might think that we should just -- *infer* the type of the default method (here forall a. a->a), but @@ -32,4 +32,4 @@ class Baz v x where foo :: x -> x foo y = y -instance Baz Int Int +instance Baz Int Int diff --git a/testsuite/tests/typecheck/should_compile/tc201.hs b/testsuite/tests/typecheck/should_compile/tc201.hs index c60aa85406..cc926f8d62 100644 --- a/testsuite/tests/typecheck/should_compile/tc201.hs +++ b/testsuite/tests/typecheck/should_compile/tc201.hs @@ -1,7 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, ExistentialQuantification, FlexibleContexts #-} -{- Email 30 Jan 2006 +{- Email 30 Jan 2006 > the attached program compiles under GHC, but not with Hugs. as far as > i see, Hugs don't use dependencies in class headers to figure out that @@ -16,10 +16,10 @@ soon). module ShoudlCompile where - class (Monad m) => Stream m h | h->m where - vMkIOError :: h -> Int + class (Monad m) => Stream m h | h->m where + vMkIOError :: h -> Int - data BinHandle = forall h . Stream IO h => BinH h + data BinHandle = forall h . Stream IO h => BinH h - instance Stream IO BinHandle where - vMkIOError (BinH h) = vMkIOError h + instance Stream IO BinHandle where + vMkIOError (BinH h) = vMkIOError h diff --git a/testsuite/tests/typecheck/should_compile/tc205.hs b/testsuite/tests/typecheck/should_compile/tc205.hs index 621061a3de..1fe2cc255f 100644 --- a/testsuite/tests/typecheck/should_compile/tc205.hs +++ b/testsuite/tests/typecheck/should_compile/tc205.hs @@ -4,7 +4,7 @@ module ShouldCompile where -infix 1 `DArrowX` -- (->) has precedence 0 +infix 1 `DArrowX` -- (->) has precedence 0 data DArrowX :: * -> * -> * where First :: a `DArrowX` a' -> (a,b) `DArrowX` (a',b) diff --git a/testsuite/tests/typecheck/should_compile/tc207.hs b/testsuite/tests/typecheck/should_compile/tc207.hs index a5b952176b..9f5a04a42d 100644 --- a/testsuite/tests/typecheck/should_compile/tc207.hs +++ b/testsuite/tests/typecheck/should_compile/tc207.hs @@ -3,14 +3,14 @@ module ShouldCompile where -foo xs = let - f :: Eq a => [a] -> [a] - f [] = [] - f xs | null (g [True]) = [] - | otherwise = tail (g xs) +foo xs = let + f :: Eq a => [a] -> [a] + f [] = [] + f xs | null (g [True]) = [] + | otherwise = tail (g xs) - g :: Eq b => [b] -> [b] - g [] = [] - g xs | null (f "hello") = [] - | otherwise = tail (f xs) - in f xs + g :: Eq b => [b] -> [b] + g [] = [] + g xs | null (f "hello") = [] + | otherwise = tail (f xs) + in f xs diff --git a/testsuite/tests/typecheck/should_compile/tc211.hs b/testsuite/tests/typecheck/should_compile/tc211.hs index 8f273ba923..7dc45e5be7 100644 --- a/testsuite/tests/typecheck/should_compile/tc211.hs +++ b/testsuite/tests/typecheck/should_compile/tc211.hs @@ -57,20 +57,20 @@ h2 (g::(forall a. a ->a)) = let y = P (g 3) (g (P 3 4)) xs1 :: List (forall a. a ->a) xs1 = let cons = Cons :: (forall a. a ->a) - -> List (forall a. a->a) - -> List (forall a. a ->a) + -> List (forall a. a->a) + -> List (forall a. a ->a) in cons (\x -> x) Nil xs2 :: List (forall a. a -> a) xs2 = (Cons :: ((forall a. a->a) - -> List (forall a. a->a) - -> List (forall a. a->a))) - (\x ->x) Nil + -> List (forall a. a->a) + -> List (forall a. a->a))) + (\x ->x) Nil foo2 :: forall a. List a -> a -> a foo2 x y = y -bar4 = (foo2 :: List (forall a. a->a) -> (forall a. a->a) -> (forall a.a->a)) - xs1 (\x -> x) +bar4 = (foo2 :: List (forall a. a->a) -> (forall a. a->a) -> (forall a.a->a)) + xs1 (\x -> x) diff --git a/testsuite/tests/typecheck/should_compile/tc213.hs b/testsuite/tests/typecheck/should_compile/tc213.hs index 1f0b46449a..43bba76526 100644 --- a/testsuite/tests/typecheck/should_compile/tc213.hs +++ b/testsuite/tests/typecheck/should_compile/tc213.hs @@ -1,7 +1,7 @@ {-# LANGUAGE RankNTypes, ScopedTypeVariables, FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies #-} --- This tests scoped type variables, used in an expression +-- This tests scoped type variables, used in an expression -- type signature in t1 and t2 module Foo7 where @@ -36,14 +36,14 @@ instance Ix key => Mark (ST s) (STUArray s key Bool) key where -- traversing the hull suc^*(start) with loop detection trav suc start i = new i >>= \ c -> mapM_ (compo c) start >> return c where compo c x = markQ c x >>= flip unless (visit c x) - visit c x = mark c x >> mapM_ (compo c) (suc x) + visit c x = mark c x >> mapM_ (compo c) (suc x) -- sample graph f 1 = 1 : [] f n = n : f (if even n then div n 2 else 3*n+1) t1 = runST ( (trav f [1..10] (1,52) >>= \ (s::STRef s (Set Int)) -> seen s) - :: forall s. ST s [Int] ) + :: forall s. ST s [Int] ) t2 = runST ( (trav f [1..10] (1,52) >>= \ (s::STUArray s Int Bool) -> seen s) - :: forall s. ST s [Int] ) + :: forall s. ST s [Int] ) diff --git a/testsuite/tests/typecheck/should_compile/tc222.hs b/testsuite/tests/typecheck/should_compile/tc222.hs index ee8fb1cb6f..4c5717e50a 100644 --- a/testsuite/tests/typecheck/should_compile/tc222.hs +++ b/testsuite/tests/typecheck/should_compile/tc222.hs @@ -20,15 +20,15 @@ f c = g $ c -- Fully annotated version of f, as compiled by GHC 6.4.2 -- --- f ?env c = $ (C->C) (C->C) --- (\(x:C->C). g ?env (\?env. x)) --- (c ?env) +-- f ?env c = $ (C->C) (C->C) +-- (\(x:C->C). g ?env (\?env. x)) +-- (c ?env) -- -- The subsumption test needed from the call to $ is this: --- ?env => (?env => C -> C) -> C -> C <= a->b --- (?env => C -> C) -> C -> C <= a->b --- (a) C->C <= b --- (b) a <= (?env => C -> C) +-- ?env => (?env => C -> C) -> C -> C <= a->b +-- (?env => C -> C) -> C -> C <= a->b +-- (a) C->C <= b +-- (b) a <= (?env => C -> C) -- And perhaps surprisingly (b) succeeds! g :: PPDoc -> PPDoc diff --git a/testsuite/tests/typecheck/should_compile/tc223.hs b/testsuite/tests/typecheck/should_compile/tc223.hs index fc8a9d10cf..dfdc0363d1 100644 --- a/testsuite/tests/typecheck/should_compile/tc223.hs +++ b/testsuite/tests/typecheck/should_compile/tc223.hs @@ -9,7 +9,7 @@ import Control.Monad.Error class Error e => Game b mv e | b -> mv e where newBoard :: MonadState b m => m () - -- This method is unambiguous, because - -- m determines b (via a fundep in MonadState) + -- This method is unambiguous, because + -- m determines b (via a fundep in MonadState) diff --git a/testsuite/tests/typecheck/should_compile/tc231.hs b/testsuite/tests/typecheck/should_compile/tc231.hs index 7039ffcc66..1c00294009 100644 --- a/testsuite/tests/typecheck/should_compile/tc231.hs +++ b/testsuite/tests/typecheck/should_compile/tc231.hs @@ -5,7 +5,7 @@ -- The key thing here is that foo should get the type -- foo :: forall b s t1. (Zork s (Z [Char]) b) --- => Q s (Z [Char]) t1 -> ST s () +-- => Q s (Z [Char]) t1 -> ST s () -- Note the quantification over 'b', which was previously -- omitted; see Note [Important subtlety in oclose] in FunDeps diff --git a/testsuite/tests/typecheck/should_compile/tc235.hs b/testsuite/tests/typecheck/should_compile/tc235.hs index 4973ec1b33..39bda75168 100644 --- a/testsuite/tests/typecheck/should_compile/tc235.hs +++ b/testsuite/tests/typecheck/should_compile/tc235.hs @@ -11,7 +11,7 @@ module Foo where import Text.PrettyPrint import Prelude hiding(head,tail) -class FooBar m k l | m -> k l where +class FooBar m k l | m -> k l where a :: m graphtype instance FooBar [] Bool Bool where @@ -20,16 +20,16 @@ instance FooBar [] Bool Bool where instance FooBar Maybe Int Int where a = error "urk" -class (Monad m)=>Gr g ep m where +class (Monad m)=>Gr g ep m where x:: m Int v:: m Int instance (Monad m, FooBar m x z) => Gr g ep m where x = error "urk" - v = error "urk" + v = error "urk" -- Old GHC claims for y: y :: (Monad m, FooBar m GHC.Prim.Any GHC.Prim.Any) --- => m Int (which is wrong) +-- => m Int (which is wrong) -- The uses in foo and bar show if that happens y () = x diff --git a/testsuite/tests/typecheck/should_fail/T2307.hs b/testsuite/tests/typecheck/should_fail/T2307.hs index ea0c335a96..5bf508679c 100644 --- a/testsuite/tests/typecheck/should_fail/T2307.hs +++ b/testsuite/tests/typecheck/should_fail/T2307.hs @@ -1,6 +1,6 @@ {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, - IncoherentInstances, + IncoherentInstances, FlexibleInstances #-} -- Trac #2307 diff --git a/testsuite/tests/typecheck/should_fail/T5684.hs b/testsuite/tests/typecheck/should_fail/T5684.hs index 41d3773ebe..d1addf399f 100755..100644 --- a/testsuite/tests/typecheck/should_fail/T5684.hs +++ b/testsuite/tests/typecheck/should_fail/T5684.hs @@ -1,62 +1,62 @@ -{-# OPTIONS -XFunctionalDependencies -XUndecidableInstances -XFlexibleInstances #-} +{-# OPTIONS -XFunctionalDependencies -XUndecidableInstances -XFlexibleInstances #-} module T5684 where class B a b | a -> b where op :: a -> b -> () - + class A a | -> a instance A b => B Bool b {- This used to be a bug in various versions of GHC <= 7.2.2 - The source of the problem is the kicking out of inert Solved goals back to + The source of the problem is the kicking out of inert Solved goals back to the worklist, which violated our invariant that when two constraints of the same class meet (workitem-inert) then the combination (Given-Wanted) is impossible. Actually it turns our that it is possible. The order in which the constraints appear - below is important so we add two combinations to make sure that the testcase is + below is important so we add two combinations to make sure that the testcase is order-insensitive. -} flop1 = [ op False False -- (3) Creates a functional dependency which kicks the solved out - -- back in the worklist. Next time round the solved workitem + -- back in the worklist. Next time round the solved workitem -- meets the wanted from stage (2) and boom, the assertion fails! - + , op 'c' undefined -- (2) Creates a ([W] B Char beta) permanently in inerts , op True undefined -- (1) Creates ([W] B Bool alpha) -- which immediately becomes [S] B Bool alpha ] -flop2 = [ op False False +flop2 = [ op False False , op True undefined - , op 'c' undefined + , op 'c' undefined ] - -flop3 = [ op 'c' undefined + +flop3 = [ op 'c' undefined , op True undefined - , op False False + , op False False ] -flop4 = [ op 'c' undefined - , op False False +flop4 = [ op 'c' undefined + , op False False , op True undefined ] flop5 = [ op True undefined - , op 'c' undefined - , op False False + , op 'c' undefined + , op False False ] flop6 = [ op True undefined - , op False False - , op 'c' undefined + , op False False + , op 'c' undefined ] {- Now, in HEAD we no longer have cached GivenSolved goals in the inerts and hence this situation can no longer appear. If a Given gets kicked out it is only because - it got rewritten by a given equality: Notice that since Givens now never contain - plain old unification variables (since they are not GivenSolveds!) they can never be + it got rewritten by a given equality: Notice that since Givens now never contain + plain old unification variables (since they are not GivenSolveds!) they can never be rewritten by a spontaneously solved either! So our invariant now holds. -} diff --git a/testsuite/tests/typecheck/should_fail/T5853.hs b/testsuite/tests/typecheck/should_fail/T5853.hs index 7dde62d89d..6375691ea4 100644 --- a/testsuite/tests/typecheck/should_fail/T5853.hs +++ b/testsuite/tests/typecheck/should_fail/T5853.hs @@ -7,10 +7,10 @@ type family Elem f :: * type family Subst f b :: * class (Subst fa (Elem fa) ~ fa) => F fa where - (<$>) :: (Elem fa ~ a, Elem fb ~ b, - Subst fa b ~ fb, Subst fb a ~ fa) => - (a -> b) -> (fa -> fb) + (<$>) :: (Elem fa ~ a, Elem fb ~ b, + Subst fa b ~ fb, Subst fb a ~ fa) => + (a -> b) -> (fa -> fb) {-# RULES "map/map" forall f g xs. f <$> (g <$> xs) = (f.g) <$> xs - #-} + #-} diff --git a/testsuite/tests/typecheck/should_fail/tcfail032.hs b/testsuite/tests/typecheck/should_fail/tcfail032.hs index 8c6bdd46c7..fda4a5ed6d 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail032.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail032.hs @@ -4,8 +4,8 @@ Signature: t76 -> Int Inferred type: t75 -It *is* an error, because x does not have the polytype - forall a. Eq a => a -> Int +It *is* an error, because x does not have the polytype + forall a. Eq a => a -> Int because it is monomorphic, but the error message isn't very illuminating. -} diff --git a/testsuite/tests/typecheck/should_fail/tcfail038.hs b/testsuite/tests/typecheck/should_fail/tcfail038.hs index 1770bde61c..f9e80823d4 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail038.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail038.hs @@ -4,8 +4,8 @@ module ShouldFail where data NUM = ONE | TWO instance Eq NUM where - a == b = True - a /= b = False - a == b = False - a /= b = True + a == b = True + a /= b = False + a == b = False + a /= b = True diff --git a/testsuite/tests/typecheck/should_fail/tcfail040.hs b/testsuite/tests/typecheck/should_fail/tcfail040.hs index 8ac06b363c..d43e6f4225 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail040.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail040.hs @@ -5,14 +5,14 @@ module ShouldFail where data NUM = ONE | TWO class EQ a where - (===) :: a -> a -> Bool + (===) :: a -> a -> Bool class ORD a where - (<<) :: a -> a -> Bool - a << b = True + (<<) :: a -> a -> Bool + a << b = True instance EQ (a -> b) where - f === g = True + f === g = True instance ORD (a -> b) @@ -22,8 +22,8 @@ f = (<<) === (<<) {- instance EQ NUM where --- a /= b = False - a === b = True --- a /= b = False +-- a /= b = False + a === b = True +-- a /= b = False -} diff --git a/testsuite/tests/typecheck/should_fail/tcfail043.hs b/testsuite/tests/typecheck/should_fail/tcfail043.hs index 184a4e23bf..542aa6668f 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail043.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail043.hs @@ -6,7 +6,7 @@ -- search falls under the monomorphism restriction, and there is no -- call to search which might fix its type. So there should be a complaint. -- But the actual error message is horrible: --- +-- -- "bug001.hs", line 26: Ambiguous overloading: -- class "Ord_", type "a" (at a use of an overloaded identifier: gt) -- class "Eq_", type "a" (at a use of an overloaded identifier: eq) @@ -21,10 +21,10 @@ instance Eq_ Int where eq = eqIntEq instance (Eq_ a) => Eq_ [a] where - eq = \ xs ys -> - if (null xs) + eq = \ xs ys -> + if (null xs) then (null ys) - else if (null ys) + else if (null ys) then False else (&&) (eq (hd xs) (hd ys)) (eq (tl xs) (tl ys)) @@ -34,9 +34,9 @@ class (Eq_ a) => Ord_ a where instance Ord_ Int where gt = ordIntGt -search +search = \ a bs -> if gt (hd bs) a - then False + then False else if eq a (hd bs) then True else search a (tl bs) @@ -61,50 +61,50 @@ eqIntEq 2 3 = True Main.Eq__INST_PreludeBuiltin.Int = let AbsBinds [] [] [(eq, eq)] - {- nonrec -} - {-# LINE 2 "test3.hs" -} + {- nonrec -} + {-# LINE 2 "test3.hs" -} - eq :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool - eq = Main.eqIntEq + eq :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool + eq = Main.eqIntEq in ({-dict-} [] [eq]) Main.Eq__INST_PreludeBuiltin.List = /\ t135 -> - \{-dict-} _dict138 -> - let - {- nonrec -} - _dict136 = {-singleDict-} _dict138 - {- nonrec -} - _dict129 = {-singleDict-} _dict136 - AbsBinds [] [] [(eq, eq)] - {- nonrec -} - - _dict133 = - Main.Eq__INST_PreludeBuiltin.List - [t135] [{-singleDict-} _dict136] - {- nonrec -} - {-# LINE 5 "test3.hs" -} - - eq :: [t135] -> [t135] -> PreludeCore.Bool - eq = \ xs ys -> + \{-dict-} _dict138 -> + let + {- nonrec -} + _dict136 = {-singleDict-} _dict138 + {- nonrec -} + _dict129 = {-singleDict-} _dict136 + AbsBinds [] [] [(eq, eq)] + {- nonrec -} + + _dict133 = + Main.Eq__INST_PreludeBuiltin.List + [t135] [{-singleDict-} _dict136] + {- nonrec -} + {-# LINE 5 "test3.hs" -} + + eq :: [t135] -> [t135] -> PreludeCore.Bool + eq = \ xs ys -> if (Main.null t135) xs then - (Main.null t135) ys - else + (Main.null t135) ys + else + + if (Main.null t135) ys then + PreludeCore.False + else - if (Main.null t135) ys then - PreludeCore.False - else + Main.and - Main.and + ((Main.Eq_.eq t135 _dict129) - ((Main.Eq_.eq t135 _dict129) + ((Main.hd t135) xs) + ((Main.hd t135) ys)) - ((Main.hd t135) xs) - ((Main.hd t135) ys)) - @@ -114,19 +114,19 @@ if (Main.null t135) xs then - ((Main.tl t135) xs) - ((Main.tl t135) ys)) - in ({-dict-} [] [eq]) + ((Main.tl t135) xs) + ((Main.tl t135) ys)) + in ({-dict-} [] [eq]) Main.Ord__INST_PreludeBuiltin.Int = let {- nonrec -} _dict142 = Main.Eq__INST_PreludeBuiltin.Int [] [] AbsBinds [] [] [(gt, gt)] - {- nonrec -} - {-# LINE 16 "test3.hs" -} + {- nonrec -} + {-# LINE 16 "test3.hs" -} - gt :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool - gt = Main.ordIntGt + gt :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool + gt = Main.ordIntGt in ({-dict-} [_dict142] [gt]) Main.Eq_.eq = /\ a -> \{-classdict-} [] [eq] -> eq @@ -142,7 +142,7 @@ AbsBinds [t60] [] [(hd, Main.hd)] hd :: [t60] -> t60 hd (a PreludeBuiltin.: as) - = a + = a AbsBinds [t68] [] [(tl, Main.tl)] {- nonrec -} @@ -152,7 +152,7 @@ AbsBinds [t68] [] [(tl, Main.tl)] tl :: [t68] -> [t68] tl (a PreludeBuiltin.: as) - = as + = as AbsBinds [t91] [_dict85, _dict88] [(search, Main.search)] @@ -162,23 +162,23 @@ AbsBinds [t91] [_dict85, _dict88] [(search, Main.search)] search :: t91 -> [t91] -> PreludeCore.Bool search - = \ a bs -> + = \ a bs -> if (Main.Ord_.gt t91 _dict85) ((Main.hd t91) bs) a then - PreludeCore.False - else + PreludeCore.False + else - if (Main.Eq_.eq t91 _dict88) a ((Main.hd t91) bs) then - PreludeCore.True - else + if (Main.Eq_.eq t91 _dict88) a ((Main.hd t91) bs) then + PreludeCore.True + else - search a ((Main.tl t91) bs) + search a ((Main.tl t91) bs) AbsBinds [] [] [(and, Main.and)] {- nonrec -} and :: PreludeCore.Bool -> PreludeCore.Bool -> PreludeCore.Bool and PreludeCore.True PreludeCore.True - = PreludeCore.True + = PreludeCore.True AbsBinds [] [] [(ordIntGt, Main.ordIntGt)] {- nonrec -} _dict97 = PreludeCore.Num_INST_PreludeBuiltin.Int [] [] @@ -194,7 +194,7 @@ AbsBinds [] [] [(ordIntGt, Main.ordIntGt)] ordIntGt :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool ordIntGt - 2 3 = PreludeCore.True + 2 3 = PreludeCore.True AbsBinds [] [] [(eqIntEq, Main.eqIntEq)] {- nonrec -} _dict105 = PreludeCore.Num_INST_PreludeBuiltin.Int [] [] @@ -208,7 +208,7 @@ AbsBinds [] [] [(eqIntEq, Main.eqIntEq)] eqIntEq :: PreludeBuiltin.Int -> PreludeBuiltin.Int -> PreludeCore.Bool eqIntEq - 2 3 = PreludeCore.True + 2 3 = PreludeCore.True AbsBinds [t112] [] [(null, Main.null)] diff --git a/testsuite/tests/typecheck/should_fail/tcfail046.hs b/testsuite/tests/typecheck/should_fail/tcfail046.hs index 67225acde0..1d8894252f 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail046.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail046.hs @@ -5,23 +5,23 @@ module ShouldFail where type Process a = Pid -> Time -> Message a -> ( MessList a, - Continuation a) + Continuation a) data Continuation a = Do (Process a) deriving Eq -type ProcList a = [ (Pid, Status, Process a) ] -data Status = Active | Passive | Busy Integer | Terminated - deriving Eq +type ProcList a = [ (Pid, Status, Process a) ] +data Status = Active | Passive | Busy Integer | Terminated + deriving Eq -data Message a = Create (Process a) | Created Pid | Activate Pid | - Passivate Pid | Terminate Pid | Wait Pid Time | - Query Pid a | Data Pid a | Event | - Output Pid String +data Message a = Create (Process a) | Created Pid | Activate Pid | + Passivate Pid | Terminate Pid | Wait Pid Time | + Query Pid a | Data Pid a | Event | + Output Pid String deriving Eq -type MessList a = [ Message a ] +type MessList a = [ Message a ] -type Pid = Integer -type Time = Integer +type Pid = Integer +type Time = Integer diff --git a/testsuite/tests/typecheck/should_fail/tcfail068.hs b/testsuite/tests/typecheck/should_fail/tcfail068.hs index 40dc0e0bd8..f6dc30fb74 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail068.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail068.hs @@ -4,45 +4,45 @@ module ShouldFail where import GHC.Arr -import Control.Monad.ST ( runST ) +import Control.Monad.ST ( runST ) type IndTree s t = STArray s (Int,Int) t itgen :: Constructed a => (Int,Int) -> a -> IndTree s a -itgen n x = - runST ( - newSTArray ((1,1),n) x) +itgen n x = + runST ( + newSTArray ((1,1),n) x) itiap :: Constructed a => (Int,Int) -> (a->a) -> IndTree s a -> IndTree s a itiap i f arr = - runST ( - readSTArray arr i >>= \val -> - writeSTArray arr i (f val) >> - return arr) + runST ( + readSTArray arr i >>= \val -> + writeSTArray arr i (f val) >> + return arr) itrap :: Constructed a => ((Int,Int),(Int,Int)) -> (a->a) -> IndTree s a -> IndTree s a itrap ((i,k),(j,l)) f arr = runST (itrap' i k) - where - itrap' i k = if k > l then return arr - else (itrapsnd i k >> - itrap' i (k+1)) - itrapsnd i k = if i > j then return arr + where + itrap' i k = if k > l then return arr + else (itrapsnd i k >> + itrap' i (k+1)) + itrapsnd i k = if i > j then return arr else (readSTArray arr (i,k) >>= \val -> - writeSTArray arr (i,k) (f val) >> - itrapsnd (i+1) k) + writeSTArray arr (i,k) (f val) >> + itrapsnd (i+1) k) itrapstate :: Constructed b => ((Int,Int),(Int,Int)) -> (a->b->(a,b)) -> ((Int,Int)->c->a) -> - (a->c) -> c -> IndTree s b -> (c, IndTree s b) + (a->c) -> c -> IndTree s b -> (c, IndTree s b) itrapstate ((i,k),(j,l)) f c d s arr = runST(itrapstate' i k s) - where - itrapstate' i k s = if k > l then return (s,arr) - else (itrapstatesnd i k s >>= \(s,arr) -> - itrapstate' i (k+1) s) - itrapstatesnd i k s = if i > j then return (s,arr) + where + itrapstate' i k s = if k > l then return (s,arr) + else (itrapstatesnd i k s >>= \(s,arr) -> + itrapstate' i (k+1) s) + itrapstatesnd i k s = if i > j then return (s,arr) else (readSTArray arr (i,k) >>= \val -> - let (newstate, newval) = f (c (i,k) s) val - in writeSTArray arr (i,k) newval >> - itrapstatesnd (i+1) k (d newstate)) + let (newstate, newval) = f (c (i,k) s) val + in writeSTArray arr (i,k) newval >> + itrapstatesnd (i+1) k (d newstate)) -- stuff from Auxiliary: copied here (partain) diff --git a/testsuite/tests/typecheck/should_fail/tcfail069.hs b/testsuite/tests/typecheck/should_fail/tcfail069.hs index 63684fa9db..80db8451d7 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail069.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail069.hs @@ -1,4 +1,4 @@ -{- +{- From: Marc van Dongen <dongen@cs.ucc.ie> Date: Wed, 9 Apr 1997 14:06:39 +0100 (BST) @@ -20,9 +20,9 @@ too_much ds ((k,m):q1) s0 = case (list1,list2) of [] -> error "foo" -- too_much ds q2m s2m where list1 = ds - list2 = ds - {- - list1 = [k' | k' <- ds, k == k'] + list2 = ds + {- + list1 = [k' | k' <- ds, k == k'] list2 = [k' | k' <- ds, m == k'] s1 = aas s0 k raM = [] @@ -35,7 +35,7 @@ too_much ds ((k,m):q1) s0 q2m = raM s2km = foldr (flip aas) s1 raKM q2km = raKM - -} + -} listUnion :: (v -> v -> Bool) -> [v] -> [v] -> [v] listUnion _ _ _ diff --git a/testsuite/tests/typecheck/should_fail/tcfail070.hs b/testsuite/tests/typecheck/should_fail/tcfail070.hs index 6cd2a28404..a9aedbce5d 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail070.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail070.hs @@ -1,4 +1,4 @@ -{- +{- From: Wolfgang Drotschmann <drotschm@athene.informatik.uni-bonn.de> Resent-Date: Thu, 15 May 1997 17:23:09 +0100 @@ -7,7 +7,7 @@ I couldn't fix. But I played around with it, I found a small little script which reproduces it very well: panic! (the `impossible' happened): - tlist + tlist -} module TcFail where diff --git a/testsuite/tests/typecheck/should_fail/tcfail076.hs b/testsuite/tests/typecheck/should_fail/tcfail076.hs index e8a34558b6..fc4fc011d4 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail076.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail076.hs @@ -1,8 +1,8 @@ {-# LANGUAGE RankNTypes #-} -{- - From: Ralf Hinze <ralf@uran.informatik.uni-bonn.de> - Date: Fri, 15 Aug 1997 15:20:51 +0200 (MET DST) +{- + From: Ralf Hinze <ralf@uran.informatik.uni-bonn.de> + Date: Fri, 15 Aug 1997 15:20:51 +0200 (MET DST) I *suppose* that there is a bug in GHC's type checker. The following program, which I think is ill-typed, passes silently the type checker. @@ -11,11 +11,11 @@ Needless to say that it uses some of GHC's arcane type extensions. module ShouldFail where -data ContT m a = KContT (forall res. (a -> m res) -> m res) -unKContT (KContT x) = x +data ContT m a = KContT (forall res. (a -> m res) -> m res) +unKContT (KContT x) = x -callcc :: ((a -> ContT m b) -> ContT m a) -> ContT m a -callcc f = KContT (\cont -> unKContT (f (\a -> KContT (\cont' -> cont a))) cont) +callcc :: ((a -> ContT m b) -> ContT m a) -> ContT m a +callcc f = KContT (\cont -> unKContT (f (\a -> KContT (\cont' -> cont a))) cont) {- `ContT' is a continuation monad transformer. Note that we locally diff --git a/testsuite/tests/typecheck/should_fail/tcfail077.hs b/testsuite/tests/typecheck/should_fail/tcfail077.hs index 54735b98cd..8fa5d4a695 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail077.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail077.hs @@ -5,4 +5,4 @@ module ShouldFail where class Foo a where op :: a -> a - op2 x = x -- Bogus declaration + op2 x = x -- Bogus declaration diff --git a/testsuite/tests/typecheck/should_fail/tcfail080.hs b/testsuite/tests/typecheck/should_fail/tcfail080.hs index fa77ad8242..fa8fdd56cc 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail080.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail080.hs @@ -3,11 +3,11 @@ -- !!! Multi-param type classes test: ambiguity bug -- GHC actually accepts this program because --- q :: Collection c a => a -> Bool +-- q :: Collection c a => a -> Bool -- and there is no a priori reason to suppose that -- q would be ambiguous in every context. For example, -- it could be fine if we had --- instance c Int where ... +-- instance c Int where ... -- Of course, it'd be hard to fill in the "..." in this particular -- case, but that relies on observations about the form of the types -- of the class methods, surely beyond what a compiler should do. diff --git a/testsuite/tests/typecheck/should_fail/tcfail083.hs b/testsuite/tests/typecheck/should_fail/tcfail083.hs index a79be4e7ac..7c451433f0 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail083.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail083.hs @@ -11,6 +11,6 @@ display (State{ bar = Bar { flag = f, baz = b }}) = print (f,b) -- display (State{ bar = Bar { flag = f }, baz = b }) = print (f,b) -- GHC 4.04 (as released) crashed with --- panic! (the `impossible' happened): tcLookupValue: b{-r4n-} +-- panic! (the `impossible' happened): tcLookupValue: b{-r4n-} -- Bug reported by Sven Panne diff --git a/testsuite/tests/typecheck/should_fail/tcfail093.hs b/testsuite/tests/typecheck/should_fail/tcfail093.hs index 1f2063a1c2..6e2e6781ba 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail093.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail093.hs @@ -4,7 +4,7 @@ module ShouldFail where --- A stripped down functional-dependency +-- A stripped down functional-dependency -- example that causes GHC 4.08.1 to crash with: -- "basicTypes/Var.lhs:194: Non-exhaustive patterns in function readMutTyVar" -- Reported by Thomas Hallgren Nov 00 @@ -18,19 +18,19 @@ primDup = undefined dup () = call primDup --- call :: Call c h => c -> h +-- call :: Call c h => c -> h -- --- call primDup :: {Call (Int -> IO Int) h} => h with +-- call primDup :: {Call (Int -> IO Int) h} => h with -- Using the instance decl gives --- call primDup :: {Call (IO Int) h'} => Int -> h' +-- call primDup :: {Call (IO Int) h'} => Int -> h' -- The functional dependency means that h must be constant --- Hence program is rejected because it can't find an instance +-- Hence program is rejected because it can't find an instance -- for {Call (IO Int) h'} class Call c h | c -> h where call :: c -> h -instance Call c h => Call (Int->c) (Int->h) where +instance Call c h => Call (Int->c) (Int->h) where call f = call . f diff --git a/testsuite/tests/typecheck/should_fail/tcfail096.hs b/testsuite/tests/typecheck/should_fail/tcfail096.hs index 8a4edfbc6c..c019bfbb96 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail096.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail096.hs @@ -7,15 +7,15 @@ class Foo f a r | f a -> r where -- These instances are incompatible because we can unify -- the first two paramters, though it's rather obscure: --- p -> (a,b) --- t -> (,) (a,a) --- c -> (,) a --- r -> s +-- p -> (a,b) +-- t -> (,) (a,a) +-- c -> (,) a +-- r -> s -- -- So a constraint which would sow this up is --- Foo ((Int,Int)->Int) --- ((Int,Int), (Int,Int)) --- t +-- Foo ((Int,Int)->Int) +-- ((Int,Int), (Int,Int)) +-- t -- This matches both. Not easy to spot, and the error -- message would be improved by giving the unifier, or -- a witness. diff --git a/testsuite/tests/typecheck/should_fail/tcfail101.hs b/testsuite/tests/typecheck/should_fail/tcfail101.hs index 8bd88749c3..df538e3605 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail101.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail101.hs @@ -6,5 +6,5 @@ module ShouldCompile where type A i = i data T k = MkT (k Int) -f :: T A -- BAD! +f :: T A -- BAD! f = error "foo" diff --git a/testsuite/tests/typecheck/should_fail/tcfail103.hs b/testsuite/tests/typecheck/should_fail/tcfail103.hs index 2ed6df2485..0337feab16 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail103.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail103.hs @@ -11,6 +11,6 @@ f:: ST t Int f = do v <- newSTRef 5 let g :: ST s Int - -- Implicitly forall s. ST s Int + -- Implicitly forall s. ST s Int g = readSTRef v g diff --git a/testsuite/tests/typecheck/should_fail/tcfail104.hs b/testsuite/tests/typecheck/should_fail/tcfail104.hs index 7a6a50547c..371ed32557 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail104.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail104.hs @@ -6,18 +6,18 @@ module ShouldFail where -- These two are ok -f1 = (\ (x :: forall a. a->a) -> x) +f1 = (\ (x :: forall a. a->a) -> x) f2 = (\ (x :: forall a. a->a) -> x) id 'c' -- These fail f3 v = (if v then - (\ (x :: forall a. a->a) -> x) - else - (\ x -> x) + (\ (x :: forall a. a->a) -> x) + else + (\ x -> x) ) id 'c' f4 v = (if v then - (\ x -> x) - else - (\ (x :: forall a. a->a) -> x) + (\ x -> x) + else + (\ (x :: forall a. a->a) -> x) ) id 'c' diff --git a/testsuite/tests/typecheck/should_fail/tcfail105.hs b/testsuite/tests/typecheck/should_fail/tcfail105.hs index 331e38322b..b0efc5b424 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail105.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail105.hs @@ -3,8 +3,8 @@ -- Existential context should quantify over some new type variables -- -- Jan07: this is now fine, because we've lifted the restrction --- that the context on a constructor should mention --- existential type variables +-- that the context on a constructor should mention +-- existential type variables module ShouldFail where diff --git a/testsuite/tests/typecheck/should_fail/tcfail112.hs b/testsuite/tests/typecheck/should_fail/tcfail112.hs index 01dd578ab7..5252f83b14 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail112.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail112.hs @@ -1,4 +1,4 @@ --- Record construction should fail statically +-- Record construction should fail statically -- if there are any strict fields, -- including in the non-record case. @@ -8,8 +8,8 @@ data S = S { x::Int, y:: ! Int } data T = T Int !Int data U = U Int Int -s1 = S {} -- Bad -s2 = S { x=3 } -- Bad -s3 = S { y=3 } -- Ok -t = T {} -- Bad -u = U {} -- Ok +s1 = S {} -- Bad +s2 = S { x=3 } -- Bad +s3 = S { y=3 } -- Ok +t = T {} -- Bad +u = U {} -- Ok diff --git a/testsuite/tests/typecheck/should_fail/tcfail114.hs b/testsuite/tests/typecheck/should_fail/tcfail114.hs index 2d0fc19f4b..a9305ad190 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail114.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail114.hs @@ -9,5 +9,5 @@ data Bar = Bar { bar :: () } test :: Bar test = undefined { foo = () } - -- The point is that foo is a class method, - -- but not a record selector + -- The point is that foo is a class method, + -- but not a record selector diff --git a/testsuite/tests/typecheck/should_fail/tcfail118.hs b/testsuite/tests/typecheck/should_fail/tcfail118.hs index 1b81c7e01a..763fa70fe3 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail118.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail118.hs @@ -1,9 +1,9 @@ --- Gave a bad error message in a version of 6.3, as a +-- Gave a bad error message in a version of 6.3, as a -- result of 6.3's new duplicate-instance reporting structure -- --- Foo.hs:4:5: --- No instance for `Eq Foo' --- When deriving the `Eq' instance for type `Bar' +-- Foo.hs:4:5: +-- No instance for `Eq Foo' +-- When deriving the `Eq' instance for type `Bar' module ShouldFail where diff --git a/testsuite/tests/typecheck/should_fail/tcfail119.hs b/testsuite/tests/typecheck/should_fail/tcfail119.hs index 52b9c8a5eb..1b11ee9885 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail119.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail119.hs @@ -1,5 +1,5 @@ -- Gave a nasty --- tcLookupGlobal: `FunnyError.$dmb' is not in scope +-- tcLookupGlobal: `FunnyError.$dmb' is not in scope -- failure in GHC 6.2, because the type-checking of -- the default method didn't recover. diff --git a/testsuite/tests/typecheck/should_fail/tcfail122.hs b/testsuite/tests/typecheck/should_fail/tcfail122.hs index 0576f5f9d0..2594ca6e24 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail122.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail122.hs @@ -5,4 +5,4 @@ module ShouldFail where -- There should be a kind error, when unifying (a b) against (c d) foo = [ undefined :: forall a b. a b, - undefined :: forall (c:: (* -> *) -> *) (d :: * -> *). c d ] + undefined :: forall (c:: (* -> *) -> *) (d :: * -> *). c d ] diff --git a/testsuite/tests/typecheck/should_fail/tcfail123.hs b/testsuite/tests/typecheck/should_fail/tcfail123.hs index 6a33eb7e64..6bd8fef755 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail123.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail123.hs @@ -3,7 +3,7 @@ module ShouldFail where -- The danger here is getting a type like --- f :: forall (a::??). a -> Bool +-- f :: forall (a::??). a -> Bool -- and hence allowing the bogus calls that follow f x = True diff --git a/testsuite/tests/typecheck/should_fail/tcfail125.hs b/testsuite/tests/typecheck/should_fail/tcfail125.hs index 664354d840..e8d006bab7 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail125.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail125.hs @@ -7,5 +7,5 @@ module ShouldCompile where data (Show a) => Obs a = forall b. LiftObs a b -f :: Obs a -> String -- Needs a (Show a) context +f :: Obs a -> String -- Needs a (Show a) context f (LiftObs _ _) = "yes" diff --git a/testsuite/tests/typecheck/should_fail/tcfail126.hs b/testsuite/tests/typecheck/should_fail/tcfail126.hs index 20b0f55e3c..3c5f2b1267 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail126.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail126.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} {-# LANGUAGE RankNTypes, ExistentialQuantification #-} --- An interesting interaction of universals and existentials, prompted by +-- An interesting interaction of universals and existentials, prompted by -- http://www.haskell.org/pipermail/haskell-cafe/2004-October/007160.html -- -- Note the nested pattern-match in runProg; tc183 checks the @@ -13,9 +13,9 @@ module Foo where import Control.Monad.Trans -data Bar m - = forall t. (MonadTrans t, Monad (t m)) - => Bar (t m () -> m ()) (t m Int) +data Bar m + = forall t. (MonadTrans t, Monad (t m)) + => Bar (t m () -> m ()) (t m Int) data Foo = Foo (forall m. Monad m => Bar m) @@ -23,7 +23,7 @@ runProg :: Foo -> IO () runProg (Foo (Bar run op)) = run (prog op) -- This nested match "ought" to work; because -- runProg (Foo b) = case b of --- Bar run op -> run (prog op) +-- Bar run op -> run (prog op) -- does work. But the interactions with GADTs and -- desugaring defeated me, and I removed (in GHC 6.4) the ability -- to instantiate functions on the left diff --git a/testsuite/tests/typecheck/should_fail/tcfail128.hs b/testsuite/tests/typecheck/should_fail/tcfail128.hs index 08971837a2..01b23a56d2 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail128.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail128.hs @@ -10,13 +10,13 @@ import Data.Array.IArray as IA (Array,listArray) main :: IO () main = do let sL = [1,4,6,3,2,5] - dim = length sL - help :: [FlatVector] - help = [listFlatVector (1,s) [0|i<-[1..s]]|s<-sL] - tmp :: Vector FlatVector - tmp = listVector (1,dim) help - v <- thaw tmp - return () + dim = length sL + help :: [FlatVector] + help = [listFlatVector (1,s) [0|i<-[1..s]]|s<-sL] + tmp :: Vector FlatVector + tmp = listVector (1,dim) help + v <- thaw tmp + return () type FlatVector = UArray Int Double diff --git a/testsuite/tests/typecheck/should_fail/tcfail131.hs b/testsuite/tests/typecheck/should_fail/tcfail131.hs index 98b0a29c80..fa4a7a9ff4 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail131.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail131.hs @@ -2,6 +2,6 @@ module ShouldFail where - f = (*) -- Monomorphic + f = (*) -- Monomorphic g :: Num b => b -> b g x = f x x diff --git a/testsuite/tests/typecheck/should_fail/tcfail132.hs b/testsuite/tests/typecheck/should_fail/tcfail132.hs index dd8d644abc..910fc2267c 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail132.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail132.hs @@ -2,7 +2,7 @@ -- The current error message was rather horrible (trac bug #312): -- -- Kind error: Expecting kind `k_a1JA -> k_a1JE -> k_a1JI -> *', --- but `DUnit t' has kind `k_a1JA -> k_a1JE -> *' +-- but `DUnit t' has kind `k_a1JA -> k_a1JE -> *' -- -- as we couldn't tidy kinds, because they didn't have OccNames. -- This test recalls the bad error message. @@ -15,5 +15,5 @@ type DUnit t o1 o2 = () type T f g t o1 o2 = Either (f t o1 o2) (g t o1 o2) type LiftObject t f' f = T (Object f' f t) (DUnit t) - + diff --git a/testsuite/tests/typecheck/should_fail/tcfail135.hs b/testsuite/tests/typecheck/should_fail/tcfail135.hs index 5cfc926085..e65aa21d1d 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail135.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail135.hs @@ -3,7 +3,7 @@ module ShoudlFail where class Foo f where - baa :: f a -> f + baa :: f a -> f instance Foo Maybe where - baa z = z + baa z = z diff --git a/testsuite/tests/typecheck/should_fail/tcfail138.hs b/testsuite/tests/typecheck/should_fail/tcfail138.hs index 63485a32df..31cde734ec 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail138.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail138.hs @@ -12,16 +12,16 @@ -- In the instance declaration for `C (Maybe a) a' -- -- Since L is a superclass of the (sought) constraint (C a b'), you might --- think that we'd generate the superclasses (L a b') and (L a b), and now +-- think that we'd generate the superclasses (L a b') and (L a b), and now -- the fundep will force b=b'. But GHC is very cautious about generating -- superclasses when doing context reduction for instance declarations, -- because of the danger of superclass loops. -- -- So, today, this program fails. It's trivial to fix by adding a fundep for C --- class (G a, L a b) => C a b | a -> b +-- class (G a, L a b) => C a b | a -> b --- Note: Sept 08: when fixing Trac #1470, tc138 started working! --- This test is a very strange one (fundeps, undecidable instances), +-- Note: Sept 08: when fixing Trac #1470, tc138 started working! +-- This test is a very strange one (fundeps, undecidable instances), -- so I'm just marking it as "should-succeed". It's not very clear to -- me what the "right" answer should be; when we have the type equality -- story more worked out we might want to think about that. diff --git a/testsuite/tests/typecheck/should_fail/tcfail143.hs b/testsuite/tests/typecheck/should_fail/tcfail143.hs index 67eb62bafb..f0ee21f352 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail143.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail143.hs @@ -1,10 +1,10 @@ {-# LANGUAGE UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies #-} -module Foo where +module Foo where -data Z = Z -data S a = S a +data Z = Z +data S a = S a class MinMax a b c d | a b -> c d, a c d -> b, b c d -> a instance MinMax Z Z Z Z -- (a) @@ -15,23 +15,23 @@ instance MinMax a b c d => MinMax (S a) (S b) (S c) (S d) class Extend a b where extend :: a -> b -> b instance Extend Z b where Z `extend` b = b -instance MinMax a b _c b => Extend a b where - _a `extend` b = b +instance MinMax a b _c b => Extend a b where + _a `extend` b = b -t :: MinMax a b _c d => a -> b -> d -t _ _ = (undefined :: d) +t :: MinMax a b _c d => a -> b -> d +t _ _ = (undefined :: d) -n0 = Z -n1 = S n0 +n0 = Z +n1 = S n0 -t1 = n1 `t` n0 -- L2 +t1 = n1 `t` n0 -- L2 t2 = n1 `extend` n0 -- L3: uncommenting just this line produces - -- an error message pointing at L1 and L2 - -- with no mention of the real culprit, L3. + -- an error message pointing at L1 and L2 + -- with no mention of the real culprit, L3. --- t1 :: S Z -- L4: uncommenting this and L3 produces an - -- error message rightly pointing at L2 and L3. +-- t1 :: S Z -- L4: uncommenting this and L3 produces an + -- error message rightly pointing at L2 and L3. {- n0 :: Z; n1 :: S Z @@ -52,20 +52,20 @@ Lacking the type signature t1 :: S Z, we get n0 :: Z n1 :: S v1 - t1 :: d1 with constraint ([L2] MinMax (S v1) Z c1 d1) - t2 :: Z with constraint ([L3] Extend (S v1) Z) + t1 :: d1 with constraint ([L2] MinMax (S v1) Z c1 d1) + t2 :: Z with constraint ([L3] Extend (S v1) Z) [L2] MinMax (S v1) Z c1 d1, [L3] Extend (S v1) Z ----> <by instance for Extend a b> +---> <by instance for Extend a b> [L2] MinMax (S v1) Z c1 d1, [L3] MinMax (S v1) Z c2 Z} ----> <combining these two constraints using (a b -> c d) +---> <combining these two constraints using (a b -> c d) [L2] MinMax (S v1) Z c1 Z, [L3] MinMax (S v1) Z c1 Z} Now there are the two constraints are indistinguishable, and both give rise to the same error: ----> <combining first with [L1] instance MinMax a Z Z a> - c1=Z, Z=S v1 ERROR +---> <combining first with [L1] instance MinMax a Z Z a> + c1=Z, Z=S v1 ERROR In either case, the error points to L1. @@ -73,9 +73,9 @@ In either case, the error points to L1. A different sequence leads to a different error: [L2] MinMax (S v1) Z c1 d1, [L3] Extend (S v1) Z ----> <by instance for Extend a b> +---> <by instance for Extend a b> [L2] MinMax (S v1) Z c1 d1, [L3] MinMax (S v1) Z c2 Z} ----> <combining first with [L1] instance MinMax a Z Z a> +---> <combining first with [L1] instance MinMax a Z Z a> [L2] MinMax (S v1) Z Z (S2 v1), [L3] MinMax (S v1) Z c2 Z} Now combining the two constraints gives rise to the error, but @@ -85,11 +85,11 @@ I can't explain exactly why adding the type signature for t1 changes the order. -Hmm. Perhaps a good improvement strategy would be: +Hmm. Perhaps a good improvement strategy would be: - first do improvement against the instance declartions - and only then do pairwise improvement between constraints -I've implemented that, and indeed it improves the result. +I've implemented that, and indeed it improves the result. Instead of: Foo.hs:1:0: @@ -113,4 +113,4 @@ we get And this error in t2 is perfectly correct. You get it even if you comment out the entire definition of t1. --}
\ No newline at end of file +-} diff --git a/testsuite/tests/typecheck/should_fail/tcfail149.hs b/testsuite/tests/typecheck/should_fail/tcfail149.hs index 090db8de22..fabf6bf768 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail149.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail149.hs @@ -4,11 +4,11 @@ module Main where class C a where op :: (Show a, Show b) => a -> b -> String - -- This class op adds a constraint on 'a' + -- This class op adds a constraint on 'a' - -- In GHC 7.0 this is fine, and it's a royal - -- pain to reject it when in H98 mode, so - -- I'm just allowing it + -- In GHC 7.0 this is fine, and it's a royal + -- pain to reject it when in H98 mode, so + -- I'm just allowing it instance C Int where op x y = show x ++ " " ++ show y diff --git a/testsuite/tests/typecheck/should_fail/tcfail157.hs b/testsuite/tests/typecheck/should_fail/tcfail157.hs index 74f02ed1e5..3a57cd1707 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail157.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail157.hs @@ -5,12 +5,12 @@ -- This one (due to Oleg) made 6.4.1 go into a loop in the typechecker, -- despite the lack of UndecidableInstances -- --- The example corresponds to a type function (realized as a class E --- with functional dependencies) in the context of an instance. +-- The example corresponds to a type function (realized as a class E +-- with functional dependencies) in the context of an instance. -- The function in question is -- --- class E m a b | m a -> b --- instance E m (() -> ()) (m ()) +-- class E m a b | m a -> b +-- instance E m (() -> ()) (m ()) -- -- We see that the result of the function, "m ()" is smaller (in the -- number of constructors) that the functions' arguments, "m" and diff --git a/testsuite/tests/typecheck/should_fail/tcfail159.hs b/testsuite/tests/typecheck/should_fail/tcfail159.hs index c0c2eb1902..1d4b540e2b 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail159.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail159.hs @@ -5,5 +5,5 @@ module ShouldFail where h :: Int -> (# Int, Int #) h x = (# x,x #) -foo x = case h x of - ~(# p, q #) -> p +foo x = case h x of + ~(# p, q #) -> p diff --git a/testsuite/tests/typecheck/should_fail/tcfail169.hs b/testsuite/tests/typecheck/should_fail/tcfail169.hs index e0d6e4f838..46606a838d 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail169.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail169.hs @@ -3,6 +3,6 @@ module ShoulFail where -data Succ a = S a -- NB: deriving Show omitted +data Succ a = S a -- NB: deriving Show omitted data Seq a = Cons a (Seq (Succ a)) | Nil deriving Show diff --git a/testsuite/tests/typecheck/should_fail/tcfail170.hs b/testsuite/tests/typecheck/should_fail/tcfail170.hs index 1e7838cb43..66c8cf3bcc 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail170.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail170.hs @@ -5,4 +5,4 @@ module ShouldFail where class C a b | a -> b instance C [p] [q] - -- Coverage condition fails + -- Coverage condition fails diff --git a/testsuite/tests/typecheck/should_fail/tcfail181.hs b/testsuite/tests/typecheck/should_fail/tcfail181.hs index ca96a2c07e..ee242207bd 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail181.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail181.hs @@ -1,8 +1,8 @@ -- GHC 6.7 at one point said wog's type was: -- -- wog :: forall t e (m :: * -> *). --- (Monad GHC.Prim.Any1, Monad m) => --- t -> Something (m Bool) e +-- (Monad GHC.Prim.Any1, Monad m) => +-- t -> Something (m Bool) e -- -- The stupid 'GHC.Prim.Any1' arose because of type ambiguity -- which should be reported, and wasn't. diff --git a/testsuite/tests/typecheck/should_fail/tcfail185.hs b/testsuite/tests/typecheck/should_fail/tcfail185.hs index 59af50f738..d6026368ec 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail185.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail185.hs @@ -4,7 +4,7 @@ module ShouldFail where f :: Int -> Int -> Bool -> Bool -> Int -> Int f a b = \ x y -> let { y1 = y; y2 = y1; y3 = y2; y4 = y3; y5 = y4; - y6 = y5; y7 = y6 } in x + y6 = y5; y7 = y6 } in x diff --git a/testsuite/tests/typecheck/should_fail/tcfail198.hs b/testsuite/tests/typecheck/should_fail/tcfail198.hs index 658545e9b2..e9718c57d3 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail198.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail198.hs @@ -2,6 +2,6 @@ module ShouldFail where -f3 :: forall a. [a] -> [a] +f3 :: forall a. [a] -> [a] Just f3 = Just (\(x:xs) -> xs ++ [ x :: a ]) -- Not OK! - -- The type variable does not scope in a pattern binding + -- The type variable does not scope in a pattern binding diff --git a/testsuite/tests/typecheck/should_fail/tcfail201.hs b/testsuite/tests/typecheck/should_fail/tcfail201.hs index ac59cb0b55..5b18dd9860 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail201.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail201.hs @@ -1,7 +1,7 @@ {-# LANGUAGE RankNTypes #-} --- Claus reported by email that +-- Claus reported by email that -- GHCi, version 6.9.20080217 loops on this program -- http://www.haskell.org/pipermail/cvs-ghc/2008-June/043173.html -- So I'm adding it to the test suite so that we'll see it if it happens again @@ -14,8 +14,8 @@ data HsDoc id gfoldl' :: (forall a b . c (a -> b) -> a -> c b) -> (forall g . g -> c g) -> a -> c a gfoldl' k z hsDoc = case hsDoc of - DocEmpty -> z DocEmpty --- (DocParagraph hsDoc) -> z DocParagraph `k` hsDoc + DocEmpty -> z DocEmpty +-- (DocParagraph hsDoc) -> z DocParagraph `k` hsDoc diff --git a/testsuite/tests/typecheck/should_run/Defer01.hs b/testsuite/tests/typecheck/should_run/Defer01.hs index f6c69dcfa7..f6c69dcfa7 100755..100644 --- a/testsuite/tests/typecheck/should_run/Defer01.hs +++ b/testsuite/tests/typecheck/should_run/Defer01.hs diff --git a/testsuite/tests/typecheck/should_run/T1624.hs b/testsuite/tests/typecheck/should_run/T1624.hs index e92e2664d3..1b2b838ecc 100644 --- a/testsuite/tests/typecheck/should_run/T1624.hs +++ b/testsuite/tests/typecheck/should_run/T1624.hs @@ -13,4 +13,4 @@ instance Foo (Maybe a) a where main = do { print (foo (Just 'x')) - ; print (bar (Just 'y')) } + ; print (bar (Just 'y')) } diff --git a/testsuite/tests/typecheck/should_run/TcRun025_B.hs b/testsuite/tests/typecheck/should_run/TcRun025_B.hs index ae48117661..bc5eb0c6de 100644 --- a/testsuite/tests/typecheck/should_run/TcRun025_B.hs +++ b/testsuite/tests/typecheck/should_run/TcRun025_B.hs @@ -4,35 +4,35 @@ module TcRun025_B where - import Data.List( sort ) - - -- This class has no tyvars in its class op context - -- One uses a newtype, the other a data type - class C1 a where - fc1 :: (?p :: String) => a; - class C2 a where - fc2 :: (?p :: String) => a; - opc :: a - - instance C1 String where - fc1 = ?p; - instance C2 String where - fc2 = ?p; - opc = "x" - - -- This class constrains no new type variables in - -- its class op context - class D1 a where - fd1 :: (Ord a) => [a] -> [a] - class D2 a where - fd2 :: (Ord a) => [a] -> [a] - opd :: a - - instance D1 (Maybe a) where - fd1 xs = sort xs - instance D2 (Maybe a) where - fd2 xs = sort xs - opd = Nothing + import Data.List( sort ) + + -- This class has no tyvars in its class op context + -- One uses a newtype, the other a data type + class C1 a where + fc1 :: (?p :: String) => a; + class C2 a where + fc2 :: (?p :: String) => a; + opc :: a + + instance C1 String where + fc1 = ?p; + instance C2 String where + fc2 = ?p; + opc = "x" + + -- This class constrains no new type variables in + -- its class op context + class D1 a where + fd1 :: (Ord a) => [a] -> [a] + class D2 a where + fd2 :: (Ord a) => [a] -> [a] + opd :: a + + instance D1 (Maybe a) where + fd1 xs = sort xs + instance D2 (Maybe a) where + fd2 xs = sort xs + opd = Nothing diff --git a/testsuite/tests/typecheck/should_run/tcrun004.hs b/testsuite/tests/typecheck/should_run/tcrun004.hs index 2319fc3bec..388a1e8ed4 100644 --- a/testsuite/tests/typecheck/should_run/tcrun004.hs +++ b/testsuite/tests/typecheck/should_run/tcrun004.hs @@ -3,51 +3,51 @@ -- Originally from Kevin Glynn module Main(main) where -data Coordinate3D = Coord3D {cx, cy, cz::Double} +data Coordinate3D = Coord3D {cx, cy, cz::Double} deriving (Eq, Show) -- We Represent a line by two coordinates which it passes through. -data Line = MkLine Coordinate3D Coordinate3D +data Line = MkLine Coordinate3D Coordinate3D class PictureObject pot where -- Returns ordered (rel to 0 0 0) of points where the object - -- intersects the given line. + -- intersects the given line. intersectLineObject :: pot -> Line -> [Coordinate3D] getPictureName :: pot -> String -data Sphere = - Sphere Coordinate3D -- Centre - Double -- Radius - Double -- ambient coeff - Double -- diffuse coeff - Double -- specular coeff - Double -- phong specular exponent +data Sphere = + Sphere Coordinate3D -- Centre + Double -- Radius + Double -- ambient coeff + Double -- diffuse coeff + Double -- specular coeff + Double -- phong specular exponent intersectLineSphere :: Sphere -> Line -> [Coordinate3D] intersectLineSphere sp line = [] instance PictureObject Sphere where - intersectLineObject = intersectLineSphere - getPictureName _ = "Sphere" - -data Cube = - Cube Coordinate3D -- Origin corner - Coordinate3D -- Opposite corner - Double -- ambient coeff - Double -- diffuse coeff - Double -- specular coeff - Double -- phong specular exponent + intersectLineObject = intersectLineSphere + getPictureName _ = "Sphere" + +data Cube = + Cube Coordinate3D -- Origin corner + Coordinate3D -- Opposite corner + Double -- ambient coeff + Double -- diffuse coeff + Double -- specular coeff + Double -- phong specular exponent deriving (Eq, Show) intersectLineCube :: Cube -> Line -> [Coordinate3D] intersectLineCube cube line = [] instance PictureObject Cube where - intersectLineObject = intersectLineCube - getPictureName _ = "Cube" + intersectLineObject = intersectLineCube + getPictureName _ = "Cube" data GenPic = forall pot. (PictureObject pot) => MkGenPic pot @@ -58,7 +58,7 @@ sphere = Sphere (Coord3D 1 1 1) 1 1 1 1 1 cube :: Cube cube = Cube (Coord3D 1 1 1) (Coord3D 2 2 2) 1 1 1 1 -obj_list:: [GenPic] +obj_list:: [GenPic] obj_list = [MkGenPic sphere, MkGenPic cube] putName :: PictureObject pot => pot -> IO () diff --git a/testsuite/tests/typecheck/should_run/tcrun005.hs b/testsuite/tests/typecheck/should_run/tcrun005.hs index 2c315725ef..e3e834bad5 100644 --- a/testsuite/tests/typecheck/should_run/tcrun005.hs +++ b/testsuite/tests/typecheck/should_run/tcrun005.hs @@ -7,19 +7,19 @@ module Main where data TTT = TTT class CC a where - op_cc :: a -> a - + op_cc :: a -> a + class CCT a where - op_cct :: a -> a + op_cct :: a -> a -- These two instances should get different dfun names! -- In GHC 4.04 they both got $fCCTTT instance CC TTT where - op_cc = id + op_cc = id instance CCT TT where - op_cct = id + op_cct = id main = case op_cc TTT of - TTT -> print "ok" + TTT -> print "ok" diff --git a/testsuite/tests/typecheck/should_run/tcrun006.hs b/testsuite/tests/typecheck/should_run/tcrun006.hs index f3d0e13cef..c8e31cace9 100644 --- a/testsuite/tests/typecheck/should_run/tcrun006.hs +++ b/testsuite/tests/typecheck/should_run/tcrun006.hs @@ -4,13 +4,13 @@ -- This program, reported in Aug'00 by Jose Emilio Labra Gayo -- gave rise to a Lint error because the selector 'newout' below -- was given the type --- Eq f => NewT f -> f +-- Eq f => NewT f -> f -- but lacked a dictionary argument in its body. module Main where -newtype (Eq f) => NewT f = NewIn { newout :: f } -data (Eq f) => DataT f = DataIn { dataout :: f } +newtype (Eq f) => NewT f = NewIn { newout :: f } +data (Eq f) => DataT f = DataIn { dataout :: f } main = print (newout (NewIn "ok new") ++ dataout (DataIn " ok data")) diff --git a/testsuite/tests/typecheck/should_run/tcrun009.hs b/testsuite/tests/typecheck/should_run/tcrun009.hs index 1adc350084..bc8baacfb7 100644 --- a/testsuite/tests/typecheck/should_run/tcrun009.hs +++ b/testsuite/tests/typecheck/should_run/tcrun009.hs @@ -19,7 +19,7 @@ test3:: [a] -> [a] test3 = foo . foo -- First foo must use the first instance, -- second must use the second. So we should --- get in effect: test3 (x:xs) = [x] +-- get in effect: test3 (x:xs) = [x] main:: IO () main = print (test3 "foo") diff --git a/testsuite/tests/typecheck/should_run/tcrun011.hs b/testsuite/tests/typecheck/should_run/tcrun011.hs index 5c6cab8ea0..ead5827568 100644 --- a/testsuite/tests/typecheck/should_run/tcrun011.hs +++ b/testsuite/tests/typecheck/should_run/tcrun011.hs @@ -8,7 +8,7 @@ module Main (main) where class MyClass a b where - foo :: a -> b -> Int + foo :: a -> b -> Int data Special = forall b. (MyClass Int b)=> MkSpecial b data General a = forall b. (MyClass a b)=> MkGeneral b @@ -21,5 +21,5 @@ xs :: [General Int] xs = [MkGeneral True, MkGeneral False] main = print [foo (3::Int) x | MkGeneral x <- xs] - -- Without the (::Int) part we get an - -- incomprehensible error message :-( + -- Without the (::Int) part we get an + -- incomprehensible error message :-( diff --git a/testsuite/tests/typecheck/should_run/tcrun012.hs b/testsuite/tests/typecheck/should_run/tcrun012.hs index a3c946a24e..e39444ce00 100644 --- a/testsuite/tests/typecheck/should_run/tcrun012.hs +++ b/testsuite/tests/typecheck/should_run/tcrun012.hs @@ -5,7 +5,7 @@ module Main where main = do { let ?x = 13 in putStrLn $ show $ foo - ; let ?x = 14 in putStrLn $ show $ baz () } + ; let ?x = 14 in putStrLn $ show $ baz () } foo :: (?x :: Int) => Int foo = ?x diff --git a/testsuite/tests/typecheck/should_run/tcrun016.hs b/testsuite/tests/typecheck/should_run/tcrun016.hs index b498ed4220..34e38d6642 100644 --- a/testsuite/tests/typecheck/should_run/tcrun016.hs +++ b/testsuite/tests/typecheck/should_run/tcrun016.hs @@ -11,36 +11,36 @@ module Main where main = print (get ((AttributeLeaf (MyLabel "x") 4)::Env1) (MyLabel "x")) class Eq l => Domain d l | d -> l where - (<<) :: d -> d -> d - empty :: d + (<<) :: d -> d -> d + empty :: d class Domain e l => Environment e l t | e -> l t where - get :: e -> l -> Maybe t - attribute :: l -> t -> e + get :: e -> l -> Maybe t + attribute :: l -> t -> e class Eq' a where - (=?=) :: a -> a -> Bool + (=?=) :: a -> a -> Bool newtype MyLabel = MyLabel String deriving Eq instance Eq' MyLabel where - l =?= l' = l == l' + l =?= l' = l == l' -data BinTreeEnv l t = - EmptyEnv | - AttributeLeaf l t | - Union (BinTreeEnv l t) (BinTreeEnv l t) +data BinTreeEnv l t = + EmptyEnv | + AttributeLeaf l t | + Union (BinTreeEnv l t) (BinTreeEnv l t) instance (Eq l, Eq' l) => Domain (BinTreeEnv l t) l where - EmptyEnv << d = d - d << EmptyEnv = d - d << d' = Union d d' - empty = EmptyEnv + EmptyEnv << d = d + d << EmptyEnv = d + d << d' = Union d d' + empty = EmptyEnv instance (Eq l, Eq' l) => Environment (BinTreeEnv l t) l t where - get EmptyEnv l = Nothing - get (AttributeLeaf l t) l' = if l =?= l' then Just t - else Nothing - get (Union d d') l = error "!??" + get EmptyEnv l = Nothing + get (AttributeLeaf l t) l' = if l =?= l' then Just t + else Nothing + get (Union d d') l = error "!??" attribute l t = AttributeLeaf l t diff --git a/testsuite/tests/typecheck/should_run/tcrun017.hs b/testsuite/tests/typecheck/should_run/tcrun017.hs index f994df3a4f..3ef8b6877c 100644 --- a/testsuite/tests/typecheck/should_run/tcrun017.hs +++ b/testsuite/tests/typecheck/should_run/tcrun017.hs @@ -6,9 +6,9 @@ module Main where foo :: ((?x :: Int) => IO a) -> Int -> IO a - -- Note the rank2 type -foo s z = do let ?x = z in s -- Should pick up ?x = z - let ?x = z+3 in s -- Ditto z+3 + -- Note the rank2 type +foo s z = do let ?x = z in s -- Should pick up ?x = z + let ?x = z+3 in s -- Ditto z+3 main = foo (print ?x) 42 diff --git a/testsuite/tests/typecheck/should_run/tcrun018.hs b/testsuite/tests/typecheck/should_run/tcrun018.hs index 9f9bd14d0f..cf7db6304f 100644 --- a/testsuite/tests/typecheck/should_run/tcrun018.hs +++ b/testsuite/tests/typecheck/should_run/tcrun018.hs @@ -22,18 +22,18 @@ instance C3 Maybe Bool main = do { print (c2 True :: Maybe Bool) ; - print (c3 True :: Maybe Bool) } + print (c3 True :: Maybe Bool) } ------------------------------------------------------------------------ -{- Here's the email from Ralf Laemmel - reporting a bug in Hugs +{- Here's the email from Ralf Laemmel + reporting a bug in Hugs 1. If you evaluate "test", then you get as expected "Just True". 2. Now remove the "Monad M" constraint - in the class C2. [giving the class C3] - This is of course legal and semantics-preserving + in the class C2. [giving the class C3] + This is of course legal and semantics-preserving since the monad constraints is implied by C1 anyway. @@ -47,7 +47,7 @@ anything etc.), then you see "Program error: {_Gc Black Hole}". Of course, there is no such black hole. I extracted the above fragment from a huge problem. -The scheme is the following. It seems have to do +The scheme is the following. It seems have to do with multi-parameter classes. It definitely has to do with multi-layered class hierarchies where one class has a class-wide superclass, as C2 has C1 in @@ -75,10 +75,10 @@ But I would be glad to help you by checking if the problem is gone after you did the bug fix. --- +-- Dr.-Ing. Ralf Laemmel CWI & VU, Amsterdam, The Netherlands http://www.cwi.nl/~ralf/ http://www.cs.vu.nl/~ralf/ --}
\ No newline at end of file +-} diff --git a/testsuite/tests/typecheck/should_run/tcrun019.hs b/testsuite/tests/typecheck/should_run/tcrun019.hs index 266e01d9c0..bab55d8f95 100644 --- a/testsuite/tests/typecheck/should_run/tcrun019.hs +++ b/testsuite/tests/typecheck/should_run/tcrun019.hs @@ -8,10 +8,10 @@ module Main where -- mbs@cse.ogi.edu 24-Oct-2001 22:21:27 f :: (?x :: Int) => ((?x :: Int) => Int) -> Int -> Int -f g y = if y == 0 - then g - else let ?x = ?x + 1 - in f g (y - 1) +f g y = if y == 0 + then g + else let ?x = ?x + 1 + in f g (y - 1) h :: (?x :: Int) => Int h = ?x diff --git a/testsuite/tests/typecheck/should_run/tcrun021.hs b/testsuite/tests/typecheck/should_run/tcrun021.hs index 50497dd640..d6a31ebc0f 100644 --- a/testsuite/tests/typecheck/should_run/tcrun021.hs +++ b/testsuite/tests/typecheck/should_run/tcrun021.hs @@ -52,7 +52,7 @@ model :: Map LinuxObjectId LinuxObject model = fromList [ (Left [], File []), (Left ["home"], File ["home"]) ] --- works +-- works -- model :: (LinuxObjectId, LinuxObject) -- model = (Left [], File []) diff --git a/testsuite/tests/typecheck/should_run/tcrun023.hs b/testsuite/tests/typecheck/should_run/tcrun023.hs index 3a6166b015..d1d434d2dd 100644 --- a/testsuite/tests/typecheck/should_run/tcrun023.hs +++ b/testsuite/tests/typecheck/should_run/tcrun023.hs @@ -9,5 +9,5 @@ foo n = show (n + length ?x) main = do { putStrLn (let ?x = [True,False] in foo 3) ; - putStrLn (let ?x = "fred" in foo 4) } + putStrLn (let ?x = "fred" in foo 4) } diff --git a/testsuite/tests/typecheck/should_run/tcrun024.hs b/testsuite/tests/typecheck/should_run/tcrun024.hs index 1edf5ebbe8..b8dc60dca7 100644 --- a/testsuite/tests/typecheck/should_run/tcrun024.hs +++ b/testsuite/tests/typecheck/should_run/tcrun024.hs @@ -4,40 +4,40 @@ module Main where - import Data.List( sort ) - - just = [Just "fred",Just "bill"] - - main = do { putStrLn (let ?p = "ok1" in fc1); - putStrLn (let ?p = "ok2" in fc2); - putStrLn (show (fd1 just)) ; - putStrLn (show (fd2 just)) } - - -- This class has no tyvars in its class op context - -- One uses a newtype, the other a data type - class C1 a where - fc1 :: (?p :: String) => a; - class C2 a where - fc2 :: (?p :: String) => a; - opc :: a - - instance C1 String where - fc1 = ?p; - instance C2 String where - fc2 = ?p; - opc = "x" - - -- This class constrains no new type variables in - -- its class op context - class D1 a where - fd1 :: (Ord a) => [a] -> [a] - class D2 a where - fd2 :: (Ord a) => [a] -> [a] - opd :: a - - instance D1 (Maybe a) where - fd1 xs = sort xs - instance D2 (Maybe a) where - fd2 xs = sort xs - opd = Nothing + import Data.List( sort ) + + just = [Just "fred",Just "bill"] + + main = do { putStrLn (let ?p = "ok1" in fc1); + putStrLn (let ?p = "ok2" in fc2); + putStrLn (show (fd1 just)) ; + putStrLn (show (fd2 just)) } + + -- This class has no tyvars in its class op context + -- One uses a newtype, the other a data type + class C1 a where + fc1 :: (?p :: String) => a; + class C2 a where + fc2 :: (?p :: String) => a; + opc :: a + + instance C1 String where + fc1 = ?p; + instance C2 String where + fc2 = ?p; + opc = "x" + + -- This class constrains no new type variables in + -- its class op context + class D1 a where + fd1 :: (Ord a) => [a] -> [a] + class D2 a where + fd2 :: (Ord a) => [a] -> [a] + opd :: a + + instance D1 (Maybe a) where + fd1 xs = sort xs + instance D2 (Maybe a) where + fd2 xs = sort xs + opd = Nothing diff --git a/testsuite/tests/typecheck/should_run/tcrun025.hs b/testsuite/tests/typecheck/should_run/tcrun025.hs index b7a565934e..2777cd7f75 100644 --- a/testsuite/tests/typecheck/should_run/tcrun025.hs +++ b/testsuite/tests/typecheck/should_run/tcrun025.hs @@ -3,13 +3,13 @@ -- Like tcrun024, but cross module module Main where - import TcRun025_B + import TcRun025_B - just = [Just "fred",Just "bill"] + just = [Just "fred",Just "bill"] - main = do { putStrLn (let ?p = "ok1" in fc1); - putStrLn (let ?p = "ok2" in fc2); - putStrLn (show (fd1 just)) ; - putStrLn (show (fd2 just)) } + main = do { putStrLn (let ?p = "ok1" in fc1); + putStrLn (let ?p = "ok2" in fc2); + putStrLn (show (fd1 just)) ; + putStrLn (show (fd2 just)) } diff --git a/testsuite/tests/typecheck/should_run/tcrun026.hs b/testsuite/tests/typecheck/should_run/tcrun026.hs index 7e52d3ce54..cac8fe850d 100644 --- a/testsuite/tests/typecheck/should_run/tcrun026.hs +++ b/testsuite/tests/typecheck/should_run/tcrun026.hs @@ -1,8 +1,8 @@ {-# LANGUAGE Rank2Types #-} -- Crashed GHC 5.04 with tcTyC --- panic: tcSplitTyConApp forall x{-r6S-} :: *. --- Main.L{-rr-} x{-r6S-} +-- panic: tcSplitTyConApp forall x{-r6S-} :: *. +-- Main.L{-rr-} x{-r6S-} -- GHC 6.3: this is now an error (can do subsumption in patterns) @@ -14,9 +14,9 @@ newtype L x = L [x] my_nil = FA (L []) :: FA L sample :: String -sample = case my_nil of FA (L x) -> "foo"++x +sample = case my_nil of FA (L x) -> "foo"++x -- -- but this works fine --- sample = case my_nil of FA x -> case x of L y -> "foo"++y +-- sample = case my_nil of FA x -> case x of L y -> "foo"++y main = print sample diff --git a/testsuite/tests/typecheck/should_run/tcrun029.hs b/testsuite/tests/typecheck/should_run/tcrun029.hs index 55071be483..e1d55051c5 100644 --- a/testsuite/tests/typecheck/should_run/tcrun029.hs +++ b/testsuite/tests/typecheck/should_run/tcrun029.hs @@ -7,23 +7,23 @@ module Main where -data Color = Red - | Black - deriving Show +data Color = Red + | Black + deriving Show -data Ord k => Tree k d = None - | Node{color::Color, - key::k, - item::d, - left::(Tree k d), - right::(Tree k d)} - deriving Show +data Ord k => Tree k d = None + | Node{color::Color, + key::k, + item::d, + left::(Tree k d), + right::(Tree k d)} + deriving Show insert k i t = (insert2 t) {color=Black} where insert2 None = Node{color=Red, - key=k, - item=i, - left=None, - right=None} + key=k, + item=i, + left=None, + right=None} -main = print (insert 1 2 None)
\ No newline at end of file +main = print (insert 1 2 None) diff --git a/testsuite/tests/typecheck/should_run/tcrun031.hs b/testsuite/tests/typecheck/should_run/tcrun031.hs index fbffe97c0e..fc7c46ea19 100644 --- a/testsuite/tests/typecheck/should_run/tcrun031.hs +++ b/testsuite/tests/typecheck/should_run/tcrun031.hs @@ -13,4 +13,4 @@ instance C [a] Char where newtype T = T Char deriving( Show, C [a] ) main = do { print (op [] 'x') - ; print (op [] (T 'y')) } + ; print (op [] (T 'y')) } diff --git a/testsuite/tests/typecheck/should_run/tcrun037.hs b/testsuite/tests/typecheck/should_run/tcrun037.hs index ee1acba354..b45e2945ee 100644 --- a/testsuite/tests/typecheck/should_run/tcrun037.hs +++ b/testsuite/tests/typecheck/should_run/tcrun037.hs @@ -4,10 +4,10 @@ module Main where class C a where op :: (Show a, Show b) => a -> b -> String - -- This class op has local quantification, but - -- also adds a constraint on 'a' + -- This class op has local quantification, but + -- also adds a constraint on 'a' instance C Bool where op x y = show x ++ " " ++ show y -main = do { putStrLn (op True 'x'); putStrLn (op False (3::Int)) } +main = do { putStrLn (op True 'x'); putStrLn (op False (3::Int)) } |