diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs index 2d86b8438a588441ce010d92ef14f0f48e671fda..b8ed3c5fbf02a64f3c967bcc67c57293e6b64173 100644 --- a/compiler/deSugar/DsExpr.hs +++ b/compiler/deSugar/DsExpr.hs @@ -368,14 +368,13 @@ ds_expr _ (ExplicitTuple tup_args boxity) go (lam_vars, args) (L _ (Present expr)) -- Expressions that are present don't generate -- lambdas, just arguments. - = do { core_expr <- dsLExpr expr + = do { core_expr <- dsLExprNoLP expr ; return (lam_vars, core_expr : args) } - ; (lam_vars, args) <- foldM go ([], []) (reverse tup_args) + ; dsWhenNoErrs (foldM go ([], []) (reverse tup_args)) -- The reverse is because foldM goes left-to-right - - ; return $ mkCoreLams lam_vars $ - mkCoreTupBoxity boxity args } + (\(lam_vars, args) -> mkCoreLams lam_vars $ + mkCoreTupBoxity boxity args) } ds_expr _ (ExplicitSum alt arity expr types) = do { core_expr <- dsLExpr expr diff --git a/testsuite/tests/typecheck/should_fail/T13929.hs b/testsuite/tests/typecheck/should_fail/T13929.hs new file mode 100644 index 0000000000000000000000000000000000000000..f0a026d27e548d083582c84e316fad589171c72c --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13929.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + +module Main where + +import GHC.Exts +import Data.Kind +import GHC.Generics + +class GUnbox (f :: Type -> Type) (r :: RuntimeRep) where + type GUnboxed f r :: TYPE r + gunbox :: f p -> GUnboxed f r + +instance (GUnbox f rf, GUnbox g rg) => GUnbox (f :*: g) ('TupleRep '[rf, rg]) where + type GUnboxed (f :*: g) ('TupleRep '[rf, rg]) = (# GUnboxed f rf, GUnboxed g rg #) + -- if I remove implementation of `gunbox` it compiles successfully + gunbox (x :*: y) = (# gunbox x, gunbox y #) + +main :: IO () +main = pure () diff --git a/testsuite/tests/typecheck/should_fail/T13929.stderr b/testsuite/tests/typecheck/should_fail/T13929.stderr new file mode 100644 index 0000000000000000000000000000000000000000..3ddf5b38c07db867fc7e6141719ed23686710ca9 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13929.stderr @@ -0,0 +1,12 @@ + +T13929.hs:29:27: error: + A levity-polymorphic type is not allowed here: + Type: GUnboxed f rf + Kind: TYPE rf + In the type of expression: gunbox x + +T13929.hs:29:37: error: + A levity-polymorphic type is not allowed here: + Type: GUnboxed g rg + Kind: TYPE rg + In the type of expression: gunbox y diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 230e5f478df0a78980a8e04fcba0b0eb45acdf3c..fe71e3715d0116d1dae04f9a22697a6e9bf05d2a 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -456,4 +456,5 @@ test('T11963', normal, compile_fail, ['']) test('T14000', normal, compile_fail, ['']) test('T14055', normal, compile_fail, ['']) test('T13909', normal, compile_fail, ['']) +test('T13929', normal, compile_fail, ['']) test('T14232', normal, compile_fail, [''])