diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2016-11-08 21:37:48 +0200 |
|---|---|---|
| committer | Alan Zimmerman <alan.zimm@gmail.com> | 2016-12-07 21:31:13 +0200 |
| commit | 499e43824bda967546ebf95ee33ec1f84a114a7c (patch) | |
| tree | 58b313d734cfba014395ea5876db48e8400296a8 /testsuite | |
| parent | 83d69dca896c7df1f2a36268d5b45c9283985ebf (diff) | |
| download | haskell-499e43824bda967546ebf95ee33ec1f84a114a7c.tar.gz | |
Add HsSyn prettyprinter tests
Summary:
Add prettyprinter tests, which take a file, parse it, pretty print it,
re-parse the pretty printed version and then compare the original and
new ASTs (ignoring locations)
Updates haddock submodule to match the AST changes.
There are three issues outstanding
1. Extra parens around a context are not reproduced. This will require an
AST change and will be done in a separate patch.
2. Currently if an `HsTickPragma` is found, this is not pretty-printed,
to prevent noise in the output.
I am not sure what the desired behaviour in this case is, so have left
it as before. Test Ppr047 is marked as expected fail for this.
3. Apart from in a context, the ParsedSource AST keeps all the parens from
the original source. Something is happening in the renamer to remove the
parens around visible type application, causing T12530 to fail, as the
dumped splice decl is after the renamer.
This needs to be fixed by keeping the parens, but I do not know where they
are being removed. I have amended the test to pass, by removing the parens
in the expected output.
Test Plan: ./validate
Reviewers: goldfire, mpickering, simonpj, bgamari, austin
Reviewed By: simonpj, bgamari
Subscribers: simonpj, goldfire, thomie, mpickering
Differential Revision: https://phabricator.haskell.org/D2752
GHC Trac Issues: #3384
Diffstat (limited to 'testsuite')
192 files changed, 4211 insertions, 627 deletions
diff --git a/testsuite/mk/boilerplate.mk b/testsuite/mk/boilerplate.mk index 93b4f01f40..0b684c7195 100644 --- a/testsuite/mk/boilerplate.mk +++ b/testsuite/mk/boilerplate.mk @@ -220,6 +220,7 @@ RM = rm -f PYTHON = python3 CHECK_API_ANNOTATIONS := $(abspath $(TOP)/../inplace/bin/check-api-annotations) +CHECK_PPR := $(abspath $(TOP)/../inplace/bin/check-ppr) # ----------------------------------------------------------------------------- # configuration of TEST_HC diff --git a/testsuite/tests/ado/ado002.stderr b/testsuite/tests/ado/ado002.stderr index fe730f6c91..c2fb6b63b1 100644 --- a/testsuite/tests/ado/ado002.stderr +++ b/testsuite/tests/ado/ado002.stderr @@ -6,9 +6,9 @@ ado002.hs:8:8: error: but its type ‘IO Char’ has none In a stmt of a 'do' block: y <- getChar 'a' In the expression: - do { x <- getChar; - y <- getChar 'a'; - print (x, y) } + do x <- getChar + y <- getChar 'a' + print (x, y) ado002.hs:9:3: error: • Couldn't match type ‘()’ with ‘Int’ @@ -16,31 +16,31 @@ ado002.hs:9:3: error: Actual type: IO () • In a stmt of a 'do' block: print (x, y) In the expression: - do { x <- getChar; - y <- getChar 'a'; - print (x, y) } + do x <- getChar + y <- getChar 'a' + print (x, y) In an equation for ‘f’: - f = do { x <- getChar; - y <- getChar 'a'; - print (x, y) } + f = do x <- getChar + y <- getChar 'a' + print (x, y) ado002.hs:15:11: error: • Couldn't match expected type ‘Int’ with actual type ‘Char’ • In the expression: y In a stmt of a 'do' block: return (y, x) In the expression: - do { x <- getChar; - y <- getChar; - return (y, x) } + do x <- getChar + y <- getChar + return (y, x) ado002.hs:15:13: error: • Couldn't match expected type ‘Int’ with actual type ‘Char’ • In the expression: x In a stmt of a 'do' block: return (y, x) In the expression: - do { x <- getChar; - y <- getChar; - return (y, x) } + do x <- getChar + y <- getChar + return (y, x) ado002.hs:23:9: error: • Couldn't match expected type ‘Char -> IO t0’ @@ -49,33 +49,33 @@ ado002.hs:23:9: error: but its type ‘IO Char’ has none In a stmt of a 'do' block: x5 <- getChar x4 In the expression: - do { x1 <- getChar; - x2 <- getChar; - x3 <- const (return ()) x1; - x4 <- getChar; - x5 <- getChar x4; - return (x2, x4) } + do x1 <- getChar + x2 <- getChar + x3 <- const (return ()) x1 + x4 <- getChar + x5 <- getChar x4 + return (x2, x4) ado002.hs:24:11: error: • Couldn't match expected type ‘Int’ with actual type ‘Char’ • In the expression: x2 In a stmt of a 'do' block: return (x2, x4) In the expression: - do { x1 <- getChar; - x2 <- getChar; - x3 <- const (return ()) x1; - x4 <- getChar; - x5 <- getChar x4; - return (x2, x4) } + do x1 <- getChar + x2 <- getChar + x3 <- const (return ()) x1 + x4 <- getChar + x5 <- getChar x4 + return (x2, x4) ado002.hs:24:14: error: • Couldn't match expected type ‘Int’ with actual type ‘Char’ • In the expression: x4 In a stmt of a 'do' block: return (x2, x4) In the expression: - do { x1 <- getChar; - x2 <- getChar; - x3 <- const (return ()) x1; - x4 <- getChar; - x5 <- getChar x4; - return (x2, x4) } + do x1 <- getChar + x2 <- getChar + x3 <- const (return ()) x1 + x4 <- getChar + x5 <- getChar x4 + return (x2, x4) diff --git a/testsuite/tests/ado/ado003.stderr b/testsuite/tests/ado/ado003.stderr index 5d04f15896..cdc5c59d38 100644 --- a/testsuite/tests/ado/ado003.stderr +++ b/testsuite/tests/ado/ado003.stderr @@ -4,6 +4,6 @@ ado003.hs:7:3: error: In the pattern: 'a' In a stmt of a 'do' block: 'a' <- return (3 :: Int) In the expression: - do { x <- getChar; - 'a' <- return (3 :: Int); - return () } + do x <- getChar + 'a' <- return (3 :: Int) + return () diff --git a/testsuite/tests/ado/ado005.stderr b/testsuite/tests/ado/ado005.stderr index 4bfc79eca4..90d0b023bf 100644 --- a/testsuite/tests/ado/ado005.stderr +++ b/testsuite/tests/ado/ado005.stderr @@ -11,11 +11,11 @@ ado005.hs:8:3: error: test :: Applicative f => (Int -> f Int) -> f Int In a stmt of a 'do' block: x <- f 3 In the expression: - do { x <- f 3; - y <- f x; - return (x + y) } + do x <- f 3 + y <- f x + return (x + y) In an equation for ‘test’: test f - = do { x <- f 3; - y <- f x; - return (x + y) } + = do x <- f 3 + y <- f x + return (x + y) diff --git a/testsuite/tests/arrows/should_fail/arrowfail004.stderr b/testsuite/tests/arrows/should_fail/arrowfail004.stderr index 1386d14ce2..e479369554 100644 --- a/testsuite/tests/arrows/should_fail/arrowfail004.stderr +++ b/testsuite/tests/arrows/should_fail/arrowfail004.stderr @@ -2,6 +2,6 @@ arrowfail004.hs:12:15: Proc patterns cannot use existential or GADT data constructors In the pattern: T x - In the expression: proc (T x) -> do { returnA -< T x } + In the expression: proc (T x) -> do returnA -< T x In an equation for ‘panic’: - panic = proc (T x) -> do { returnA -< T x } + panic = proc (T x) -> do returnA -< T x diff --git a/testsuite/tests/boxy/Base1.stderr b/testsuite/tests/boxy/Base1.stderr index 053a3bc105..75a8e0cfe2 100644 --- a/testsuite/tests/boxy/Base1.stderr +++ b/testsuite/tests/boxy/Base1.stderr @@ -13,6 +13,6 @@ Base1.hs:25:39: error: • In the expression: Just (x, y) In a case alternative: MRight y -> Just (x, y) In the expression: - case m of { + case m of MRight y -> Just (x, y) - _ -> Nothing } + _ -> Nothing diff --git a/testsuite/tests/dependent/should_fail/PromotedClass.stderr b/testsuite/tests/dependent/should_fail/PromotedClass.stderr index 544124ed07..f0683309bc 100644 --- a/testsuite/tests/dependent/should_fail/PromotedClass.stderr +++ b/testsuite/tests/dependent/should_fail/PromotedClass.stderr @@ -1,6 +1,5 @@ PromotedClass.hs:10:15: error: • Illegal constraint in a type: Show a0 - • In the first argument of ‘Proxy’, namely ‘MkX True’ - In the type signature: - foo :: Proxy (MkX True) + • In the first argument of ‘Proxy’, namely ‘( 'MkX 'True)’ + In the type signature: foo :: Proxy ( 'MkX 'True) diff --git a/testsuite/tests/dependent/should_fail/RAE_T32a.stderr b/testsuite/tests/dependent/should_fail/RAE_T32a.stderr index 1a54c7d53b..cb94dd2854 100644 --- a/testsuite/tests/dependent/should_fail/RAE_T32a.stderr +++ b/testsuite/tests/dependent/should_fail/RAE_T32a.stderr @@ -15,5 +15,5 @@ RAE_T32a.hs:28:20: error: RAE_T32a.hs:28:27: error: Expected kind ‘Sigma’, but ‘Sigma p r’ has kind ‘*’ - In the second argument of ‘Sing’, namely ‘Sigma p r’ + In the second argument of ‘Sing’, namely ‘(Sigma p r)’ In the data instance declaration for ‘Sing’ diff --git a/testsuite/tests/dependent/should_fail/T11334b.stderr b/testsuite/tests/dependent/should_fail/T11334b.stderr index 8f4251b0cd..effdf20828 100644 --- a/testsuite/tests/dependent/should_fail/T11334b.stderr +++ b/testsuite/tests/dependent/should_fail/T11334b.stderr @@ -3,22 +3,22 @@ T11334b.hs:8:14: error: • Cannot default kind variable ‘f0’ of kind: k0 -> * Perhaps enable PolyKinds or add a kind signature - • In an expression type signature: Proxy Compose - In the expression: Proxy :: Proxy Compose - In an equation for ‘p’: p = Proxy :: Proxy Compose + • In an expression type signature: Proxy 'Compose + In the expression: Proxy :: Proxy 'Compose + In an equation for ‘p’: p = Proxy :: Proxy 'Compose T11334b.hs:8:14: error: • Cannot default kind variable ‘g0’ of kind: k10 -> k0 Perhaps enable PolyKinds or add a kind signature - • In an expression type signature: Proxy Compose - In the expression: Proxy :: Proxy Compose - In an equation for ‘p’: p = Proxy :: Proxy Compose + • In an expression type signature: Proxy 'Compose + In the expression: Proxy :: Proxy 'Compose + In an equation for ‘p’: p = Proxy :: Proxy 'Compose T11334b.hs:8:14: error: • Cannot default kind variable ‘a0’ of kind: k10 Perhaps enable PolyKinds or add a kind signature - • In an expression type signature: Proxy Compose - In the expression: Proxy :: Proxy Compose - In an equation for ‘p’: p = Proxy :: Proxy Compose + • In an expression type signature: Proxy 'Compose + In the expression: Proxy :: Proxy 'Compose + In an equation for ‘p’: p = Proxy :: Proxy 'Compose diff --git a/testsuite/tests/ffi/should_fail/T10461.stderr b/testsuite/tests/ffi/should_fail/T10461.stderr index fae0f50b14..3421467715 100644 --- a/testsuite/tests/ffi/should_fail/T10461.stderr +++ b/testsuite/tests/ffi/should_fail/T10461.stderr @@ -4,4 +4,4 @@ T10461.hs:6:1: error: ‘Word#’ cannot be marshalled in a foreign call To marshal unlifted types, use UnliftedFFITypes When checking declaration: - foreign import prim safe "static cheneycopy" cheneycopy :: Any -> Word# + foreign import prim safe cheneycopy :: Any -> Word# diff --git a/testsuite/tests/ffi/should_fail/T3066.stderr b/testsuite/tests/ffi/should_fail/T3066.stderr index e6d292d4ec..3b6c3f9b47 100644 --- a/testsuite/tests/ffi/should_fail/T3066.stderr +++ b/testsuite/tests/ffi/should_fail/T3066.stderr @@ -3,5 +3,4 @@ T3066.hs:6:1: Unacceptable argument type in foreign declaration: ‘forall u. Ptr ()’ is not a data type When checking declaration: - foreign import ccall safe "static bla" bla - :: (forall u. X u) -> IO () + foreign import ccall safe bla :: (forall u. X u) -> IO () diff --git a/testsuite/tests/ffi/should_fail/T7506.stderr b/testsuite/tests/ffi/should_fail/T7506.stderr index dd893df155..9a1aa25a8e 100644 --- a/testsuite/tests/ffi/should_fail/T7506.stderr +++ b/testsuite/tests/ffi/should_fail/T7506.stderr @@ -4,5 +4,5 @@ T7506.hs:6:1: ‘Int -> IO ()’ cannot be marshalled in a foreign call A foreign-imported address (via &foo) must have type (Ptr a) or (FunPtr a) When checking declaration: - foreign import ccall safe "static stdio.h &putchar" c_putchar + foreign import ccall safe "stdio.h &putchar" c_putchar :: Int -> IO () diff --git a/testsuite/tests/ffi/should_fail/capi_value_function.stderr b/testsuite/tests/ffi/should_fail/capi_value_function.stderr index 99ffad6ab8..6732c5c2da 100644 --- a/testsuite/tests/ffi/should_fail/capi_value_function.stderr +++ b/testsuite/tests/ffi/should_fail/capi_value_function.stderr @@ -2,5 +2,4 @@ capi_value_function.hs:8:1: `value' imports cannot have function types When checking declaration: - foreign import capi safe "static math.h value sqrt" f - :: CInt -> CInt + foreign import capi safe "math.h value sqrt" f :: CInt -> CInt diff --git a/testsuite/tests/ffi/should_fail/ccfail001.stderr b/testsuite/tests/ffi/should_fail/ccfail001.stderr index e890041b02..01c7ea5d15 100644 --- a/testsuite/tests/ffi/should_fail/ccfail001.stderr +++ b/testsuite/tests/ffi/should_fail/ccfail001.stderr @@ -3,5 +3,4 @@ ccfail001.hs:10:1: Unacceptable result type in foreign declaration: ‘State# RealWorld’ cannot be marshalled in a foreign call When checking declaration: - foreign import ccall safe "static foo" foo - :: Int -> State# RealWorld + foreign import ccall safe foo :: Int -> State# RealWorld diff --git a/testsuite/tests/ffi/should_fail/ccfail002.stderr b/testsuite/tests/ffi/should_fail/ccfail002.stderr index 309fa521d2..c3c04e25d5 100644 --- a/testsuite/tests/ffi/should_fail/ccfail002.stderr +++ b/testsuite/tests/ffi/should_fail/ccfail002.stderr @@ -3,5 +3,5 @@ ccfail002.hs:10:1: Unacceptable result type in foreign declaration: ‘(# Int#, Int#, Int# #)’ cannot be marshalled in a foreign call When checking declaration: - foreign import ccall unsafe "static foo" foo + foreign import ccall unsafe "foo" foo :: Int# -> Int# -> Int# -> (# Int#, Int#, Int# #) diff --git a/testsuite/tests/ffi/should_fail/ccfail004.stderr b/testsuite/tests/ffi/should_fail/ccfail004.stderr index 825c47ca1e..60aaf30188 100644 --- a/testsuite/tests/ffi/should_fail/ccfail004.stderr +++ b/testsuite/tests/ffi/should_fail/ccfail004.stderr @@ -5,7 +5,7 @@ ccfail004.hs:9:1: because its data constructor is not in scope Possible fix: import the data constructor to bring it into scope When checking declaration: - foreign import ccall safe "static f1" f1 :: NInt -> IO Int + foreign import ccall safe f1 :: NInt -> IO Int ccfail004.hs:10:1: Unacceptable result type in foreign declaration: @@ -13,7 +13,7 @@ ccfail004.hs:10:1: because its data constructor is not in scope Possible fix: import the data constructor to bring it into scope When checking declaration: - foreign import ccall safe "static f2" f2 :: Int -> IO NInt + foreign import ccall safe f2 :: Int -> IO NInt ccfail004.hs:11:1: Unacceptable result type in foreign declaration: @@ -21,16 +21,16 @@ ccfail004.hs:11:1: because the data constructor for ‘NIO’ is not in scope Possible fix: import the data constructor to bring it into scope When checking declaration: - foreign import ccall safe "static f3" f3 :: Int -> NIO Int + foreign import ccall safe f3 :: Int -> NIO Int ccfail004.hs:14:1: Unacceptable argument type in foreign declaration: ‘[NT]’ cannot be marshalled in a foreign call When checking declaration: - foreign import ccall safe "static f4" f4 :: NT -> IO () + foreign import ccall safe f4 :: NT -> IO () ccfail004.hs:15:1: Unacceptable result type in foreign declaration: ‘[NT]’ cannot be marshalled in a foreign call When checking declaration: - foreign import ccall safe "static f5" f5 :: IO NT + foreign import ccall safe f5 :: IO NT diff --git a/testsuite/tests/ffi/should_fail/ccfail005.stderr b/testsuite/tests/ffi/should_fail/ccfail005.stderr index 413faa702c..d5e2a27901 100644 --- a/testsuite/tests/ffi/should_fail/ccfail005.stderr +++ b/testsuite/tests/ffi/should_fail/ccfail005.stderr @@ -2,11 +2,9 @@ ccfail005.hs:14:1: Unacceptable argument type in foreign declaration: ‘D’ cannot be marshalled in a foreign call - When checking declaration: - foreign import ccall safe "static f1" f1 :: F Bool + When checking declaration: foreign import ccall safe f1 :: F Bool ccfail005.hs:15:1: Unacceptable result type in foreign declaration: ‘D’ cannot be marshalled in a foreign call - When checking declaration: - foreign import ccall safe "static f2" f2 :: F Char + When checking declaration: foreign import ccall safe f2 :: F Char diff --git a/testsuite/tests/generics/GenDerivOutput.stderr b/testsuite/tests/generics/GenDerivOutput.stderr index 65dcadba85..3e1f175178 100644 --- a/testsuite/tests/generics/GenDerivOutput.stderr +++ b/testsuite/tests/generics/GenDerivOutput.stderr @@ -4,7 +4,7 @@ Derived class instances: instance GHC.Generics.Generic (GenDerivOutput.List a) where GHC.Generics.from x = GHC.Generics.M1 - (case x of { + (case x of GenDerivOutput.Nil -> GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) GenDerivOutput.Cons g1 g2 @@ -12,19 +12,19 @@ Derived class instances: (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) - (GHC.Generics.M1 (GHC.Generics.K1 g2)))) }) + (GHC.Generics.M1 (GHC.Generics.K1 g2))))) GHC.Generics.to (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1)) -> GenDerivOutput.Nil - GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) - (GHC.Generics.M1 (GHC.Generics.K1 g2)))) - -> GenDerivOutput.Cons g1 g2 } + (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) + (GHC.Generics.M1 (GHC.Generics.K1 g2))))) + -> GenDerivOutput.Cons g1 g2 instance GHC.Generics.Generic1 GenDerivOutput.List where GHC.Generics.from1 x = GHC.Generics.M1 - (case x of { + (case x of GenDerivOutput.Nil -> GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) GenDerivOutput.Cons g1 g2 @@ -32,15 +32,15 @@ Derived class instances: (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.Par1 g1)) - (GHC.Generics.M1 (GHC.Generics.Rec1 g2)))) }) + (GHC.Generics.M1 (GHC.Generics.Rec1 g2))))) GHC.Generics.to1 (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1)) -> GenDerivOutput.Nil - GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) - (GHC.Generics.M1 g2))) + (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) + (GHC.Generics.M1 g2)))) -> GenDerivOutput.Cons - (GHC.Generics.unPar1 g1) (GHC.Generics.unRec1 g2) } + (GHC.Generics.unPar1 g1) (GHC.Generics.unRec1 g2) instance GHC.Base.Functor GenDerivOutput.List where GHC.Base.fmap f GenDerivOutput.Nil = GenDerivOutput.Nil @@ -50,7 +50,7 @@ Derived class instances: instance GHC.Generics.Generic (GenDerivOutput.Rose a) where GHC.Generics.from x = GHC.Generics.M1 - (case x of { + (case x of GenDerivOutput.Empty -> GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) GenDerivOutput.Rose g1 g2 @@ -58,19 +58,19 @@ Derived class instances: (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) - (GHC.Generics.M1 (GHC.Generics.K1 g2)))) }) + (GHC.Generics.M1 (GHC.Generics.K1 g2))))) GHC.Generics.to (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1)) -> GenDerivOutput.Empty - GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) - (GHC.Generics.M1 (GHC.Generics.K1 g2)))) - -> GenDerivOutput.Rose g1 g2 } + (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) + (GHC.Generics.M1 (GHC.Generics.K1 g2))))) + -> GenDerivOutput.Rose g1 g2 instance GHC.Generics.Generic1 GenDerivOutput.Rose where GHC.Generics.from1 x = GHC.Generics.M1 - (case x of { + (case x of GenDerivOutput.Empty -> GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) GenDerivOutput.Rose g1 g2 @@ -80,17 +80,17 @@ Derived class instances: (GHC.Generics.M1 (GHC.Generics.Par1 g1)) (GHC.Generics.M1 ((GHC.Base..) - GHC.Generics.Comp1 (GHC.Base.fmap GHC.Generics.Rec1) g2)))) }) + GHC.Generics.Comp1 (GHC.Base.fmap GHC.Generics.Rec1) g2))))) GHC.Generics.to1 (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1)) -> GenDerivOutput.Empty - GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) - (GHC.Generics.M1 g2))) + (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) + (GHC.Generics.M1 g2)))) -> GenDerivOutput.Rose (GHC.Generics.unPar1 g1) ((GHC.Base..) - (GHC.Base.fmap GHC.Generics.unRec1) GHC.Generics.unComp1 g2) } + (GHC.Base.fmap GHC.Generics.unRec1) GHC.Generics.unComp1 g2) Derived type family instances: diff --git a/testsuite/tests/generics/GenDerivOutput1_0.stderr b/testsuite/tests/generics/GenDerivOutput1_0.stderr index 162fa0fa08..bf9cf1590c 100644 --- a/testsuite/tests/generics/GenDerivOutput1_0.stderr +++ b/testsuite/tests/generics/GenDerivOutput1_0.stderr @@ -4,7 +4,7 @@ Derived class instances: instance GHC.Generics.Generic1 GenDerivOutput1_0.List where GHC.Generics.from1 x = GHC.Generics.M1 - (case x of { + (case x of GenDerivOutput1_0.Nil -> GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) GenDerivOutput1_0.Cons g1 g2 @@ -12,15 +12,15 @@ Derived class instances: (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.Par1 g1)) - (GHC.Generics.M1 (GHC.Generics.Rec1 g2)))) }) + (GHC.Generics.M1 (GHC.Generics.Rec1 g2))))) GHC.Generics.to1 (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1)) -> GenDerivOutput1_0.Nil - GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) - (GHC.Generics.M1 g2))) + (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) + (GHC.Generics.M1 g2)))) -> GenDerivOutput1_0.Cons - (GHC.Generics.unPar1 g1) (GHC.Generics.unRec1 g2) } + (GHC.Generics.unPar1 g1) (GHC.Generics.unRec1 g2) Derived type family instances: diff --git a/testsuite/tests/generics/GenDerivOutput1_1.stderr b/testsuite/tests/generics/GenDerivOutput1_1.stderr index 31a9e4368a..5f4e7e241d 100644 --- a/testsuite/tests/generics/GenDerivOutput1_1.stderr +++ b/testsuite/tests/generics/GenDerivOutput1_1.stderr @@ -4,7 +4,7 @@ Derived class instances: instance GHC.Generics.Generic1 CanDoRep1_1.Dd where GHC.Generics.from1 x = GHC.Generics.M1 - (case x of { + (case x of CanDoRep1_1.D0d -> GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) CanDoRep1_1.D1d g1 g2 @@ -12,20 +12,20 @@ Derived class instances: (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.Par1 g1)) - (GHC.Generics.M1 (GHC.Generics.Rec1 g2)))) }) + (GHC.Generics.M1 (GHC.Generics.Rec1 g2))))) GHC.Generics.to1 (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1)) -> CanDoRep1_1.D0d - GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) - (GHC.Generics.M1 g2))) + (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) + (GHC.Generics.M1 g2)))) -> CanDoRep1_1.D1d - (GHC.Generics.unPar1 g1) (GHC.Generics.unRec1 g2) } + (GHC.Generics.unPar1 g1) (GHC.Generics.unRec1 g2) instance GHC.Generics.Generic (CanDoRep1_1.Dd a) where GHC.Generics.from x = GHC.Generics.M1 - (case x of { + (case x of CanDoRep1_1.D0d -> GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) CanDoRep1_1.D1d g1 g2 @@ -33,19 +33,19 @@ Derived class instances: (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) - (GHC.Generics.M1 (GHC.Generics.K1 g2)))) }) + (GHC.Generics.M1 (GHC.Generics.K1 g2))))) GHC.Generics.to (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1)) -> CanDoRep1_1.D0d - GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) - (GHC.Generics.M1 (GHC.Generics.K1 g2)))) - -> CanDoRep1_1.D1d g1 g2 } + (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) + (GHC.Generics.M1 (GHC.Generics.K1 g2))))) + -> CanDoRep1_1.D1d g1 g2 instance GHC.Generics.Generic (CanDoRep1_1.Dc a) where GHC.Generics.from x = GHC.Generics.M1 - (case x of { + (case x of CanDoRep1_1.D0c -> GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) CanDoRep1_1.D1c g1 g2 @@ -53,19 +53,19 @@ Derived class instances: (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) - (GHC.Generics.M1 (GHC.Generics.K1 g2)))) }) + (GHC.Generics.M1 (GHC.Generics.K1 g2))))) GHC.Generics.to (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1)) -> CanDoRep1_1.D0c - GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) - (GHC.Generics.M1 (GHC.Generics.K1 g2)))) - -> CanDoRep1_1.D1c g1 g2 } + (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) + (GHC.Generics.M1 (GHC.Generics.K1 g2))))) + -> CanDoRep1_1.D1c g1 g2 instance GHC.Generics.Generic1 CanDoRep1_1.Db where GHC.Generics.from1 x = GHC.Generics.M1 - (case x of { + (case x of CanDoRep1_1.D0b -> GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) CanDoRep1_1.D1b g1 g2 @@ -73,57 +73,58 @@ Derived class instances: (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.Par1 g1)) - (GHC.Generics.M1 (GHC.Generics.Rec1 g2)))) }) + (GHC.Generics.M1 (GHC.Generics.Rec1 g2))))) GHC.Generics.to1 (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1)) -> CanDoRep1_1.D0b - GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) - (GHC.Generics.M1 g2))) + (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) + (GHC.Generics.M1 g2)))) -> CanDoRep1_1.D1b - (GHC.Generics.unPar1 g1) (GHC.Generics.unRec1 g2) } + (GHC.Generics.unPar1 g1) (GHC.Generics.unRec1 g2) instance GHC.Generics.Generic (CanDoRep1_1.Da a) where GHC.Generics.from x = GHC.Generics.M1 - (case x of { + (case x of CanDoRep1_1.D0 -> GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) CanDoRep1_1.D1 g1 g2 -> GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) - (GHC.Generics.M1 (GHC.Generics.K1 g2)))) }) + (GHC.Generics.M1 (GHC.Generics.K1 g2))))) GHC.Generics.to (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) -> CanDoRep1_1.D0 - GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) - (GHC.Generics.M1 (GHC.Generics.K1 g2)))) - -> CanDoRep1_1.D1 g1 g2 } + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1)) + -> CanDoRep1_1.D0 + (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) + (GHC.Generics.M1 (GHC.Generics.K1 g2))))) + -> CanDoRep1_1.D1 g1 g2 instance GHC.Generics.Generic1 CanDoRep1_1.Da where GHC.Generics.from1 x = GHC.Generics.M1 - (case x of { + (case x of CanDoRep1_1.D0 -> GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) CanDoRep1_1.D1 g1 g2 -> GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.Par1 g1)) - (GHC.Generics.M1 (GHC.Generics.Rec1 g2)))) }) + (GHC.Generics.M1 (GHC.Generics.Rec1 g2))))) GHC.Generics.to1 (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) -> CanDoRep1_1.D0 - GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) - (GHC.Generics.M1 g2))) - -> CanDoRep1_1.D1 - (GHC.Generics.unPar1 g1) (GHC.Generics.unRec1 g2) } + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1)) + -> CanDoRep1_1.D0 + (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) + (GHC.Generics.M1 g2)))) + -> CanDoRep1_1.D1 (GHC.Generics.unPar1 g1) (GHC.Generics.unRec1 g2) instance GHC.Generics.Generic (CanDoRep1_1.Db a) where GHC.Generics.from x = GHC.Generics.M1 - (case x of { + (case x of CanDoRep1_1.D0b -> GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) CanDoRep1_1.D1b g1 g2 @@ -131,19 +132,19 @@ Derived class instances: (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) - (GHC.Generics.M1 (GHC.Generics.K1 g2)))) }) + (GHC.Generics.M1 (GHC.Generics.K1 g2))))) GHC.Generics.to (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1)) -> CanDoRep1_1.D0b - GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) - (GHC.Generics.M1 (GHC.Generics.K1 g2)))) - -> CanDoRep1_1.D1b g1 g2 } + (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) + (GHC.Generics.M1 (GHC.Generics.K1 g2))))) + -> CanDoRep1_1.D1b g1 g2 instance GHC.Generics.Generic1 CanDoRep1_1.Dc where GHC.Generics.from1 x = GHC.Generics.M1 - (case x of { + (case x of CanDoRep1_1.D0c -> GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) CanDoRep1_1.D1c g1 g2 @@ -151,15 +152,15 @@ Derived class instances: (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.Par1 g1)) - (GHC.Generics.M1 (GHC.Generics.Rec1 g2)))) }) + (GHC.Generics.M1 (GHC.Generics.Rec1 g2))))) GHC.Generics.to1 (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1) + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 GHC.Generics.U1)) -> CanDoRep1_1.D0c - GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) - (GHC.Generics.M1 g2))) + (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) + (GHC.Generics.M1 g2)))) -> CanDoRep1_1.D1c - (GHC.Generics.unPar1 g1) (GHC.Generics.unRec1 g2) } + (GHC.Generics.unPar1 g1) (GHC.Generics.unRec1 g2) Derived type family instances: diff --git a/testsuite/tests/generics/T10604/T10604_deriving.stderr b/testsuite/tests/generics/T10604/T10604_deriving.stderr index 9576346899..d90c2733b1 100644 --- a/testsuite/tests/generics/T10604/T10604_deriving.stderr +++ b/testsuite/tests/generics/T10604/T10604_deriving.stderr @@ -33,7 +33,7 @@ Derived class instances: T10604_deriving.Proxy -> GHC.Generics.M1 GHC.Generics.U1 }) GHC.Generics.to (GHC.Generics.M1 x) = case x of { - GHC.Generics.M1 GHC.Generics.U1 -> T10604_deriving.Proxy } + (GHC.Generics.M1 GHC.Generics.U1) -> T10604_deriving.Proxy } instance GHC.Generics.Generic1 k (T10604_deriving.Proxy k) where GHC.Generics.from1 x @@ -42,7 +42,7 @@ Derived class instances: T10604_deriving.Proxy -> GHC.Generics.M1 GHC.Generics.U1 }) GHC.Generics.to1 (GHC.Generics.M1 x) = case x of { - GHC.Generics.M1 GHC.Generics.U1 -> T10604_deriving.Proxy } + (GHC.Generics.M1 GHC.Generics.U1) -> T10604_deriving.Proxy } instance GHC.Generics.Generic (T10604_deriving.Wrap a) where GHC.Generics.from x @@ -52,7 +52,7 @@ Derived class instances: -> GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1)) }) GHC.Generics.to (GHC.Generics.M1 x) = case x of { - GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1)) + (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1))) -> T10604_deriving.Wrap g1 } instance GHC.Generics.Generic1 @@ -64,7 +64,7 @@ Derived class instances: -> GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.Rec1 g1)) }) GHC.Generics.to1 (GHC.Generics.M1 x) = case x of { - GHC.Generics.M1 (GHC.Generics.M1 g1) + (GHC.Generics.M1 (GHC.Generics.M1 g1)) -> T10604_deriving.Wrap (GHC.Generics.unRec1 g1) } instance forall k (a :: k -> GHC.Types.*). @@ -76,7 +76,7 @@ Derived class instances: -> GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1)) }) GHC.Generics.to (GHC.Generics.M1 x) = case x of { - GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1)) + (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1))) -> T10604_deriving.Wrap2 g1 } instance GHC.Generics.Generic1 @@ -91,7 +91,7 @@ Derived class instances: GHC.Generics.Comp1 (GHC.Base.fmap GHC.Generics.Rec1) g1)) }) GHC.Generics.to1 (GHC.Generics.M1 x) = case x of { - GHC.Generics.M1 (GHC.Generics.M1 g1) + (GHC.Generics.M1 (GHC.Generics.M1 g1)) -> T10604_deriving.Wrap2 ((GHC.Base..) (GHC.Base.fmap GHC.Generics.unRec1) GHC.Generics.unComp1 g1) } @@ -100,7 +100,7 @@ Derived class instances: GHC.Generics.Generic (T10604_deriving.SumOfProducts k a) where GHC.Generics.from x = GHC.Generics.M1 - (case x of { + (case x of T10604_deriving.Prod1 g1 g2 -> GHC.Generics.L1 (GHC.Generics.M1 @@ -112,21 +112,21 @@ Derived class instances: (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) - (GHC.Generics.M1 (GHC.Generics.K1 g2)))) }) + (GHC.Generics.M1 (GHC.Generics.K1 g2))))) GHC.Generics.to (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) - (GHC.Generics.M1 (GHC.Generics.K1 g2)))) + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) + (GHC.Generics.M1 (GHC.Generics.K1 g2))))) -> T10604_deriving.Prod1 g1 g2 - GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) - (GHC.Generics.M1 (GHC.Generics.K1 g2)))) - -> T10604_deriving.Prod2 g1 g2 } + (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.K1 g1)) + (GHC.Generics.M1 (GHC.Generics.K1 g2))))) + -> T10604_deriving.Prod2 g1 g2 instance GHC.Generics.Generic1 k (T10604_deriving.SumOfProducts k) where GHC.Generics.from1 x = GHC.Generics.M1 - (case x of { + (case x of T10604_deriving.Prod1 g1 g2 -> GHC.Generics.L1 (GHC.Generics.M1 @@ -138,51 +138,51 @@ Derived class instances: (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 (GHC.Generics.Rec1 g1)) - (GHC.Generics.M1 (GHC.Generics.Rec1 g2)))) }) + (GHC.Generics.M1 (GHC.Generics.Rec1 g2))))) GHC.Generics.to1 (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) - (GHC.Generics.M1 g2))) + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) + (GHC.Generics.M1 g2)))) -> T10604_deriving.Prod1 (GHC.Generics.unRec1 g1) (GHC.Generics.unRec1 g2) - GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) - (GHC.Generics.M1 g2))) + (GHC.Generics.R1 (GHC.Generics.M1 ((GHC.Generics.:*:) (GHC.Generics.M1 g1) + (GHC.Generics.M1 g2)))) -> T10604_deriving.Prod2 - (GHC.Generics.unRec1 g1) (GHC.Generics.unRec1 g2) } + (GHC.Generics.unRec1 g1) (GHC.Generics.unRec1 g2) instance GHC.Generics.Generic (T10604_deriving.Starify a) where GHC.Generics.from x = GHC.Generics.M1 - (case x of { + (case x of T10604_deriving.Starify1 g1 -> GHC.Generics.L1 (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1))) T10604_deriving.Starify2 g1 -> GHC.Generics.R1 - (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1))) }) + (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1)))) GHC.Generics.to (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1))) + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1)))) -> T10604_deriving.Starify1 g1 - GHC.Generics.R1 (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1))) - -> T10604_deriving.Starify2 g1 } + (GHC.Generics.R1 (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1)))) + -> T10604_deriving.Starify2 g1 instance GHC.Generics.Generic1 * T10604_deriving.Starify where GHC.Generics.from1 x = GHC.Generics.M1 - (case x of { + (case x of T10604_deriving.Starify1 g1 -> GHC.Generics.L1 (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.Par1 g1))) T10604_deriving.Starify2 g1 -> GHC.Generics.R1 - (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1))) }) + (GHC.Generics.M1 (GHC.Generics.M1 (GHC.Generics.K1 g1)))) GHC.Generics.to1 (GHC.Generics.M1 x) - = case x of { - GHC.Generics.L1 (GHC.Generics.M1 (GHC.Generics.M1 g1)) + = case x of + (GHC.Generics.L1 (GHC.Generics.M1 (GHC.Generics.M1 g1))) -> T10604_deriving.Starify1 (GHC.Generics.unPar1 g1) - GHC.Generics.R1 (GHC.Generics.M1 (GHC.Generics.M1 g1)) - -> T10604_deriving.Starify2 (GHC.Generics.unK1 g1) } + (GHC.Generics.R1 (GHC.Generics.M1 (GHC.Generics.M1 g1))) + -> T10604_deriving.Starify2 (GHC.Generics.unK1 g1) Derived type family instances: diff --git a/testsuite/tests/ghc-api/annotations-literals/literals.stdout b/testsuite/tests/ghc-api/annotations-literals/literals.stdout index 077c570f2b..0e8ce7c9dc 100644 --- a/testsuite/tests/ghc-api/annotations-literals/literals.stdout +++ b/testsuite/tests/ghc-api/annotations-literals/literals.stdout @@ -24,7 +24,7 @@ (LiteralsTest.hs:5:3,ITequal,[=]), -(LiteralsTest.hs:5:5-8,ITinteger "0003" 3,[0003]), +(LiteralsTest.hs:5:5-8,ITinteger (SourceText "0003") 3,[0003]), (LiteralsTest.hs:6:1,ITsemi,[]), @@ -32,7 +32,7 @@ (LiteralsTest.hs:6:3,ITequal,[=]), -(LiteralsTest.hs:6:5-8,ITinteger "0x04" 4,[0x04]), +(LiteralsTest.hs:6:5-8,ITinteger (SourceText "0x04") 4,[0x04]), (LiteralsTest.hs:8:1,ITsemi,[]), @@ -48,7 +48,7 @@ (LiteralsTest.hs:9:3,ITequal,[=]), -(LiteralsTest.hs:9:5-10,ITstring "\"\\x20\"" " ",["\x20"]), +(LiteralsTest.hs:9:5-10,ITstring (SourceText "\"\\x20\"") " ",["\x20"]), (LiteralsTest.hs:11:1,ITsemi,[]), @@ -64,7 +64,7 @@ (LiteralsTest.hs:12:3,ITequal,[=]), -(LiteralsTest.hs:12:5-10,ITchar "'\\x20'" ' ',['\x20']), +(LiteralsTest.hs:12:5-10,ITchar (SourceText "'\\x20'") ' ',['\x20']), (LiteralsTest.hs:14:1,ITsemi,[]), @@ -98,7 +98,7 @@ (LiteralsTest.hs:19:11,ITequal,[=]), -(LiteralsTest.hs:19:13-19,ITprimchar "'\\x41'" 'A',['\x41'#]), +(LiteralsTest.hs:19:13-19,ITprimchar (SourceText "'\\x41'") 'A',['\x41'#]), (LiteralsTest.hs:20:5,ITsemi,[]), @@ -106,7 +106,7 @@ (LiteralsTest.hs:20:10,ITequal,[=]), -(LiteralsTest.hs:20:12-16,ITprimint "0004#" 4,[0004#]), +(LiteralsTest.hs:20:12-16,ITprimint (SourceText "0004#") 4,[0004#]), (LiteralsTest.hs:21:5,ITsemi,[]), @@ -114,7 +114,7 @@ (LiteralsTest.hs:21:11,ITequal,[=]), -(LiteralsTest.hs:21:13-17,ITprimword "005##" 5,[005##]), +(LiteralsTest.hs:21:13-17,ITprimword (SourceText "005##") 5,[005##]), (LiteralsTest.hs:22:5,ITsemi,[]), @@ -138,7 +138,7 @@ (LiteralsTest.hs:24:7,ITequal,[=]), -(LiteralsTest.hs:24:9,ITinteger "1" 1,[1]), +(LiteralsTest.hs:24:9,ITinteger (SourceText "1") 1,[1]), (LiteralsTest.hs:25:1,ITvccurly,[]), diff --git a/testsuite/tests/ghc-api/annotations-literals/parsed.hs b/testsuite/tests/ghc-api/annotations-literals/parsed.hs index 8664fdcf13..0170bc2949 100644 --- a/testsuite/tests/ghc-api/annotations-literals/parsed.hs +++ b/testsuite/tests/ghc-api/annotations-literals/parsed.hs @@ -3,7 +3,7 @@ -- argument. module Main where --- import Data.Generics +import BasicTypes import Data.Data import Data.List import System.IO @@ -42,21 +42,33 @@ testOneFile libdir fileName = do gq ast = everything (++) ([] `mkQ` doHsLit `extQ` doOverLit) ast doHsLit :: HsLit -> [String] - doHsLit (HsChar src c) = ["HsChar [" ++ src ++ "] " ++ show c] - doHsLit (HsCharPrim src c) = ["HsCharPrim [" ++ src ++ "] " ++ show c] - doHsLit (HsString src c) = ["HsString [" ++ src ++ "] " ++ show c] - doHsLit (HsStringPrim src c) = ["HsStringPrim [" ++ src ++ "] " ++ show c] - doHsLit (HsInt src c) = ["HsInt [" ++ src ++ "] " ++ show c] - doHsLit (HsIntPrim src c) = ["HsIntPrim [" ++ src ++ "] " ++ show c] - doHsLit (HsWordPrim src c) = ["HsWordPrim [" ++ src ++ "] " ++ show c] - doHsLit (HsInt64Prim src c) = ["HsInt64Prim [" ++ src ++ "] " ++ show c] - doHsLit (HsWord64Prim src c) = ["HsWord64Prim [" ++ src ++ "] " ++ show c] - doHsLit (HsInteger src c _) = ["HsInteger [" ++ src ++ "] " ++ show c] + doHsLit (HsChar (SourceText src) c) + = ["HsChar [" ++ src ++ "] " ++ show c] + doHsLit (HsCharPrim (SourceText src) c) + = ["HsCharPrim [" ++ src ++ "] " ++ show c] + doHsLit (HsString (SourceText src) c) + = ["HsString [" ++ src ++ "] " ++ show c] + doHsLit (HsStringPrim (SourceText src) c) + = ["HsStringPrim [" ++ src ++ "] " ++ show c] + doHsLit (HsInt (SourceText src) c) + = ["HsInt [" ++ src ++ "] " ++ show c] + doHsLit (HsIntPrim (SourceText src) c) + = ["HsIntPrim [" ++ src ++ "] " ++ show c] + doHsLit (HsWordPrim (SourceText src) c) + = ["HsWordPrim [" ++ src ++ "] " ++ show c] + doHsLit (HsInt64Prim (SourceText src) c) + = ["HsInt64Prim [" ++ src ++ "] " ++ show c] + doHsLit (HsWord64Prim (SourceText src) c) + = ["HsWord64Prim [" ++ src ++ "] " ++ show c] + doHsLit (HsInteger (SourceText src) c _) + = ["HsInteger [" ++ src ++ "] " ++ show c] doHsLit _ = [] doOverLit :: OverLitVal -> [String] - doOverLit (HsIntegral src c) = ["HsIntegral [" ++ src ++ "] " ++ show c] - doOverLit (HsIsString src c) = ["HsIsString [" ++ src ++ "] " ++ show c] + doOverLit (HsIntegral (SourceText src) c) + = ["HsIntegral [" ++ src ++ "] " ++ show c] + doOverLit (HsIsString (SourceText src) c) + = ["HsIsString [" ++ src ++ "] " ++ show c] doOverLit _ = [] pp a = showPpr unsafeGlobalDynFlags a diff --git a/testsuite/tests/ghc-api/annotations-literals/parsed.stdout b/testsuite/tests/ghc-api/annotations-literals/parsed.stdout index ce7a004929..7984181504 100644 --- a/testsuite/tests/ghc-api/annotations-literals/parsed.stdout +++ b/testsuite/tests/ghc-api/annotations-literals/parsed.stdout @@ -1,12 +1,12 @@ HsIntegral [0003] 3 -HsString [] "noExpr" +HsString [noExpr] "noExpr" HsIntegral [0x04] 4 -HsString [] "noExpr" +HsString [noExpr] "noExpr" HsString ["\x20"] " " HsChar ['\x20'] ' ' -HsString [] "noExpr" +HsString [noExpr] "noExpr" HsCharPrim ['\x41'] 'A' HsIntPrim [0004#] 4 HsWordPrim [005##] 5 HsIntegral [1] 1 -HsString [] "noExpr" +HsString [noExpr] "noExpr" diff --git a/testsuite/tests/ghc-api/annotations/T10276.stderr b/testsuite/tests/ghc-api/annotations/T10276.stderr index d79fc3a6e3..fff4c8ce4f 100644 --- a/testsuite/tests/ghc-api/annotations/T10276.stderr +++ b/testsuite/tests/ghc-api/annotations/T10276.stderr @@ -8,8 +8,7 @@ Test10276.hs:11:29: error: In the Template Haskell quotation [|| fst $ runState - ($$(qqExpM x)) - ((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||] + $$(qqExpM x) ((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||] Test10276.hs:11:46: error: Not in scope: type constructor or class ‘M.Map’ @@ -17,8 +16,7 @@ Test10276.hs:11:46: error: In the Template Haskell quotation [|| fst $ runState - ($$(qqExpM x)) - ((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||] + $$(qqExpM x) ((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||] Test10276.hs:11:52: error: Not in scope: type constructor or class ‘L.Name’ @@ -26,8 +24,7 @@ Test10276.hs:11:52: error: In the Template Haskell quotation [|| fst $ runState - ($$(qqExpM x)) - ((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||] + $$(qqExpM x) ((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||] Test10276.hs:11:60: error: Not in scope: type constructor or class ‘L.Operand’ @@ -35,8 +32,7 @@ Test10276.hs:11:60: error: In the Template Haskell quotation [|| fst $ runState - ($$(qqExpM x)) - ((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||] + $$(qqExpM x) ((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||] Test10276.hs:14:3: error: ‘qqExp’ is not a (visible) method of class ‘QQExp2’ @@ -47,8 +43,7 @@ Test10276.hs:15:29: error: In the Template Haskell quotation [|| fst $ runState - ($$(qqExpM x)) - ((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||] + $$(qqExpM x) ((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||] Test10276.hs:15:46: error: Not in scope: type constructor or class ‘M.Map’ @@ -56,8 +51,7 @@ Test10276.hs:15:46: error: In the Template Haskell quotation [|| fst $ runState - ($$(qqExpM x)) - ((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||] + $$(qqExpM x) ((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||] Test10276.hs:15:52: error: Not in scope: type constructor or class ‘L.Name’ @@ -65,8 +59,7 @@ Test10276.hs:15:52: error: In the Template Haskell quotation [|| fst $ runState - ($$(qqExpM x)) - ((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||] + $$(qqExpM x) ((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||] Test10276.hs:15:60: error: Not in scope: type constructor or class ‘L.Operand’ @@ -74,5 +67,4 @@ Test10276.hs:15:60: error: In the Template Haskell quotation [|| fst $ runState - ($$(qqExpM x)) - ((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||] + $$(qqExpM x) ((0, M.empty) :: (Int, M.Map L.Name [L.Operand])) ||] diff --git a/testsuite/tests/ghc-api/annotations/T10313.stdout b/testsuite/tests/ghc-api/annotations/T10313.stdout index a2680a9582..d1cc35cb61 100644 --- a/testsuite/tests/ghc-api/annotations/T10313.stdout +++ b/testsuite/tests/ghc-api/annotations/T10313.stdout @@ -1,27 +1,17 @@ -[([i], [([", b, \, x, 6, 1, s, e, "], base)]), +[([i], [(SourceText "b\x61se", base)]), ([w], - [([", N, e, w, , Z, 3, , A, P, I, , s, u, p, p, o, r, t, , i, - s, , s, t, i, l, l, , i, n, c, o, m, p, l, e, t, e, , a, n, d, - , f, r, a, g, i, l, e, :, , \, -, , , , , , , , , , , - \, y, o, u, , m, a, y, , e, x, p, e, r, i, e, n, c, e, , s, e, - g, m, e, n, t, a, t, i, o, n, , f, a, u, l, t, s, !, "], + [(SourceText "New Z3 API support is still incomplete and fragile: \ + \you may experience segmentation faults!", New Z3 API support is still incomplete and fragile: you may experience segmentation faults!)]), ([d], - [([", D, e, p, r, e, c, a, t, i, o, n, :, , \, -, , , , , , - , , , , , \, y, o, u, , m, a, y, , e, x, p, e, r, i, e, n, - c, e, , s, e, g, m, e, n, t, a, t, i, o, n, , f, a, u, l, t, s, - !, "], + [(SourceText "Deprecation: \ + \you may experience segmentation faults!", Deprecation: you may experience segmentation faults!)]), - ([c], - [([", f, o, o, \, x, 6, 3, "], fooc), - ([", b, \, x, 6, 1, r, "], bar)]), - ([r], [([", f, o, o, 1, \, x, 6, 7, "], foo1g)]), - ([s, t], [([", a, \, x, 6, 2, "], ab)]), + ([c], [(SourceText "foo\x63", fooc), (SourceText "b\x61r", bar)]), + ([r], [(SourceText "foo1\x67", foo1g)]), + ([s, t], [(SourceText "a\x62", ab)]), ([c, o], - [([", S, t, r, i, c, t, , B, i, t, s, t, r, e, a, m, , s, t, r, - e, \, x, 6, 1, m, "], + [(SourceText "Strict Bitstream stre\x61m", Strict Bitstream stream)]), - ([s, c], [([", f, o, o, \, x, 6, 4, "], food)]), - ([t, p], [([", f, o, o, b, \, x, 6, 1, r, "], foobar)])] + ([s, c], [(SourceText "foo\x64", food)]), + ([t, p], [(SourceText "foob\x61r", foobar)])] diff --git a/testsuite/tests/ghc-api/annotations/T11430.stdout b/testsuite/tests/ghc-api/annotations/T11430.stdout index 32d7ff1b24..157c29bb06 100644 --- a/testsuite/tests/ghc-api/annotations/T11430.stdout +++ b/testsuite/tests/ghc-api/annotations/T11430.stdout @@ -3,4 +3,4 @@ ("ia",["1"]) ("ia",["0x999"]) ("ia",["1"]) -("tp",["((\"0x1\",\"0x2\"),(\"0x3\",\"0x4\"))"]) +("tp",["((SourceText \"0x1\",SourceText \"0x2\"),(SourceText \"0x3\",SourceText \"0x4\"))"]) diff --git a/testsuite/tests/ghc-api/annotations/t11430.hs b/testsuite/tests/ghc-api/annotations/t11430.hs index 1f00d1d5d2..151efbe611 100644 --- a/testsuite/tests/ghc-api/annotations/t11430.hs +++ b/testsuite/tests/ghc-api/annotations/t11430.hs @@ -56,20 +56,24 @@ testOneFile libdir fileName = do ) ast doFixity :: Fixity -> [(String,[String])] - doFixity (Fixity ss _ _) = [("f",[ss])] + doFixity (Fixity (SourceText ss) _ _) = [("f",[ss])] doRuleDecl :: RuleDecl RdrName -> [(String,[String])] - doRuleDecl (HsRule _ (ActiveBefore ss _) _ _ _ _ _) = [("rb",[ss])] - doRuleDecl (HsRule _ (ActiveAfter ss _) _ _ _ _ _) = [("ra",[ss])] + doRuleDecl (HsRule _ (ActiveBefore (SourceText ss) _) _ _ _ _ _) + = [("rb",[ss])] + doRuleDecl (HsRule _ (ActiveAfter (SourceText ss) _) _ _ _ _ _) + = [("ra",[ss])] doRuleDecl (HsRule _ _ _ _ _ _ _) = [] doHsExpr :: HsExpr RdrName -> [(String,[String])] doHsExpr (HsTickPragma src (_,_,_) ss _) = [("tp",[show ss])] doHsExpr _ = [] - doInline (InlinePragma _ _ _ (ActiveBefore ss _) _) = [("ib",[ss])] - doInline (InlinePragma _ _ _ (ActiveAfter ss _) _) = [("ia",[ss])] + doInline (InlinePragma _ _ _ (ActiveBefore (SourceText ss) _) _) + = [("ib",[ss])] + doInline (InlinePragma _ _ _ (ActiveAfter (SourceText ss) _) _) + = [("ia",[ss])] doInline (InlinePragma _ _ _ _ _ ) = [] showAnns anns = "[\n" ++ (intercalate "\n" diff --git a/testsuite/tests/ghci/scripts/T8959b.stderr b/testsuite/tests/ghci/scripts/T8959b.stderr index d968f8ac56..28b48fdba8 100644 --- a/testsuite/tests/ghci/scripts/T8959b.stderr +++ b/testsuite/tests/ghci/scripts/T8959b.stderr @@ -6,8 +6,8 @@ T8959b.hs:5:7: error: T8959b.hs:8:7: error: • Couldn't match expected type ‘()’ with actual type ‘t0 → m0 t0’ - • In the expression: proc x -> do { return ⤙ x } - In an equation for ‘bar’: bar = proc x -> do { return ⤙ x } + • In the expression: proc x -> do return ⤙ x + In an equation for ‘bar’: bar = proc x -> do return ⤙ x T8959b.hs:10:7: error: • Couldn't match expected type ‘(∀ a2. a2 → a2) → a1’ diff --git a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr index c2994dc1a5..8f06390348 100644 --- a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr +++ b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr @@ -127,7 +127,7 @@ data R1 <document comment> f :: C a => a -> Int <document comment> -foreign import ccall safe "static header.h g" g :: Int -> IO CInt +foreign import ccall safe "header.h" g :: Int -> IO CInt <document comment> h :: Int h = 42 @@ -169,7 +169,7 @@ newn :: -> N1 () one of the arguments -> IO Int newn = undefined <document comment> -foreign import ccall unsafe "static header.h o" o +foreign import ccall unsafe "header.h" o :: Float The input float -> IO Float The output float <document comment> newp :: Int diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr index 684a6f072a..060dd06ad2 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr @@ -3,7 +3,7 @@ module T11768 where data Foo = Foo - deriving (Eq Documenting a single type) + deriving Eq Documenting a single type data Bar = Bar deriving (Eq Documenting one of multiple types, Ord) diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr index bd9ec257e7..47d2468ea5 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr @@ -1,7 +1,7 @@ ==================== Parser ==================== module ShouldCompile where -data (<-->) a b = Mk a b +data a <--> b = Mk a b test :: [a] doc1 -> a <--> b -> [a] blabla test xs ys = xs diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail14.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail14.stderr index 7079d8cc84..f18894df85 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail14.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail14.stderr @@ -1,6 +1,6 @@ SimpleFail14.hs:5:15: error: • Expected a type, but ‘a ~ a’ has kind ‘Constraint’ - • In the type ‘a ~ a’ + • In the type ‘(a ~ a)’ In the definition of data constructor ‘T’ In the data declaration for ‘T’ diff --git a/testsuite/tests/indexed-types/should_fail/T12867.stderr b/testsuite/tests/indexed-types/should_fail/T12867.stderr index e712c49c4f..40e566b3ec 100644 --- a/testsuite/tests/indexed-types/should_fail/T12867.stderr +++ b/testsuite/tests/indexed-types/should_fail/T12867.stderr @@ -2,8 +2,8 @@ T12867.hs:7:21: error: • Expecting one fewer arguments to ‘TestM’ Expected kind ‘k0 -> *’, but ‘TestM’ has kind ‘*’ - • In the first argument of ‘Eq’, namely ‘TestM a’ - In the type ‘Eq (TestM a)’ + • In the first argument of ‘Eq’, namely ‘(TestM a)’ + In the type ‘(Eq (TestM a))’ In the type declaration for ‘Test2’ T12867.hs:9:1: error: diff --git a/testsuite/tests/indexed-types/should_fail/T2664.stderr b/testsuite/tests/indexed-types/should_fail/T2664.stderr index eb06fa479b..1217196f8a 100644 --- a/testsuite/tests/indexed-types/should_fail/T2664.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2664.stderr @@ -14,16 +14,16 @@ T2664.hs:31:9: error: (O $ takeMVar v, E (pchoose Right v newPChan) (pchoose Left v newPChan)) In the expression: - do { v <- newEmptyMVar; - return - (O $ takeMVar v, - E (pchoose Right v newPChan) (pchoose Left v newPChan)) } + do v <- newEmptyMVar + return + (O $ takeMVar v, + E (pchoose Right v newPChan) (pchoose Left v newPChan)) In an equation for ‘newPChan’: newPChan - = do { v <- newEmptyMVar; - return - (O $ takeMVar v, - E (pchoose Right v newPChan) (pchoose Left v newPChan)) } + = do v <- newEmptyMVar + return + (O $ takeMVar v, + E (pchoose Right v newPChan) (pchoose Left v newPChan)) • Relevant bindings include v :: MVar (Either (PChan a) (PChan b)) (bound at T2664.hs:24:9) newPChan :: IO (PChan (a :*: b), PChan c) (bound at T2664.hs:23:5) diff --git a/testsuite/tests/indexed-types/should_fail/T2693.stderr b/testsuite/tests/indexed-types/should_fail/T2693.stderr index c0bd7329fd..f9485d1d42 100644 --- a/testsuite/tests/indexed-types/should_fail/T2693.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2693.stderr @@ -39,6 +39,6 @@ T2693.hs:29:20: error: • In the first argument of ‘mapM’, namely ‘g’ In a stmt of a 'do' block: pvs <- mapM g undefined In the expression: - do { pvs <- mapM g undefined; - let n = (map pvrX pvs) `min` (map pvrX pvs); - undefined } + do pvs <- mapM g undefined + let n = (map pvrX pvs) `min` (map pvrX pvs) + undefined diff --git a/testsuite/tests/indexed-types/should_fail/T5439.stderr b/testsuite/tests/indexed-types/should_fail/T5439.stderr index 9cc8912814..f712d47f0e 100644 --- a/testsuite/tests/indexed-types/should_fail/T5439.stderr +++ b/testsuite/tests/indexed-types/should_fail/T5439.stderr @@ -8,8 +8,8 @@ T5439.hs:82:33: error: In a stmt of a 'do' block: c <- complete ev $ inj $ Failure (e :: SomeException) In the expression: - do { c <- complete ev $ inj $ Failure (e :: SomeException); - return $ c || not first } + do c <- complete ev $ inj $ Failure (e :: SomeException) + return $ c || not first • Relevant bindings include register :: Bool -> Peano n -> WaitOps (HDrop n rs) -> IO Bool (bound at T5439.hs:64:9) diff --git a/testsuite/tests/indexed-types/should_fail/T7786.stderr b/testsuite/tests/indexed-types/should_fail/T7786.stderr index 8fdb49bd8e..89984ca6b0 100644 --- a/testsuite/tests/indexed-types/should_fail/T7786.stderr +++ b/testsuite/tests/indexed-types/should_fail/T7786.stderr @@ -7,12 +7,12 @@ T7786.hs:94:41: error: (Sing (Intersect (BuriedUnder sub k 'Empty) inv)) • In a stmt of a 'do' block: Nil :: Sing xxx <- foogle db k sub In the expression: - do { Nil :: Sing xxx <- foogle db k sub; - return $ Sub db k sub } + do Nil :: Sing xxx <- foogle db k sub + return $ Sub db k sub In an equation for ‘addSub’: addSub db k sub - = do { Nil :: Sing xxx <- foogle db k sub; - return $ Sub db k sub } + = do Nil :: Sing xxx <- foogle db k sub + return $ Sub db k sub • Relevant bindings include sub :: Database sub (bound at T7786.hs:94:13) k :: Sing k (bound at T7786.hs:94:11) @@ -36,8 +36,8 @@ T7786.hs:95:31: error: • In the second argument of ‘($)’, namely ‘Sub db k sub’ In a stmt of a 'do' block: return $ Sub db k sub In the expression: - do { Nil :: Sing xxx <- foogle db k sub; - return $ Sub db k sub } + do Nil :: Sing xxx <- foogle db k sub + return $ Sub db k sub • Relevant bindings include sub :: Database sub (bound at T7786.hs:94:13) k :: Sing k (bound at T7786.hs:94:11) diff --git a/testsuite/tests/monadfail/MonadFailErrors.stderr b/testsuite/tests/monadfail/MonadFailErrors.stderr index 84334b980b..1507984d14 100644 --- a/testsuite/tests/monadfail/MonadFailErrors.stderr +++ b/testsuite/tests/monadfail/MonadFailErrors.stderr @@ -13,12 +13,12 @@ MonadFailErrors.hs:16:5: error: general :: Monad m => m a • In a stmt of a 'do' block: Just x <- undefined In the expression: - do { Just x <- undefined; - undefined } + do Just x <- undefined + undefined In an equation for ‘general’: general - = do { Just x <- undefined; - undefined } + = do Just x <- undefined + undefined MonadFailErrors.hs:30:5: error: • No instance for (MonadFail Identity) @@ -26,12 +26,12 @@ MonadFailErrors.hs:30:5: error: with the failable pattern ‘Just x’ • In a stmt of a 'do' block: Just x <- undefined In the expression: - do { Just x <- undefined; - undefined } + do Just x <- undefined + undefined In an equation for ‘identity’: identity - = do { Just x <- undefined; - undefined } + = do Just x <- undefined + undefined MonadFailErrors.hs:44:5: error: • No instance for (MonadFail (ST s)) @@ -39,12 +39,12 @@ MonadFailErrors.hs:44:5: error: with the failable pattern ‘Just x’ • In a stmt of a 'do' block: Just x <- undefined In the expression: - do { Just x <- undefined; - undefined } + do Just x <- undefined + undefined In an equation for ‘st’: st - = do { Just x <- undefined; - undefined } + = do Just x <- undefined + undefined MonadFailErrors.hs:51:5: error: • No instance for (MonadFail ((->) r)) @@ -52,9 +52,9 @@ MonadFailErrors.hs:51:5: error: with the failable pattern ‘Just x’ • In a stmt of a 'do' block: Just x <- undefined In the expression: - do { Just x <- undefined; - undefined } + do Just x <- undefined + undefined In an equation for ‘reader’: reader - = do { Just x <- undefined; - undefined } + = do Just x <- undefined + undefined diff --git a/testsuite/tests/monadfail/MonadFailWarnings.stderr b/testsuite/tests/monadfail/MonadFailWarnings.stderr index 544f14aeb4..ac16d6cd9e 100644 --- a/testsuite/tests/monadfail/MonadFailWarnings.stderr +++ b/testsuite/tests/monadfail/MonadFailWarnings.stderr @@ -13,12 +13,12 @@ MonadFailWarnings.hs:19:5: warning: [-Wmissing-monadfail-instances (in -Wcompat) general :: Monad m => m a • In a stmt of a 'do' block: Just x <- undefined In the expression: - do { Just x <- undefined; - undefined } + do Just x <- undefined + undefined In an equation for ‘general’: general - = do { Just x <- undefined; - undefined } + = do Just x <- undefined + undefined MonadFailWarnings.hs:35:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] • No instance for (MonadFail Identity) @@ -26,12 +26,12 @@ MonadFailWarnings.hs:35:5: warning: [-Wmissing-monadfail-instances (in -Wcompat) (this will become an error in a future GHC release) • In a stmt of a 'do' block: Just x <- undefined In the expression: - do { Just x <- undefined; - undefined } + do Just x <- undefined + undefined In an equation for ‘identity’: identity - = do { Just x <- undefined; - undefined } + = do Just x <- undefined + undefined MonadFailWarnings.hs:51:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] • No instance for (MonadFail (ST s)) @@ -39,12 +39,12 @@ MonadFailWarnings.hs:51:5: warning: [-Wmissing-monadfail-instances (in -Wcompat) (this will become an error in a future GHC release) • In a stmt of a 'do' block: Just x <- undefined In the expression: - do { Just x <- undefined; - undefined } + do Just x <- undefined + undefined In an equation for ‘st’: st - = do { Just x <- undefined; - undefined } + = do Just x <- undefined + undefined MonadFailWarnings.hs:59:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] • No instance for (MonadFail ((->) r)) @@ -52,9 +52,9 @@ MonadFailWarnings.hs:59:5: warning: [-Wmissing-monadfail-instances (in -Wcompat) (this will become an error in a future GHC release) • In a stmt of a 'do' block: Just x <- undefined In the expression: - do { Just x <- undefined; - undefined } + do Just x <- undefined + undefined In an equation for ‘reader’: reader - = do { Just x <- undefined; - undefined } + = do Just x <- undefined + undefined diff --git a/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr b/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr index fc12b71b6b..ea974895e2 100644 --- a/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr +++ b/testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr @@ -3,7 +3,7 @@ SplicesUsed.hs:7:16: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘Maybe Bool’ - • In the type signature: maybeBool :: _ + • In the type signature: maybeBool :: (_) SplicesUsed.hs:8:15: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_a’ standing for ‘w’ @@ -37,21 +37,21 @@ SplicesUsed.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)] Where: ‘a’ is a rigid type variable bound by the inferred type of filter' :: (a -> Bool) -> [a] -> [a] at SplicesUsed.hs:14:1-16 - • In the type signature: filter' :: _ -> _ -> _ + • In the type signature: filter' :: (_ -> _ -> _) SplicesUsed.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘[a]’ Where: ‘a’ is a rigid type variable bound by the inferred type of filter' :: (a -> Bool) -> [a] -> [a] at SplicesUsed.hs:14:1-16 - • In the type signature: filter' :: _ -> _ -> _ + • In the type signature: filter' :: (_ -> _ -> _) SplicesUsed.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘[a]’ Where: ‘a’ is a rigid type variable bound by the inferred type of filter' :: (a -> Bool) -> [a] -> [a] at SplicesUsed.hs:14:1-16 - • In the type signature: filter' :: _ -> _ -> _ + • In the type signature: filter' :: (_ -> _ -> _) SplicesUsed.hs:16:3: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘Eq a’ diff --git a/testsuite/tests/partial-sigs/should_compile/T12845.stderr b/testsuite/tests/partial-sigs/should_compile/T12845.stderr index 0d19b1a6ed..b9d7d60a97 100644 --- a/testsuite/tests/partial-sigs/should_compile/T12845.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T12845.stderr @@ -3,5 +3,5 @@ T12845.hs:18:70: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘() :: Constraint’ • In the type signature: broken :: forall r r' rngs. - ('(r, r') ~ Head rngs, Bar r r' ~ True, _) => + ('(r, r') ~ Head rngs, Bar r r' ~ 'True, _) => Foo r -> Proxy rngs -> () diff --git a/testsuite/tests/polykinds/PolyKinds04.stderr b/testsuite/tests/polykinds/PolyKinds04.stderr index 8162dd247b..2a88291623 100644 --- a/testsuite/tests/polykinds/PolyKinds04.stderr +++ b/testsuite/tests/polykinds/PolyKinds04.stderr @@ -3,5 +3,5 @@ PolyKinds04.hs:5:16: Expecting one more argument to ‘Maybe’ Expected a type, but ‘Maybe’ has kind ‘* -> *’ In the first argument of ‘A’, namely ‘Maybe’ - In the type ‘A Maybe’ + In the type ‘(A Maybe)’ In the definition of data constructor ‘B1’ diff --git a/testsuite/tests/polykinds/PolyKinds07.stderr b/testsuite/tests/polykinds/PolyKinds07.stderr index 3a38a6777f..ce70e7d07a 100644 --- a/testsuite/tests/polykinds/PolyKinds07.stderr +++ b/testsuite/tests/polykinds/PolyKinds07.stderr @@ -2,6 +2,6 @@ PolyKinds07.hs:10:11: Data constructor ‘A1’ cannot be used here (it is defined and used in the same recursive group) - In the first argument of ‘B’, namely ‘A1’ - In the type ‘B A1’ + In the first argument of ‘B’, namely ‘ 'A1’ + In the type ‘B 'A1’ In the definition of data constructor ‘B1’ diff --git a/testsuite/tests/polykinds/T10503.stderr b/testsuite/tests/polykinds/T10503.stderr index 43cd62fd5f..ac8972dec6 100644 --- a/testsuite/tests/polykinds/T10503.stderr +++ b/testsuite/tests/polykinds/T10503.stderr @@ -13,4 +13,5 @@ T10503.hs:8:6: error: To defer the ambiguity check to use sites, enable AllowAmbiguousTypes In the type signature: h :: forall r. - (Proxy (KProxy :: KProxy k) ~ Proxy (KProxy :: KProxy *) => r) -> r + (Proxy ( 'KProxy :: KProxy k) ~ Proxy ( 'KProxy :: KProxy *) => r) + -> r diff --git a/testsuite/tests/polykinds/T11399.stderr b/testsuite/tests/polykinds/T11399.stderr index 48af87efc4..cd78c24792 100644 --- a/testsuite/tests/polykinds/T11399.stderr +++ b/testsuite/tests/polykinds/T11399.stderr @@ -5,5 +5,5 @@ T11399.hs:10:32: error: a :: * -> * TYPE :: GHC.Types.RuntimeRep -> * Expected kind ‘* -> *’, but ‘UhOh a’ has kind ‘a * -> *’ - • In the first argument of ‘Functor’, namely ‘UhOh a’ + • In the first argument of ‘Functor’, namely ‘(UhOh a)’ In the instance declaration for ‘Functor (UhOh a)’ diff --git a/testsuite/tests/polykinds/T11520.stderr b/testsuite/tests/polykinds/T11520.stderr index f598d85551..11a81baf62 100644 --- a/testsuite/tests/polykinds/T11520.stderr +++ b/testsuite/tests/polykinds/T11520.stderr @@ -2,5 +2,5 @@ T11520.hs:15:77: error: • Expected kind ‘k20 -> k10’, but ‘g’ has kind ‘k’ • In the second argument of ‘Compose’, namely ‘g’ - In the first argument of ‘Typeable’, namely ‘Compose f g’ + In the first argument of ‘Typeable’, namely ‘(Compose f g)’ In the instance declaration for ‘Typeable (Compose f g)’ diff --git a/testsuite/tests/polykinds/T11611.stderr b/testsuite/tests/polykinds/T11611.stderr index 15d4749393..6c723786b0 100644 --- a/testsuite/tests/polykinds/T11611.stderr +++ b/testsuite/tests/polykinds/T11611.stderr @@ -2,5 +2,5 @@ T11611.hs:8:37: error: • Expected kind ‘[*]’, but ‘a’ has kind ‘*’ • In the first argument of ‘A’, namely ‘a’ - In the first argument of ‘Show’, namely ‘A a’ + In the first argument of ‘Show’, namely ‘(A a)’ In the stand-alone deriving instance for ‘Show a => Show (A a)’ diff --git a/testsuite/tests/polykinds/T5716.stderr b/testsuite/tests/polykinds/T5716.stderr index 8bc8883daf..d85166b0bb 100644 --- a/testsuite/tests/polykinds/T5716.stderr +++ b/testsuite/tests/polykinds/T5716.stderr @@ -2,6 +2,6 @@ T5716.hs:13:33: error: Data constructor ‘U1’ cannot be used here (Perhaps you intended to use TypeInType) - In the first argument of ‘I’, namely ‘U1 DFInt’ + In the first argument of ‘I’, namely ‘(U1 DFInt)’ In the type ‘I (U1 DFInt)’ In the definition of data constructor ‘I1’ diff --git a/testsuite/tests/polykinds/T5716a.stderr b/testsuite/tests/polykinds/T5716a.stderr index 5cee2edc2e..acec5e146d 100644 --- a/testsuite/tests/polykinds/T5716a.stderr +++ b/testsuite/tests/polykinds/T5716a.stderr @@ -2,6 +2,6 @@ T5716a.hs:10:27: Data constructor ‘Bar’ cannot be used here (it comes from a data family instance) - In the type ‘Bar a’ + In the type ‘(Bar a)’ In the definition of data constructor ‘Bar’ In the data instance declaration for ‘DF’ diff --git a/testsuite/tests/polykinds/T6054.stderr b/testsuite/tests/polykinds/T6054.stderr index c8b39b06ad..800b5599ce 100644 --- a/testsuite/tests/polykinds/T6054.stderr +++ b/testsuite/tests/polykinds/T6054.stderr @@ -3,7 +3,7 @@ T6054.hs:7:14: error: • No instance for (Bar '() a0) arising from an expression type signature • In the first argument of ‘print’, namely - ‘(Proxy :: Bar () a => Proxy a)’ - In the expression: print (Proxy :: Bar () a => Proxy a) + ‘(Proxy :: Bar '() a => Proxy a)’ + In the expression: print (Proxy :: Bar '() a => Proxy a) In an equation for ‘foo’: - foo = print (Proxy :: Bar () a => Proxy a) + foo = print (Proxy :: Bar '() a => Proxy a) diff --git a/testsuite/tests/polykinds/T7151.stderr b/testsuite/tests/polykinds/T7151.stderr index 00fed221c1..8b9ff9040e 100644 --- a/testsuite/tests/polykinds/T7151.stderr +++ b/testsuite/tests/polykinds/T7151.stderr @@ -1,4 +1,4 @@ T7151.hs:3:12: - Illegal type: ‘'[Int, String]’ + Illegal type: ‘[Int, String]’ Perhaps you intended to use DataKinds diff --git a/testsuite/tests/polykinds/T7328.stderr b/testsuite/tests/polykinds/T7328.stderr index 95b3a7782f..76f81555dd 100644 --- a/testsuite/tests/polykinds/T7328.stderr +++ b/testsuite/tests/polykinds/T7328.stderr @@ -2,5 +2,5 @@ T7328.hs:8:34: error: • Occurs check: cannot construct the infinite kind: k1 ~ k0 -> k1 • In the first argument of ‘Foo’, namely ‘f’ - In the first argument of ‘Proxy’, namely ‘Foo f’ + In the first argument of ‘Proxy’, namely ‘(Foo f)’ In the type signature: foo :: a ~ f i => Proxy (Foo f) diff --git a/testsuite/tests/polykinds/T7433.stderr b/testsuite/tests/polykinds/T7433.stderr index d3f57a9ee7..1cd2ad2f29 100644 --- a/testsuite/tests/polykinds/T7433.stderr +++ b/testsuite/tests/polykinds/T7433.stderr @@ -2,5 +2,5 @@ T7433.hs:2:10: Data constructor ‘Z’ cannot be used here (Perhaps you intended to use DataKinds) - In the type ‘Z’ + In the type ‘ 'Z’ In the type declaration for ‘T’ diff --git a/testsuite/tests/polykinds/T7805.stderr b/testsuite/tests/polykinds/T7805.stderr index 33b9d4df6b..9ca48645be 100644 --- a/testsuite/tests/polykinds/T7805.stderr +++ b/testsuite/tests/polykinds/T7805.stderr @@ -2,5 +2,5 @@ T7805.hs:7:21: error: Expected kind ‘forall a. a -> a’, but ‘x’ has kind ‘k0’ In the first argument of ‘HR’, namely ‘x’ - In the first argument of ‘F’, namely ‘HR x’ + In the first argument of ‘F’, namely ‘(HR x)’ In the type instance declaration for ‘F’ diff --git a/testsuite/tests/printer/.gitignore b/testsuite/tests/printer/.gitignore new file mode 100644 index 0000000000..2da49b2630 --- /dev/null +++ b/testsuite/tests/printer/.gitignore @@ -0,0 +1,17 @@ +*.ast +*.ppr.hs +*.ppr +*.o +*.hi +*.out +Ppr003 +Ppr004 +Ppr016 +Ppr026 +Ppr029 +Ppr034 +Ppr041 +Ppr042 +Ppr043 +Ppr044 +Ppr046
\ No newline at end of file diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile new file mode 100644 index 0000000000..b21419c30f --- /dev/null +++ b/testsuite/tests/printer/Makefile @@ -0,0 +1,195 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +clean: + rm -f *.o *.hi *.ppr.hs + rm Ppr003 Ppr004 + +.PHONY: ppr001 +ppr001: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr001.hs + +.PHONY: ppr002 +ppr002: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr002.hs + +.PHONY: ppr003 +ppr003: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr003.hs + +.PHONY: ppr004 +ppr004: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr004.hs + +.PHONY: ppr005 +ppr005: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr005.hs + +.PHONY: ppr006 +ppr006: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr006.hs + +.PHONY: ppr007 +ppr007: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr007.hs + +.PHONY: ppr008 +ppr008: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr008.hs + +.PHONY: ppr009 +ppr009: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr009.hs + +.PHONY: ppr010 +ppr010: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr010.hs + +.PHONY: ppr011 +ppr011: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr011.hs + +.PHONY: ppr012 +ppr012: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr012.hs + +.PHONY: ppr013 +ppr013: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr013.hs + +.PHONY: ppr014 +ppr014: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr014.hs + +.PHONY: ppr015 +ppr015: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr015.hs + +.PHONY: ppr016 +ppr016: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr016.hs + +.PHONY: ppr017 +ppr017: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr017.hs + +.PHONY: ppr018 +ppr018: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr018.hs + +.PHONY: ppr019 +ppr019: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr019.hs + +.PHONY: ppr020 +ppr020: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr020.hs + +.PHONY: ppr021 +ppr021: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr021.hs + +.PHONY: ppr022 +ppr022: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr022.hs + +.PHONY: ppr023 +ppr023: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr023.hs + +.PHONY: ppr024 +ppr024: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr024.hs + +.PHONY: ppr025 +ppr025: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr025.hs + +.PHONY: ppr026 +ppr026: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr026.hs + +.PHONY: ppr027 +ppr027: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr027.hs + +.PHONY: ppr028 +ppr028: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr028.hs + +.PHONY: ppr029 +ppr029: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr029.hs + +.PHONY: ppr030 +ppr030: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr030.hs + +.PHONY: ppr031 +ppr031: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr031.hs + +.PHONY: ppr032 +ppr032: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr032.hs + +.PHONY: ppr033 +ppr033: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr033.hs + +.PHONY: ppr034 +ppr034: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr034.hs + +.PHONY: ppr035 +ppr035: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr035.hs + +.PHONY: ppr036 +ppr036: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr036.hs + +.PHONY: ppr037 +ppr037: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr037.hs + +.PHONY: ppr038 +ppr038: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr038.hs + +.PHONY: ppr039 +ppr039: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr039.hs + +.PHONY: ppr040 +ppr040: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr040.hs + +.PHONY: ppr041 +ppr041: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr041.hs + +.PHONY: ppr042 +ppr042: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr042.hs + +.PHONY: ppr043 +ppr043: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr043.hs + +.PHONY: ppr044 +ppr044: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr044.hs + +.PHONY: ppr045 +ppr045: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr045.hs + +.PHONY: ppr046 +ppr046: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr046.hs + +.PHONY: ppr047 +ppr047: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr047.hs diff --git a/testsuite/tests/printer/Ppr001.hs b/testsuite/tests/printer/Ppr001.hs new file mode 100644 index 0000000000..5277da5abf --- /dev/null +++ b/testsuite/tests/printer/Ppr001.hs @@ -0,0 +1,7 @@ +module Ppr001 where + +main = putStrLn "hello" + +foo x = y + 3 + where + y = 2 ^ x diff --git a/testsuite/tests/printer/Ppr002.hs b/testsuite/tests/printer/Ppr002.hs new file mode 100644 index 0000000000..a98e0689ee --- /dev/null +++ b/testsuite/tests/printer/Ppr002.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE Arrows #-} +module Arrow where + +import Control.Arrow +import qualified Control.Category as Cat + +addA :: Arrow a => a b Int -> a b Int -> a b Int +addA f g = proc x -> do + y <- f -< x + z <- g -< x + returnA -< y + z + +newtype Circuit a b = Circuit { unCircuit :: a -> (Circuit a b, b) } + +instance Cat.Category Circuit where + id = Circuit $ \a -> (Cat.id, a) + (.) = dot + where + (Circuit cir2) `dot` (Circuit cir1) = Circuit $ \a -> + let (cir1', b) = cir1 a + (cir2', c) = cir2 b + in (cir2' `dot` cir1', c) + +instance Arrow Circuit where + arr f = Circuit $ \a -> (arr f, f a) + first (Circuit cir) = Circuit $ \(b, d) -> + let (cir', c) = cir b + in (first cir', (c, d)) + +-- | Accumulator that outputs a value determined by the supplied function. +accum :: acc -> (a -> acc -> (b, acc)) -> Circuit a b +accum acc f = Circuit $ \input -> + let (output, acc') = input `f` acc + in (accum acc' f, output) + +-- | Accumulator that outputs the accumulator value. +accum' :: b -> (a -> b -> b) -> Circuit a b +accum' acc f = accum acc (\a b -> let b' = a `f` b in (b', b')) + +total :: Num a => Circuit a a +total = accum' 0 (+) + +mean3 :: Fractional a => Circuit a a +mean3 = proc value -> do + (t, n) <- (| (&&&) (total -< value) (total -< 1) |) + returnA -< t / n diff --git a/testsuite/tests/printer/Ppr003.hs b/testsuite/tests/printer/Ppr003.hs new file mode 100644 index 0000000000..2cd738e4fe --- /dev/null +++ b/testsuite/tests/printer/Ppr003.hs @@ -0,0 +1,11 @@ +main = putStrLn "hello" + +foo x = + case x of + { ;;; -- leading + 0 -> 'a'; -- case 0 + 1 -> 'b' -- case 1 + ; 2 -> 'c' ; -- case 2 + ; 3 -> 'd' -- case 3 + ;;; -- case 4 + } diff --git a/testsuite/tests/printer/Ppr004.hs b/testsuite/tests/printer/Ppr004.hs new file mode 100644 index 0000000000..797d36106a --- /dev/null +++ b/testsuite/tests/printer/Ppr004.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GADTs #-} + +-- From https://www.haskell.org/haskellwiki/GHC/Type_families#An_associated_data_type_example + +import qualified Data.IntMap +import Prelude hiding (lookup) +import Data.Char (ord) + +class GMapKey k where + data GMap k :: * -> * + empty :: GMap k v + lookup :: k -> GMap k v -> Maybe v + insert :: k -> v -> GMap k v -> GMap k v + +-- An Int instance +instance GMapKey Int where + data GMap Int v = GMapInt (Data.IntMap.IntMap v) + empty = GMapInt Data.IntMap.empty + lookup k (GMapInt m) = Data.IntMap.lookup k m + insert k v (GMapInt m) = GMapInt (Data.IntMap.insert k v m) + +-- A Char instance +instance GMapKey Char where + data GMap Char v = GMapChar (GMap Int v) + empty = GMapChar empty + lookup k (GMapChar m) = lookup (ord k) m + insert k v (GMapChar m) = GMapChar (insert (ord k) v m) + +-- A Unit instance +instance GMapKey () where + data GMap () v = GMapUnit (Maybe v) + empty = GMapUnit Nothing + lookup () (GMapUnit v) = v + insert () v (GMapUnit _) = GMapUnit $ Just v + +-- Product and sum instances +instance (GMapKey a, GMapKey b) => GMapKey (a, b) where + data GMap (a, b) v = GMapPair (GMap a (GMap b v)) + empty = GMapPair empty + lookup (a, b) (GMapPair gm) = lookup a gm >>= lookup b + insert (a, b) v (GMapPair gm) = GMapPair $ case lookup a gm of + Nothing -> insert a (insert b v empty) gm + Just gm2 -> insert a (insert b v gm2 ) gm + +instance (GMapKey a, GMapKey b) => GMapKey (Either a b) where + data GMap (Either a b) v = GMapEither (GMap a v) (GMap b v) + empty = GMapEither empty empty + lookup (Left a) (GMapEither gm1 _gm2) = lookup a gm1 + lookup (Right b) (GMapEither _gm1 gm2 ) = lookup b gm2 + insert (Left a) v (GMapEither gm1 gm2) = GMapEither (insert a v gm1) gm2 + insert (Right b) v (GMapEither gm1 gm2) = GMapEither gm1 (insert b v gm2) + +myGMap :: GMap (Int, Either Char ()) String +myGMap = insert (5, Left 'c') "(5, Left 'c')" $ + insert (4, Right ()) "(4, Right ())" $ + insert (5, Right ()) "This is the one!" $ + insert (5, Right ()) "This is the two!" $ + insert (6, Right ()) "(6, Right ())" $ + insert (5, Left 'a') "(5, Left 'a')" $ + empty + +main = putStrLn $ maybe "Couldn't find key!" id $ lookup (5, Right ()) myGMap + +-- (Type) Synonym Family + +type family Elem c + +type instance Elem [e] = e + +-- type instance Elem BitSet = Char + + +data family T a +data instance T Int = T1 Int | T2 Bool +newtype instance T Char = TC Bool + +data family G a b +data instance G [a] b where + G1 :: c -> G [Int] b + G2 :: G [a] Bool diff --git a/testsuite/tests/printer/Ppr005.hs b/testsuite/tests/printer/Ppr005.hs new file mode 100644 index 0000000000..8d4a920e76 --- /dev/null +++ b/testsuite/tests/printer/Ppr005.hs @@ -0,0 +1,11 @@ +module Ppr005 where + +import Data.List + +foo = do + let x = 1 + Just 5 + +f = undefined +go = undefined +e = undefined diff --git a/testsuite/tests/printer/Ppr006.hs b/testsuite/tests/printer/Ppr006.hs new file mode 100644 index 0000000000..280ec564b4 --- /dev/null +++ b/testsuite/tests/printer/Ppr006.hs @@ -0,0 +1,257 @@ +{-# LANGUAGE QuasiQuotes #-} +module Ppr006 where + +commands :: [Command] +commands = [ + command "help" "display a list of all commands, and their current keybindings" $ do + macroGuesses <- Macro.guessCommands commandNames <$> getMacros + addTab (Other "Help") (makeHelpWidget commands macroGuesses) AutoClose + + , command "log" "show the error log" $ do + messages <- gets logMessages + let widget = ListWidget.moveLast (ListWidget.new $ reverse messages) + addTab (Other "Log") (AnyWidget . LogWidget $ widget) AutoClose + + , command "map" "display a list of all commands that are currently bound to keys" $ do + showMappings + + , command "map" "display the command that is currently bound to the key {name}" $ do + showMapping + + , command "map" [help| + Bind the command {expansion} to the key {name}. The same command may + be bound to different keys. + |] $ do + addMapping + + , command "unmap" "remove the binding currently bound to the key {name}" $ do + \(MacroName m) -> removeMacro m + + , command "mapclear" "" $ do + clearMacros + + , command "exit" "exit vimus" $ do + eval "quit" + + , command "quit" "exit vimus" $ do + liftIO exitSuccess :: Vimus () + + , command "close" "close the current window (not all windows can be closed)" $ do + void closeTab + + , command "source" "read the file {path} and interprets all lines found there as if they were entered as commands." $ do + \(Path p) -> liftIO (expandHome p) >>= either printError source_ + + , command "runtime" "" $ + \(Path p) -> liftIO (getDataFileName p) >>= source_ + + , command "color" "define the fore- and background color for a thing on the screen." $ do + \color fg bg -> liftIO (defineColor color fg bg) :: Vimus () + + , command "repeat" "set the playlist option *repeat*. When *repeat* is set, the playlist will start over when the last song has finished playing." $ do + MPD.repeat True :: Vimus () + + , command "norepeat" "Unset the playlist option *repeat*." $ do + MPD.repeat False :: Vimus () + + , command "consume" "set the playlist option *consume*. When *consume* is set, songs that have finished playing are automatically removed from the playlist." $ do + MPD.consume True :: Vimus () + + , command "noconsume" "Unset the playlist option *consume*." $ do + MPD.consume False :: Vimus () + + , command "random" "set the playlist option *random*. When *random* is set, songs in the playlist are played in random order." $ do + MPD.random True :: Vimus () + + , command "norandom" "Unset the playlist option *random*." $ do + MPD.random False :: Vimus () + + , command "single" "Set the playlist option *single*. When *single* is set, playback does not advance automatically to the next item in the playlist. Combine with *repeat* to repeatedly play the same song." $ do + MPD.single True :: Vimus () + + , command "nosingle" "Unset the playlist option *single*." $ do + MPD.single False :: Vimus () + + , command "autotitle" "Set the *autotitle* option. When *autotitle* is set, the console window title is automatically set to the currently playing song." $ do + setAutoTitle True + + , command "noautotitle" "Unset the *autotitle* option." $ do + setAutoTitle False + + , command "volume" "[+-] set volume to or adjust by [+-] num" $ do + volume :: Volume -> Vimus () + + , command "toggle-repeat" "Toggle the *repeat* option." $ do + MPD.status >>= MPD.repeat . not . MPD.stRepeat :: Vimus () + + , command "toggle-consume" "Toggle the *consume* option." $ do + MPD.status >>= MPD.consume . not . MPD.stConsume :: Vimus () + + , command "toggle-random" "Toggle the *random* option." $ do + MPD.status >>= MPD.random . not . MPD.stRandom :: Vimus () + + , command "toggle-single" "Toggle the *single* option." $ do + MPD.status >>= MPD.single . not . MPD.stSingle :: Vimus () + + , command "set-library-path" "While MPD knows where your songs are stored, vimus doesn't. If you want to use the *%* feature of the command :! you need to tell vimus where your songs are stored." $ do + \(Path p) -> setLibraryPath p + + , command "next" "stop playing the current song, and starts the next one" $ do + MPD.next :: Vimus () + + , command "previous" "stop playing the current song, and starts the previous one" $ do + MPD.previous :: Vimus () + + , command "toggle" "toggle between play and pause" $ do + MPDE.toggle :: Vimus () + + , command "stop" "stop playback" $ do + MPD.stop :: Vimus () + + , command "update" "tell MPD to update the music database. You must update your database when you add or delete files in your music directory, or when you edit the metadata of a song. MPD will only rescan a file already in the database if its modification time has changed." $ do + void (MPD.update Nothing) :: Vimus () + + , command "rescan" "" $ do + void (MPD.rescan Nothing) :: Vimus () + + , command "clear" "delete all songs from the playlist" $ do + MPD.clear :: Vimus () + + , command "search-next" "jump to the next occurrence of the search string in the current window" + searchNext + + , command "search-prev" "jump to the previous occurrence of the search string in the current window" + searchPrev + + + , command "window-library" "open the *Library* window" $ + selectTab Library + + , command "window-playlist" "open the *Playlist* window" $ + selectTab Playlist + + , command "window-search" "open the *SearchResult* window" $ + selectTab SearchResult + + , command "window-browser" "open the *Browser* window" $ + selectTab Browser + + , command "window-next" "open the window to the right of the current one" + nextTab + + , command "window-prev" "open the window to the left of the current one" + previousTab + + , command "!" "execute {cmd} on the system shell. See chapter \"Using an external tag editor\" for an example." + runShellCommand + + , command "seek" "jump to the given position in the current song" + seek + + , command "visual" "start visual selection" $ + sendEventCurrent EvVisual + + , command "novisual" "cancel visual selection" $ + sendEventCurrent EvNoVisual + + -- Remove current song from playlist + , command "remove" "remove the song under the cursor from the playlist" $ + sendEventCurrent EvRemove + + , command "paste" "add the last deleted song after the selected song in the playlist" $ + sendEventCurrent EvPaste + + , command "paste-prev" "" $ + sendEventCurrent EvPastePrevious + + , command "copy" "" $ + sendEventCurrent EvCopy + + , command "shuffle" "shuffle the current playlist" $ do + MPD.shuffle Nothing :: Vimus () + + , command "add" "append selected songs to the end of the playlist" $ do + sendEventCurrent EvAdd + + -- insert a song right after the current song + , command "insert" [help| + inserts a song to the playlist. The song is inserted after the currently + playing song. + |] $ do + st <- MPD.status + case MPD.stSongPos st of + Just n -> do + -- there is a current song, insert after + sendEventCurrent (EvInsert (n + 1)) + _ -> do + -- there is no current song, just add + sendEventCurrent EvAdd + + -- Playlist: play selected song + -- Library: add song to playlist and play it + -- Browse: either add song to playlist and play it, or :move-in + , command "default-action" [help| + depending on the item under the cursor, somthing different happens: + + - *Playlist* start playing the song under the cursor + + - *Library* append the song under the cursor to the playlist and start playing it + + - *Browser* on a song: append the song to the playlist and play it. On a directory: go down to that directory. + |] $ do + sendEventCurrent EvDefaultAction + + , command "add-album" "add all songs of the album of the selected song to the playlist" $ do + songs <- fromCurrent MPD.Album [MPD.Disc, MPD.Track] + maybe (printError "Song has no album metadata!") (MPDE.addMany "" . map MPD.sgFilePath) songs + + , command "add-artist" "add all songs of the artist of the selected song to the playlist" $ do + songs <- fromCurrent MPD.Artist [MPD.Date, MPD.Album, MPD.Disc, MPD.Track] + maybe (printError "Song has no artist metadata!") (MPDE.addMany "" . map MPD.sgFilePath) songs + + -- movement + , command "move-up" "move the cursor one line up" $ + sendEventCurrent EvMoveUp + + , command "move-down" "move the cursor one line down" $ + sendEventCurrent EvMoveDown + + , command "move-album-prev" "move the cursor up to the first song of an album" $ + sendEventCurrent EvMoveAlbumPrev + + , command "move-album-next" "move the cursor down to the first song of an album" $ + sendEventCurrent EvMoveAlbumNext + + , command "move-in" "go down one level the directory hierarchy in the *Browser* window" $ + sendEventCurrent EvMoveIn + + , command "move-out" "go up one level in the directory hierarchy in the *Browser* window" $ + sendEventCurrent EvMoveOut + + , command "move-first" "go to the first line in the current window" $ + sendEventCurrent EvMoveFirst + + , command "move-last" "go to the last line in the current window" $ + sendEventCurrent EvMoveLast + + , command "scroll-up" "scroll the contents of the current window up one line" $ + sendEventCurrent (EvScroll (-1)) + + , command "scroll-down" "scroll the contents of the current window down one line" $ + sendEventCurrent (EvScroll 1) + + , command "scroll-page-up" "scroll the contents of the current window up one page" $ + pageScroll >>= sendEventCurrent . EvScroll . negate + + , command "scroll-half-page-up" "scroll the contents of the current window up one half page" $ + pageScroll >>= sendEventCurrent . EvScroll . negate . (`div` 2) + + , command "scroll-page-down" "scroll the contents of the current window down one page" $ + pageScroll >>= sendEventCurrent . EvScroll + + , command "scroll-half-page-down" "scroll the contents of the current window down one half page" $ + pageScroll >>= sendEventCurrent . EvScroll . (`div` 2) + + , command "song-format" "set song rendering format" $ + sendEvent . EvChangeSongFormat + ] diff --git a/testsuite/tests/printer/Ppr006.stderr b/testsuite/tests/printer/Ppr006.stderr new file mode 100644 index 0000000000..d0b3c7b9b8 --- /dev/null +++ b/testsuite/tests/printer/Ppr006.stderr @@ -0,0 +1,45 @@ +Ppr006.hs:4:14: error: + Not in scope: type constructor or class ‘Command’ + +Ppr006.hs:7:23: error: + Not in scope: ‘Macro.guessCommands’ + No module named ‘Macro’ is imported. + +Ppr006.hs:12:20: error: + Not in scope: ‘ListWidget.moveLast’ + No module named ‘ListWidget’ is imported. + +Ppr006.hs:12:41: error: + Not in scope: ‘ListWidget.new’ + No module named ‘ListWidget’ is imported. + +Ppr006.hs:21:19: error: + • Not in scope: ‘help’ + • In the quasi-quotation: + [help| + Bind the command {expansion} to the key {name}. The same command may + be bound to different keys. + |] + +Ppr006.ppr.hs:3:14: error: + Not in scope: type constructor or class ‘Command’ + +Ppr006.ppr.hs:8:29: error: + Not in scope: ‘Macro.guessCommands’ + No module named ‘Macro’ is imported. + +Ppr006.ppr.hs:14:21: error: + Not in scope: ‘ListWidget.moveLast’ + No module named ‘ListWidget’ is imported. + +Ppr006.ppr.hs:14:42: error: + Not in scope: ‘ListWidget.new’ + No module named ‘ListWidget’ is imported. + +Ppr006.ppr.hs:26:8: error: + • Not in scope: ‘help’ + • In the quasi-quotation: + [help| + Bind the command {expansion} to the key {name}. The same command may + be bound to different keys. + |] diff --git a/testsuite/tests/printer/Ppr007.hs b/testsuite/tests/printer/Ppr007.hs new file mode 100644 index 0000000000..65ff9a7b63 --- /dev/null +++ b/testsuite/tests/printer/Ppr007.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE ApplicativeDo #-} +module Ppr007 where + +g :: IO () +g = do + x <- getChar + 'a' <- return (3::Int) -- type error + return () diff --git a/testsuite/tests/printer/Ppr007.stderr b/testsuite/tests/printer/Ppr007.stderr new file mode 100644 index 0000000000..5bb122a269 --- /dev/null +++ b/testsuite/tests/printer/Ppr007.stderr @@ -0,0 +1,17 @@ +Ppr007.hs:7:3: error: + • Couldn't match expected type ‘Int’ with actual type ‘Char’ + • In the pattern: 'a' + In a stmt of a 'do' block: 'a' <- return (3 :: Int) + In the expression: + do x <- getChar + 'a' <- return (3 :: Int) + return () + +Ppr007.ppr.hs:5:8: error: + • Couldn't match expected type ‘Int’ with actual type ‘Char’ + • In the pattern: 'a' + In a stmt of a 'do' block: 'a' <- return (3 :: Int) + In the expression: + do x <- getChar + 'a' <- return (3 :: Int) + return () diff --git a/testsuite/tests/printer/Ppr008.hs b/testsuite/tests/printer/Ppr008.hs new file mode 100644 index 0000000000..b5b99e501c --- /dev/null +++ b/testsuite/tests/printer/Ppr008.hs @@ -0,0 +1,213 @@ +{-# LANGUAGE Unsafe #-} +{-# LANGUAGE CPP + , NoImplicitPrelude + , ScopedTypeVariables + , BangPatterns + #-} + +module Ppr008 + ( + -- * Managing the IO manager + Signal + , ControlMessage(..) + , Control + , newControl + , closeControl + -- ** Control message reception + , readControlMessage + -- *** File descriptors + , controlReadFd + , controlWriteFd + , wakeupReadFd + -- ** Control message sending + , sendWakeup + , sendDie + -- * Utilities + , setNonBlockingFD + ) where + +#include "EventConfig.h" + +import Foreign.ForeignPtr (ForeignPtr) +import GHC.Base +import GHC.Conc.Signal (Signal) +import GHC.Real (fromIntegral) +import GHC.Show (Show) +import GHC.Word (Word8) +import Foreign.C.Error (throwErrnoIfMinus1_) +import Foreign.C.Types (CInt(..), CSize(..)) +import Foreign.ForeignPtr (mallocForeignPtrBytes, withForeignPtr) +import Foreign.Marshal (alloca, allocaBytes) +import Foreign.Marshal.Array (allocaArray) +import Foreign.Ptr (castPtr) +import Foreign.Storable (peek, peekElemOff, poke) +import System.Posix.Internals (c_close, c_pipe, c_read, c_write, + setCloseOnExec, setNonBlockingFD) +import System.Posix.Types (Fd) + +#if defined(HAVE_EVENTFD) +import Foreign.C.Error (throwErrnoIfMinus1) +import Foreign.C.Types (CULLong(..)) +#else +import Foreign.C.Error (eAGAIN, eWOULDBLOCK, getErrno, throwErrno) +#endif + +data ControlMessage = CMsgWakeup + | CMsgDie + | CMsgSignal {-# UNPACK #-} !(ForeignPtr Word8) + {-# UNPACK #-} !Signal + deriving (Eq, Show) + +-- | The structure used to tell the IO manager thread what to do. +data Control = W { + controlReadFd :: {-# UNPACK #-} !Fd + , controlWriteFd :: {-# UNPACK #-} !Fd +#if defined(HAVE_EVENTFD) + , controlEventFd :: {-# UNPACK #-} !Fd +#else + , wakeupReadFd :: {-# UNPACK #-} !Fd + , wakeupWriteFd :: {-# UNPACK #-} !Fd +#endif + , didRegisterWakeupFd :: !Bool + } deriving (Show) + +#if defined(HAVE_EVENTFD) +wakeupReadFd :: Control -> Fd +wakeupReadFd = controlEventFd +{-# INLINE wakeupReadFd #-} +#endif + +-- | Create the structure (usually a pipe) used for waking up the IO +-- manager thread from another thread. +newControl :: Bool -> IO Control +newControl shouldRegister = allocaArray 2 $ \fds -> do + let createPipe = do + throwErrnoIfMinus1_ "pipe" $ c_pipe fds + rd <- peekElemOff fds 0 + wr <- peekElemOff fds 1 + -- The write end must be non-blocking, since we may need to + -- poke the event manager from a signal handler. + setNonBlockingFD wr True + setCloseOnExec rd + setCloseOnExec wr + return (rd, wr) + (ctrl_rd, ctrl_wr) <- createPipe +#if defined(HAVE_EVENTFD) + ev <- throwErrnoIfMinus1 "eventfd" $ c_eventfd 0 0 + setNonBlockingFD ev True + setCloseOnExec ev + when shouldRegister $ c_setIOManagerWakeupFd ev +#else + (wake_rd, wake_wr) <- createPipe + when shouldRegister $ c_setIOManagerWakeupFd wake_wr +#endif + return W { controlReadFd = fromIntegral ctrl_rd + , controlWriteFd = fromIntegral ctrl_wr +#if defined(HAVE_EVENTFD) + , controlEventFd = fromIntegral ev +#else + , wakeupReadFd = fromIntegral wake_rd + , wakeupWriteFd = fromIntegral wake_wr +#endif + , didRegisterWakeupFd = shouldRegister + } + +-- | Close the control structure used by the IO manager thread. +-- N.B. If this Control is the Control whose wakeup file was registered with +-- the RTS, then *BEFORE* the wakeup file is closed, we must call +-- c_setIOManagerWakeupFd (-1), so that the RTS does not try to use the wakeup +-- file after it has been closed. +closeControl :: Control -> IO () +closeControl w = do + _ <- c_close . fromIntegral . controlReadFd $ w + _ <- c_close . fromIntegral . controlWriteFd $ w + when (didRegisterWakeupFd w) $ c_setIOManagerWakeupFd (-1) +#if defined(HAVE_EVENTFD) + _ <- c_close . fromIntegral . controlEventFd $ w +#else + _ <- c_close . fromIntegral . wakeupReadFd $ w + _ <- c_close . fromIntegral . wakeupWriteFd $ w +#endif + return () + +io_MANAGER_WAKEUP, io_MANAGER_DIE :: Word8 +io_MANAGER_WAKEUP = 0xff +io_MANAGER_DIE = 0xfe + +foreign import ccall "__hscore_sizeof_siginfo_t" + sizeof_siginfo_t :: CSize + +readControlMessage :: Control -> Fd -> IO ControlMessage +readControlMessage ctrl fd + | fd == wakeupReadFd ctrl = allocaBytes wakeupBufferSize $ \p -> do + throwErrnoIfMinus1_ "readWakeupMessage" $ + c_read (fromIntegral fd) p (fromIntegral wakeupBufferSize) + return CMsgWakeup + | otherwise = + alloca $ \p -> do + throwErrnoIfMinus1_ "readControlMessage" $ + c_read (fromIntegral fd) p 1 + s <- peek p + case s of + -- Wakeup messages shouldn't be sent on the control + -- file descriptor but we handle them anyway. + _ | s == io_MANAGER_WAKEUP -> return CMsgWakeup + _ | s == io_MANAGER_DIE -> return CMsgDie + _ -> do -- Signal + fp <- mallocForeignPtrBytes (fromIntegral sizeof_siginfo_t) + withForeignPtr fp $ \p_siginfo -> do + r <- c_read (fromIntegral fd) (castPtr p_siginfo) + sizeof_siginfo_t + when (r /= fromIntegral sizeof_siginfo_t) $ + error "failed to read siginfo_t" + let !s' = fromIntegral s + return $ CMsgSignal fp s' + + where wakeupBufferSize = +#if defined(HAVE_EVENTFD) + 8 +#else + 4096 +#endif + +sendWakeup :: Control -> IO () +#if defined(HAVE_EVENTFD) +sendWakeup c = + throwErrnoIfMinus1_ "sendWakeup" $ + c_eventfd_write (fromIntegral (controlEventFd c)) 1 +#else +sendWakeup c = do + n <- sendMessage (wakeupWriteFd c) CMsgWakeup + case n of + _ | n /= -1 -> return () + | otherwise -> do + errno <- getErrno + when (errno /= eAGAIN && errno /= eWOULDBLOCK) $ + throwErrno "sendWakeup" +#endif + +sendDie :: Control -> IO () +sendDie c = throwErrnoIfMinus1_ "sendDie" $ + sendMessage (controlWriteFd c) CMsgDie + +sendMessage :: Fd -> ControlMessage -> IO Int +sendMessage fd msg = alloca $ \p -> do + case msg of + CMsgWakeup -> poke p io_MANAGER_WAKEUP + CMsgDie -> poke p io_MANAGER_DIE + CMsgSignal _fp _s -> error "Signals can only be sent from within the RTS" + fromIntegral `fmap` c_write (fromIntegral fd) p 1 + +#if defined(HAVE_EVENTFD) +foreign import ccall unsafe "sys/eventfd.h eventfd" + c_eventfd :: CInt -> CInt -> IO CInt + +foreign import ccall unsafe "sys/eventfd.h eventfd_write" + c_eventfd_write :: CInt -> CULLong -> IO CInt +#endif + +foreign import ccall unsafe "setIOManagerWakeupFd" + c_setIOManagerWakeupFd :: CInt -> IO () + +foreign import ccall unsafe "static baz" + c_baz :: CInt -> IO () diff --git a/testsuite/tests/printer/Ppr009.hs b/testsuite/tests/printer/Ppr009.hs new file mode 100644 index 0000000000..d24ecdc517 --- /dev/null +++ b/testsuite/tests/printer/Ppr009.hs @@ -0,0 +1,9 @@ +module Ppr009 where + + +{-# INLINE strictStream #-} +strictStream (Bitstream l v) + = {-# CORE "Strict Bitstream stream" #-} + S.concatMap stream (GV.stream v) + `S.sized` + Exact l diff --git a/testsuite/tests/printer/Ppr009.stderr b/testsuite/tests/printer/Ppr009.stderr new file mode 100644 index 0000000000..3aabba4ceb --- /dev/null +++ b/testsuite/tests/printer/Ppr009.stderr @@ -0,0 +1,28 @@ +Ppr009.hs:5:15: error: Not in scope: data constructor ‘Bitstream’ + +Ppr009.hs:7:7: error: + Not in scope: ‘S.concatMap’ + No module named ‘S’ is imported. + +Ppr009.hs:7:27: error: + Not in scope: ‘GV.stream’ + No module named ‘GV’ is imported. + +Ppr009.hs:8:7: error: + Not in scope: ‘S.sized’ + No module named ‘S’ is imported. + +Ppr009.ppr.hs:4:15: error: + Not in scope: data constructor ‘Bitstream’ + +Ppr009.ppr.hs:6:5: error: + Not in scope: ‘S.concatMap’ + No module named ‘S’ is imported. + +Ppr009.ppr.hs:6:25: error: + Not in scope: ‘GV.stream’ + No module named ‘GV’ is imported. + +Ppr009.ppr.hs:6:38: error: + Not in scope: ‘S.sized’ + No module named ‘S’ is imported. diff --git a/testsuite/tests/printer/Ppr010.hs b/testsuite/tests/printer/Ppr010.hs new file mode 100644 index 0000000000..2373eb6494 --- /dev/null +++ b/testsuite/tests/printer/Ppr010.hs @@ -0,0 +1,17 @@ +{-# Language CPP #-} +module Ppr010 where + +#if __GLASGOW_HASKELL__ > 704 +foo :: Int +#else +foo :: Integer +#endif +foo = 3 + +bar :: ( +#if __GLASGOW_HASKELL__ > 704 + Int) +#else + Integer) +#endif +bar = 4 diff --git a/testsuite/tests/printer/Ppr011.hs b/testsuite/tests/printer/Ppr011.hs new file mode 100644 index 0000000000..b967e247b6 --- /dev/null +++ b/testsuite/tests/printer/Ppr011.hs @@ -0,0 +1,34 @@ +{-# Language DatatypeContexts #-} +{-# Language ExistentialQuantification #-} +{-# LAnguage GADTs #-} +{-# LAnguage KindSignatures #-} + +data Foo = A + | B + | C + +-- | data_or_newtype capi_ctype tycl_hdr constrs deriving +data {-# Ctype "Foo" "bar" #-} F1 = F1 +data {-# Ctype "baz" #-} Eq a => F2 a = F2 a + +data (Eq a,Ord a) => F3 a = F3 Int a + +data F4 a = forall x y. (Eq x,Eq y) => F4 a x y + | forall x y. (Eq x,Eq y) => F4b a x y + + +data G1 a :: * where + G1A, G1B :: Int -> G1 a + G1C :: Double -> G1 a + +data G2 a :: * where + G2A :: { g2a :: a, g2b :: Int } -> G2 a + G2C :: Double -> G2 a + + + +data (Eq a,Ord a) => G3 a = G3 + { g3A :: Int + , g3B :: Bool + , g3a :: a + } deriving (Eq,Ord) diff --git a/testsuite/tests/printer/Ppr011.stderr b/testsuite/tests/printer/Ppr011.stderr new file mode 100644 index 0000000000..d5b40af36c --- /dev/null +++ b/testsuite/tests/printer/Ppr011.stderr @@ -0,0 +1,12 @@ + +Ppr011.hs:1:14: warning: + -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. + +Ppr011.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ + +Ppr011.ppr.hs:1:14: warning: + -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. + +Ppr011.ppr.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/printer/Ppr012.hs b/testsuite/tests/printer/Ppr012.hs new file mode 100644 index 0000000000..b34b1470f4 --- /dev/null +++ b/testsuite/tests/printer/Ppr012.hs @@ -0,0 +1,42 @@ +{-# OPTIONS -O -ddump-stranal #-} + +module Dead1(foo) where + +foo :: Int -> Int +foo n = baz (n+1) (bar1 n) + +{-# NOINLINE bar1 #-} +bar1 n = 1 + bar n + +bar :: Int -> Int +{-# NOINLINE bar #-} +{-# RULES +"bar/foo" forall n. bar (foo n) = n + #-} +bar n = n-1 + +baz :: Int -> Int -> Int +{-# INLINE [0] baz #-} +baz m n = m + + +{- Ronam writes (Feb08) + + Note that bar becomes dead as soon as baz gets inlined. But strangely, + the simplifier only deletes it after full laziness and CSE. That is, it + is not deleted in the phase in which baz gets inlined. In fact, it is + still there after w/w and the subsequent simplifier run. It gets deleted + immediately if I comment out the rule. + + I stumbled over this when I removed one simplifier run after SpecConstr + (at the moment, it runs twice at the end but I don't think that should + be necessary). With this change, the original version of a specialised + loop (the one with the rules) is not longer deleted even if it isn't + used any more. I'll reenable the second simplifier run for now but + should this really be necessary? + +No, it should not be necessary. A refactoring in OccurAnal makes +this work right. Look at the simplifier output just before strictness +analysis; there should be a binding for 'foo', but for nothing else. + +-} diff --git a/testsuite/tests/printer/Ppr012.stderr b/testsuite/tests/printer/Ppr012.stderr new file mode 100644 index 0000000000..5dd1384f3c --- /dev/null +++ b/testsuite/tests/printer/Ppr012.stderr @@ -0,0 +1,8 @@ + +Ppr012.hs:14:1: warning: [-Winline-rule-shadowing] + Rule "bar/foo" may never fire because ‘foo’ might inline first + Probable fix: add an INLINE[n] or NOINLINE[n] pragma for ‘foo’ + +Ppr012.ppr.hs:11:11: warning: [-Winline-rule-shadowing] + Rule "bar/foo" may never fire because ‘foo’ might inline first + Probable fix: add an INLINE[n] or NOINLINE[n] pragma for ‘foo’ diff --git a/testsuite/tests/printer/Ppr012.stdout b/testsuite/tests/printer/Ppr012.stdout new file mode 100644 index 0000000000..b4e01eb8a3 --- /dev/null +++ b/testsuite/tests/printer/Ppr012.stdout @@ -0,0 +1,186 @@ + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 19, types: 8, coercions: 0} + +-- RHS size: {terms: 2, types: 0, coercions: 0} +$trModule_sK3 :: GHC.Types.TrName +[LclId, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}] +$trModule_sK3 = GHC.Types.TrNameS "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0} +$trModule_sK4 :: GHC.Types.TrName +[LclId, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 20}] +$trModule_sK4 = GHC.Types.TrNameS "Dead1"# + +-- RHS size: {terms: 3, types: 0, coercions: 0} +Dead1.$trModule :: GHC.Types.Module +[LclIdX, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +Dead1.$trModule = GHC.Types.Module $trModule_sK3 $trModule_sK4 + +-- RHS size: {terms: 8, types: 3, coercions: 0} +foo :: Int -> Int +[LclIdX, + Arity=1, + Str=<S(S),1*U(U)>m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 21 20}] +foo = + \ (n_axW [Dmd=<S(S),1*U(U)>] :: Int) -> + case n_axW of { GHC.Types.I# x_aKq [Dmd=<S,U>] -> + GHC.Types.I# (GHC.Prim.+# x_aKq 1#) + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 19, types: 8, coercions: 0} + +-- RHS size: {terms: 2, types: 0, coercions: 0} +$trModule_sK3 :: GHC.Types.TrName +[LclId, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}] +$trModule_sK3 = GHC.Types.TrNameS "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0} +$trModule_sK4 :: GHC.Types.TrName +[LclId, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 20}] +$trModule_sK4 = GHC.Types.TrNameS "Dead1"# + +-- RHS size: {terms: 3, types: 0, coercions: 0} +Dead1.$trModule :: GHC.Types.Module +[LclIdX, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +Dead1.$trModule = GHC.Types.Module $trModule_sK3 $trModule_sK4 + +-- RHS size: {terms: 8, types: 3, coercions: 0} +foo :: Int -> Int +[LclIdX, + Arity=1, + Str=<S(S),1*U(U)>m, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (n_axW [Occ=Once!] :: Int) -> + case n_axW of { GHC.Types.I# x_aKq [Occ=Once] -> + GHC.Types.I# (GHC.Prim.+# x_aKq 1#) + }}] +foo = + \ (n_axW [Dmd=<S(S),1*U(U)>] :: Int) -> + case n_axW of { GHC.Types.I# x_aKq [Dmd=<S,U>] -> + GHC.Types.I# (GHC.Prim.+# x_aKq 1#) + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 19, types: 8, coercions: 0} + +-- RHS size: {terms: 2, types: 0, coercions: 0} +$trModule_s1vS :: GHC.Types.TrName +[LclId, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}] +$trModule_s1vS = GHC.Types.TrNameS "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0} +$trModule_s1vT :: GHC.Types.TrName +[LclId, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 20}] +$trModule_s1vT = GHC.Types.TrNameS "Dead1"# + +-- RHS size: {terms: 3, types: 0, coercions: 0} +Dead1.$trModule :: GHC.Types.Module +[LclIdX, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +Dead1.$trModule = GHC.Types.Module $trModule_s1vS $trModule_s1vT + +-- RHS size: {terms: 8, types: 3, coercions: 0} +foo :: Int -> Int +[LclIdX, + Arity=1, + Str=<S(S),1*U(U)>m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 21 20}] +foo = + \ (n_a1jL [Dmd=<S(S),1*U(U)>] :: Int) -> + case n_a1jL of { GHC.Types.I# x_a1wf [Dmd=<S,U>] -> + GHC.Types.I# (GHC.Prim.+# x_a1wf 1#) + } + + + + +==================== Demand analysis ==================== +Result size of Demand analysis + = {terms: 19, types: 8, coercions: 0} + +-- RHS size: {terms: 2, types: 0, coercions: 0} +$trModule_s1vS :: GHC.Types.TrName +[LclId, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}] +$trModule_s1vS = GHC.Types.TrNameS "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0} +$trModule_s1vT :: GHC.Types.TrName +[LclId, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 20}] +$trModule_s1vT = GHC.Types.TrNameS "Dead1"# + +-- RHS size: {terms: 3, types: 0, coercions: 0} +Dead1.$trModule :: GHC.Types.Module +[LclIdX, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +Dead1.$trModule = GHC.Types.Module $trModule_s1vS $trModule_s1vT + +-- RHS size: {terms: 8, types: 3, coercions: 0} +foo :: Int -> Int +[LclIdX, + Arity=1, + Str=<S(S),1*U(U)>m, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (n_a1jL [Occ=Once!] :: Int) -> + case n_a1jL of { GHC.Types.I# x_a1wf [Occ=Once] -> + GHC.Types.I# (GHC.Prim.+# x_a1wf 1#) + }}] +foo = + \ (n_a1jL [Dmd=<S(S),1*U(U)>] :: Int) -> + case n_a1jL of { GHC.Types.I# x_a1wf [Dmd=<S,U>] -> + GHC.Types.I# (GHC.Prim.+# x_a1wf 1#) + } + + + diff --git a/testsuite/tests/printer/Ppr013.hs b/testsuite/tests/printer/Ppr013.hs new file mode 100644 index 0000000000..2b0bca6b07 --- /dev/null +++ b/testsuite/tests/printer/Ppr013.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DeriveDataTypeable #-} + +import Data.Data + +data Foo = FooA | FooB + +deriving instance Show Foo + +deriving instance {-# Overlappable #-} Eq Foo +deriving instance {-# Overlapping #-} Ord Foo +deriving instance {-# Overlaps #-} Typeable Foo +deriving instance {-# Incoherent #-} Data Foo diff --git a/testsuite/tests/printer/Ppr013.stderr b/testsuite/tests/printer/Ppr013.stderr new file mode 100644 index 0000000000..5bfa1c790d --- /dev/null +++ b/testsuite/tests/printer/Ppr013.stderr @@ -0,0 +1,6 @@ + +Ppr013.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ + +Ppr013.ppr.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/printer/Ppr014.hs b/testsuite/tests/printer/Ppr014.hs new file mode 100644 index 0000000000..c0448688ba --- /dev/null +++ b/testsuite/tests/printer/Ppr014.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} + +-- from https://ocharles.org.uk/blog/guest-posts/2014-12-19-existential-quantification.html + +data HashMap k v = HM -- ... -- actual implementation + +class Hashable v where + h :: v -> Int + +data HashMapM hm = HashMapM + { empty :: forall k v . hm k v + , lookup :: Hashable k => k -> hm k v -> Maybe v + , insert :: Hashable k => k -> v -> hm k v -> hm k v + , union :: Hashable k => hm k v -> hm k v -> hm k v + } + + +data HashMapE = forall hm . HashMapE (HashMapM hm) + +-- public +mkHashMapE :: Int -> HashMapE +mkHashMapE = HashMapE . mkHashMapM + +-- private +mkHashMapM :: Int -> HashMapM HashMap +mkHashMapM salt = HashMapM { {- implementation -} } + +instance Hashable String where + +type Name = String +data Gift = G String + +giraffe :: Gift +giraffe = G "giraffe" + +addGift :: HashMapM hm -> hm Name Gift -> hm Name Gift +addGift mod gifts = + let + HashMapM{..} = mod + in + insert "Ollie" giraffe gifts + +-- ------------------------------- + +santa'sSecretSalt = undefined +sendGiftToOllie = undefined +traverse_ = undefined + +sendGifts = + case mkHashMapE santa'sSecretSalt of + HashMapE (mod@HashMapM{..}) -> + let + gifts = addGift mod empty + in + traverse_ sendGiftToOllie $ lookup "Ollie" gifts diff --git a/testsuite/tests/printer/Ppr014.stderr b/testsuite/tests/printer/Ppr014.stderr new file mode 100644 index 0000000000..d7ef8c588b --- /dev/null +++ b/testsuite/tests/printer/Ppr014.stderr @@ -0,0 +1,76 @@ + +Ppr014.hs:16:24: error: Not in scope: type variable ‘k’ + +Ppr014.hs:16:29: error: Not in scope: type variable ‘k’ + +Ppr014.hs:16:37: error: Not in scope: type variable ‘k’ + +Ppr014.hs:16:39: error: Not in scope: type variable ‘v’ + +Ppr014.hs:16:50: error: Not in scope: type variable ‘v’ + +Ppr014.hs:17:24: error: Not in scope: type variable ‘k’ + +Ppr014.hs:17:29: error: Not in scope: type variable ‘k’ + +Ppr014.hs:17:34: error: Not in scope: type variable ‘v’ + +Ppr014.hs:17:42: error: Not in scope: type variable ‘k’ + +Ppr014.hs:17:44: error: Not in scope: type variable ‘v’ + +Ppr014.hs:17:52: error: Not in scope: type variable ‘k’ + +Ppr014.hs:17:54: error: Not in scope: type variable ‘v’ + +Ppr014.hs:18:24: error: Not in scope: type variable ‘k’ + +Ppr014.hs:18:32: error: Not in scope: type variable ‘k’ + +Ppr014.hs:18:34: error: Not in scope: type variable ‘v’ + +Ppr014.hs:18:42: error: Not in scope: type variable ‘k’ + +Ppr014.hs:18:44: error: Not in scope: type variable ‘v’ + +Ppr014.hs:18:52: error: Not in scope: type variable ‘k’ + +Ppr014.hs:18:54: error: Not in scope: type variable ‘v’ + +Ppr014.ppr.hs:11:34: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:11:39: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:11:47: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:11:49: error: Not in scope: type variable ‘v’ + +Ppr014.ppr.hs:11:60: error: Not in scope: type variable ‘v’ + +Ppr014.ppr.hs:12:34: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:12:39: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:12:44: error: Not in scope: type variable ‘v’ + +Ppr014.ppr.hs:12:52: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:12:54: error: Not in scope: type variable ‘v’ + +Ppr014.ppr.hs:12:62: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:12:64: error: Not in scope: type variable ‘v’ + +Ppr014.ppr.hs:13:33: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:13:41: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:13:43: error: Not in scope: type variable ‘v’ + +Ppr014.ppr.hs:13:51: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:13:53: error: Not in scope: type variable ‘v’ + +Ppr014.ppr.hs:13:61: error: Not in scope: type variable ‘k’ + +Ppr014.ppr.hs:13:63: error: Not in scope: type variable ‘v’ diff --git a/testsuite/tests/printer/Ppr015.hs b/testsuite/tests/printer/Ppr015.hs new file mode 100644 index 0000000000..531ebc77a0 --- /dev/null +++ b/testsuite/tests/printer/Ppr015.hs @@ -0,0 +1,5 @@ +module ExprPragmas where + +a = {-# SCC "name" #-} 0x5 + +b = {-# SCC foo #-} 006 diff --git a/testsuite/tests/printer/Ppr016.hs b/testsuite/tests/printer/Ppr016.hs new file mode 100644 index 0000000000..630045c0b2 --- /dev/null +++ b/testsuite/tests/printer/Ppr016.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE ImplicitParams #-} + +explicit :: ((?above :: q, ?below :: a -> q) => b) -> q -> (a -> q) -> b +explicit x ab be = x where ?above = ab; ?below = be diff --git a/testsuite/tests/printer/Ppr016.stderr b/testsuite/tests/printer/Ppr016.stderr new file mode 100644 index 0000000000..2d508fa4dd --- /dev/null +++ b/testsuite/tests/printer/Ppr016.stderr @@ -0,0 +1,14 @@ + +Ppr016.hs:3:13: error: + • Illegal qualified type: (?above::q, ?below::a -> q) => b + Perhaps you intended to use RankNTypes or Rank2Types + • In the type signature: + explicit :: ((?above :: q, ?below :: a -> q) => b) + -> q -> (a -> q) -> b + +Ppr016.ppr.hs:3:3: error: + • Illegal qualified type: (?above::q, ?below::a -> q) => b + Perhaps you intended to use RankNTypes or Rank2Types + • In the type signature: + explicit :: ((?above :: q, ?below :: a -> q) => b) + -> q -> (a -> q) -> b diff --git a/testsuite/tests/printer/Ppr017.hs b/testsuite/tests/printer/Ppr017.hs new file mode 100644 index 0000000000..091ffee048 --- /dev/null +++ b/testsuite/tests/printer/Ppr017.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ExplicitNamespaces #-} +module Imports( f, type (+), pattern Single ) where + +import GHC.TypeLits + +pattern Single x = [x] + +f = undefined diff --git a/testsuite/tests/printer/Ppr018.hs b/testsuite/tests/printer/Ppr018.hs new file mode 100644 index 0000000000..c05ce66c8a --- /dev/null +++ b/testsuite/tests/printer/Ppr018.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DeriveAnyClass #-} + +data Foo a = F Int | A a + deriving Show + +data Foo1 a = F1 Int | A1 a + deriving (Show) + +data Foo2 a = F2 Int | A2 a + deriving (Show, Eq) + +data FooStock = FS Int + deriving stock Show + +data FooAnyClass = Fa Int + deriving anyclass Show + +newtype FooNewType = Fn Int + deriving newtype (Show) diff --git a/testsuite/tests/printer/Ppr018.stderr b/testsuite/tests/printer/Ppr018.stderr new file mode 100644 index 0000000000..7172b4e8be --- /dev/null +++ b/testsuite/tests/printer/Ppr018.stderr @@ -0,0 +1,12 @@ + +Ppr018.hs:20:21: + Can't make a derived instance of + ‘Show FooNewType’ with the newtype strategy: + Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension + In the newtype declaration for ‘FooNewType’ + +Ppr018.ppr.hs:20:21: + Can't make a derived instance of + ‘Show FooNewType’ with the newtype strategy: + Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension + In the newtype declaration for ‘FooNewType’ diff --git a/testsuite/tests/printer/Ppr019.hs b/testsuite/tests/printer/Ppr019.hs new file mode 100644 index 0000000000..c934cc5ccc --- /dev/null +++ b/testsuite/tests/printer/Ppr019.hs @@ -0,0 +1,427 @@ +{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, + CPP #-} +#if __GLASGOW_HASKELL__ >= 708 +{-# LANGUAGE RoleAnnotations #-} +#endif + +{-# OPTIONS_HADDOCK hide #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Array.IO.Internal +-- Copyright : (c) The University of Glasgow 2001-2012 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (uses Data.Array.Base) +-- +-- Mutable boxed and unboxed arrays in the IO monad. +-- +----------------------------------------------------------------------------- + +module Data.Array.IO.Internals ( + IOArray(..), -- instance of: Eq, Typeable + IOUArray(..), -- instance of: Eq, Typeable + castIOUArray, -- :: IOUArray ix a -> IO (IOUArray ix b) + unsafeThawIOUArray, + ) where + +import Data.Int +import Data.Word +import Data.Typeable + +import Control.Monad.ST ( RealWorld, stToIO ) +import Foreign.Ptr ( Ptr, FunPtr ) +import Foreign.StablePtr ( StablePtr ) + +#if __GLASGOW_HASKELL__ < 711 +import Data.Ix +#endif +import Data.Array.Base + +import GHC.IOArray (IOArray(..)) + +----------------------------------------------------------------------------- +-- Flat unboxed mutable arrays (IO monad) + +-- | Mutable, unboxed, strict arrays in the 'IO' monad. The type +-- arguments are as follows: +-- +-- * @i@: the index type of the array (should be an instance of 'Ix') +-- +-- * @e@: the element type of the array. Only certain element types +-- are supported: see "Data.Array.MArray" for a list of instances. +-- +newtype IOUArray i e = IOUArray (STUArray RealWorld i e) + deriving Typeable +#if __GLASGOW_HASKELL__ >= 708 +-- Both parameters have class-based invariants. See also #9220. +type role IOUArray nominal nominal +#endif + +instance Eq (IOUArray i e) where + IOUArray s1 == IOUArray s2 = s1 == s2 + +instance MArray IOUArray Bool IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Char IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Int IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Word IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray (Ptr a) IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray (FunPtr a) IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Float IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Double IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray (StablePtr a) IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Int8 IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Int16 IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Int32 IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Int64 IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Word8 IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Word16 IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Word32 IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +instance MArray IOUArray Word64 IO where + {-# INLINE getBounds #-} + getBounds (IOUArray arr) = stToIO $ getBounds arr + {-# INLINE getNumElements #-} + getNumElements (IOUArray arr) = stToIO $ getNumElements arr + {-# INLINE newArray #-} + newArray lu initialValue = stToIO $ do + marr <- newArray lu initialValue; return (IOUArray marr) + {-# INLINE unsafeNewArray_ #-} + unsafeNewArray_ lu = stToIO $ do + marr <- unsafeNewArray_ lu; return (IOUArray marr) + {-# INLINE newArray_ #-} + newArray_ = unsafeNewArray_ + {-# INLINE unsafeRead #-} + unsafeRead (IOUArray marr) i = stToIO (unsafeRead marr i) + {-# INLINE unsafeWrite #-} + unsafeWrite (IOUArray marr) i e = stToIO (unsafeWrite marr i e) + +-- | Casts an 'IOUArray' with one element type into one with a +-- different element type. All the elements of the resulting array +-- are undefined (unless you know what you\'re doing...). +castIOUArray :: IOUArray ix a -> IO (IOUArray ix b) +castIOUArray (IOUArray marr) = stToIO $ do + marr' <- castSTUArray marr + return (IOUArray marr') + +{-# INLINE unsafeThawIOUArray #-} +#if __GLASGOW_HASKELL__ >= 711 +unsafeThawIOUArray :: UArray ix e -> IO (IOUArray ix e) +#else +unsafeThawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e) +#endif +unsafeThawIOUArray arr = stToIO $ do + marr <- unsafeThawSTUArray arr + return (IOUArray marr) + +{-# RULES +"unsafeThaw/IOUArray" unsafeThaw = unsafeThawIOUArray + #-} + +#if __GLASGOW_HASKELL__ >= 711 +thawIOUArray :: UArray ix e -> IO (IOUArray ix e) +#else +thawIOUArray :: Ix ix => UArray ix e -> IO (IOUArray ix e) +#endif +thawIOUArray arr = stToIO $ do + marr <- thawSTUArray arr + return (IOUArray marr) + +{-# RULES +"thaw/IOUArray" thaw = thawIOUArray + #-} + +{-# INLINE unsafeFreezeIOUArray #-} +#if __GLASGOW_HASKELL__ >= 711 +unsafeFreezeIOUArray :: IOUArray ix e -> IO (UArray ix e) +#else +unsafeFreezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e) +#endif +unsafeFreezeIOUArray (IOUArray marr) = stToIO (unsafeFreezeSTUArray marr) + +{-# RULES +"unsafeFreeze/IOUArray" unsafeFreeze = unsafeFreezeIOUArray + #-} + +#if __GLASGOW_HASKELL__ >= 711 +freezeIOUArray :: IOUArray ix e -> IO (UArray ix e) +#else +freezeIOUArray :: Ix ix => IOUArray ix e -> IO (UArray ix e) +#endif +freezeIOUArray (IOUArray marr) = stToIO (freezeSTUArray marr) + +{-# RULES +"freeze/IOUArray" freeze = freezeIOUArray + #-} diff --git a/testsuite/tests/printer/Ppr020.hs b/testsuite/tests/printer/Ppr020.hs new file mode 100644 index 0000000000..f567f726a1 --- /dev/null +++ b/testsuite/tests/printer/Ppr020.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE LambdaCase #-} + +foo = f >>= \case + Just h -> loadTestDB (h ++ "/.testdb") + Nothing -> fmap S.Right initTestDB + +{-| Is the alarm set - i.e. will it go off at some point in the future even if + `setAlarm` is not called? -} +isAlarmSetSTM :: AlarmClock -> STM Bool +isAlarmSetSTM AlarmClock{..} = readTVar acNewSetting + >>= \case { AlarmNotSet -> readTVar acIsSet; _ -> return True } diff --git a/testsuite/tests/printer/Ppr020.stderr b/testsuite/tests/printer/Ppr020.stderr new file mode 100644 index 0000000000..bd82bca25e --- /dev/null +++ b/testsuite/tests/printer/Ppr020.stderr @@ -0,0 +1,31 @@ + +Ppr020.hs:5:25: + Not in scope: data constructor ‘S.Right’ + No module named ‘S’ is imported. + +Ppr020.hs:9:18: + Not in scope: type constructor or class ‘AlarmClock’ + +Ppr020.hs:9:32: + Not in scope: type constructor or class ‘STM’ + +Ppr020.hs:10:15: Not in scope: data constructor ‘AlarmClock’ + +Ppr020.hs:11:15: + Not in scope: data constructor ‘AlarmNotSet’ + +Ppr020.ppr.hs:6:27: + Not in scope: data constructor ‘S.Right’ + No module named ‘S’ is imported. + +Ppr020.ppr.hs:7:18: + Not in scope: type constructor or class ‘AlarmClock’ + +Ppr020.ppr.hs:7:32: + Not in scope: type constructor or class ‘STM’ + +Ppr020.ppr.hs:8:15: + Not in scope: data constructor ‘AlarmClock’ + +Ppr020.ppr.hs:12:11: + Not in scope: data constructor ‘AlarmNotSet’ diff --git a/testsuite/tests/printer/Ppr021.hs b/testsuite/tests/printer/Ppr021.hs new file mode 100644 index 0000000000..03bda3dcff --- /dev/null +++ b/testsuite/tests/printer/Ppr021.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# Language DeriveFoldable #-} +{-# LANGUAGE Safe #-} +{-# options_ghc -w #-} + +-- | A simple let expression, to ensure the layout is detected +-- With some haddock in the top +{- And a normal + multiline comment too -} + module {- brah -} LetExpr ( foo -- foo does .. + , bar -- bar does .. + , Baz () -- baz does .. + , Ba ( ..),Ca(Cc,Cd) , + bbb , aaa + , module Data.List + , pattern Bar + ) + where + +import Data.List +-- A comment in the middle +import {-# SOURCE #-} BootImport ( Foo(..) ) +import {-# SoURCE #-} safe qualified BootImport as BI +import qualified Data.Map as {- blah -} Foo.Map + +import Control.Monad ( ) +import Data.Word (Word8) +import Data.Tree hiding ( drawTree ) + +import qualified Data.Maybe as M hiding ( maybe , isJust ) + + +-- comment +foo = let x = 1 + y = 2 + in x + y + +bar = 3 +bbb x + | x == 1 = () + | otherwise = () + + +aaa [ ] _ = 0 +aaa x _unk = 1 + +aba () = 0 + +x `ccc` 1 = x + 1 +x `ccc` y = x + y + +x !@# y = x + y + +data Baz = Baz1 | Baz2 + +data Ba = Ba | Bb + +data Ca = Cc | Cd + +pattern Foo a <- RealFoo a +pattern Bar a <- RealBar a + +data Thing = RealFoo Thing | RealBar Int diff --git a/testsuite/tests/printer/Ppr021.stderr b/testsuite/tests/printer/Ppr021.stderr new file mode 100644 index 0000000000..c8eb1667c4 --- /dev/null +++ b/testsuite/tests/printer/Ppr021.stderr @@ -0,0 +1,16 @@ + +Ppr021.hs:22:1: error: + Could not find module ‘BootImport’ + Use -v to see a list of the files searched for. + +Ppr021.hs:23:1: error: + Could not find module ‘BootImport’ + Use -v to see a list of the files searched for. + +Ppr021.ppr.hs:10:1: error: + Could not find module ‘BootImport’ + Use -v to see a list of the files searched for. + +Ppr021.ppr.hs:11:1: error: + Could not find module ‘BootImport’ + Use -v to see a list of the files searched for. diff --git a/testsuite/tests/printer/Ppr022.hs b/testsuite/tests/printer/Ppr022.hs new file mode 100644 index 0000000000..9d57907522 --- /dev/null +++ b/testsuite/tests/printer/Ppr022.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds, TemplateHaskell #-} + +applicate :: Bool -> [Stmt] -> ExpQ +applicate rawPatterns stmt = do + return $ foldl (\g e -> VarE '(<**>) `AppE` e `AppE` g) + (VarE 'pure `AppE` f') + es + +tuple :: Int -> ExpQ +tuple n = do + ns <- replicateM n (newName "x") + lamE [foldr (\x y -> conP '(:) [varP x,y]) wildP ns] (tupE $ map varE ns) diff --git a/testsuite/tests/printer/Ppr022.stderr b/testsuite/tests/printer/Ppr022.stderr new file mode 100644 index 0000000000..3094acae7a --- /dev/null +++ b/testsuite/tests/printer/Ppr022.stderr @@ -0,0 +1,28 @@ + +Ppr022.hs:3:23: + Not in scope: type constructor or class ‘Stmt’ + +Ppr022.hs:3:32: + Not in scope: type constructor or class ‘ExpQ’ + +Ppr022.hs:5:34: + Not in scope: ‘<**>’ + Perhaps you meant ‘<*>’ (imported from Prelude) + In the Template Haskell quotation '(<**>) + +Ppr022.hs:9:17: + Not in scope: type constructor or class ‘ExpQ’ + +Ppr022.ppr.hs:2:23: + Not in scope: type constructor or class ‘Stmt’ + +Ppr022.ppr.hs:2:32: + Not in scope: type constructor or class ‘ExpQ’ + +Ppr022.ppr.hs:6:29: + Not in scope: ‘<**>’ + Perhaps you meant ‘<*>’ (imported from Prelude) + In the Template Haskell quotation '(<**>) + +Ppr022.ppr.hs:7:17: + Not in scope: type constructor or class ‘ExpQ’ diff --git a/testsuite/tests/printer/Ppr023.hs b/testsuite/tests/printer/Ppr023.hs new file mode 100644 index 0000000000..7291854f07 --- /dev/null +++ b/testsuite/tests/printer/Ppr023.hs @@ -0,0 +1,37 @@ +class AwsType a where + toText :: a -> b + + + {-# MINIMAL toText #-} + +class Minimal a where + toText :: a -> b + {-# MINIMAL decimal, hexadecimal, realFloat, scientific #-} + +class Minimal a where + toText :: a -> b + {-# MINIMAL shape, (maskedIndex | maskedLinearIndex) #-} + +class Minimal a where + toText :: a -> b + {-# MINIMAL (toSample | toSamples) #-} + +class ManyOps a where + aOp :: a -> a -> Bool + bOp :: a -> a -> Bool + cOp :: a -> a -> Bool + dOp :: a -> a -> Bool + eOp :: a -> a -> Bool + fOp :: a -> a -> Bool + {-# MINIMAL ( aOp) + | ( bOp , cOp) + | ((dOp | eOp) , fOp) + #-} + +class Foo a where + bar :: a -> a -> Bool + foo :: a -> a -> Bool + baq :: a -> a -> Bool + baz :: a -> a -> Bool + quux :: a -> a -> Bool + {-# MINIMAL bar, (foo, baq | foo, quux) #-} diff --git a/testsuite/tests/printer/Ppr023.stderr b/testsuite/tests/printer/Ppr023.stderr new file mode 100644 index 0000000000..35440a54cd --- /dev/null +++ b/testsuite/tests/printer/Ppr023.stderr @@ -0,0 +1,49 @@ +Ppr023.hs:15:1: error: + Multiple declarations of ‘Minimal’ + Declared at: Ppr023.hs:11:1 + Ppr023.hs:15:1 + +Ppr023.hs:15:1: error: + Multiple declarations of ‘Minimal’ + Declared at: Ppr023.hs:7:1 + Ppr023.hs:15:1 + +Ppr023.hs:16:3: error: + Multiple declarations of ‘toText’ + Declared at: Ppr023.hs:12:3 + Ppr023.hs:16:3 + +Ppr023.hs:16:3: error: + Multiple declarations of ‘toText’ + Declared at: Ppr023.hs:8:3 + Ppr023.hs:16:3 + +Ppr023.hs:16:3: error: + Multiple declarations of ‘toText’ + Declared at: Ppr023.hs:2:5 + Ppr023.hs:16:3 + +Ppr023.ppr.hs:11:1: error: + Multiple declarations of ‘Minimal’ + Declared at: Ppr023.ppr.hs:8:1 + Ppr023.ppr.hs:11:1 + +Ppr023.ppr.hs:11:1: error: + Multiple declarations of ‘Minimal’ + Declared at: Ppr023.ppr.hs:5:1 + Ppr023.ppr.hs:11:1 + +Ppr023.ppr.hs:12:3: error: + Multiple declarations of ‘toText’ + Declared at: Ppr023.ppr.hs:9:3 + Ppr023.ppr.hs:12:3 + +Ppr023.ppr.hs:12:3: error: + Multiple declarations of ‘toText’ + Declared at: Ppr023.ppr.hs:6:3 + Ppr023.ppr.hs:12:3 + +Ppr023.ppr.hs:12:3: error: + Multiple declarations of ‘toText’ + Declared at: Ppr023.ppr.hs:3:3 + Ppr023.ppr.hs:12:3 diff --git a/testsuite/tests/printer/Ppr024.hs b/testsuite/tests/printer/Ppr024.hs new file mode 100644 index 0000000000..cccd8b163c --- /dev/null +++ b/testsuite/tests/printer/Ppr024.hs @@ -0,0 +1,47 @@ +import Data.List () +import Data.List hiding () + +infixl 1 `f` +-- infixr 2 `\\\` +infix 3 :==> +infix 4 `MkFoo` + +data Foo = MkFoo Int | Float :==> Double + +x `f` y = x + +(\\\) :: (Eq a) => [a] -> [a] -> [a] +(\\\) xs ys = xs + +g x = x + if True then 1 else 2 +h x = x + 1::Int + +{-# SPECIALISe j :: Int -> Int + , Integer -> Integer #-} + +j n = n + 1 + +test = let k x y = x+y in 1 `k` 2 `k` 3 + +data Rec = (:<-:) { a :: Int, b :: Float } + +ng1 x y = negate y + +instance (Num a, Num b) => Num (a,b) + where + {-# Specialise instance Num (Int,Int) #-} + negate (a,b) = (ng 'c' a, ng1 'c' b) where ng x y = negate y + + + +class Foo1 a where + +class Foz a + +x = 2 where +y = 3 + +instance Foo1 Int where + +ff = ff where g = g where +type T = Int diff --git a/testsuite/tests/printer/Ppr024.stderr b/testsuite/tests/printer/Ppr024.stderr new file mode 100644 index 0000000000..3672a804b4 --- /dev/null +++ b/testsuite/tests/printer/Ppr024.stderr @@ -0,0 +1,6 @@ + +Ppr024.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ + +Ppr024.ppr.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/printer/Ppr025.hs b/testsuite/tests/printer/Ppr025.hs new file mode 100644 index 0000000000..c198e18a41 --- /dev/null +++ b/testsuite/tests/printer/Ppr025.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE Arrows #-} + +operator = describe "Operators on ProcessA"$ + do + describe "feedback" $ + do + it "acts like local variable with hold." $ + do + let + pa = proc evx -> + do + (\evy -> hold 10 -< evy) + `feedback` \y -> + do + returnA -< ((+y) <$> evx, (y+1) <$ evx) + run pa [1, 2, 3] `shouldBe` [11, 13, 15] + + it "correctly handles stream end." $ + do + let + pa = proc x -> + (\asx -> returnA -< asx) + `feedback` + (\asy -> returnA -< (asy::Event Int, x)) + comp = mkProc (PgPush PgStop) >>> pa + stateProc comp [0, 0] `shouldBe` ([], [0]) + + it "correctly handles stream end.(2)" $ + do + pendingWith "many utilities behave incorrectly at end of stream." diff --git a/testsuite/tests/printer/Ppr025.stderr b/testsuite/tests/printer/Ppr025.stderr new file mode 100644 index 0000000000..4d552b72f5 --- /dev/null +++ b/testsuite/tests/printer/Ppr025.stderr @@ -0,0 +1,6 @@ + +Ppr025.hs:24:47: error: + Not in scope: type constructor or class ‘Event’ + +Ppr025.ppr.hs:17:77: error: + Not in scope: type constructor or class ‘Event’ diff --git a/testsuite/tests/printer/Ppr026.hs b/testsuite/tests/printer/Ppr026.hs new file mode 100644 index 0000000000..9bdfad7104 --- /dev/null +++ b/testsuite/tests/printer/Ppr026.hs @@ -0,0 +1,14 @@ +{-# Language OverloadedStrings #-} +-- from https://ocharles.org.uk/blog/posts/2014-12-17-overloaded-strings.html + +import Data.String + +n :: Num a => a +n = 43 + +f :: Fractional a => a +f = 03.1420 + +-- foo :: Text +foo :: Data.String.IsString a => a +foo = "hello\n there" diff --git a/testsuite/tests/printer/Ppr026.stderr b/testsuite/tests/printer/Ppr026.stderr new file mode 100644 index 0000000000..5768dc97df --- /dev/null +++ b/testsuite/tests/printer/Ppr026.stderr @@ -0,0 +1,6 @@ + +Ppr026.hs:1:1: + The IO action ‘main’ is not defined in module ‘Main’ + +Ppr026.ppr.hs:1:1: + The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/printer/Ppr027.hs b/testsuite/tests/printer/Ppr027.hs new file mode 100644 index 0000000000..50de503689 --- /dev/null +++ b/testsuite/tests/printer/Ppr027.hs @@ -0,0 +1,5 @@ +{-# OPTIONS -XTemplateHaskell #-} +module TH( x ) where +import Language.Haskell.TH + +x = $(return (LitE (StringL "hello\ngoodbye\nand then"))) diff --git a/testsuite/tests/printer/Ppr028.hs b/testsuite/tests/printer/Ppr028.hs new file mode 100644 index 0000000000..8c9e7ddf09 --- /dev/null +++ b/testsuite/tests/printer/Ppr028.hs @@ -0,0 +1,12 @@ +{-#LANGUAGE Arrows, RankNTypes, ScopedTypeVariables, FlexibleContexts, + TypeSynonymInstances, NoMonomorphismRestriction, FlexibleInstances #-} + +valForm initVal vtor label = withInput $ + proc ((),nm,fi) -> do + s_curr <- keepState initVal -< fi + valid <- vtor -< s_curr + case valid of + Left err -> returnA -< (textField label (Just err) s_curr nm, + Nothing) + Right x -> returnA -< (textField label Nothing s_curr nm, + Just x) diff --git a/testsuite/tests/printer/Ppr028.stderr b/testsuite/tests/printer/Ppr028.stderr new file mode 100644 index 0000000000..c53770c3d0 --- /dev/null +++ b/testsuite/tests/printer/Ppr028.stderr @@ -0,0 +1,6 @@ + +Ppr028.hs:1:1: + The IO action ‘main’ is not defined in module ‘Main’ + +Ppr028.ppr.hs:1:1: + The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/printer/Ppr029.hs b/testsuite/tests/printer/Ppr029.hs new file mode 100644 index 0000000000..6018455e12 --- /dev/null +++ b/testsuite/tests/printer/Ppr029.hs @@ -0,0 +1,37 @@ +module Rules where + +import Data.Char + +{-# RULES "map-loop" [ ~ ] forall f . map' f = map' (id . f) #-} + +{-# NOINLINE map' #-} +map' f [] = [] +map' f (x:xs) = f x : map' f xs + +main = print (map' toUpper "Hello, World") + +-- Should warn +foo1 x = x +{-# RULES "foo1" [ 1] forall x. foo1 x = x #-} + +-- Should warn +foo2 x = x +{-# INLINE foo2 #-} +{-# RULES "foo2" [~ 1 ] forall x. foo2 x = x #-} + +-- Should not warn +foo3 x = x +{-# NOINLINE foo3 #-} +{-# RULES "foo3" forall x. foo3 x = x #-} + +{-# NOINLINE f #-} +f :: Int -> String +f x = "NOT FIRED" + +{-# NOINLINE neg #-} +neg :: Int -> Int +neg = negate + +{-# RULES + "f" forall (c::Char->Int) (x::Char). f (c x) = "RULE FIRED" + #-} diff --git a/testsuite/tests/printer/Ppr029.stderr b/testsuite/tests/printer/Ppr029.stderr new file mode 100644 index 0000000000..a17efb9687 --- /dev/null +++ b/testsuite/tests/printer/Ppr029.stderr @@ -0,0 +1,16 @@ + +Ppr029.hs:15:11: warning: [-Winline-rule-shadowing] + Rule "foo1" may never fire because ‘foo1’ might inline first + Probable fix: add an INLINE[n] or NOINLINE[n] pragma for ‘foo1’ + +Ppr029.hs:20:11: warning: [-Winline-rule-shadowing] + Rule "foo2" may never fire because ‘foo2’ might inline first + Probable fix: add an INLINE[n] or NOINLINE[n] pragma for ‘foo2’ + +Ppr029.ppr.hs:10:11: warning: [-Winline-rule-shadowing] + Rule "foo1" may never fire because ‘foo1’ might inline first + Probable fix: add an INLINE[n] or NOINLINE[n] pragma for ‘foo1’ + +Ppr029.ppr.hs:13:11: warning: [-Winline-rule-shadowing] + Rule "foo2" may never fire because ‘foo2’ might inline first + Probable fix: add an INLINE[n] or NOINLINE[n] pragma for ‘foo2’ diff --git a/testsuite/tests/printer/Ppr030.hs b/testsuite/tests/printer/Ppr030.hs new file mode 100644 index 0000000000..84364c0bea --- /dev/null +++ b/testsuite/tests/printer/Ppr030.hs @@ -0,0 +1,10 @@ +{-# RULES + "cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x; + "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x; + "cFloatConv/Float->CFloat" forall (x::Float). cFloatConv x = CFloat x; + "cFloatConv/CFloat->Float" forall (x::Float). cFloatConv CFloat x = x; + "cFloatConv/Double->CDouble" forall (x::Double). cFloatConv x = CDouble x; + "cFloatConv/CDouble->Double" forall (x::Double). cFloatConv CDouble x = x + #-}; + +cFloatConv = undefined diff --git a/testsuite/tests/printer/Ppr030.stderr b/testsuite/tests/printer/Ppr030.stderr new file mode 100644 index 0000000000..723d746d1a --- /dev/null +++ b/testsuite/tests/printer/Ppr030.stderr @@ -0,0 +1,6 @@ + +Ppr030.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ + +Ppr030.ppr.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/printer/Ppr031.hs b/testsuite/tests/printer/Ppr031.hs new file mode 100644 index 0000000000..b31896a9fc --- /dev/null +++ b/testsuite/tests/printer/Ppr031.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE ImplicitParams, NamedFieldPuns, ParallelListComp, PatternGuards #-} +spec :: Spec +spec = do + describe "split4'8" $ do + it "0xabc" $ do + split4'8 0xabc `shouldBe` (0x0a, 0xbc) + it "0xfff" $ do + split4'8 0xfff `shouldBe` (0x0f, 0xff) + + describe "(x, y) = split4'8 z" $ do + prop "x <= 0x0f" $ + \z -> let (x, _) = split4'8 z in x <= 0x0f + prop "x << 8 | y == z" $ do + \z -> let (x, y) = split4'8 z in + fromIntegral x `shiftL` 8 .|. fromIntegral y == z + +match s@Status{ pos, flips, captureAt, captureLen } + | isOne ?pat = ite (pos .>= strLen) __FAIL__ one + | otherwise = ite (pos + (toEnum $ minLen ?pat) .> strLen) __FAIL__ $ case ?pat of + POr ps -> choice flips $ map (\p -> \b -> let ?pat = p in match s{ flips = b }) ps + +foo = 1 diff --git a/testsuite/tests/printer/Ppr031.stderr b/testsuite/tests/printer/Ppr031.stderr new file mode 100644 index 0000000000..bc9bc3779f --- /dev/null +++ b/testsuite/tests/printer/Ppr031.stderr @@ -0,0 +1,46 @@ + +Ppr031.hs:2:9: error: + Not in scope: type constructor or class ‘Spec’ + +Ppr031.hs:17:9: error: Not in scope: data constructor ‘Status’ + +Ppr031.hs:17:17: error: + Not in scope: ‘pos’ + Perhaps you meant ‘cos’ (imported from Prelude) + +Ppr031.hs:17:22: error: + Not in scope: ‘flips’ + Perhaps you meant ‘flip’ (imported from Prelude) + +Ppr031.hs:17:29: error: Not in scope: ‘captureAt’ + +Ppr031.hs:17:40: error: Not in scope: ‘captureLen’ + +Ppr031.hs:20:5: error: Not in scope: data constructor ‘POr’ + +Ppr031.hs:20:72: error: + Not in scope: ‘flips’ + Perhaps you meant ‘flip’ (imported from Prelude) + +Ppr031.ppr.hs:2:9: error: + Not in scope: type constructor or class ‘Spec’ + +Ppr031.ppr.hs:13:9: error: Not in scope: data constructor ‘Status’ + +Ppr031.ppr.hs:13:17: error: + Not in scope: ‘pos’ + Perhaps you meant ‘cos’ (imported from Prelude) + +Ppr031.ppr.hs:13:22: error: + Not in scope: ‘flips’ + Perhaps you meant ‘flip’ (imported from Prelude) + +Ppr031.ppr.hs:13:29: error: Not in scope: ‘captureAt’ + +Ppr031.ppr.hs:13:40: error: Not in scope: ‘captureLen’ + +Ppr031.ppr.hs:18:11: error: Not in scope: data constructor ‘POr’ + +Ppr031.ppr.hs:20:64: error: + Not in scope: ‘flips’ + Perhaps you meant ‘flip’ (imported from Prelude) diff --git a/testsuite/tests/printer/Ppr032.hs b/testsuite/tests/printer/Ppr032.hs new file mode 100644 index 0000000000..bd79f1e63b --- /dev/null +++ b/testsuite/tests/printer/Ppr032.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE PatternSynonyms #-} + +module Sigs where + +-- TypeSig +f :: Num a => a -> a +f = undefined + +pattern Single :: () => (Show a) => a -> [a] +pattern Single x = [x] + +g :: (Show a) => [a] -> a +g (Single x) = x + +-- Fixities + +infixr 6 +++ +infixr 7 ***,/// + +(+++) :: Int -> Int -> Int +a +++ b = a + 2*b + +(***) :: Int -> Int -> Int +a *** b = a - 4*b + +(///) :: Int -> Int -> Int +a /// b = 2*a - 3*b + +-- Inline signatures + +{-# Inline g #-} +{-# INLINE [~34] f #-} + +-- Specialise signature + +-- Multiple sigs +x,y,z :: Int +x = 0 +y = 0 +z = 0 diff --git a/testsuite/tests/printer/Ppr032.stderr b/testsuite/tests/printer/Ppr032.stderr new file mode 100644 index 0000000000..cbca8d8f9c --- /dev/null +++ b/testsuite/tests/printer/Ppr032.stderr @@ -0,0 +1,18 @@ + +Ppr032.hs:10:21: + No instance for (Show a) + arising from the "provided" constraints claimed by + the signature of ‘Single’ + In other words, a successful match on the pattern + [x] + does not provide the constraint (Show a) + In the declaration for pattern synonym ‘Single’ + +Ppr032.ppr.hs:6:21: + No instance for (Show a) + arising from the "provided" constraints claimed by + the signature of ‘Single’ + In other words, a successful match on the pattern + [x] + does not provide the constraint (Show a) + In the declaration for pattern synonym ‘Single’ diff --git a/testsuite/tests/printer/Ppr033.hs b/testsuite/tests/printer/Ppr033.hs new file mode 100644 index 0000000000..1aa9060228 --- /dev/null +++ b/testsuite/tests/printer/Ppr033.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE TemplateHaskell #-} + +import Language.Haskell.TH + +makeLenses '' PostscriptFont + +ty :: Q Type +ty = [t| Int |] + +f :: $ty +f = undefined + +g :: $(ty) +g = undefined + +thb = $(do { let x = mkName "x" + v = return (LamE [VarP x] $ VarE x) + ; [| $v . id |] }) + +foo2 :: A Bool +foo2 = $$(y) diff --git a/testsuite/tests/printer/Ppr033.stderr b/testsuite/tests/printer/Ppr033.stderr new file mode 100644 index 0000000000..4b3e8d55bf --- /dev/null +++ b/testsuite/tests/printer/Ppr033.stderr @@ -0,0 +1,8 @@ + +Ppr033.hs:5:12: + Not in scope: type constructor or class ‘PostscriptFont’ + In the Template Haskell quotation ''PostscriptFont + +Ppr033.ppr.hs:3:12: + Not in scope: type constructor or class ‘PostscriptFont’ + In the Template Haskell quotation ''PostscriptFont diff --git a/testsuite/tests/printer/Ppr034.hs b/testsuite/tests/printer/Ppr034.hs new file mode 100644 index 0000000000..c16e0bfbae --- /dev/null +++ b/testsuite/tests/printer/Ppr034.hs @@ -0,0 +1,423 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Algebra.Additive ( + -- * Class + C, + zero, + (+), (-), + negate, subtract, + + -- * Complex functions + sum, sum1, + sumNestedAssociative, + sumNestedCommutative, + + -- * Instance definition helpers + elementAdd, elementSub, elementNeg, + (<*>.+), (<*>.-), (<*>.-$), + + -- * Instances for atomic types + propAssociative, + propCommutative, + propIdentity, + propInverse, + ) where + +import qualified Algebra.Laws as Laws + +import Data.Int (Int, Int8, Int16, Int32, Int64, ) +import Data.Word (Word, Word8, Word16, Word32, Word64, ) + +import qualified NumericPrelude.Elementwise as Elem +import Control.Applicative (Applicative(pure, (<*>)), ) +import Data.Tuple.HT (fst3, snd3, thd3, ) +import qualified Data.List.Match as Match + +import qualified Data.Complex as Complex98 +import qualified Data.Ratio as Ratio98 +import qualified Prelude as P +import Prelude (Integer, Float, Double, fromInteger, ) +import NumericPrelude.Base + + +infixl 6 +, - + +{- | +Additive a encapsulates the notion of a commutative group, specified +by the following laws: + +@ + a + b === b + a + (a + b) + c === a + (b + c) + zero + a === a + a + negate a === 0 +@ + +Typical examples include integers, dollars, and vectors. + +Minimal definition: '+', 'zero', and ('negate' or '(-)') +-} + +class C a where + {-# MINIMAL zero, (+), ((-) | negate) #-} + -- | zero element of the vector space + zero :: a + -- | add and subtract elements + (+), (-) :: a -> a -> a + -- | inverse with respect to '+' + negate :: a -> a + + {-# INLINE negate #-} + negate a = zero - a + {-# INLINE (-) #-} + a - b = a + negate b + +{- | +'subtract' is @(-)@ with swapped operand order. +This is the operand order which will be needed in most cases +of partial application. +-} +subtract :: C a => a -> a -> a +subtract = flip (-) + + + + +{- | +Sum up all elements of a list. +An empty list yields zero. + +This function is inappropriate for number types like Peano. +Maybe we should make 'sum' a method of Additive. +This would also make 'lengthLeft' and 'lengthRight' superfluous. +-} +sum :: (C a) => [a] -> a +sum = foldl (+) zero + +{- | +Sum up all elements of a non-empty list. +This avoids including a zero which is useful for types +where no universal zero is available. +-} +sum1 :: (C a) => [a] -> a +sum1 = foldl1 (+) + + +{- | +Sum the operands in an order, +such that the dependencies are minimized. +Does this have a measurably effect on speed? + +Requires associativity. +-} +sumNestedAssociative :: (C a) => [a] -> a +sumNestedAssociative [] = zero +sumNestedAssociative [x] = x +sumNestedAssociative xs = sumNestedAssociative (sum2 xs) + +{- +Make sure that the last entries in the list +are equally often part of an addition. +Maybe this can reduce rounding errors. +The list that sum2 computes is a breadth-first-flattened binary tree. + +Requires associativity and commutativity. +-} +sumNestedCommutative :: (C a) => [a] -> a +sumNestedCommutative [] = zero +sumNestedCommutative xs@(_:rs) = + let ys = xs ++ Match.take rs (sum2 ys) + in last ys + +_sumNestedCommutative :: (C a) => [a] -> a +_sumNestedCommutative [] = zero +_sumNestedCommutative xs@(_:rs) = + let ys = xs ++ take (length rs) (sum2 ys) + in last ys + +{- +[a,b,c, a+b,c+(a+b)] +[a,b,c,d, a+b,c+d,(a+b)+(c+d)] +[a,b,c,d,e, a+b,c+d,e+(a+b),(c+d)+e+(a+b)] +[a,b,c,d,e,f, a+b,c+d,e+f,(a+b)+(c+d),(e+f)+((a+b)+(c+d))] +-} + +sum2 :: (C a) => [a] -> [a] +sum2 (x:y:rest) = (x+y) : sum2 rest +sum2 xs = xs + + + +{- | +Instead of baking the add operation into the element function, +we could use higher rank types +and pass a generic @uncurry (+)@ to the run function. +We do not do so in order to stay Haskell 98 +at least for parts of NumericPrelude. +-} +{-# INLINE elementAdd #-} +elementAdd :: + (C x) => + (v -> x) -> Elem.T (v,v) x +elementAdd f = + Elem.element (\(x,y) -> f x + f y) + +{-# INLINE elementSub #-} +elementSub :: + (C x) => + (v -> x) -> Elem.T (v,v) x +elementSub f = + Elem.element (\(x,y) -> f x - f y) + +{-# INLINE elementNeg #-} +elementNeg :: + (C x) => + (v -> x) -> Elem.T v x +elementNeg f = + Elem.element (negate . f) + + +-- like <*> +infixl 4 <*>.+, <*>.-, <*>.-$ + +{- | +> addPair :: (Additive.C a, Additive.C b) => (a,b) -> (a,b) -> (a,b) +> addPair = Elem.run2 $ Elem.with (,) <*>.+ fst <*>.+ snd +-} +{-# INLINE (<*>.+) #-} +(<*>.+) :: + (C x) => + Elem.T (v,v) (x -> a) -> (v -> x) -> Elem.T (v,v) a +(<*>.+) f acc = + f <*> elementAdd acc + +{-# INLINE (<*>.-) #-} +(<*>.-) :: + (C x) => + Elem.T (v,v) (x -> a) -> (v -> x) -> Elem.T (v,v) a +(<*>.-) f acc = + f <*> elementSub acc + +{-# INLINE (<*>.-$) #-} +(<*>.-$) :: + (C x) => + Elem.T v (x -> a) -> (v -> x) -> Elem.T v a +(<*>.-$) f acc = + f <*> elementNeg acc + + +-- * Instances for atomic types + +instance C Integer where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Float where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Double where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + + +instance C Int where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Int8 where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Int16 where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Int32 where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Int64 where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + + +instance C Word where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Word8 where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Word16 where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Word32 where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + +instance C Word64 where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + negate = P.negate + (+) = (P.+) + (-) = (P.-) + + + + +-- * Instances for composed types + +instance (C v0, C v1) => C (v0, v1) where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = (,) zero zero + (+) = Elem.run2 $ pure (,) <*>.+ fst <*>.+ snd + (-) = Elem.run2 $ pure (,) <*>.- fst <*>.- snd + negate = Elem.run $ pure (,) <*>.-$ fst <*>.-$ snd + +instance (C v0, C v1, C v2) => C (v0, v1, v2) where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = (,,) zero zero zero + (+) = Elem.run2 $ pure (,,) <*>.+ fst3 <*>.+ snd3 <*>.+ thd3 + (-) = Elem.run2 $ pure (,,) <*>.- fst3 <*>.- snd3 <*>.- thd3 + negate = Elem.run $ pure (,,) <*>.-$ fst3 <*>.-$ snd3 <*>.-$ thd3 + + +instance (C v) => C [v] where + zero = [] + negate = map negate + (+) (x:xs) (y:ys) = (+) x y : (+) xs ys + (+) xs [] = xs + (+) [] ys = ys + (-) (x:xs) (y:ys) = (-) x y : (-) xs ys + (-) xs [] = xs + (-) [] ys = negate ys + + +instance (C v) => C (b -> v) where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero _ = zero + (+) f g x = (+) (f x) (g x) + (-) f g x = (-) (f x) (g x) + negate f x = negate (f x) + +-- * Properties + +propAssociative :: (Eq a, C a) => a -> a -> a -> Bool +propCommutative :: (Eq a, C a) => a -> a -> Bool +propIdentity :: (Eq a, C a) => a -> Bool +propInverse :: (Eq a, C a) => a -> Bool + +propCommutative = Laws.commutative (+) +propAssociative = Laws.associative (+) +propIdentity = Laws.identity (+) zero +propInverse = Laws.inverse (+) negate zero + + + +-- legacy + +instance (P.Integral a) => C (Ratio98.Ratio a) where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + (+) = (P.+) + (-) = (P.-) + negate = P.negate + +instance (P.RealFloat a) => C (Complex98.Complex a) where + {-# INLINE zero #-} + {-# INLINE negate #-} + {-# INLINE (+) #-} + {-# INLINE (-) #-} + zero = P.fromInteger 0 + (+) = (P.+) + (-) = (P.-) + negate = P.negate diff --git a/testsuite/tests/printer/Ppr034.stderr b/testsuite/tests/printer/Ppr034.stderr new file mode 100644 index 0000000000..a57a2860aa --- /dev/null +++ b/testsuite/tests/printer/Ppr034.stderr @@ -0,0 +1,42 @@ + +Ppr034.hs:25:1: + Could not find module ‘Algebra.Laws’ + Use -v to see a list of the files searched for. + +Ppr034.hs:30:1: + Could not find module ‘NumericPrelude.Elementwise’ + Use -v to see a list of the files searched for. + +Ppr034.hs:32:1: + Could not find module ‘Data.Tuple.HT’ + Perhaps you meant Data.Tuple (from base-4.9.0.0) + Use -v to see a list of the files searched for. + +Ppr034.hs:33:1: + Could not find module ‘Data.List.Match’ + Use -v to see a list of the files searched for. + +Ppr034.hs:39:1: + Could not find module ‘NumericPrelude.Base’ + Use -v to see a list of the files searched for. + +Ppr034.ppr.hs:8:1: + Could not find module ‘Algebra.Laws’ + Use -v to see a list of the files searched for. + +Ppr034.ppr.hs:11:1: + Could not find module ‘NumericPrelude.Elementwise’ + Use -v to see a list of the files searched for. + +Ppr034.ppr.hs:13:1: + Could not find module ‘Data.Tuple.HT’ + Perhaps you meant Data.Tuple (from base-4.9.0.0) + Use -v to see a list of the files searched for. + +Ppr034.ppr.hs:14:1: + Could not find module ‘Data.List.Match’ + Use -v to see a list of the files searched for. + +Ppr034.ppr.hs:19:1: + Could not find module ‘NumericPrelude.Base’ + Use -v to see a list of the files searched for. diff --git a/testsuite/tests/printer/Ppr035.hs b/testsuite/tests/printer/Ppr035.hs new file mode 100644 index 0000000000..fa75e2e1e5 --- /dev/null +++ b/testsuite/tests/printer/Ppr035.hs @@ -0,0 +1,14 @@ +module Warning +{-# WARNINg ["This is a module warning", + "multi-line"] #-} + where + +{-# Warning foo , bar + ["This is a multi-line", + "deprecation message", + "for foo"] #-} +foo :: Int +foo = 4 + +bar :: Char +bar = 'c' diff --git a/testsuite/tests/printer/Ppr036.hs b/testsuite/tests/printer/Ppr036.hs new file mode 100644 index 0000000000..99bdeaf917 --- /dev/null +++ b/testsuite/tests/printer/Ppr036.hs @@ -0,0 +1,15 @@ +module Deprecation +{-# Deprecated ["This is a module \"deprecation\"", + "multi-line", + "with unicode: Frère" ] #-} + ( foo ) + where + +{-# DEPRECATEd foo + ["This is a multi-line", + "deprecation message", + "for foo"] #-} +foo :: Int +foo = 4 + +{-# DEPRECATED withBool "The C2HS module will soon stop providing unnecessary\nutility functions. Please use standard FFI library functions instead." #-} diff --git a/testsuite/tests/printer/Ppr036.stderr b/testsuite/tests/printer/Ppr036.stderr new file mode 100644 index 0000000000..3fd1c71544 --- /dev/null +++ b/testsuite/tests/printer/Ppr036.stderr @@ -0,0 +1,6 @@ + +Ppr036.hs:15:16: + The deprecation for ‘withBool’ lacks an accompanying binding + +Ppr036.ppr.hs:13:16: + The deprecation for ‘withBool’ lacks an accompanying binding diff --git a/testsuite/tests/printer/Ppr037.hs b/testsuite/tests/printer/Ppr037.hs new file mode 100644 index 0000000000..a812643fed --- /dev/null +++ b/testsuite/tests/printer/Ppr037.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE TypeOperators, DataKinds, PolyKinds, TypeFamilies, + RankNTypes, FlexibleContexts, TemplateHaskell, + UndecidableInstances, GADTs, DefaultSignatures #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Singletons.Prelude.Eq +-- Copyright : (C) 2013 Richard Eisenberg +-- License : BSD-style (see LICENSE) +-- Maintainer : Richard Eisenberg (eir@cis.upenn.edu) +-- Stability : experimental +-- Portability : non-portable +-- +-- Defines the SEq singleton version of the Eq type class. +-- +----------------------------------------------------------------------------- + +module Data.Singletons.Prelude.Eq ( + PEq(..), SEq(..), + (:==$), (:==$$), (:==$$$), (:/=$), (:/=$$), (:/=$$$) + ) where + +import Data.Singletons.Prelude.Bool +import Data.Singletons +import Data.Singletons.Single +import Data.Singletons.Prelude.Instances +import Data.Singletons.Util +import Data.Singletons.Promote +import Data.Type.Equality + +-- NB: These must be defined by hand because of the custom handling of the +-- default for (:==) to use Data.Type.Equality.== + +-- | The promoted analogue of 'Eq'. If you supply no definition for '(:==)', +-- then it defaults to a use of '(==)', from @Data.Type.Equality@. +class kproxy ~ 'KProxy => PEq (kproxy :: KProxy a) where + type (:==) (x :: a) (y :: a) :: Bool + type (:/=) (x :: a) (y :: a) :: Bool + + type (x :: a) :== (y :: a) = x == y + type (x :: a) :/= (y :: a) = Not (x :== y) + +infix 4 :== +infix 4 :/= + +$(genDefunSymbols [''(:==), ''(:/=)]) + +-- | The singleton analogue of 'Eq'. Unlike the definition for 'Eq', it is +-- required that instances define a body for '(%:==)'. You may also supply a +-- body for '(%:/=)'. +class (kparam ~ 'KProxy) => SEq (kparam :: KProxy k) where + -- | Boolean equality on singletons + (%:==) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Sing (a :== b) + infix 4 %:== + + -- | Boolean disequality on singletons + (%:/=) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Sing (a :/= b) + default (%:/=) :: forall (a :: k) (b :: k). + ((a :/= b) ~ Not (a :== b)) + => Sing a -> Sing b -> Sing (a :/= b) + a %:/= b = sNot (a %:== b) + infix 4 %:/= + +$(singEqInstances basicTypes) diff --git a/testsuite/tests/printer/Ppr037.stderr b/testsuite/tests/printer/Ppr037.stderr new file mode 100644 index 0000000000..da004e313e --- /dev/null +++ b/testsuite/tests/printer/Ppr037.stderr @@ -0,0 +1,48 @@ + +Ppr037.hs:23:1: error: + Could not find module ‘Data.Singletons.Prelude.Bool’ + Use -v to see a list of the files searched for. + +Ppr037.hs:24:1: error: + Could not find module ‘Data.Singletons’ + Use -v to see a list of the files searched for. + +Ppr037.hs:25:1: error: + Could not find module ‘Data.Singletons.Single’ + Use -v to see a list of the files searched for. + +Ppr037.hs:26:1: error: + Could not find module ‘Data.Singletons.Prelude.Instances’ + Use -v to see a list of the files searched for. + +Ppr037.hs:27:1: error: + Could not find module ‘Data.Singletons.Util’ + Use -v to see a list of the files searched for. + +Ppr037.hs:28:1: error: + Could not find module ‘Data.Singletons.Promote’ + Use -v to see a list of the files searched for. + +Ppr037.ppr.hs:8:1: error: + Could not find module ‘Data.Singletons.Prelude.Bool’ + Use -v to see a list of the files searched for. + +Ppr037.ppr.hs:9:1: error: + Could not find module ‘Data.Singletons’ + Use -v to see a list of the files searched for. + +Ppr037.ppr.hs:10:1: error: + Could not find module ‘Data.Singletons.Single’ + Use -v to see a list of the files searched for. + +Ppr037.ppr.hs:11:1: error: + Could not find module ‘Data.Singletons.Prelude.Instances’ + Use -v to see a list of the files searched for. + +Ppr037.ppr.hs:12:1: error: + Could not find module ‘Data.Singletons.Util’ + Use -v to see a list of the files searched for. + +Ppr037.ppr.hs:13:1: error: + Could not find module ‘Data.Singletons.Promote’ + Use -v to see a list of the files searched for. diff --git a/testsuite/tests/printer/Ppr038.hs b/testsuite/tests/printer/Ppr038.hs new file mode 100644 index 0000000000..43fafaf01c --- /dev/null +++ b/testsuite/tests/printer/Ppr038.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE MagicHash #-} +module LiteralsTest2 where + +x,y :: Int +x = 0003 +y = 0x04 + +s :: String +s = "\x20" + +c :: Char +c = '\x20' + +d :: Double +d = 0.00 + +blah = x + where + charH = '\x41'# + intH = 0004# + wordH = 005## + floatH = 3.20# + doubleH = 04.16## + -- int64H = 00456L# + -- word64H = 00456L## + x = 1 diff --git a/testsuite/tests/printer/Ppr039.hs b/testsuite/tests/printer/Ppr039.hs new file mode 100644 index 0000000000..3650283986 --- /dev/null +++ b/testsuite/tests/printer/Ppr039.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE MultiWayIf #-} +module MultiWayIf where + +foo = if | test1 -> e1 + | test2 witharg -> e2 + | otherwise -> def + +bar = if { | test1 -> if { | test2 -> e1 + | test3 -> e2 } + | test4 -> e3 + } + +-- taken from GHC's test suite +x = 10 +x1 = if | x < 10 -> "< 10" | otherwise -> "" +x2 = if | x < 10 -> "< 10" + | otherwise -> "" +x3 = if | x < 10 -> "< 10" + | otherwise -> "" +x4 = if | True -> "yes" +x5 = if | True -> if | False -> 1 | True -> 2 + +x6 = if | x < 10 -> if | True -> "yes" + | False -> "no" + | otherwise -> "maybe" + +x7 = (if | True -> 0) + +-- issue #98 +spam = if | () <- () -> () diff --git a/testsuite/tests/printer/Ppr039.stderr b/testsuite/tests/printer/Ppr039.stderr new file mode 100644 index 0000000000..004d5fe2a2 --- /dev/null +++ b/testsuite/tests/printer/Ppr039.stderr @@ -0,0 +1,73 @@ + +Ppr039.hs:4:12: error: Variable not in scope: test1 :: Bool + +Ppr039.hs:4:21: error: + • Variable not in scope: e1 + • Perhaps you meant ‘x1’ (line 15) + +Ppr039.hs:5:12: error: Variable not in scope: test2 :: t0 -> Bool + +Ppr039.hs:5:18: error: Variable not in scope: witharg + +Ppr039.hs:5:29: error: + • Variable not in scope: e2 + • Perhaps you meant ‘x2’ (line 16) + +Ppr039.hs:6:25: error: Variable not in scope: def + +Ppr039.hs:8:14: error: Variable not in scope: test1 :: Bool + +Ppr039.hs:8:30: error: Variable not in scope: test2 :: Bool + +Ppr039.hs:8:39: error: + • Variable not in scope: e1 + • Perhaps you meant ‘x1’ (line 15) + +Ppr039.hs:9:30: error: Variable not in scope: test3 :: Bool + +Ppr039.hs:9:39: error: + • Variable not in scope: e2 + • Perhaps you meant ‘x2’ (line 16) + +Ppr039.hs:10:14: error: Variable not in scope: test4 :: Bool + +Ppr039.hs:10:23: error: + • Variable not in scope: e3 + • Perhaps you meant ‘x3’ (line 18) + +Ppr039.ppr.hs:4:10: error: Variable not in scope: test1 :: Bool + +Ppr039.ppr.hs:4:19: error: + • Variable not in scope: e1 + • Perhaps you meant ‘x1’ (line 13) + +Ppr039.ppr.hs:5:10: error: + Variable not in scope: test2 :: t0 -> Bool + +Ppr039.ppr.hs:5:16: error: Variable not in scope: witharg + +Ppr039.ppr.hs:5:27: error: + • Variable not in scope: e2 + • Perhaps you meant ‘x2’ (line 16) + +Ppr039.ppr.hs:6:23: error: Variable not in scope: def + +Ppr039.ppr.hs:8:10: error: Variable not in scope: test1 :: Bool + +Ppr039.ppr.hs:9:20: error: Variable not in scope: test2 :: Bool + +Ppr039.ppr.hs:9:29: error: + • Variable not in scope: e1 + • Perhaps you meant ‘x1’ (line 13) + +Ppr039.ppr.hs:10:20: error: Variable not in scope: test3 :: Bool + +Ppr039.ppr.hs:10:29: error: + • Variable not in scope: e2 + • Perhaps you meant ‘x2’ (line 16) + +Ppr039.ppr.hs:11:10: error: Variable not in scope: test4 :: Bool + +Ppr039.ppr.hs:11:19: error: + • Variable not in scope: e3 + • Perhaps you meant ‘x3’ (line 19) diff --git a/testsuite/tests/printer/Ppr040.hs b/testsuite/tests/printer/Ppr040.hs new file mode 100644 index 0000000000..a9885a9d53 --- /dev/null +++ b/testsuite/tests/printer/Ppr040.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE TemplateHaskell, RankNTypes, TypeOperators, DataKinds, + PolyKinds, TypeFamilies, GADTs, TypeInType #-} + +module RAE_T32a where + +import Data.Kind + +data family Sing (k :: *) :: k -> * + +data TyArr' (a :: *) (b :: *) :: * +type TyArr (a :: *) (b :: *) = TyArr' a b -> * +type family (a :: TyArr k1 k2) @@ (b :: k1) :: k2 +data TyPi' (a :: *) (b :: TyArr a *) :: * +type TyPi (a :: *) (b :: TyArr a *) = TyPi' a b -> * +type family (a :: TyPi k1 k2) @@@ (b :: k1) :: k2 @@ b +$(return []) + +data MkStar (p :: *) (x :: TyArr' p *) +type instance MkStar p @@ x = * +$(return []) + +type instance (MkStar p) @@ x = * +$(return []) + +foo :: forall p x . MkStar p @@ x +foo = undefined + +data Sigma (p :: *) (r :: TyPi p (MkStar p)) :: * where + Sigma :: + forall (p :: *) (r :: TyPi p (MkStar p)) (a :: p) (b :: r @@@ a). + Sing * p -> Sing (TyPi p (MkStar p)) r -> Sing p a -> Sing (r @@@ a) b + -> Sigma p r +$(return []) + +data instance Sing Sigma (Sigma p r) x where + SSigma :: + forall (p :: *) (r :: TyPi p (MkStar p)) (a :: p) (b :: r @@@ a) + (sp :: Sing * p) (sr :: Sing (TyPi p (MkStar p)) r) (sa :: Sing p a) + (sb :: Sing (r @@@ a) b). + Sing (Sing (r @@@ a) b) sb -> + Sing (Sigma p r) ('Sigma sp sr sa sb) + +-- I (RAE) believe this last definition is ill-typed. diff --git a/testsuite/tests/printer/Ppr040.stderr b/testsuite/tests/printer/Ppr040.stderr new file mode 100644 index 0000000000..5083b4cb7e --- /dev/null +++ b/testsuite/tests/printer/Ppr040.stderr @@ -0,0 +1,38 @@ + +Ppr040.hs:35:1: error: + • Too many parameters to Sing: + x is unexpected; + expected only two parameters + • In the data instance declaration for ‘Sing’ + +Ppr040.hs:35:20: error: + • Expecting two more arguments to ‘Sigma’ + Expected a type, but + ‘Sigma’ has kind + ‘forall p -> TyPi p (MkStar p) -> *’ + • In the first argument of ‘Sing’, namely ‘Sigma’ + In the data instance declaration for ‘Sing’ + +Ppr040.hs:35:27: error: + • Expected kind ‘Sigma’, but ‘Sigma p r’ has kind ‘*’ + • In the second argument of ‘Sing’, namely ‘(Sigma p r)’ + In the data instance declaration for ‘Sing’ + +Ppr040.ppr.hs:30:1: error: + • Too many parameters to Sing: + x is unexpected; + expected only two parameters + • In the data instance declaration for ‘Sing’ + +Ppr040.ppr.hs:30:20: error: + • Expecting two more arguments to ‘Sigma’ + Expected a type, but + ‘Sigma’ has kind + ‘forall p -> TyPi p (MkStar p) -> *’ + • In the first argument of ‘Sing’, namely ‘Sigma’ + In the data instance declaration for ‘Sing’ + +Ppr040.ppr.hs:30:27: error: + • Expected kind ‘Sigma’, but ‘Sigma p r’ has kind ‘*’ + • In the second argument of ‘Sing’, namely ‘(Sigma p r)’ + In the data instance declaration for ‘Sing’ diff --git a/testsuite/tests/printer/Ppr041.hs b/testsuite/tests/printer/Ppr041.hs new file mode 100644 index 0000000000..154a6097f7 --- /dev/null +++ b/testsuite/tests/printer/Ppr041.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE MagicHash #-} +module Main where + +import GHC.Prim + +data P = Positives Int# Float# Double# Char# Word# deriving Show +data N = Negatives Int# Float# Double# deriving Show + +main = do + print $ Positives 42# 4.23# 4.23## '4'# 4## + print $ Negatives -4# -4.0# -4.0## diff --git a/testsuite/tests/printer/Ppr042.hs b/testsuite/tests/printer/Ppr042.hs new file mode 100644 index 0000000000..1085dc1b48 --- /dev/null +++ b/testsuite/tests/printer/Ppr042.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE MagicHash, GHCForeignImportPrim #-} + +module T10461 where +import GHC.Exts + +foreign import prim cheneycopy :: Any -> Word# + +foreign import prim "foo" foo :: Any -> Word# diff --git a/testsuite/tests/printer/Ppr042.stderr b/testsuite/tests/printer/Ppr042.stderr new file mode 100644 index 0000000000..8644650899 --- /dev/null +++ b/testsuite/tests/printer/Ppr042.stderr @@ -0,0 +1,28 @@ + +Ppr042.hs:6:1: error: + • Unacceptable result type in foreign declaration: + ‘Word#’ cannot be marshalled in a foreign call + To marshal unlifted types, use UnliftedFFITypes + • When checking declaration: + foreign import prim safe cheneycopy :: Any -> Word# + +Ppr042.hs:8:1: error: + • Unacceptable result type in foreign declaration: + ‘Word#’ cannot be marshalled in a foreign call + To marshal unlifted types, use UnliftedFFITypes + • When checking declaration: + foreign import prim safe "foo" foo :: Any -> Word# + +Ppr042.ppr.hs:4:1: error: + • Unacceptable result type in foreign declaration: + ‘Word#’ cannot be marshalled in a foreign call + To marshal unlifted types, use UnliftedFFITypes + • When checking declaration: + foreign import prim safe cheneycopy :: Any -> Word# + +Ppr042.ppr.hs:5:1: error: + • Unacceptable result type in foreign declaration: + ‘Word#’ cannot be marshalled in a foreign call + To marshal unlifted types, use UnliftedFFITypes + • When checking declaration: + foreign import prim safe "foo" foo :: Any -> Word# diff --git a/testsuite/tests/printer/Ppr043.hs b/testsuite/tests/printer/Ppr043.hs new file mode 100644 index 0000000000..3fe2519891 --- /dev/null +++ b/testsuite/tests/printer/Ppr043.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE MagicHash, TemplateHaskell #-} +module Main where + +import Language.Haskell.TH + +main :: IO () +main = do + putStrLn $([| 'a'# |] >>= stringE . show) + putStrLn $([| "abc"# |] >>= stringE . show) diff --git a/testsuite/tests/printer/Ppr044.hs b/testsuite/tests/printer/Ppr044.hs new file mode 100644 index 0000000000..5720aa7f64 --- /dev/null +++ b/testsuite/tests/printer/Ppr044.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE DeriveLift #-} +module T1830_2 where + +import Language.Haskell.TH.Syntax (Lift) + +data Nothing deriving Lift diff --git a/testsuite/tests/printer/Ppr045.hs b/testsuite/tests/printer/Ppr045.hs new file mode 100644 index 0000000000..73364982b4 --- /dev/null +++ b/testsuite/tests/printer/Ppr045.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UndecidableSuperClasses #-} +{-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-} + +module T3927b where + +import Data.Proxy +import GHC.Exts + +data Message + +data SocketType = Dealer | Push | Pull + +data SocketOperation = Read | Write + +type family Restrict (a :: SocketOperation) (as :: [SocketOperation]) + :: Constraint where + Restrict a (a ': as) = () + Restrict x (a ': as) = Restrict x as + Restrict x '[] = ("Error!" ~ "Tried to apply a restricted type!") + +type family Implements (t :: SocketType) :: [SocketOperation] where + Implements Dealer = ['Read, Write] + Implements Push = '[Write] + Implements Pull = '[ 'Read] + +data SockOp :: SocketType -> SocketOperation -> * where + SRead :: SockOp sock 'Read + SWrite :: SockOp sock Write + +data Socket :: SocketType -> * where + Socket :: proxy sock + -> (forall op . Restrict op (Implements sock) + => SockOp sock op -> Operation op) + -> Socket sock + +type family Operation (op :: SocketOperation) :: * where + Operation 'Read = IO Message + Operation Write = Message -> IO () + +class Restrict 'Read (Implements t) => Readable t where + readSocket :: Socket t -> Operation 'Read + readSocket (Socket _ f) = f (SRead :: SockOp t 'Read) + +instance Readable Dealer + +type family Writable (t :: SocketType) :: Constraint where + Writable Dealer = () + Writable Push = () + +dealer :: Socket Dealer +dealer = Socket (Proxy :: Proxy Dealer) f + where + f :: Restrict op (Implements Dealer) => SockOp Dealer op -> Operation op + f SRead = undefined + f SWrite = undefined + +push :: Socket Push +push = Socket (Proxy :: Proxy Push) f + where + f :: Restrict op (Implements Push) => SockOp Push op -> Operation op + f SWrite = undefined + +pull :: Socket Pull +pull = Socket (Proxy :: Proxy Pull) f + where + f :: Restrict op (Implements Pull) => SockOp Pull op -> Operation op + f SRead = undefined + +foo :: IO Message +foo = readSocket dealer diff --git a/testsuite/tests/printer/Ppr046.hs b/testsuite/tests/printer/Ppr046.hs new file mode 100644 index 0000000000..c2cb596263 --- /dev/null +++ b/testsuite/tests/printer/Ppr046.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE PackageImports #-} +{-# LANGUAGE MagicHash, UnliftedFFITypes #-} +{-# LANGUAGE ForeignFunctionInterface #-} + +module Test10313 where + +import "b\x61se" Data.List + +{-# WARNING Logic + , solverCheckAndGetModel + "New Z3 API support is still incomplete and fragile: \ + \you may experience segmentation faults!" + #-} + +{-# Deprecated Logic + , solverCheckAndGetModel + "Deprecation: \ + \you may experience segmentation faults!" + #-} + +data {-# ctype "foo\x63" "b\x61r" #-} Logic = Logic + +-- Should warn +foo1 x = x +{-# RULEs "foo1\x67" [ 1] forall x. foo1 x = x #-} + +foreign import prim unsafe "a\x62" a :: IO Int + +{-# INLINe strictStream #-} +strictStream (Bitstream l v) + = {-# CORe "Strict Bitstream stre\x61m" #-} + S.concatMap stream (GV.stream v) + `S.sized` + Exact l + +b = {-# SCc "foo\x64" #-} 006 diff --git a/testsuite/tests/printer/Ppr046.stderr b/testsuite/tests/printer/Ppr046.stderr new file mode 100644 index 0000000000..ebe2d0620e --- /dev/null +++ b/testsuite/tests/printer/Ppr046.stderr @@ -0,0 +1,61 @@ + +Ppr046.hs:9:13: error: + The deprecation for ‘solverCheckAndGetModel’ + lacks an accompanying binding + +Ppr046.hs:15:16: error: + Multiple warning declarations for ‘Logic’ + also at Ppr046.hs:9:13-17 + +Ppr046.hs:15:16: error: + The deprecation for ‘solverCheckAndGetModel’ + lacks an accompanying binding + +Ppr046.hs:16:13: error: + Multiple warning declarations for ‘solverCheckAndGetModel’ + also at Ppr046.hs:10:13-34 + +Ppr046.hs:30:15: error: Not in scope: data constructor ‘Bitstream’ + +Ppr046.hs:32:7: error: + Not in scope: ‘S.concatMap’ + No module named ‘S’ is imported. + +Ppr046.hs:32:27: error: + Not in scope: ‘GV.stream’ + No module named ‘GV’ is imported. + +Ppr046.hs:33:7: error: + Not in scope: ‘S.sized’ + No module named ‘S’ is imported. + +Ppr046.ppr.hs:6:13: error: + The deprecation for ‘solverCheckAndGetModel’ + lacks an accompanying binding + +Ppr046.ppr.hs:8:16: error: + Multiple warning declarations for ‘Logic’ + also at Ppr046.ppr.hs:6:13-17 + +Ppr046.ppr.hs:8:16: error: + The deprecation for ‘solverCheckAndGetModel’ + lacks an accompanying binding + +Ppr046.ppr.hs:8:23: error: + Multiple warning declarations for ‘solverCheckAndGetModel’ + also at Ppr046.ppr.hs:6:20-41 + +Ppr046.ppr.hs:15:15: error: + Not in scope: data constructor ‘Bitstream’ + +Ppr046.ppr.hs:17:5: error: + Not in scope: ‘S.concatMap’ + No module named ‘S’ is imported. + +Ppr046.ppr.hs:17:25: error: + Not in scope: ‘GV.stream’ + No module named ‘GV’ is imported. + +Ppr046.ppr.hs:17:38: error: + Not in scope: ‘S.sized’ + No module named ‘S’ is imported. diff --git a/testsuite/tests/printer/Ppr047.hs b/testsuite/tests/printer/Ppr047.hs new file mode 100644 index 0000000000..3ef54c4b38 --- /dev/null +++ b/testsuite/tests/printer/Ppr047.hs @@ -0,0 +1,4 @@ +module ExprPragmas where + +-- Should it be possible to ppr the following annotation? +c = {-# GENERATED "foobar" 1 : 2 - 3 : 4 #-} 0.00 diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T new file mode 100644 index 0000000000..c39656e892 --- /dev/null +++ b/testsuite/tests/printer/all.T @@ -0,0 +1,47 @@ +test('Ppr001', normal, run_command, ['$MAKE -s --no-print-directory ppr001']) +test('Ppr002', normal, run_command, ['$MAKE -s --no-print-directory ppr002']) +test('Ppr003', normal, run_command, ['$MAKE -s --no-print-directory ppr003']) +test('Ppr004', normal, run_command, ['$MAKE -s --no-print-directory ppr004']) +test('Ppr005', normal, run_command, ['$MAKE -s --no-print-directory ppr005']) +test('Ppr006', normal, run_command, ['$MAKE -s --no-print-directory ppr006']) +test('Ppr007', normal, run_command, ['$MAKE -s --no-print-directory ppr007']) +test('Ppr008', normal, run_command, ['$MAKE -s --no-print-directory ppr008']) +test('Ppr009', normal, run_command, ['$MAKE -s --no-print-directory ppr009']) +test('Ppr010', normal, run_command, ['$MAKE -s --no-print-directory ppr010']) +test('Ppr011', normal, run_command, ['$MAKE -s --no-print-directory ppr011']) +test('Ppr012', normal, run_command, ['$MAKE -s --no-print-directory ppr012']) +test('Ppr013', normal, run_command, ['$MAKE -s --no-print-directory ppr013']) +test('Ppr014', normal, run_command, ['$MAKE -s --no-print-directory ppr014']) +test('Ppr015', normal, run_command, ['$MAKE -s --no-print-directory ppr015']) +test('Ppr016', normal, run_command, ['$MAKE -s --no-print-directory ppr016']) +test('Ppr017', normal, run_command, ['$MAKE -s --no-print-directory ppr017']) +test('Ppr018', normal, run_command, ['$MAKE -s --no-print-directory ppr018']) +test('Ppr019', normal, run_command, ['$MAKE -s --no-print-directory ppr019']) +test('Ppr020', normal, run_command, ['$MAKE -s --no-print-directory ppr020']) +test('Ppr021', normal, run_command, ['$MAKE -s --no-print-directory ppr021']) +test('Ppr022', normal, run_command, ['$MAKE -s --no-print-directory ppr022']) +test('Ppr023', normal, run_command, ['$MAKE -s --no-print-directory ppr023']) +test('Ppr024', normal, run_command, ['$MAKE -s --no-print-directory ppr024']) +test('Ppr025', normal, run_command, ['$MAKE -s --no-print-directory ppr025']) +test('Ppr026', normal, run_command, ['$MAKE -s --no-print-directory ppr026']) +test('Ppr027', normal, run_command, ['$MAKE -s --no-print-directory ppr027']) +test('Ppr028', normal, run_command, ['$MAKE -s --no-print-directory ppr028']) +test('Ppr029', normal, run_command, ['$MAKE -s --no-print-directory ppr029']) +test('Ppr030', normal, run_command, ['$MAKE -s --no-print-directory ppr030']) +test('Ppr031', normal, run_command, ['$MAKE -s --no-print-directory ppr031']) +test('Ppr032', normal, run_command, ['$MAKE -s --no-print-directory ppr032']) +test('Ppr033', normal, run_command, ['$MAKE -s --no-print-directory ppr033']) +test('Ppr034', normal, run_command, ['$MAKE -s --no-print-directory ppr034']) +test('Ppr035', normal, run_command, ['$MAKE -s --no-print-directory ppr035']) +test('Ppr036', normal, run_command, ['$MAKE -s --no-print-directory ppr036']) +test('Ppr037', normal, run_command, ['$MAKE -s --no-print-directory ppr037']) +test('Ppr038', normal, run_command, ['$MAKE -s --no-print-directory ppr038']) +test('Ppr039', normal, run_command, ['$MAKE -s --no-print-directory ppr039']) +test('Ppr040', normal, run_command, ['$MAKE -s --no-print-directory ppr040']) +test('Ppr041', normal, run_command, ['$MAKE -s --no-print-directory ppr041']) +test('Ppr042', normal, run_command, ['$MAKE -s --no-print-directory ppr042']) +test('Ppr043', normal, run_command, ['$MAKE -s --no-print-directory ppr043']) +test('Ppr044', normal, run_command, ['$MAKE -s --no-print-directory ppr044']) +test('Ppr045', normal, run_command, ['$MAKE -s --no-print-directory ppr045']) +test('Ppr046', normal, run_command, ['$MAKE -s --no-print-directory ppr046']) +test('Ppr047', expect_fail, run_command, ['$MAKE -s --no-print-directory ppr047']) diff --git a/testsuite/tests/quasiquotation/T7918.hs b/testsuite/tests/quasiquotation/T7918.hs index 2d4577c963..0f32699415 100644 --- a/testsuite/tests/quasiquotation/T7918.hs +++ b/testsuite/tests/quasiquotation/T7918.hs @@ -35,7 +35,7 @@ traverse a = return () showTyVar :: Maybe (HsType Name) -> Traverse () - showTyVar (Just (HsTyVar (L _ v))) = + showTyVar (Just (HsTyVar _ (L _ v))) = modify $ \(loc, ids) -> (loc, (v, loc) : ids) showTyVar _ = return () diff --git a/testsuite/tests/rebindable/rebindable6.stderr b/testsuite/tests/rebindable/rebindable6.stderr index 712724d28f..342ee53de5 100644 --- a/testsuite/tests/rebindable/rebindable6.stderr +++ b/testsuite/tests/rebindable/rebindable6.stderr @@ -15,14 +15,14 @@ rebindable6.hs:110:17: error: -- Defined at rebindable6.hs:56:18 • In a stmt of a 'do' block: f In the expression: - do { f; - Just (b :: b) <- g; - return b } + do f + Just (b :: b) <- g + return b In an equation for ‘test_do’: test_do f g - = do { f; - Just (b :: b) <- g; - return b } + = do f + Just (b :: b) <- g + return b rebindable6.hs:111:17: error: • Ambiguous type variables ‘p0’, ‘t0’ arising from a do statement @@ -39,14 +39,14 @@ rebindable6.hs:111:17: error: -- Defined at rebindable6.hs:51:18 • In a stmt of a 'do' block: Just (b :: b) <- g In the expression: - do { f; - Just (b :: b) <- g; - return b } + do f + Just (b :: b) <- g + return b In an equation for ‘test_do’: test_do f g - = do { f; - Just (b :: b) <- g; - return b } + = do f + Just (b :: b) <- g + return b rebindable6.hs:112:17: error: • Ambiguous type variable ‘p0’ arising from a use of ‘return’ @@ -62,11 +62,11 @@ rebindable6.hs:112:17: error: instance HasReturn (a -> IO a) -- Defined at rebindable6.hs:46:18 • In a stmt of a 'do' block: return b In the expression: - do { f; - Just (b :: b) <- g; - return b } + do f + Just (b :: b) <- g + return b In an equation for ‘test_do’: test_do f g - = do { f; - Just (b :: b) <- g; - return b } + = do f + Just (b :: b) <- g + return b diff --git a/testsuite/tests/rename/should_fail/Misplaced.stderr b/testsuite/tests/rename/should_fail/Misplaced.stderr index 67d845d9a5..610281ca5c 100644 --- a/testsuite/tests/rename/should_fail/Misplaced.stderr +++ b/testsuite/tests/rename/should_fail/Misplaced.stderr @@ -1,4 +1,4 @@ Misplaced.hs:4:1: error: Misplaced SPECIALISE instance pragma: - {-# SPECIALIZE instance Eq (T Int) #-} + {-# SPECIALISE instance Eq (T Int) #-} diff --git a/testsuite/tests/rename/should_fail/rnfail026.stderr b/testsuite/tests/rename/should_fail/rnfail026.stderr index c44f655ccb..dc6ee9691a 100644 --- a/testsuite/tests/rename/should_fail/rnfail026.stderr +++ b/testsuite/tests/rename/should_fail/rnfail026.stderr @@ -3,7 +3,7 @@ rnfail026.hs:16:27: error: • Expecting one fewer arguments to ‘Set a’ Expected kind ‘* -> *’, but ‘Set a’ has kind ‘*’ • In the first argument of ‘Monad’, namely - ‘forall a. Eq a => Set a’ + ‘(forall a. Eq a => Set a)’ In the instance declaration for ‘Monad (forall a. Eq a => Set a)’ rnfail026.hs:19:10: error: diff --git a/testsuite/tests/roles/should_compile/T8958.stderr b/testsuite/tests/roles/should_compile/T8958.stderr index 5369daa5cd..28ef9ce128 100644 --- a/testsuite/tests/roles/should_compile/T8958.stderr +++ b/testsuite/tests/roles/should_compile/T8958.stderr @@ -62,7 +62,7 @@ T8958.$trModule AbsBinds [a] [] {Exports: [T8958.$fRepresentationala <= $dRepresentational wrap: <>] - Exported types: T8958.$fRepresentationala [InlPrag=[ALWAYS] CONLIKE] + Exported types: T8958.$fRepresentationala [InlPrag=CONLIKE] :: forall a. Representational a [LclIdX[DFunId], Unf=DFun: \ (@ a) -> T8958.C:Representational TYPE: a] @@ -71,7 +71,7 @@ AbsBinds [a] [] AbsBinds [a] [] {Exports: [T8958.$fNominala <= $dNominal wrap: <>] - Exported types: T8958.$fNominala [InlPrag=[ALWAYS] CONLIKE] + Exported types: T8958.$fNominala [InlPrag=CONLIKE] :: forall a. Nominal a [LclIdX[DFunId], Unf=DFun: \ (@ a) -> T8958.C:Nominal TYPE: a] Binds: $dNominal = T8958.C:Nominal @ a diff --git a/testsuite/tests/safeHaskell/ghci/p6.stderr b/testsuite/tests/safeHaskell/ghci/p6.stderr index 74beb053ca..2e68cd9a60 100644 --- a/testsuite/tests/safeHaskell/ghci/p6.stderr +++ b/testsuite/tests/safeHaskell/ghci/p6.stderr @@ -3,7 +3,7 @@ • Unacceptable result type in foreign declaration: Safe Haskell is on, all FFI imports must be in the IO monad • When checking declaration: - foreign import ccall safe "static sin" c_sin :: Double -> Double + foreign import ccall safe "sin" c_sin :: Double -> Double <interactive>:12:1: error: • Variable not in scope: c_sin :: Integer -> t diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang08.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang08.stderr index 7d06e2f11c..ae5d658619 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang08.stderr +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang08.stderr @@ -3,5 +3,5 @@ SafeLang08.hs:9:1: Unacceptable result type in foreign declaration: Safe Haskell is on, all FFI imports must be in the IO monad When checking declaration: - foreign import ccall safe "static SafeLang08_A" c_sin + foreign import ccall safe "SafeLang08_A" c_sin :: CDouble -> CDouble diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang10.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang10.stderr index d0c5c68d6a..557c4f4858 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang10.stderr +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang10.stderr @@ -15,6 +15,6 @@ SafeLang10.hs:8:13: In the expression: res [(1 :: Int)] In an equation for ‘r’: r = res [(1 :: Int)] In the expression: - do { let r = res ...; - putStrLn $ "Result: " ++ show r; - putStrLn $ "Result: " ++ show function } + do let r = res ... + putStrLn $ "Result: " ++ show r + putStrLn $ "Result: " ++ show function diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang17.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang17.stderr index c59f86670a..3585721654 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang17.stderr +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang17.stderr @@ -15,6 +15,6 @@ SafeLang17.hs:8:13: In the expression: res [(1 :: Int)] In an equation for ‘r’: r = res [(1 :: Int)] In the expression: - do { let r = res ...; - putStrLn $ "Result: " ++ show r; - putStrLn $ "Result: " ++ show function } + do let r = res ... + putStrLn $ "Result: " ++ show r + putStrLn $ "Result: " ++ show function diff --git a/testsuite/tests/simplCore/should_compile/T7785.stderr b/testsuite/tests/simplCore/should_compile/T7785.stderr index c71a077b1d..c0e91b9169 100644 --- a/testsuite/tests/simplCore/should_compile/T7785.stderr +++ b/testsuite/tests/simplCore/should_compile/T7785.stderr @@ -1,6 +1,6 @@ ==================== Tidy Core rules ==================== -"SPEC shared @ []" [ALWAYS] +"SPEC shared @ []" forall (irred :: Domain [] Int) ($dMyFunctor :: MyFunctor []). shared @ [] $dMyFunctor irred = bar_$sshared diff --git a/testsuite/tests/simplCore/should_compile/T8331.stderr b/testsuite/tests/simplCore/should_compile/T8331.stderr index 1b3c21eaea..322323be6c 100644 --- a/testsuite/tests/simplCore/should_compile/T8331.stderr +++ b/testsuite/tests/simplCore/should_compile/T8331.stderr @@ -1,6 +1,6 @@ ==================== Tidy Core rules ==================== -"SPEC useAbstractMonad" [ALWAYS] +"SPEC useAbstractMonad" forall (@ s) ($dMonadAbstractIOST :: MonadAbstractIOST (ReaderT Int (ST s))). useAbstractMonad @ (ReaderT Int (ST s)) $dMonadAbstractIOST diff --git a/testsuite/tests/simplCore/should_compile/T8848a.stderr b/testsuite/tests/simplCore/should_compile/T8848a.stderr index f9f2597c6b..f6f8b4f247 100644 --- a/testsuite/tests/simplCore/should_compile/T8848a.stderr +++ b/testsuite/tests/simplCore/should_compile/T8848a.stderr @@ -1,6 +1,6 @@ ==================== Tidy Core rules ==================== -"SPEC f" [ALWAYS] +"SPEC f" forall (@ b) ($dOrd :: Ord [Int]). f @ [Int] @ b $dOrd = f_$sf @ b diff --git a/testsuite/tests/simplCore/should_compile/simpl017.stderr b/testsuite/tests/simplCore/should_compile/simpl017.stderr index bb74213dfe..5a82506164 100644 --- a/testsuite/tests/simplCore/should_compile/simpl017.stderr +++ b/testsuite/tests/simplCore/should_compile/simpl017.stderr @@ -5,17 +5,17 @@ simpl017.hs:50:15: error: Expected type: E m (forall v. [E m i] -> E' v m a) Actual type: E' RValue m ([E m i] -> E' v0 m a) • In the expression: - E (do { let ix :: [E m i] -> m i - ix [i] = runE i - {-# INLINE f #-} - ....; - return f }) + E (do let ix :: [E m i] -> m i + ix [i] = runE i + {-# INLINE f #-} + .... + return f) In an equation for ‘liftArray’: liftArray a - = E (do { let ix :: [E m i] -> m i - ix [i] = runE i - ....; - return f }) + = E (do let ix :: [E m i] -> m i + ix [i] = runE i + .... + return f) • Relevant bindings include a :: arr i a (bound at simpl017.hs:50:11) liftArray :: arr i a -> E m (forall v. [E m i] -> E' v m a) diff --git a/testsuite/tests/th/T10598_TH.stderr b/testsuite/tests/th/T10598_TH.stderr index bcfbb089c5..434138eb76 100644 --- a/testsuite/tests/th/T10598_TH.stderr +++ b/testsuite/tests/th/T10598_TH.stderr @@ -1,41 +1,41 @@ T10598_TH.hs:(27,3)-(42,50): Splicing declarations - do { fooDataName <- newName "Foo"; - mkFooConName <- newName "MkFoo"; - let fooType = conT fooDataName; - sequence - [newtypeD - (cxt []) - fooDataName - [] - Nothing - (normalC - mkFooConName - [bangType - (bang noSourceUnpackedness noSourceStrictness) [t| Int |]]) - [derivClause (Just Stock) [[t| Eq |]], - derivClause (Just Anyclass) [[t| C |]], - derivClause (Just Newtype) [[t| Read |]]], - standaloneDerivWithStrategyD - (Just Stock) - (cxt []) - [t| Ord $fooType |] - pending(rn) [<splice, fooType>], - standaloneDerivWithStrategyD - (Just Anyclass) - (cxt []) - [t| D $fooType |] - pending(rn) [<splice, fooType>], - standaloneDerivWithStrategyD - (Just Newtype) - (cxt []) - [t| Show $fooType |] - pending(rn) [<splice, fooType>]] } + do fooDataName <- newName "Foo" + mkFooConName <- newName "MkFoo" + let fooType = conT fooDataName + sequence + [newtypeD + (cxt []) + fooDataName + [] + Nothing + (normalC + mkFooConName + [bangType + (bang noSourceUnpackedness noSourceStrictness) [t| Int |]]) + [derivClause (Just Stock) [[t| Eq |]], + derivClause (Just Anyclass) [[t| C |]], + derivClause (Just Newtype) [[t| Read |]]], + standaloneDerivWithStrategyD + (Just Stock) + (cxt []) + [t| Ord $(fooType) |] + pending(rn) [<splice, fooType>], + standaloneDerivWithStrategyD + (Just Anyclass) + (cxt []) + [t| D $(fooType) |] + pending(rn) [<splice, fooType>], + standaloneDerivWithStrategyD + (Just Newtype) + (cxt []) + [t| Show $(fooType) |] + pending(rn) [<splice, fooType>]] ======> newtype Foo = MkFoo Int - deriving stock (Eq) - deriving anyclass (C) - deriving newtype (Read) - deriving stock instance Ord Foo - deriving anyclass instance D Foo - deriving newtype instance Show Foo + deriving stock Eq + deriving anyclass C + deriving newtype Read + deriving stock instance () => Ord Foo + deriving anyclass instance () => D Foo + deriving newtype instance () => Show Foo diff --git a/testsuite/tests/th/T10638.stderr b/testsuite/tests/th/T10638.stderr index 3a626ce46a..cc4946a074 100644 --- a/testsuite/tests/th/T10638.stderr +++ b/testsuite/tests/th/T10638.stderr @@ -2,5 +2,4 @@ T10638.hs:26:11: ‘static test2’ is not a valid C identifier When checking declaration: - foreign import prim safe "static static test2" cmm_test2 - :: Int# -> Int# + foreign import prim safe "static test2" cmm_test2 :: Int# -> Int# diff --git a/testsuite/tests/th/T12530.stderr b/testsuite/tests/th/T12530.stderr index 0ba15360ac..d2d1820742 100644 --- a/testsuite/tests/th/T12530.stderr +++ b/testsuite/tests/th/T12530.stderr @@ -5,6 +5,6 @@ T12530.hs:(8,3)-(15,6): Splicing declarations g = undefined @(_) @(a) |] ======> f :: Maybe Int -> Maybe Int - f = id @(Maybe Int) + f = id @Maybe Int g :: forall a. a g = undefined @_ @a diff --git a/testsuite/tests/th/T3177a.stderr b/testsuite/tests/th/T3177a.stderr index 0b540a8bf2..e2e8cadbdc 100644 --- a/testsuite/tests/th/T3177a.stderr +++ b/testsuite/tests/th/T3177a.stderr @@ -2,11 +2,9 @@ T3177a.hs:8:8: error: • Expecting one fewer arguments to ‘Int’ Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’ - • In the type signature: - f :: Int Int + • In the type signature: f :: (Int Int) T3177a.hs:11:6: error: • Expecting one fewer arguments to ‘Int’ Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’ - • In the type signature: - g :: Int Int + • In the type signature: g :: Int Int diff --git a/testsuite/tests/th/T3319.stderr b/testsuite/tests/th/T3319.stderr index 87ba3f54c7..44ec90ffe7 100644 --- a/testsuite/tests/th/T3319.stderr +++ b/testsuite/tests/th/T3319.stderr @@ -4,4 +4,4 @@ T3319.hs:8:3-93: Splicing declarations (ImportF CCall Unsafe "&" (mkName "foo") (AppT (ConT ''Ptr) (ConT ''())))] ======> - foreign import ccall unsafe "static &foo" foo :: Ptr GHC.Tuple.() + foreign import ccall unsafe "&" foo :: Ptr GHC.Tuple.() diff --git a/testsuite/tests/th/T3899a.hs b/testsuite/tests/th/T3899a.hs index 2ac985136f..73ed534786 100644 --- a/testsuite/tests/th/T3899a.hs +++ b/testsuite/tests/th/T3899a.hs @@ -10,5 +10,6 @@ data Nil = Nil nestedTuple n = do xs <- replicateM n (newName "x") - return $ LamE [foldr (\v prev -> ConP 'Cons [VarP v,prev]) (ConP 'Nil []) xs] + return $ LamE [foldr (\v prev -> ParensP (ConP 'Cons [VarP v,prev])) + (ConP 'Nil []) xs] (TupE $ map VarE xs) diff --git a/testsuite/tests/th/T4436.stderr b/testsuite/tests/th/T4436.stderr index 1b7fdf6277..d87bfc1a2f 100644 --- a/testsuite/tests/th/T4436.stderr +++ b/testsuite/tests/th/T4436.stderr @@ -1,11 +1,6 @@ T4436.hs:5:7-56: Splicing expression - return - (LitE - (StringL - "hello\n\ - \goodbye\n\ - \and then")) + return (LitE (StringL "hello/ngoodbye/nand then")) ======> - "hello\n\ - \goodbye\n\ - \and then" + "hello +goodbye +and then" diff --git a/testsuite/tests/th/T5217.stderr b/testsuite/tests/th/T5217.stderr index e1a92c89ca..17bbd7b00e 100644 --- a/testsuite/tests/th/T5217.stderr +++ b/testsuite/tests/th/T5217.stderr @@ -9,6 +9,6 @@ T5217.hs:(6,3)-(9,53): Splicing declarations data T a b where T1 :: Int -> T Int Char - T2 :: forall a. a -> T a a - T3 :: forall a. a -> T [a] a - T4 :: forall a b. a -> b -> T b [a] + T2 :: forall a. () => a -> T a a + T3 :: forall a. () => a -> T [a] a + T4 :: forall a b. () => a -> b -> T b [a] diff --git a/testsuite/tests/th/T5358.stderr b/testsuite/tests/th/T5358.stderr index 4a17272310..d9485cebb7 100644 --- a/testsuite/tests/th/T5358.stderr +++ b/testsuite/tests/th/T5358.stderr @@ -4,8 +4,8 @@ T5358.hs:14:12: error: runTest called error: forall (t_0 :: *) . t_0 -> GHC.Types.Bool CallStack (from ImplicitParams): error, called at T5358.hs:15:18 in main:T5358 - Code: do { VarI _ t _ <- reify (mkName "prop_x1"); - ($) error ((++) "runTest called error: " pprint t) } + Code: do VarI _ t _ <- reify (mkName "prop_x1") + ($) error ((++) "runTest called error: " pprint t) In the untyped splice: - $(do { VarI _ t _ <- reify (mkName "prop_x1"); - error $ ("runTest called error: " ++ pprint t) }) + $(do VarI _ t _ <- reify (mkName "prop_x1") + error $ ("runTest called error: " ++ pprint t)) diff --git a/testsuite/tests/th/T5508.stderr b/testsuite/tests/th/T5508.stderr index 3cd9bf27ed..7000204913 100644 --- a/testsuite/tests/th/T5508.stderr +++ b/testsuite/tests/th/T5508.stderr @@ -1,7 +1,7 @@ T5508.hs:(7,9)-(9,28): Splicing expression - do { let x = mkName "x" - v = return (LamE [VarP x] $ VarE x); - [| $v . id |] - pending(rn) [<splice, v>] } + do let x = mkName "x" + v = return (LamE [VarP x] $ VarE x) + [| $v . id |] + pending(rn) [<splice, v>] ======> ((\ x -> x) . id) diff --git a/testsuite/tests/th/T5700.stderr b/testsuite/tests/th/T5700.stderr index 729a36604f..f2f428892e 100644 --- a/testsuite/tests/th/T5700.stderr +++ b/testsuite/tests/th/T5700.stderr @@ -1,6 +1,6 @@ T5700.hs:8:3-9: Splicing declarations mkC ''D ======> - instance C D where + instance () => C D where {-# INLINE inlinable #-} inlinable _ = GHC.Tuple.() diff --git a/testsuite/tests/th/T5883.stderr b/testsuite/tests/th/T5883.stderr index aa87a41052..b63ea2f38c 100644 --- a/testsuite/tests/th/T5883.stderr +++ b/testsuite/tests/th/T5883.stderr @@ -6,6 +6,6 @@ T5883.hs:(7,4)-(12,4): Splicing declarations {-# INLINE show #-} |] ======> data Unit = Unit - instance Show Unit where + instance () => Show Unit where {-# INLINE show #-} show _ = "" diff --git a/testsuite/tests/th/T7532.stderr b/testsuite/tests/th/T7532.stderr index baaf04f3f5..21b753b5d3 100644 --- a/testsuite/tests/th/T7532.stderr +++ b/testsuite/tests/th/T7532.stderr @@ -6,10 +6,10 @@ instance C Bool where T7532.hs:11:3-7: Splicing declarations bang' ======> - instance C Int where + instance () => C Int where data D Int = T ==================== Renamer ==================== -instance C Int where +instance () => C Int where data D Int = T7532.T diff --git a/testsuite/tests/th/T8577.stderr b/testsuite/tests/th/T8577.stderr index ef95cc313d..1a0fb75bd1 100644 --- a/testsuite/tests/th/T8577.stderr +++ b/testsuite/tests/th/T8577.stderr @@ -4,5 +4,5 @@ T8577.hs:9:11: error: Expected type: Q (TExp (A Bool)) Actual type: Q (TExp (A Int)) In the expression: y - In the Template Haskell splice $$y - In the expression: $$y + In the Template Haskell splice $$(y) + In the expression: $$(y) diff --git a/testsuite/tests/th/T8761.stderr b/testsuite/tests/th/T8761.stderr index 6a7af1e9e3..86f175631b 100644 --- a/testsuite/tests/th/T8761.stderr +++ b/testsuite/tests/th/T8761.stderr @@ -3,34 +3,33 @@ pattern x1_0 Q2 x2_1 = ((x1_0, x2_1)) pattern Q3 {qx3, qy3, qz3} <- ((qx3, qy3), [qz3]) where Q3 qx3 qy3 qz3 = ((qx3, qy3), [qz3]) T8761.hs:(16,1)-(39,13): Splicing declarations - do { [qx1, qy1, qz1] <- mapM - (\ i -> newName $ "x" ++ show i) [1, 2, 3]; - let nm1 = mkName "Q1" - prefixPat - = patSynD - nm1 - (prefixPatSyn [qx1, qy1, qz1]) - unidir - (tupP [tupP [varP qx1, varP qy1], listP [varP qz1], wildP, wildP]); - [qx2, qy2] <- mapM (\ i -> newName $ "x" ++ show i) [1, 2]; - let nm2 = mkName "Q2" - infixPat - = patSynD - nm2 - (infixPatSyn qx2 qy2) - implBidir - (tupP [tupP [varP qx2, varP qy2]]); - let nm3 = mkName "Q3" - [qx3, qy3, qz3] = map mkName ["qx3", "qy3", "qz3"] - patP = tupP [tupP [varP qx3, varP qy3], listP [varP qz3]] - patE = tupE [tupE [varE qx3, varE qy3], listE [varE qz3]] - cls = clause [varP qx3, varP qy3, varP qz3] (normalB patE) [] - recordPat - = patSynD - nm3 (recordPatSyn [qx3, qy3, qz3]) (explBidir [cls]) patP; - pats <- sequence [prefixPat, infixPat, recordPat]; - mapM_ (runIO . hPutStrLn stderr . pprint) pats; - return pats } + do [qx1, qy1, qz1] <- mapM + (\ i -> newName $ "x" ++ show i) [1, 2, 3] + let nm1 = mkName "Q1" + prefixPat + = patSynD + nm1 + (prefixPatSyn [qx1, qy1, qz1]) + unidir + (tupP [tupP [varP qx1, varP qy1], listP [varP qz1], wildP, wildP]) + [qx2, qy2] <- mapM (\ i -> newName $ "x" ++ show i) [1, 2] + let nm2 = mkName "Q2" + infixPat + = patSynD + nm2 + (infixPatSyn qx2 qy2) + implBidir + (tupP [tupP [varP qx2, varP qy2]]) + let nm3 = mkName "Q3" + [qx3, qy3, qz3] = map mkName ["qx3", "qy3", "qz3"] + patP = tupP [tupP [varP qx3, varP qy3], listP [varP qz3]] + patE = tupE [tupE [varE qx3, varE qy3], listE [varE qz3]] + cls = clause [varP qx3, varP qy3, varP qz3] (normalB patE) [] + recordPat + = patSynD nm3 (recordPatSyn [qx3, qy3, qz3]) (explBidir [cls]) patP + pats <- sequence [prefixPat, infixPat, recordPat] + mapM_ (runIO . hPutStrLn stderr . pprint) pats + return pats ======> pattern Q1 x1 x2 x3 <- ((x1, x2), [x3], _, _) pattern x1 `Q2` x2 = ((x1, x2)) @@ -73,55 +72,58 @@ T8761.hs:(56,1)-(62,23): Splicing declarations T8761.hs:(71,1)-(105,39): Splicing declarations [d| pattern P :: Bool pattern P <- True - pattern Pe :: forall a. a -> Ex + pattern Pe :: () => forall a. a -> Ex pattern Pe x <- MkEx x pattern Pu :: forall a. a -> a pattern Pu x <- x - pattern Pue :: forall a. forall b. a -> b -> (a, Ex) + pattern Pue :: forall a. () => forall b. a -> b -> (a, Ex) pattern Pue x y <- (x, MkEx y) pattern Pur :: forall a. (Num a, Eq a) => a -> [a] pattern Pur x <- [x, 1] - pattern Purp :: forall a b. - (Num a, Eq a) => Show b => a -> b -> ([a], UnivProv b) + pattern Purp :: + forall a b. (Num a, Eq a) => Show b => a -> b -> ([a], UnivProv b) pattern Purp x y <- ([x, 1], MkUnivProv y) - pattern Pure :: forall a. - (Num a, Eq a) => forall b. a -> b -> ([a], Ex) + pattern Pure :: + forall a. (Num a, Eq a) => forall b. a -> b -> ([a], Ex) pattern Pure x y <- ([x, 1], MkEx y) - pattern Purep :: forall a. + pattern Purep :: + forall a. (Num a, Eq a) => forall b. Show b => a -> b -> ([a], ExProv) pattern Purep x y <- ([x, 1], MkExProv y) - pattern Pep :: forall a. Show a => a -> ExProv + pattern Pep :: () => forall a. Show a => a -> ExProv pattern Pep x <- MkExProv x - pattern Pup :: forall a. Show a => a -> UnivProv a + pattern Pup :: forall a. () => Show a => a -> UnivProv a pattern Pup x <- MkUnivProv x - pattern Puep :: forall a. - forall b. (Show b) => a -> b -> (ExProv, a) + pattern Puep :: + forall a. () => forall b. (Show b) => a -> b -> (ExProv, a) pattern Puep x y <- (MkExProv y, x) |] ======> pattern P :: Bool pattern P <- True - pattern Pe :: forall a. a -> Ex + pattern Pe :: () => forall a. a -> Ex pattern Pe x <- MkEx x pattern Pu :: forall a. a -> a pattern Pu x <- x - pattern Pue :: forall a. forall b. a -> b -> (a, Ex) + pattern Pue :: forall a. () => forall b. a -> b -> (a, Ex) pattern Pue x y <- (x, MkEx y) pattern Pur :: forall a. (Num a, Eq a) => a -> [a] pattern Pur x <- [x, 1] - pattern Purp :: forall a b. - (Num a, Eq a) => Show b => a -> b -> ([a], UnivProv b) + pattern Purp :: + forall a b. (Num a, Eq a) => Show b => a -> b -> ([a], UnivProv b) pattern Purp x y <- ([x, 1], MkUnivProv y) - pattern Pure :: forall a. - (Num a, Eq a) => forall b. a -> b -> ([a], Ex) + pattern Pure :: + forall a. (Num a, Eq a) => forall b. a -> b -> ([a], Ex) pattern Pure x y <- ([x, 1], MkEx y) - pattern Purep :: forall a. + pattern Purep :: + forall a. (Num a, Eq a) => forall b. Show b => a -> b -> ([a], ExProv) pattern Purep x y <- ([x, 1], MkExProv y) - pattern Pep :: forall a. Show a => a -> ExProv + pattern Pep :: () => forall a. Show a => a -> ExProv pattern Pep x <- MkExProv x - pattern Pup :: forall a. Show a => a -> UnivProv a + pattern Pup :: forall a. () => Show a => a -> UnivProv a pattern Pup x <- MkUnivProv x - pattern Puep :: forall a. forall b. Show b => a -> b -> (ExProv, a) + pattern Puep :: + forall a. () => forall b. Show b => a -> b -> (ExProv, a) pattern Puep x y <- (MkExProv y, x) pattern T8761.P :: GHC.Types.Bool pattern T8761.Pe :: () => forall (a0_0 :: *) . a0_0 -> T8761.Ex @@ -148,11 +150,11 @@ pattern T8761.Pup :: forall (a0_0 :: *) . () => GHC.Show.Show a0_0 => pattern T8761.Puep :: forall (a0_0 :: *) . () => forall (b0_1 :: *) . GHC.Show.Show b0_1 => a0_0 -> b0_1 -> (T8761.ExProv, a0_0) T8761.hs:(108,1)-(117,25): Splicing declarations - do { infos <- mapM - reify - ['P, 'Pe, 'Pu, 'Pue, 'Pur, 'Purp, 'Pure, 'Purep, 'Pep, 'Pup, - 'Puep]; - mapM_ (runIO . hPutStrLn stderr . pprint) infos; - [d| theAnswerIs = 42 |] } + do infos <- mapM + reify + ['P, 'Pe, 'Pu, 'Pue, 'Pur, 'Purp, 'Pure, 'Purep, 'Pep, 'Pup, + 'Puep] + mapM_ (runIO . hPutStrLn stderr . pprint) infos + [d| theAnswerIs = 42 |] ======> theAnswerIs = 42 diff --git a/testsuite/tests/th/TH_PromotedTuple.stderr b/testsuite/tests/th/TH_PromotedTuple.stderr index 06260a7bee..9619d52f51 100644 --- a/testsuite/tests/th/TH_PromotedTuple.stderr +++ b/testsuite/tests/th/TH_PromotedTuple.stderr @@ -1,7 +1,7 @@ TH_PromotedTuple.hs:(14,32)-(16,43): Splicing type - do { ty <- [t| '(Int, False) |]; - reportWarning (show ty); - return ty } + do ty <- [t| '(Int, False) |] + reportWarning (show ty) + return ty ======> '(Int, False) diff --git a/testsuite/tests/th/TH_exn2.stderr b/testsuite/tests/th/TH_exn2.stderr index 8cf8d452ce..3ccc9e1c0c 100644 --- a/testsuite/tests/th/TH_exn2.stderr +++ b/testsuite/tests/th/TH_exn2.stderr @@ -2,5 +2,5 @@ TH_exn2.hs:1:1: error: Exception when trying to run compile-time code: Prelude.tail: empty list - Code: do { ds <- [d| |]; - return (tail ds) } + Code: do ds <- [d| |] + return (tail ds) diff --git a/testsuite/tests/th/TH_foreignCallingConventions.stderr b/testsuite/tests/th/TH_foreignCallingConventions.stderr index 1ff81a4fc8..dae994539d 100644 --- a/testsuite/tests/th/TH_foreignCallingConventions.stderr +++ b/testsuite/tests/th/TH_foreignCallingConventions.stderr @@ -9,21 +9,20 @@ foreign import stdcall safe "bay" bay :: (GHC.Types.Int -> foreign import javascript unsafe "bax" bax :: GHC.Ptr.Ptr GHC.Types.Int -> GHC.Types.IO GHC.Base.String TH_foreignCallingConventions.hs:(13,4)-(23,25): Splicing declarations - do { let fi cconv safety lbl name ty - = ForeignD (ImportF cconv safety lbl name ty); - dec1 <- fi CCall Interruptible "&" (mkName "foo") - <$> [t| Ptr () |]; - dec2 <- fi Prim Safe "bar" (mkName "bar") <$> [t| Int# -> Int# |]; - dec3 <- fi CApi Unsafe "baz" (mkName "baz") - <$> [t| Double -> IO () |]; - dec4 <- fi StdCall Safe "bay" (mkName "bay") - <$> [t| (Int -> Bool) -> IO Int |]; - dec5 <- fi JavaScript Unsafe "bax" (mkName "bax") - <$> [t| Ptr Int -> IO String |]; - runIO - $ mapM_ (putStrLn . pprint) [dec1, dec2, dec3, dec4, dec5] - >> hFlush stdout; - return [dec1, dec2] } + do let fi cconv safety lbl name ty + = ForeignD (ImportF cconv safety lbl name ty) + dec1 <- fi CCall Interruptible "&" (mkName "foo") <$> [t| Ptr () |] + dec2 <- fi Prim Safe "bar" (mkName "bar") <$> [t| Int# -> Int# |] + dec3 <- fi CApi Unsafe "baz" (mkName "baz") + <$> [t| Double -> IO () |] + dec4 <- fi StdCall Safe "bay" (mkName "bay") + <$> [t| (Int -> Bool) -> IO Int |] + dec5 <- fi JavaScript Unsafe "bax" (mkName "bax") + <$> [t| Ptr Int -> IO String |] + runIO + $ mapM_ (putStrLn . pprint) [dec1, dec2, dec3, dec4, dec5] + >> hFlush stdout + return [dec1, dec2] ======> - foreign import ccall interruptible "static &foo" foo :: Ptr () - foreign import prim safe "static bar" bar :: Int# -> Int# + foreign import ccall interruptible "&" foo :: Ptr () + foreign import prim safe "bar" bar :: Int# -> Int# diff --git a/testsuite/tests/th/TH_foreignInterruptible.stderr b/testsuite/tests/th/TH_foreignInterruptible.stderr index 9cbf34ac87..7131eeee71 100644 --- a/testsuite/tests/th/TH_foreignInterruptible.stderr +++ b/testsuite/tests/th/TH_foreignInterruptible.stderr @@ -8,5 +8,4 @@ TH_foreignInterruptible.hs:8:3-100: Splicing declarations (mkName "foo") (AppT (ConT ''Ptr) (ConT ''())))] ======> - foreign import ccall interruptible "static &foo" foo - :: Ptr GHC.Tuple.() + foreign import ccall interruptible "&" foo :: Ptr GHC.Tuple.() diff --git a/testsuite/tests/th/TH_pragma.stderr b/testsuite/tests/th/TH_pragma.stderr index 0fcd167aa4..ddd5998b39 100644 --- a/testsuite/tests/th/TH_pragma.stderr +++ b/testsuite/tests/th/TH_pragma.stderr @@ -8,9 +8,9 @@ TH_pragma.hs:(6,4)-(8,26): Splicing declarations foo x = (x + 1) TH_pragma.hs:(10,4)-(12,31): Splicing declarations [d| bar :: Num a => a -> a - {-# SPECIALIZE INLINE[~1] bar :: Float -> Float #-} + {-# SPECIALISE INLINE [~1] bar :: Float -> Float #-} bar x = x * 10 |] ======> bar :: forall a. Num a => a -> a - {-# SPECIALIZE INLINE[~1] bar :: Float -> Float #-} + {-# SPECIALISE INLINE [~1] bar :: Float -> Float #-} bar x = (x * 10) diff --git a/testsuite/tests/th/TH_unresolvedInfix2.stderr b/testsuite/tests/th/TH_unresolvedInfix2.stderr index 6e17ef474a..4a5577f6fc 100644 --- a/testsuite/tests/th/TH_unresolvedInfix2.stderr +++ b/testsuite/tests/th/TH_unresolvedInfix2.stderr @@ -6,6 +6,6 @@ TH_unresolvedInfix2.hs:14:11: in the section: ‘:+ N :+ N’ In the untyped splice: $(let - plus = conE ':+ + plus = conE '(:+) n = conE 'N in infixE Nothing plus (Just $ uInfixE n plus n)) diff --git a/testsuite/tests/typecheck/should_compile/T11339.stderr b/testsuite/tests/typecheck/should_compile/T11339.stderr index 7fd50014f0..88250ef9a7 100644 --- a/testsuite/tests/typecheck/should_compile/T11339.stderr +++ b/testsuite/tests/typecheck/should_compile/T11339.stderr @@ -4,9 +4,9 @@ T11339.hs:15:5: error: t :: forall (f :: * -> *). Applicative f => (a -> f b) -> f t • In an equation for ‘failing’: failing left right afb s - = case pins t of { + = case pins t of [] -> right afb s - _ -> t afb } + _ -> t afb where t :: Applicative f => (a -> f b) -> f t Bazaar {getBazaar = t} = left sell s diff --git a/testsuite/tests/typecheck/should_compile/tc211.stderr b/testsuite/tests/typecheck/should_compile/tc211.stderr index 5cda3a1e97..c57c59b3fc 100644 --- a/testsuite/tests/typecheck/should_compile/tc211.stderr +++ b/testsuite/tests/typecheck/should_compile/tc211.stderr @@ -55,18 +55,18 @@ tc211.hs:68:8: error: with actual type ‘a2 -> a2’ • In the expression: Cons :: - (forall a. a -> a) - -> List (forall a. a -> a) -> List (forall a. a -> a) + ((forall a. a -> a) + -> List (forall a. a -> a) -> List (forall a. a -> a)) In the expression: (Cons :: - (forall a. a -> a) - -> List (forall a. a -> a) -> List (forall a. a -> a)) + ((forall a. a -> a) + -> List (forall a. a -> a) -> List (forall a. a -> a))) (\ x -> x) Nil In an equation for ‘xs2’: xs2 = (Cons :: - (forall a. a -> a) - -> List (forall a. a -> a) -> List (forall a. a -> a)) + ((forall a. a -> a) + -> List (forall a. a -> a) -> List (forall a. a -> a))) (\ x -> x) Nil tc211.hs:76:9: error: diff --git a/testsuite/tests/typecheck/should_fail/T11464.stderr b/testsuite/tests/typecheck/should_fail/T11464.stderr index f3402917b2..11dda61a9f 100644 --- a/testsuite/tests/typecheck/should_fail/T11464.stderr +++ b/testsuite/tests/typecheck/should_fail/T11464.stderr @@ -2,5 +2,5 @@ T11464.hs:5:14: error: • Expecting one more argument to ‘Either a’ Expected a type, but ‘Either a’ has kind ‘* -> *’ - • In the first argument of ‘Eq’, namely ‘Either a’ + • In the first argument of ‘Eq’, namely ‘(Either a)’ In the instance declaration for ‘Eq (Either a)’ diff --git a/testsuite/tests/typecheck/should_fail/T12124.stderr b/testsuite/tests/typecheck/should_fail/T12124.stderr index cf3c755f7e..bafc828304 100644 --- a/testsuite/tests/typecheck/should_fail/T12124.stderr +++ b/testsuite/tests/typecheck/should_fail/T12124.stderr @@ -4,6 +4,6 @@ T12124.hs:7:18: error: • In the pattern: Whoops a In a case alternative: Whoops a -> a In the first argument of ‘return’, namely - ‘(case Whoops 1 2 of { + ‘(case Whoops 1 2 of Whoops a -> a - _ -> 0 })’ + _ -> 0)’ diff --git a/testsuite/tests/typecheck/should_fail/T2994.stderr b/testsuite/tests/typecheck/should_fail/T2994.stderr index d4e07e4597..4777e486e6 100644 --- a/testsuite/tests/typecheck/should_fail/T2994.stderr +++ b/testsuite/tests/typecheck/should_fail/T2994.stderr @@ -14,7 +14,7 @@ T2994.hs:13:10: error: T2994.hs:13:23: error: • Expecting one more argument to ‘Reader' r’ Expected a type, but ‘Reader' r’ has kind ‘* -> *’ - • In the first argument of ‘MonadReader’, namely ‘Reader' r’ + • In the first argument of ‘MonadReader’, namely ‘(Reader' r)’ In the instance declaration for ‘MonadReader (Reader' r)’ T2994.hs:15:10: error: diff --git a/testsuite/tests/typecheck/should_fail/T3540.stderr b/testsuite/tests/typecheck/should_fail/T3540.stderr index 5df0972d58..1723e86bbe 100644 --- a/testsuite/tests/typecheck/should_fail/T3540.stderr +++ b/testsuite/tests/typecheck/should_fail/T3540.stderr @@ -1,25 +1,20 @@ T3540.hs:4:12: error: • Expected a type, but ‘a ~ Int’ has kind ‘Constraint’ - • In the type signature: - thing :: a ~ Int + • In the type signature: thing :: (a ~ Int) T3540.hs:7:20: error: • Expected a type, but ‘a ~ Int’ has kind ‘Constraint’ - • In the type signature: - thing1 :: Int -> (a ~ Int) + • In the type signature: thing1 :: Int -> (a ~ Int) T3540.hs:10:13: error: • Expected a type, but ‘a ~ Int’ has kind ‘Constraint’ - • In the type signature: - thing2 :: (a ~ Int) -> Int + • In the type signature: thing2 :: (a ~ Int) -> Int T3540.hs:13:12: error: • Expected a type, but ‘?dude::Int’ has kind ‘Constraint’ - • In the type signature: - thing3 :: (?dude :: Int) -> Int + • In the type signature: thing3 :: (?dude :: Int) -> Int T3540.hs:16:11: error: • Expected a type, but ‘Eq a’ has kind ‘Constraint’ - • In the type signature: - thing4 :: (Eq a) -> Int + • In the type signature: thing4 :: (Eq a) -> Int diff --git a/testsuite/tests/typecheck/should_fail/T3613.stderr b/testsuite/tests/typecheck/should_fail/T3613.stderr index 6d3c70346b..a221a95c17 100644 --- a/testsuite/tests/typecheck/should_fail/T3613.stderr +++ b/testsuite/tests/typecheck/should_fail/T3613.stderr @@ -14,9 +14,9 @@ T3613.hs:17:24: error: Actual type: IO () • In a stmt of a 'do' block: bar In the first argument of ‘fooThen’, namely - ‘(do { bar; - undefined })’ + ‘(do bar + undefined)’ In the expression: fooThen - (do { bar; - undefined }) + (do bar + undefined) diff --git a/testsuite/tests/typecheck/should_fail/T7748a.stderr b/testsuite/tests/typecheck/should_fail/T7748a.stderr index 17d60cc32d..ed9df46d15 100644 --- a/testsuite/tests/typecheck/should_fail/T7748a.stderr +++ b/testsuite/tests/typecheck/should_fail/T7748a.stderr @@ -9,10 +9,10 @@ T7748a.hs:16:24: error: • In the pattern: Just (Just p) In a case alternative: Just (Just p) -> p In the expression: - case zd of { + case zd of Nothing -> const () Just Nothing -> const () - Just (Just p) -> p } + Just (Just p) -> p • Relevant bindings include g :: r -> () (bound at T7748a.hs:13:16) f :: r -> () (bound at T7748a.hs:13:8) diff --git a/testsuite/tests/typecheck/should_fail/T7851.stderr b/testsuite/tests/typecheck/should_fail/T7851.stderr index b8ec6b8f32..1a0274f8a3 100644 --- a/testsuite/tests/typecheck/should_fail/T7851.stderr +++ b/testsuite/tests/typecheck/should_fail/T7851.stderr @@ -5,9 +5,9 @@ T7851.hs:5:10: error: • Probable cause: ‘print’ is applied to too few arguments In a stmt of a 'do' block: print In the expression: - do { print; - print "Hello" } + do print + print "Hello" In an equation for ‘bar’: bar - = do { print; - print "Hello" } + = do print + print "Hello" diff --git a/testsuite/tests/typecheck/should_fail/T8603.stderr b/testsuite/tests/typecheck/should_fail/T8603.stderr index baf3264734..d87bd635c4 100644 --- a/testsuite/tests/typecheck/should_fail/T8603.stderr +++ b/testsuite/tests/typecheck/should_fail/T8603.stderr @@ -13,7 +13,7 @@ T8603.hs:29:17: error: has only one In a stmt of a 'do' block: prize <- lift uniform [1, 2, 3] In the expression: - do { prize <- lift uniform [1, 2, ....]; - return False } + do prize <- lift uniform [1, 2, ....] + return False • Relevant bindings include testRVState1 :: RVState s Bool (bound at T8603.hs:28:1) diff --git a/testsuite/tests/typecheck/should_fail/T9201.stderr b/testsuite/tests/typecheck/should_fail/T9201.stderr index b6c187548b..28f2f1d391 100644 --- a/testsuite/tests/typecheck/should_fail/T9201.stderr +++ b/testsuite/tests/typecheck/should_fail/T9201.stderr @@ -2,6 +2,6 @@ T9201.hs:6:17: error: • Expected kind ‘x’, but ‘a’ has kind ‘y’ • In the first argument of ‘f’, namely ‘a’ - In the second argument of ‘d’, namely ‘f a’ + In the second argument of ‘d’, namely ‘(f a)’ In the type signature: ret :: d a (f a) diff --git a/testsuite/tests/typecheck/should_fail/T9612.stderr b/testsuite/tests/typecheck/should_fail/T9612.stderr index b5e6023664..462edc3e2d 100644 --- a/testsuite/tests/typecheck/should_fail/T9612.stderr +++ b/testsuite/tests/typecheck/should_fail/T9612.stderr @@ -7,12 +7,12 @@ T9612.hs:16:9: error: instance ‘MonadWriter w (WriterT w m)’ at T9612.hs:20:10-59 In a stmt of a 'do' block: tell (n, x) In the expression: - do { tell (n, x); - return (1, y) } + do tell (n, x) + return (1, y) In an equation for ‘f’: f y (n, x) - = do { tell (n, x); - return (1, y) } + = do tell (n, x) + return (1, y) Relevant bindings include x :: a (bound at T9612.hs:14:8) y :: a (bound at T9612.hs:14:3) diff --git a/testsuite/tests/typecheck/should_fail/tcfail028.stderr b/testsuite/tests/typecheck/should_fail/tcfail028.stderr index 38791e6c0f..518925575d 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail028.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail028.stderr @@ -2,6 +2,6 @@ tcfail028.hs:4:17: Expecting one more argument to ‘A a’ Expected a type, but ‘A a’ has kind ‘k0 -> *’ - In the type ‘A a’ + In the type ‘(A a)’ In the definition of data constructor ‘B’ In the data declaration for ‘A’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail070.stderr b/testsuite/tests/typecheck/should_fail/tcfail070.stderr index aa20e5d45f..0219626375 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail070.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail070.stderr @@ -2,5 +2,5 @@ tcfail070.hs:15:15: error: • Expecting one fewer arguments to ‘[Int]’ Expected kind ‘* -> k0’, but ‘[Int]’ has kind ‘*’ - • In the type ‘[Int] Bool’ + • In the type ‘([Int] Bool)’ In the type declaration for ‘State’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail103.stderr b/testsuite/tests/typecheck/should_fail/tcfail103.stderr index dd4d074223..ba0694b117 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail103.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail103.stderr @@ -14,10 +14,10 @@ tcfail103.hs:15:13: error: • In the expression: readSTRef v In an equation for ‘g’: g = readSTRef v In the expression: - do { v <- newSTRef 5; - let g :: ST s Int - g = readSTRef v; - g } + do v <- newSTRef 5 + let g :: ST s Int + g = readSTRef v + g • Relevant bindings include g :: ST s Int (bound at tcfail103.hs:15:9) v :: STRef t Int (bound at tcfail103.hs:12:5) diff --git a/testsuite/tests/typecheck/should_fail/tcfail128.stderr b/testsuite/tests/typecheck/should_fail/tcfail128.stderr index 63e314d80c..d78c46a191 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail128.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail128.stderr @@ -9,14 +9,14 @@ tcfail128.hs:18:16: error: (use -fprint-potential-instances to see them all) • In a stmt of a 'do' block: v <- thaw tmp In the expression: - do { let sL = ... - dim = length sL - ....; - v <- thaw tmp; - return () } + do let sL = ... + dim = length sL + .... + v <- thaw tmp + return () In an equation for ‘main’: main - = do { let sL = ... - ....; - v <- thaw tmp; - return () } + = do let sL = ... + .... + v <- thaw tmp + return () diff --git a/testsuite/tests/typecheck/should_fail/tcfail132.stderr b/testsuite/tests/typecheck/should_fail/tcfail132.stderr index 78209d2bc4..3f8f226468 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail132.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail132.stderr @@ -3,13 +3,13 @@ tcfail132.hs:17:37: error: • Expecting one fewer arguments to ‘Object f' f t’ Expected kind ‘* -> * -> * -> *’, but ‘Object f' f t’ has kind ‘* -> * -> *’ - • In the first argument of ‘T’, namely ‘Object f' f t’ + • In the first argument of ‘T’, namely ‘(Object f' f t)’ In the type ‘T (Object f' f t) (DUnit t)’ In the type declaration for ‘LiftObject’ tcfail132.hs:17:53: error: • Expected kind ‘* -> * -> * -> *’, but ‘DUnit t’ has kind ‘* -> * -> *’ - • In the second argument of ‘T’, namely ‘DUnit t’ + • In the second argument of ‘T’, namely ‘(DUnit t)’ In the type ‘T (Object f' f t) (DUnit t)’ In the type declaration for ‘LiftObject’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail146.stderr b/testsuite/tests/typecheck/should_fail/tcfail146.stderr index cf9341dfb3..ae126f5f1e 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail146.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail146.stderr @@ -1,6 +1,6 @@ tcfail146.hs:7:22: error: • Expected a type, but ‘SClass a’ has kind ‘Constraint’ - • In the type ‘SClass a’ + • In the type ‘(SClass a)’ In the definition of data constructor ‘SCon’ In the data declaration for ‘SData’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail162.stderr b/testsuite/tests/typecheck/should_fail/tcfail162.stderr index 3d1e79879b..228f18d5b8 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail162.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail162.stderr @@ -2,6 +2,6 @@ tcfail162.hs:10:33: Expecting one more argument to ‘ForeignPtr’ Expected a type, but ‘ForeignPtr’ has kind ‘* -> *’ - In the type ‘ForeignPtr’ + In the type ‘(ForeignPtr)’ In the definition of data constructor ‘Foo’ In the data declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail165.stderr b/testsuite/tests/typecheck/should_fail/tcfail165.stderr index 07d293dcd3..19fe79bb78 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail165.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail165.stderr @@ -7,6 +7,6 @@ tcfail165.hs:19:23: error: In a stmt of a 'do' block: putMVar var (show :: forall b. Show b => b -> String) In the expression: - do { var <- newEmptyMVar :: - IO (MVar (forall a. Show a => a -> String)); - putMVar var (show :: forall b. Show b => b -> String) } + do var <- newEmptyMVar :: + IO (MVar (forall a. Show a => a -> String)) + putMVar var (show :: forall b. Show b => b -> String) diff --git a/testsuite/tests/typecheck/should_fail/tcfail168.stderr b/testsuite/tests/typecheck/should_fail/tcfail168.stderr index 5f4656b13f..4ec71aaa1d 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail168.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail168.stderr @@ -5,14 +5,14 @@ tcfail168.hs:7:11: error: • Probable cause: ‘putChar’ is applied to too few arguments In a stmt of a 'do' block: putChar In the expression: - do { putChar; - putChar 'a'; - putChar 'a'; - putChar 'a'; - .... } + do putChar + putChar 'a' + putChar 'a' + putChar 'a' + .... In an equation for ‘foo’: foo - = do { putChar; - putChar 'a'; - putChar 'a'; - .... } + = do putChar + putChar 'a' + putChar 'a' + .... diff --git a/testsuite/tests/unboxedsums/ffi1.stderr b/testsuite/tests/unboxedsums/ffi1.stderr index 3a97270d0d..cdc77cea19 100644 --- a/testsuite/tests/unboxedsums/ffi1.stderr +++ b/testsuite/tests/unboxedsums/ffi1.stderr @@ -3,15 +3,14 @@ ffi1.hs:9:1: error: • Unacceptable argument type in foreign declaration: ‘(# Int | Int #)’ cannot be marshalled in a foreign call • When checking declaration: - foreign import ccall safe "static f1" f1 - :: (# Int | Int #) -> IO Int + foreign import ccall safe "f1" f1 :: (# Int | Int #) -> IO Int ffi1.hs:10:1: error: • Unacceptable argument type in foreign declaration: ‘(# (# Int, Int #) | (# Float#, Float# #) #)’ cannot be marshalled in a foreign call • When checking declaration: - foreign import ccall safe "static f2" f2 + foreign import ccall safe "f2" f2 :: (# (# Int, Int #) | (# Float#, Float# #) #) -> IO Int ffi1.hs:11:1: error: @@ -19,5 +18,5 @@ ffi1.hs:11:1: error: ‘(# (# #) | Void# | (# Int# | String #) #)’ cannot be marshalled in a foreign call • When checking declaration: - foreign import ccall safe "static f3" f3 + foreign import ccall safe "f3" f3 :: (# (# #) | Void# | (# Int# | String #) #) -> IO Int diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr index 91d3189e60..b59b49c869 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr @@ -13,12 +13,12 @@ WCompatWarningsOn.hs:13:5: warning: [-Wmissing-monadfail-instances (in -Wcompat) monadFail :: Monad m => m a • In a stmt of a 'do' block: Just _ <- undefined In the expression: - do { Just _ <- undefined; - undefined } + do Just _ <- undefined + undefined In an equation for ‘monadFail’: monadFail - = do { Just _ <- undefined; - undefined } + = do Just _ <- undefined + undefined WCompatWarningsOn.hs:16:1: warning: [-Wsemigroup (in -Wcompat)] Local definition of ‘<>’ clashes with a future Prelude name. |