summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite')
-rw-r--r--testsuite/tests/callarity/unittest/CallArity1.hs17
-rw-r--r--testsuite/tests/codeGen/should_compile/T13233.hs12
-rw-r--r--testsuite/tests/codeGen/should_fail/T13233.hs7
-rw-r--r--testsuite/tests/codeGen/should_fail/T13233.stderr28
-rw-r--r--testsuite/tests/codeGen/should_fail/T13233_elab.stderr24
-rw-r--r--testsuite/tests/dependent/should_compile/dynamic-paper.stderr2
-rw-r--r--testsuite/tests/deriving/should_compile/T14682.stderr4
-rw-r--r--testsuite/tests/driver/T4437.hs1
-rw-r--r--testsuite/tests/ghci.debugger/scripts/break006.stdout4
-rw-r--r--testsuite/tests/ghci.debugger/scripts/hist001.stdout2
-rw-r--r--testsuite/tests/ghci.debugger/scripts/hist002.stdout2
-rw-r--r--testsuite/tests/ghci/T18060/T18060.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/T8535.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/ghci020.stdout4
-rw-r--r--testsuite/tests/ghci/should_run/T10145.stdout4
-rw-r--r--testsuite/tests/linear/Makefile3
-rw-r--r--testsuite/tests/linear/should_compile/Arity2.hs42
-rw-r--r--testsuite/tests/linear/should_compile/Branches.hs13
-rw-r--r--testsuite/tests/linear/should_compile/CSETest.hs12
-rw-r--r--testsuite/tests/linear/should_compile/Dollar2.hs21
-rw-r--r--testsuite/tests/linear/should_compile/DollarDefault.hs10
-rw-r--r--testsuite/tests/linear/should_compile/DollarTest.hs18
-rw-r--r--testsuite/tests/linear/should_compile/Foldr.hs29
-rw-r--r--testsuite/tests/linear/should_compile/Iden.hs5
-rw-r--r--testsuite/tests/linear/should_compile/Linear10.hs9
-rw-r--r--testsuite/tests/linear/should_compile/Linear12.hs35
-rw-r--r--testsuite/tests/linear/should_compile/Linear14.hs25
-rw-r--r--testsuite/tests/linear/should_compile/Linear15.hs12
-rw-r--r--testsuite/tests/linear/should_compile/Linear16.hs21
-rw-r--r--testsuite/tests/linear/should_compile/Linear1Rule.hs9
-rw-r--r--testsuite/tests/linear/should_compile/Linear3.hs25
-rw-r--r--testsuite/tests/linear/should_compile/Linear4.hs10
-rw-r--r--testsuite/tests/linear/should_compile/Linear6.hs7
-rw-r--r--testsuite/tests/linear/should_compile/Linear8.hs9
-rw-r--r--testsuite/tests/linear/should_compile/LinearConstructors.hs30
-rw-r--r--testsuite/tests/linear/should_compile/LinearEmptyCase.hs8
-rw-r--r--testsuite/tests/linear/should_compile/LinearGuards.hs6
-rw-r--r--testsuite/tests/linear/should_compile/LinearLetRec.hs11
-rw-r--r--testsuite/tests/linear/should_compile/LinearPolyDollar.hs10
-rw-r--r--testsuite/tests/linear/should_compile/LinearTH1.hs6
-rw-r--r--testsuite/tests/linear/should_compile/LinearTH2.hs4
-rw-r--r--testsuite/tests/linear/should_compile/List.hs45
-rw-r--r--testsuite/tests/linear/should_compile/Makefile3
-rw-r--r--testsuite/tests/linear/should_compile/MultConstructor.hs13
-rw-r--r--testsuite/tests/linear/should_compile/OldList.hs34
-rw-r--r--testsuite/tests/linear/should_compile/Op.hs35
-rw-r--r--testsuite/tests/linear/should_compile/Pr110.hs10
-rw-r--r--testsuite/tests/linear/should_compile/RankN.hs52
-rw-r--r--testsuite/tests/linear/should_compile/T1735Min.hs29
-rw-r--r--testsuite/tests/linear/should_compile/Tunboxer.hs11
-rw-r--r--testsuite/tests/linear/should_compile/TupSection.hs13
-rw-r--r--testsuite/tests/linear/should_compile/all.T37
-rw-r--r--testsuite/tests/linear/should_compile/anf.hs21
-rw-r--r--testsuite/tests/linear/should_fail/Linear1.hs14
-rw-r--r--testsuite/tests/linear/should_fail/Linear1.stderr10
-rw-r--r--testsuite/tests/linear/should_fail/Linear11.hs14
-rw-r--r--testsuite/tests/linear/should_fail/Linear11.stderr13
-rw-r--r--testsuite/tests/linear/should_fail/Linear13.hs15
-rw-r--r--testsuite/tests/linear/should_fail/Linear13.stderr28
-rw-r--r--testsuite/tests/linear/should_fail/Linear17.hs34
-rw-r--r--testsuite/tests/linear/should_fail/Linear17.stderr45
-rw-r--r--testsuite/tests/linear/should_fail/Linear2.hs16
-rw-r--r--testsuite/tests/linear/should_fail/Linear2.stderr16
-rw-r--r--testsuite/tests/linear/should_fail/Linear5.hs7
-rw-r--r--testsuite/tests/linear/should_fail/Linear5.stderr5
-rw-r--r--testsuite/tests/linear/should_fail/Linear7.hs9
-rw-r--r--testsuite/tests/linear/should_fail/Linear7.stderr9
-rw-r--r--testsuite/tests/linear/should_fail/Linear9.hs26
-rw-r--r--testsuite/tests/linear/should_fail/Linear9.stderr43
-rw-r--r--testsuite/tests/linear/should_fail/LinearAsPat.hs6
-rw-r--r--testsuite/tests/linear/should_fail/LinearAsPat.stderr5
-rw-r--r--testsuite/tests/linear/should_fail/LinearBottomMult.hs13
-rw-r--r--testsuite/tests/linear/should_fail/LinearBottomMult.stderr6
-rw-r--r--testsuite/tests/linear/should_fail/LinearConfusedDollar.hs12
-rw-r--r--testsuite/tests/linear/should_fail/LinearConfusedDollar.stderr6
-rw-r--r--testsuite/tests/linear/should_fail/LinearErrOrigin.hs7
-rw-r--r--testsuite/tests/linear/should_fail/LinearErrOrigin.stderr16
-rw-r--r--testsuite/tests/linear/should_fail/LinearGADTNewtype.hs3
-rw-r--r--testsuite/tests/linear/should_fail/LinearGADTNewtype.stderr5
-rw-r--r--testsuite/tests/linear/should_fail/LinearIf.hs15
-rw-r--r--testsuite/tests/linear/should_fail/LinearIf.stderr15
-rw-r--r--testsuite/tests/linear/should_fail/LinearKind.hs4
-rw-r--r--testsuite/tests/linear/should_fail/LinearKind.stderr5
-rw-r--r--testsuite/tests/linear/should_fail/LinearLazyPat.hs5
-rw-r--r--testsuite/tests/linear/should_fail/LinearLazyPat.stderr6
-rw-r--r--testsuite/tests/linear/should_fail/LinearLet.hs5
-rw-r--r--testsuite/tests/linear/should_fail/LinearLet.stderr5
-rw-r--r--testsuite/tests/linear/should_fail/LinearNoExt.hs3
-rw-r--r--testsuite/tests/linear/should_fail/LinearNoExt.stderr3
-rw-r--r--testsuite/tests/linear/should_fail/LinearPartialSig.hs6
-rw-r--r--testsuite/tests/linear/should_fail/LinearPartialSig.stderr7
-rw-r--r--testsuite/tests/linear/should_fail/LinearPatSyn.hs14
-rw-r--r--testsuite/tests/linear/should_fail/LinearPatSyn.stderr6
-rw-r--r--testsuite/tests/linear/should_fail/LinearPolyType.hs16
-rw-r--r--testsuite/tests/linear/should_fail/LinearPolyType.stderr3
-rw-r--r--testsuite/tests/linear/should_fail/LinearRecordUpdate.hs8
-rw-r--r--testsuite/tests/linear/should_fail/LinearRecordUpdate.stderr5
-rw-r--r--testsuite/tests/linear/should_fail/LinearSeq.hs6
-rw-r--r--testsuite/tests/linear/should_fail/LinearSeq.stderr5
-rw-r--r--testsuite/tests/linear/should_fail/LinearSequenceExpr.hs8
-rw-r--r--testsuite/tests/linear/should_fail/LinearSequenceExpr.stderr10
-rw-r--r--testsuite/tests/linear/should_fail/LinearVar.hs5
-rw-r--r--testsuite/tests/linear/should_fail/LinearVar.stderr13
-rw-r--r--testsuite/tests/linear/should_fail/LinearViewPattern.hs11
-rw-r--r--testsuite/tests/linear/should_fail/LinearViewPattern.stderr6
-rw-r--r--testsuite/tests/linear/should_fail/Makefile3
-rw-r--r--testsuite/tests/linear/should_fail/TypeClass.hs45
-rw-r--r--testsuite/tests/linear/should_fail/TypeClass.stderr5
-rw-r--r--testsuite/tests/linear/should_fail/all.T29
-rw-r--r--testsuite/tests/linear/should_run/LinearGhci.script11
-rw-r--r--testsuite/tests/linear/should_run/LinearGhci.stdout7
-rw-r--r--testsuite/tests/linear/should_run/LinearTypeable.hs10
-rw-r--r--testsuite/tests/linear/should_run/LinearTypeable.stdout1
-rw-r--r--testsuite/tests/linear/should_run/Makefile3
-rw-r--r--testsuite/tests/linear/should_run/all.T2
-rw-r--r--testsuite/tests/parser/should_compile/DumpParsedAst.stderr59
-rw-r--r--testsuite/tests/parser/should_compile/DumpRenamedAst.stderr151
-rw-r--r--testsuite/tests/parser/should_compile/KindSigs.stderr2
-rw-r--r--testsuite/tests/parser/should_compile/T14189.stderr14
-rw-r--r--testsuite/tests/polykinds/T6002.hs2
-rw-r--r--testsuite/tests/printer/T18052a.stderr6
-rw-r--r--testsuite/tests/roles/should_compile/Roles13.stderr7
-rw-r--r--testsuite/tests/simplCore/should_compile/T18013.stderr6
-rw-r--r--testsuite/tests/simplCore/should_compile/T4201.stdout2
-rw-r--r--testsuite/tests/simplCore/should_compile/T7360.stderr2
-rw-r--r--testsuite/tests/stranal/should_compile/T16029.stdout2
-rw-r--r--testsuite/tests/th/T10019.stdout2
-rw-r--r--testsuite/tests/th/T11345.stdout4
-rw-r--r--testsuite/tests/th/T14888.stderr2
-rw-r--r--testsuite/tests/th/TH_reifyLinear.hs13
-rw-r--r--testsuite/tests/th/TH_reifyLinear.stderr1
-rw-r--r--testsuite/tests/th/all.T1
-rw-r--r--testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr32
-rw-r--r--testsuite/tests/typecheck/should_compile/all.T2
-rw-r--r--testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr4
-rw-r--r--testsuite/tests/typecheck/should_compile/holes.stderr2
-rw-r--r--testsuite/tests/typecheck/should_compile/holes3.stderr2
-rw-r--r--testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr20
-rw-r--r--testsuite/tests/typecheck/should_fail/T17021.stderr10
-rw-r--r--testsuite/tests/typecheck/should_fail/UnliftedNewtypesLevityBinder.stderr10
-rw-r--r--testsuite/tests/typecheck/should_run/T14236.stdout4
-rw-r--r--testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout2
142 files changed, 1637 insertions, 233 deletions
diff --git a/testsuite/tests/callarity/unittest/CallArity1.hs b/testsuite/tests/callarity/unittest/CallArity1.hs
index 60cb97835f..55427ff4b7 100644
--- a/testsuite/tests/callarity/unittest/CallArity1.hs
+++ b/testsuite/tests/callarity/unittest/CallArity1.hs
@@ -1,8 +1,9 @@
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TupleSections, PatternSynonyms #-}
import GHC.Core
import GHC.Core.Utils
import GHC.Types.Id
import GHC.Core.Type
+import GHC.Core.Multiplicity ( pattern Many )
import GHC.Core.Make
import GHC.Core.Opt.CallArity (callArityRHS)
import GHC.Types.Id.Make
@@ -27,16 +28,16 @@ import GHC.Data.FastString
go, go2, x, d, n, y, z, scrutf, scruta :: Id
[go, go2, x,d, n, y, z, scrutf, scruta, f] = mkTestIds
(words "go go2 x d n y z scrutf scruta f")
- [ mkVisFunTys [intTy, intTy] intTy
- , mkVisFunTys [intTy, intTy] intTy
+ [ mkVisFunTysMany [intTy, intTy] intTy
+ , mkVisFunTysMany [intTy, intTy] intTy
, intTy
- , mkVisFunTys [intTy] intTy
- , mkVisFunTys [intTy] intTy
+ , mkVisFunTysMany [intTy] intTy
+ , mkVisFunTysMany [intTy] intTy
, intTy
, intTy
- , mkVisFunTys [boolTy] boolTy
+ , mkVisFunTysMany [boolTy] boolTy
, boolTy
- , mkVisFunTys [intTy, intTy] intTy -- protoypical external function
+ , mkVisFunTysMany [intTy, intTy] intTy -- protoypical external function
]
exprs :: [(String, CoreExpr)]
@@ -188,7 +189,7 @@ mkLApps v = mkApps (Var v) . map mkLit
mkACase = mkIfThenElse (mkVarApps (Var scrutf) [scruta])
mkTestId :: Int -> String -> Type -> Id
-mkTestId i s ty = mkSysLocal (mkFastString s) (mkBuiltinUnique i) ty
+mkTestId i s ty = mkSysLocal (mkFastString s) (mkBuiltinUnique i) Many ty
mkTestIds :: [String] -> [Type] -> [Id]
mkTestIds ns tys = zipWith3 mkTestId [0..] ns tys
diff --git a/testsuite/tests/codeGen/should_compile/T13233.hs b/testsuite/tests/codeGen/should_compile/T13233.hs
new file mode 100644
index 0000000000..bb79856d3b
--- /dev/null
+++ b/testsuite/tests/codeGen/should_compile/T13233.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE UnboxedTuples #-}
+module Bug where
+
+import GHC.Exts (TYPE)
+
+class Foo (a :: TYPE rep) where
+ bar :: forall (b :: TYPE rep2). (a -> a -> b) -> a -> a -> b
+
+baz :: forall (a :: TYPE rep). Foo a => a -> a -> (# a, a #)
+baz = bar (#,#)
diff --git a/testsuite/tests/codeGen/should_fail/T13233.hs b/testsuite/tests/codeGen/should_fail/T13233.hs
index f24fc03bfb..42a30522f2 100644
--- a/testsuite/tests/codeGen/should_fail/T13233.hs
+++ b/testsuite/tests/codeGen/should_fail/T13233.hs
@@ -3,19 +3,20 @@
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE LinearTypes #-}
module Bug where
import GHC.Exts (TYPE, RuntimeRep, Weak#, State#, RealWorld, mkWeak# )
class Foo (a :: TYPE rep) where
- bar :: forall rep2 (b :: TYPE rep2). (a -> a -> b) -> a -> a -> b
+ bar :: forall rep2 (b :: TYPE rep2). (a #-> a #-> b) -> a #-> a #-> b
-baz :: forall rep (a :: TYPE rep). Foo a => a -> a -> (# a, a #)
+baz :: forall rep (a :: TYPE rep). Foo a => a #-> a #-> (# a, a #)
baz = bar (#,#)
obscure :: (forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep)
(a :: TYPE rep1) (b :: TYPE rep2).
- a -> b -> (# a, b #)) -> ()
+ a #-> b #-> (# a, b #)) -> ()
obscure _ = ()
quux :: ()
diff --git a/testsuite/tests/codeGen/should_fail/T13233.stderr b/testsuite/tests/codeGen/should_fail/T13233.stderr
index f6254778c1..1bbe161967 100644
--- a/testsuite/tests/codeGen/should_fail/T13233.stderr
+++ b/testsuite/tests/codeGen/should_fail/T13233.stderr
@@ -1,27 +1,11 @@
-T13233.hs:14:11: error:
- Cannot use function with levity-polymorphic arguments:
- (#,#) :: a -> a -> (# a, a #)
- (Note that levity-polymorphic primops such as 'coerce' and unboxed tuples
- are eta-expanded internally because they must occur fully saturated.
- Use -fprint-typechecker-elaboration to display the full expression.)
- Levity-polymorphic arguments:
- a :: TYPE rep
- a :: TYPE rep
-
-T13233.hs:22:16: error:
- Cannot use function with levity-polymorphic arguments:
- (#,#) :: forall {rep1 :: RuntimeRep} {rep2 :: RuntimeRep}
- {a :: TYPE rep1} {b :: TYPE rep2}.
- a -> b -> (# a, b #)
- (Note that levity-polymorphic primops such as 'coerce' and unboxed tuples
- are eta-expanded internally because they must occur fully saturated.
- Use -fprint-typechecker-elaboration to display the full expression.)
- Levity-polymorphic arguments:
- a :: TYPE rep1
- b :: TYPE rep2
+T13233.hs:23:16: error:
+ A levity-polymorphic type is not allowed here:
+ Type: a
+ Kind: TYPE rep1
+ When trying to create a variable of type: a
-T13233.hs:27:10: error:
+T13233.hs:28:10: error:
Cannot use function with levity-polymorphic arguments:
mkWeak# :: a
-> b
diff --git a/testsuite/tests/codeGen/should_fail/T13233_elab.stderr b/testsuite/tests/codeGen/should_fail/T13233_elab.stderr
index 40a12ecd62..6a069752f7 100644
--- a/testsuite/tests/codeGen/should_fail/T13233_elab.stderr
+++ b/testsuite/tests/codeGen/should_fail/T13233_elab.stderr
@@ -1,25 +1,11 @@
-T13233_elab.hs:17:11: error:
- Cannot use function with levity-polymorphic arguments:
- (#,#) @rep @rep @a @a :: a -> a -> (# a, a #)
- Levity-polymorphic arguments:
- a :: TYPE rep
- a :: TYPE rep
-
T13233_elab.hs:25:16: error:
- Cannot use function with levity-polymorphic arguments:
- /\(@(rep1 :: RuntimeRep)).
- /\(@(rep2 :: RuntimeRep)).
- /\(@(a :: TYPE rep1)).
- /\(@(b :: TYPE rep2)).
- (#,#) @rep1 @rep2 @a @b :: forall {rep1 :: RuntimeRep}
- {rep2 :: RuntimeRep} {a :: TYPE rep1} {b :: TYPE rep2}.
- a -> b -> (# a, b #)
- Levity-polymorphic arguments:
- a :: TYPE rep1
- b :: TYPE rep2
+ A levity-polymorphic type is not allowed here:
+ Type: a
+ Kind: TYPE rep1
+ When trying to create a variable of type: a
-T13233_elab.hs:33:10:
+T13233_elab.hs:33:10: error:
Cannot use function with levity-polymorphic arguments:
mkWeak# @rep @a @b @c :: a
-> b
diff --git a/testsuite/tests/dependent/should_compile/dynamic-paper.stderr b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr
index 44af3fd5f7..df2f4977f8 100644
--- a/testsuite/tests/dependent/should_compile/dynamic-paper.stderr
+++ b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr
@@ -12,4 +12,4 @@ Simplifier ticks exhausted
simplifier non-termination has been judged acceptable.
To see detailed counts use -ddump-simpl-stats
- Total ticks: 136724
+ Total ticks: 136962
diff --git a/testsuite/tests/deriving/should_compile/T14682.stderr b/testsuite/tests/deriving/should_compile/T14682.stderr
index 59fc405cdb..2bf9552ff9 100644
--- a/testsuite/tests/deriving/should_compile/T14682.stderr
+++ b/testsuite/tests/deriving/should_compile/T14682.stderr
@@ -21,8 +21,8 @@ Derived class instances:
instance Data.Data.Data T14682.Foo where
Data.Data.gfoldl k z (T14682.Foo a1 a2)
- = ((z T14682.Foo `k` a1) `k` a2)
- Data.Data.gunfold k z _ = k (k (z T14682.Foo))
+ = ((z (\ a1 a2 -> T14682.Foo a1 a2) `k` a1) `k` a2)
+ Data.Data.gunfold k z _ = k (k (z (\ a1 a2 -> T14682.Foo a1 a2)))
Data.Data.toConstr (T14682.Foo _ _) = T14682.$cFoo
Data.Data.dataTypeOf _ = T14682.$tFoo
diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs
index c83d29b03d..c1c9502863 100644
--- a/testsuite/tests/driver/T4437.hs
+++ b/testsuite/tests/driver/T4437.hs
@@ -40,6 +40,7 @@ expectedGhcOnlyExtensions =
[ "RelaxedLayout"
, "AlternativeLayoutRule"
, "AlternativeLayoutRuleTransitional"
+ , "LinearTypes"
]
expectedCabalOnlyExtensions :: [String]
diff --git a/testsuite/tests/ghci.debugger/scripts/break006.stdout b/testsuite/tests/ghci.debugger/scripts/break006.stdout
index 407ad3739b..2b4a6c20f8 100644
--- a/testsuite/tests/ghci.debugger/scripts/break006.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/break006.stdout
@@ -4,14 +4,14 @@ f :: Int -> a = _
x :: Int = 1
xs :: [Int] = [2,3]
xs :: [Int] = [2,3]
-x :: Int = 1
f :: Int -> a = _
+x :: Int = 1
_result :: [a] = _
y = (_t1::a)
y = 2
xs :: [Int] = [2,3]
-x :: Int = 1
f :: Int -> Int = _
+x :: Int = 1
_result :: [Int] = _
y :: Int = 2
_t1 :: Int = 2
diff --git a/testsuite/tests/ghci.debugger/scripts/hist001.stdout b/testsuite/tests/ghci.debugger/scripts/hist001.stdout
index a19a34f315..b52e8aa5fe 100644
--- a/testsuite/tests/ghci.debugger/scripts/hist001.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/hist001.stdout
@@ -20,8 +20,8 @@ _result :: a
f :: Integer -> a
x :: Integer
xs :: [t] = []
-x :: Integer = 2
f :: Integer -> a = _
+x :: Integer = 2
_result :: a = _
_result = 3
Logged breakpoint at Test3.hs:2:18-31
diff --git a/testsuite/tests/ghci.debugger/scripts/hist002.stdout b/testsuite/tests/ghci.debugger/scripts/hist002.stdout
index a19a34f315..b52e8aa5fe 100644
--- a/testsuite/tests/ghci.debugger/scripts/hist002.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/hist002.stdout
@@ -20,8 +20,8 @@ _result :: a
f :: Integer -> a
x :: Integer
xs :: [t] = []
-x :: Integer = 2
f :: Integer -> a = _
+x :: Integer = 2
_result :: a = _
_result = 3
Logged breakpoint at Test3.hs:2:18-31
diff --git a/testsuite/tests/ghci/T18060/T18060.stdout b/testsuite/tests/ghci/T18060/T18060.stdout
index 9d6ab23dba..8c3a2794fe 100644
--- a/testsuite/tests/ghci/T18060/T18060.stdout
+++ b/testsuite/tests/ghci/T18060/T18060.stdout
@@ -1,6 +1,6 @@
type (->) :: * -> * -> *
-data (->) a b
- -- Defined in ‘GHC.Prim’
+type (->) = (->) :: * -> * -> *
+ -- Defined in ‘GHC.Types’
infixr -1 ->
instance Applicative ((->) r) -- Defined in ‘GHC.Base’
instance Functor ((->) r) -- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/ghci/scripts/T8535.stdout b/testsuite/tests/ghci/scripts/T8535.stdout
index 7a949cd465..f7e40fd0f4 100644
--- a/testsuite/tests/ghci/scripts/T8535.stdout
+++ b/testsuite/tests/ghci/scripts/T8535.stdout
@@ -1,6 +1,6 @@
type (->) :: * -> * -> *
-data (->) a b
- -- Defined in ‘GHC.Prim’
+type (->) = (->) :: * -> * -> *
+ -- Defined in ‘GHC.Types’
infixr -1 ->
instance Applicative ((->) r) -- Defined in ‘GHC.Base’
instance Functor ((->) r) -- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/ghci/scripts/ghci020.stdout b/testsuite/tests/ghci/scripts/ghci020.stdout
index 7a949cd465..f7e40fd0f4 100644
--- a/testsuite/tests/ghci/scripts/ghci020.stdout
+++ b/testsuite/tests/ghci/scripts/ghci020.stdout
@@ -1,6 +1,6 @@
type (->) :: * -> * -> *
-data (->) a b
- -- Defined in ‘GHC.Prim’
+type (->) = (->) :: * -> * -> *
+ -- Defined in ‘GHC.Types’
infixr -1 ->
instance Applicative ((->) r) -- Defined in ‘GHC.Base’
instance Functor ((->) r) -- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/ghci/should_run/T10145.stdout b/testsuite/tests/ghci/should_run/T10145.stdout
index 7a949cd465..f7e40fd0f4 100644
--- a/testsuite/tests/ghci/should_run/T10145.stdout
+++ b/testsuite/tests/ghci/should_run/T10145.stdout
@@ -1,6 +1,6 @@
type (->) :: * -> * -> *
-data (->) a b
- -- Defined in ‘GHC.Prim’
+type (->) = (->) :: * -> * -> *
+ -- Defined in ‘GHC.Types’
infixr -1 ->
instance Applicative ((->) r) -- Defined in ‘GHC.Base’
instance Functor ((->) r) -- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/linear/Makefile b/testsuite/tests/linear/Makefile
new file mode 100644
index 0000000000..9a36a1c5fe
--- /dev/null
+++ b/testsuite/tests/linear/Makefile
@@ -0,0 +1,3 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/linear/should_compile/Arity2.hs b/testsuite/tests/linear/should_compile/Arity2.hs
new file mode 100644
index 0000000000..d764d5111a
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Arity2.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module Arity2 where
+{-
+inplace/bin/ghc-stage1 -O2 -dcore-lint
+-}
+
+--import GHC.Base
+
+data Id a = Id a
+
+(<$>) :: (a -> b) -> Id a -> Id b
+(<$>) f (Id a) = Id (f a)
+
+(<*>) :: Id (a -> b) -> Id a -> Id b
+(<*>) (Id a) (Id b) = Id (a b)
+
+data Q = Q () ()
+data S = S ()
+
+-- Q only gets eta-expand once and then trapped
+foo = Q <$> Id () <*> Id ()
+
+-- This compiles fine
+foo2 = S <$> Id ()
+
+{-
+[1 of 1] Compiling Arity2 ( linear-tests/Arity2.hs, linear-tests/Arity2.o )
+
+linear-tests/Arity2.hs:21:7: error:
+ • Couldn't match type ‘() ⊸ Q’ with ‘() -> b’
+ Expected type: Id (() -> b)
+ Actual type: Id (() ⊸ Q)
+ • In the first argument of ‘(<*>)’, namely ‘Q <$> Id ()’
+ In the expression: Q <$> Id () <*> Id ()
+ In an equation for ‘foo’: foo = Q <$> Id () <*> Id ()
+ • Relevant bindings include
+ foo :: Id b (bound at linear-tests/Arity2.hs:21:1)
+ |
+21 | foo = Q <$> Id () <*> Id ()
+ | ^^^^^^^^^^^
+-}
diff --git a/testsuite/tests/linear/should_compile/Branches.hs b/testsuite/tests/linear/should_compile/Branches.hs
new file mode 100644
index 0000000000..ee08ade335
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Branches.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE LinearTypes #-}
+module GuardTup where
+
+data Q = Q ()
+
+mkQ :: () -> Q
+mkQ = Q
+
+foo smart
+ | smart = mkQ
+ | otherwise = Q
+
+fooIf smart = if smart then mkQ else Q
diff --git a/testsuite/tests/linear/should_compile/CSETest.hs b/testsuite/tests/linear/should_compile/CSETest.hs
new file mode 100644
index 0000000000..3321dbd43d
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/CSETest.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE UnicodeSyntax #-}
+{- This test makes sure that if two expressions with conflicting types are
+ CSEd then appropiate things happen. -}
+module CSETest where
+
+minimal :: a ⊸ a
+minimal x = x
+
+maximal :: a -> a
+maximal x = x
diff --git a/testsuite/tests/linear/should_compile/Dollar2.hs b/testsuite/tests/linear/should_compile/Dollar2.hs
new file mode 100644
index 0000000000..4cde3dcb45
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Dollar2.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module Dollar2 where
+{-
+inplace/bin/ghc-stage1 -O2 -dcore-lint
+-}
+
+
+import GHC.Base
+
+data AB = A () | B ()
+
+qux :: Bool
+qux = True
+{-# NOINLINE qux #-}
+
+foo = id $ ((if qux then A else B) $ ())
+
+{-
+
+-}
diff --git a/testsuite/tests/linear/should_compile/DollarDefault.hs b/testsuite/tests/linear/should_compile/DollarDefault.hs
new file mode 100644
index 0000000000..dbe689566a
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/DollarDefault.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE LinearTypes #-}
+module DollarDefault where
+
+class C p where
+ cid :: p a a -> p a a
+
+instance C (->) where
+ cid = id
+
+foo = (cid $ id) $ ()
diff --git a/testsuite/tests/linear/should_compile/DollarTest.hs b/testsuite/tests/linear/should_compile/DollarTest.hs
new file mode 100644
index 0000000000..bc15a4fead
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/DollarTest.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE UnicodeSyntax #-}
+module Dollar where
+{-
+Check $ interacting with multiplicity polymorphism.
+This caused Core Lint error previously.
+-}
+
+import GHC.Base
+
+data Q a = Q a
+
+data QU = QU ()
+
+test = QU $ ()
+
+qux = Q $ ()
diff --git a/testsuite/tests/linear/should_compile/Foldr.hs b/testsuite/tests/linear/should_compile/Foldr.hs
new file mode 100644
index 0000000000..759256d5b2
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Foldr.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module FoldrExample where
+{-
+inplace/bin/ghc-stage1 -O2 -dcore-lint
+-}
+
+import GHC.Base
+import Data.Maybe
+
+qux :: [Maybe Char] -> String
+qux str = foldr (maybe id (:)) "" str
+
+{-
+
+[1 of 1] Compiling FoldrExample ( linear-tests/Foldr.hs, linear-tests/Foldr.o )
+
+linear-tests/Foldr.hs:11:27: error:
+ • Couldn't match type ‘[Char] ⊸ [Char]’ with ‘[Char] -> [Char]’
+ Expected type: Char -> [Char] -> [Char]
+ Actual type: Char ⊸ [Char] ⊸ [Char]
+ • In the second argument of ‘maybe’, namely ‘(:)’
+ In the first argument of ‘foldr’, namely ‘(maybe id (:))’
+ In the expression: foldr (maybe id (:)) "" str
+ |
+11 | qux str = foldr (maybe id (:)) "" str
+ | ^^^
+
+-}
diff --git a/testsuite/tests/linear/should_compile/Iden.hs b/testsuite/tests/linear/should_compile/Iden.hs
new file mode 100644
index 0000000000..3522a43c42
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Iden.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE LinearTypes #-}
+module Foo where
+
+newtype HappyIdentity a = HappyIdentity a
+happyIdentity = HappyIdentity
diff --git a/testsuite/tests/linear/should_compile/Linear10.hs b/testsuite/tests/linear/should_compile/Linear10.hs
new file mode 100644
index 0000000000..e76a344fb0
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Linear10.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE GADTs #-}
+module Linear10 where
+
+data Unrestricted a where Unrestricted :: a -> Unrestricted a
+
+unrestrictedDup :: Unrestricted a ⊸ (a, a)
+unrestrictedDup (Unrestricted a) = (a,a)
diff --git a/testsuite/tests/linear/should_compile/Linear12.hs b/testsuite/tests/linear/should_compile/Linear12.hs
new file mode 100644
index 0000000000..3f49e94948
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Linear12.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE GADTs #-}
+module Linear12 where
+
+type N a = a ⊸ ()
+
+consume :: a ⊸ N a ⊸ ()
+consume x k = k x
+
+data N' a where N :: N a ⊸ N' a
+
+consume' :: a ⊸ N' a ⊸ ()
+consume' x (N k) = k x
+
+data W = W (W ⊸ ())
+
+wPlusTwo :: W ⊸ W
+wPlusTwo n = W (\(W k) -> k n)
+
+data Nat = S Nat
+
+natPlusOne :: Nat ⊸ Nat
+natPlusOne n = S n
+
+data D = D ()
+
+mkD :: () ⊸ D
+mkD x = D x
+
+data Odd = E Even
+data Even = O Odd
+
+evenPlusOne :: Even ⊸ Odd
+evenPlusOne e = E e
diff --git a/testsuite/tests/linear/should_compile/Linear14.hs b/testsuite/tests/linear/should_compile/Linear14.hs
new file mode 100644
index 0000000000..3a40212f75
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Linear14.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+module Linear14 where
+
+-- Inference-related behaviour. Slightly sub-optimal still.
+
+bind1 :: (d ⊸ (a ⊸ b) ⊸ c) ⊸ d ⊸ (a⊸b) ⊸ c
+bind1 b x f = b x (\a -> f a)
+
+newtype I a = I a
+
+bind2 :: (d ⊸ (a ⊸ b) ⊸ c) ⊸ d ⊸ (I a⊸b) ⊸ c
+bind2 b x f = b x (\a -> f (I a))
+
+bind3 :: (d ⊸ I (a ⊸ b) ⊸ c) ⊸ d ⊸ (a⊸b) ⊸ c
+bind3 b x f = b x (I (\a -> f a))
+
+bind4 :: (d ⊸ I ((a ⊸ a') ⊸ b) ⊸ c) ⊸ d ⊸ ((a⊸a')⊸b) ⊸ c
+bind4 b x f = b x (I (\g -> f g))
+
+bind5 :: (d ⊸ ((a ⊸ a') ⊸ b) ⊸ c) ⊸ d ⊸ ((a⊸a')⊸b) ⊸ c
+bind5 b x f = b x (\g -> f (\a -> g a))
+
+bind6 :: (d ⊸ I ((a ⊸ a') ⊸ b) ⊸ c) ⊸ d ⊸ ((a⊸a')⊸b) ⊸ c
+bind6 b x f = b x (I (\g -> f (\a -> g a)))
diff --git a/testsuite/tests/linear/should_compile/Linear15.hs b/testsuite/tests/linear/should_compile/Linear15.hs
new file mode 100644
index 0000000000..fb244fe8b3
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Linear15.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+module Linear15 where
+
+correctWhere :: Int ⊸ Int
+correctWhere a = g a
+ where
+ f :: Int ⊸ Int
+ f x = x
+
+ g :: Int ⊸ Int
+ g x = f x
diff --git a/testsuite/tests/linear/should_compile/Linear16.hs b/testsuite/tests/linear/should_compile/Linear16.hs
new file mode 100644
index 0000000000..8ed8b5b36c
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Linear16.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE RebindableSyntax #-}
+module Linear16 where
+
+-- Rebindable do notation
+
+(>>=) :: a ⊸ (a ⊸ b) ⊸ b
+(>>=) x f = f x
+
+-- `fail` is needed due to pattern matching on ();
+-- ideally, it shouldn't be there.
+fail :: a
+fail = fail
+
+correctDo = do
+ x <- ()
+ (y,z) <- ((),x)
+ () <- y
+ () <- z
+ ()
diff --git a/testsuite/tests/linear/should_compile/Linear1Rule.hs b/testsuite/tests/linear/should_compile/Linear1Rule.hs
new file mode 100644
index 0000000000..0553c61e84
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Linear1Rule.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE LinearTypes #-}
+module Linear1Rule where
+
+-- Test the 1 <= p rule
+f :: a #-> b
+f = f
+
+g :: a # p -> b
+g x = f x
diff --git a/testsuite/tests/linear/should_compile/Linear3.hs b/testsuite/tests/linear/should_compile/Linear3.hs
new file mode 100644
index 0000000000..52b9571085
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Linear3.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+module Linear3 where
+
+correctApp1 :: (a⊸b) ⊸ a ⊸ b
+correctApp1 f a = f a
+
+correctApp2 :: (a⊸a) -> a ⊸ a
+correctApp2 f a = f (f a)
+
+correctApp3 :: Int ⊸ Int
+correctApp3 x = f x
+ where
+ f :: Int ⊸ Int
+ f y = y
+
+correctApp4 :: Int ⊸ Int
+correctApp4 x = f (f x)
+ where
+ f :: Int ⊸ Int
+ f y = y
+
+correctIf :: Bool ⊸ a ⊸ a
+correctIf x n =
+ if x then n else n
diff --git a/testsuite/tests/linear/should_compile/Linear4.hs b/testsuite/tests/linear/should_compile/Linear4.hs
new file mode 100644
index 0000000000..7f025e0a0f
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Linear4.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE LambdaCase, GADTs #-}
+module Linear4 where
+
+correctCase :: Bool ⊸ a ⊸ a
+correctCase x n =
+ case x of
+ True -> n
+ False -> n
diff --git a/testsuite/tests/linear/should_compile/Linear6.hs b/testsuite/tests/linear/should_compile/Linear6.hs
new file mode 100644
index 0000000000..ea095237f5
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Linear6.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+module Linear6 where
+
+correctEqn :: Bool ⊸ Int ⊸ Int
+correctEqn True n = n
+correctEqn False n = n
diff --git a/testsuite/tests/linear/should_compile/Linear8.hs b/testsuite/tests/linear/should_compile/Linear8.hs
new file mode 100644
index 0000000000..a7b6bf95e0
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Linear8.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE LambdaCase #-}
+module Linear8 where
+
+correctLCase :: Int ⊸ Bool -> Int
+correctLCase n = \case
+ True -> n
+ False -> n
diff --git a/testsuite/tests/linear/should_compile/LinearConstructors.hs b/testsuite/tests/linear/should_compile/LinearConstructors.hs
new file mode 100644
index 0000000000..0e0f1b547e
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/LinearConstructors.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE TupleSections #-}
+module LinearConstructors where
+
+data T a b = MkT a b
+
+f1 :: a #-> b #-> T a b
+f1 = MkT
+
+f2 :: a #-> b -> T a b
+f2 = MkT
+
+f3 :: a -> b #-> T a b
+f3 = MkT
+
+f4 :: a -> b -> T a b
+f4 = MkT
+
+-- tuple sections
+g1 :: a #-> b #-> (a, b, Int)
+g1 = (,,0)
+
+g2 :: a #-> b -> (a, b, Int)
+g2 = (,,0)
+
+g3 :: a -> b #-> (a, b, Int)
+g3 = (,,0)
+
+g4 :: a -> b -> (a, b, Int)
+g4 = (,,0)
diff --git a/testsuite/tests/linear/should_compile/LinearEmptyCase.hs b/testsuite/tests/linear/should_compile/LinearEmptyCase.hs
new file mode 100644
index 0000000000..daa1918b56
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/LinearEmptyCase.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE EmptyCase, LinearTypes #-}
+
+module LinearEmptyCase where
+
+data Void
+
+f :: a #-> Void -> b
+f x y = case y of {}
diff --git a/testsuite/tests/linear/should_compile/LinearGuards.hs b/testsuite/tests/linear/should_compile/LinearGuards.hs
new file mode 100644
index 0000000000..fae1208176
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/LinearGuards.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE LinearTypes #-}
+module LinearGuards where
+
+f :: Bool -> a #-> a
+f b a | b = a
+ | True = a
diff --git a/testsuite/tests/linear/should_compile/LinearLetRec.hs b/testsuite/tests/linear/should_compile/LinearLetRec.hs
new file mode 100644
index 0000000000..e7cf71d324
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/LinearLetRec.hs
@@ -0,0 +1,11 @@
+module NameCache where
+
+data Name = Name
+data NameCache = NameCache !Int !Name
+
+extendOrigNameCache :: Name -> Name -> Name
+extendOrigNameCache _ _ = Name
+
+initNameCache :: Int -> [Name] -> NameCache
+initNameCache us names
+ = NameCache us (foldl extendOrigNameCache Name names)
diff --git a/testsuite/tests/linear/should_compile/LinearPolyDollar.hs b/testsuite/tests/linear/should_compile/LinearPolyDollar.hs
new file mode 100644
index 0000000000..7d14351cfc
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/LinearPolyDollar.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE LinearTypes #-}
+
+module LinearPolyDollar where
+
+-- The goal of this test is to ensure that the special typing rule of ($) plays
+-- well with multiplicity-polymorphic functions
+
+data F = F Bool
+
+x = F $ True
diff --git a/testsuite/tests/linear/should_compile/LinearTH1.hs b/testsuite/tests/linear/should_compile/LinearTH1.hs
new file mode 100644
index 0000000000..4f19b3b449
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/LinearTH1.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE LinearTypes, TemplateHaskell #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+
+module LinearTH1 where
+
+x1 = [t|Int -> Int|]
diff --git a/testsuite/tests/linear/should_compile/LinearTH2.hs b/testsuite/tests/linear/should_compile/LinearTH2.hs
new file mode 100644
index 0000000000..a35f9a1c7e
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/LinearTH2.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE LinearTypes, TemplateHaskell, RankNTypes #-}
+module LinearTH2 where
+
+x1 = [t|forall p. Int # p -> Int|]
diff --git a/testsuite/tests/linear/should_compile/List.hs b/testsuite/tests/linear/should_compile/List.hs
new file mode 100644
index 0000000000..4d87dba896
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/List.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module List where
+{-
+inplace/bin/ghc-stage1 -O2 -dcore-lint
+
+See Cabal:Distribution.Types.VersionRange:556
+-}
+
+import GHC.Base
+
+data J = J ()
+
+j :: () -> J
+j = J
+
+tup = (j, J)
+tup2 = (J, j)
+
+tup3 = [j, J]
+tup4 = [J, j]
+
+{-
+
+[1 of 1] Compiling List ( linear-tests/List.hs, linear-tests/List.o )
+
+linear-tests/List.hs:17:12: error:
+ • Couldn't match expected type ‘() -> J’ with actual type ‘() ⊸ J’
+ • In the expression: J
+ In the expression: [j, J]
+ In an equation for ‘tup3’: tup3 = [j, J]
+ |
+17 | tup3 = [j, J]
+ | ^
+
+linear-tests/List.hs:18:12: error:
+ • Couldn't match expected type ‘() ⊸ J’ with actual type ‘() -> J’
+ • In the expression: j
+ In the expression: [J, j]
+ In an equation for ‘tup4’: tup4 = [J, j]
+ |
+18 | tup4 = [J, j]
+ | ^
+
+-}
diff --git a/testsuite/tests/linear/should_compile/Makefile b/testsuite/tests/linear/should_compile/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/linear/should_compile/MultConstructor.hs b/testsuite/tests/linear/should_compile/MultConstructor.hs
new file mode 100644
index 0000000000..6e631774ba
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/MultConstructor.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE GADTSyntax, DataKinds, LinearTypes, KindSignatures, ExplicitForAll #-}
+module MultConstructor where
+
+import GHC.Types
+
+data T p a where
+ MkT :: a # p -> T p a
+
+{-
+this currently fails
+g :: forall (b :: Type). T 'Many b #-> (b,b)
+g (MkT x) = (x,x)
+-}
diff --git a/testsuite/tests/linear/should_compile/OldList.hs b/testsuite/tests/linear/should_compile/OldList.hs
new file mode 100644
index 0000000000..2ed7b8aaf2
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/OldList.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE NoImplicitPrelude, ScopedTypeVariables, BangPatterns, RankNTypes #-}
+
+{-
+This is a simplified version of Data.OldList module from base.
+This caused an assertion failure in earlier version of linear
+types implementation.
+-}
+
+module Data.OldList where
+
+import GHC.Base
+
+sortBy :: forall a . (a -> a -> Ordering) -> [a]
+sortBy cmp = []
+ where
+ sequences (a:b:xs)
+ | a `cmp` b == GT = descending b [a] xs
+ | otherwise = ascending b (a:) xs
+ sequences xs = [xs]
+
+-- descending :: a -> [a] -> [a] -> [[a]]
+ descending a as (b:bs)
+ | a `cmp` b == GT = descending b (a:as) bs
+ descending a as bs = (a:as): sequences bs
+
+ ascending :: a -> (forall i . [a] # i -> [a]) -> [a] -> [[a]]
+ ascending a as (b:bs)
+ | a `cmp` b /= GT = ascending b foo bs
+ where
+ foo :: [a] # k -> [a]
+ foo ys = as (a:ys)
+ ascending a as bs = let !x = as [a]
+ in x : sequences bs
diff --git a/testsuite/tests/linear/should_compile/Op.hs b/testsuite/tests/linear/should_compile/Op.hs
new file mode 100644
index 0000000000..725fd222d9
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Op.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module Op where
+{-
+See Control.Arrow and Data.Functor.Contravariant
+-}
+
+import GHC.Base
+
+class Or p where
+ or :: p a b -> p a b -> p a b
+
+instance Or (->) where
+ or x _ = x
+
+
+foo = or Just (\x -> Just x)
+
+{-
+This caused an error in the earlier version of linear types:
+
+linear-tests/Op.hs:18:16: error:
+ • Couldn't match expected type ‘a ⊸ Maybe a’
+ with actual type ‘a0 -> Maybe a0’
+ • The lambda expression ‘\ x -> Just x’ has one argument,
+ its type is ‘p0 a b0’,
+ it is specialized to ‘a ⊸ Maybe a’
+ In the second argument of ‘or’, namely ‘(\ x -> Just x)’
+ In the expression: or Just (\ x -> Just x)
+ • Relevant bindings include
+ foo :: a ⊸ Maybe a (bound at linear-tests/Op.hs:18:1)
+ |
+18 | foo = or Just (\x -> Just x)
+ | ^^^^^^^^^^^^
+-}
diff --git a/testsuite/tests/linear/should_compile/Pr110.hs b/testsuite/tests/linear/should_compile/Pr110.hs
new file mode 100644
index 0000000000..a3311cb7b8
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Pr110.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE LinearTypes #-}
+module Pr110 where
+
+data Bloop = Bloop Bool
+
+g :: Bloop #-> Bool
+g (Bloop x) = x
+
+h :: Bool #-> Bloop
+h x = Bloop x
diff --git a/testsuite/tests/linear/should_compile/RankN.hs b/testsuite/tests/linear/should_compile/RankN.hs
new file mode 100644
index 0000000000..cadefa5290
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/RankN.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RankNTypes #-}
+module RankN where
+{-
+inplace/bin/ghc-stage1 -O2 -dcore-lint
+-}
+
+import GHC.Base
+{-
+class Data a where
+ gunfold :: (forall b r. c (b -> r) -> c r)
+ -> (forall r. r -> c r)
+ -> c a
+
+foo = 1
+{-# NOINLINE foo #-}
+
+instance Data [a] where
+ gunfold k z = k (k (z (:)))
+
+
+--qux :: Identity (Int ⊸ Int)
+qux = Identity Just
+
+app :: Identity (a -> b) -> Identity a -> Identity b
+app (Identity f) (Identity a) = Identity (f a)
+
+example = app qux (Identity 5)
+
+--unqux :: Int ⊸ Int
+unqux = Just
+
+unapp :: (a -> b) -> a -> b
+unapp f a = f a
+
+example1 = unapp unqux 5
+
+foo :: Identity (a -> b) -> a -> b
+foo = runIdentity
+
+fooTest = foo (Identity Just)
+
+foo2 :: (a -> b) -> a -> b
+foo2 = ($)
+
+fooTest2 = let f = Just in foo2 f
+-}
+
+data Identity a = Identity { runIdentity :: a }
+
+extraTest = (id Identity) :: a -> Identity a
diff --git a/testsuite/tests/linear/should_compile/T1735Min.hs b/testsuite/tests/linear/should_compile/T1735Min.hs
new file mode 100644
index 0000000000..8800272328
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/T1735Min.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UndecidableInstances, Rank2Types,
+ KindSignatures, EmptyDataDecls, MultiParamTypeClasses, CPP #-}
+
+module T1735_Help.Basics where
+
+data Proxy a = Proxy
+
+class Data ctx a where
+ gunfold :: Proxy ctx
+ -> (forall b r. Data ctx b => c (b -> r) -> c r)
+ -> (forall r. r -> c r)
+ -> Constr
+ -> c a
+
+
+newtype ID x = ID { unID :: x }
+
+fromConstrB :: Data ctx a
+ => Proxy ctx
+ -> (forall b. Data ctx b => b)
+ -> Constr
+ -> a
+fromConstrB ctx f = unID . gunfold ctx k z
+ where
+ k c = ID (unID c f)
+ z = ID
+
+data Constr = Constr
diff --git a/testsuite/tests/linear/should_compile/Tunboxer.hs b/testsuite/tests/linear/should_compile/Tunboxer.hs
new file mode 100644
index 0000000000..c6bc7f5f38
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/Tunboxer.hs
@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -O #-}
+module TUnboxer where
+
+-- This checks that the multiplicity of unboxer inside MkId.wrapCo is correct.
+-- The test is a minimized version of base/GHC/Event/PSQ.hs and requires -O.
+newtype Unique = Unique Int
+
+data IntPSQ = Bin !Unique
+
+deleteView :: Unique -> ()
+deleteView k = Bin k `seq` ()
diff --git a/testsuite/tests/linear/should_compile/TupSection.hs b/testsuite/tests/linear/should_compile/TupSection.hs
new file mode 100644
index 0000000000..ea401e6e97
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/TupSection.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE TupleSections #-}
+module TupSection where
+{-
+inplace/bin/ghc-stage1 -O2 -dcore-lint
+-}
+
+myAp :: (a -> b) -> a -> b
+myAp f x = f x
+
+foo = myAp (,()) ()
+
+qux = ("go2",) $ ()
diff --git a/testsuite/tests/linear/should_compile/all.T b/testsuite/tests/linear/should_compile/all.T
new file mode 100644
index 0000000000..8b11b9ccb9
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/all.T
@@ -0,0 +1,37 @@
+broken_multiplicity_syntax = 94 # https://github.com/tweag/ghc/issues/94
+
+test('anf', normal, compile, [''])
+test('Arity2', normal, compile, [''])
+test('Branches', normal, compile, [''])
+test('CSETest', normal, compile, [''])
+test('Dollar2', normal, compile, [''])
+test('DollarDefault', normal, compile, [''])
+test('DollarTest', normal, compile, [''])
+test('Foldr', normal, compile, [''])
+test('Iden', normal, compile, [''])
+test('List', normal, compile, [''])
+test('OldList', expect_broken(broken_multiplicity_syntax), compile, [''])
+test('Op', normal, compile, [''])
+test('RankN', normal, compile, [''])
+test('T1735Min', normal, compile, [''])
+test('TupSection', normal, compile, [''])
+test('Pr110', normal, compile, [''])
+test('Linear10', normal, compile, [''])
+test('Linear12', normal, compile, [''])
+test('Linear14', expect_broken(298), compile, [''])
+test('Linear15', normal, compile, [''])
+test('Linear16', normal, compile, [''])
+test('Linear3', normal, compile, [''])
+test('Linear4', expect_broken(20), compile, [''])
+test('Linear6', normal, compile, [''])
+test('Linear8', normal, compile, [''])
+test('LinearGuards', normal, compile, [''])
+test('LinearPolyDollar', normal, compile, [''])
+test('LinearConstructors', normal, compile, [''])
+test('Linear1Rule', expect_broken(broken_multiplicity_syntax), compile, [''])
+test('LinearEmptyCase', normal, compile, [''])
+test('Tunboxer', normal, compile, [''])
+test('MultConstructor', expect_broken(broken_multiplicity_syntax), compile, [''])
+test('LinearLetRec', expect_broken(405), compile, ['-O -dlinear-core-lint'])
+test('LinearTH1', normal, compile, [''])
+test('LinearTH2', expect_broken(broken_multiplicity_syntax), compile, [''])
diff --git a/testsuite/tests/linear/should_compile/anf.hs b/testsuite/tests/linear/should_compile/anf.hs
new file mode 100644
index 0000000000..9f1982e397
--- /dev/null
+++ b/testsuite/tests/linear/should_compile/anf.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE LinearTypes #-}
+-- !! Data constructors with strict fields
+-- This test should use -funbox-strict-fields
+
+module Main ( main ) where
+
+main = print (g (f t))
+
+t = MkT 1 2 (3,4) (MkS 5 6)
+
+g (MkT x _ _ _) = x
+
+data T = MkT Int !Int !(Int,Int) !(S Int)
+
+data S a = MkS a a
+
+
+{-# NOINLINE f #-}
+f :: T -> T -- Takes apart the thing and puts it
+ -- back together differently
+f (MkT x y (a,b) (MkS p q)) = MkT a b (p,q) (MkS x y)
diff --git a/testsuite/tests/linear/should_fail/Linear1.hs b/testsuite/tests/linear/should_fail/Linear1.hs
new file mode 100644
index 0000000000..cdb7eed939
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Linear1.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE LambdaCase, GADTs #-}
+{-# LANGUAGE RebindableSyntax #-}
+module Linear1 where
+
+
+-- Must fail:
+incorrectDup :: a ⊸ (a,a)
+incorrectDup x = (x,x)
+
+-- Must fail:
+incorrectDrop :: a ⊸ ()
+incorrectDrop x = ()
diff --git a/testsuite/tests/linear/should_fail/Linear1.stderr b/testsuite/tests/linear/should_fail/Linear1.stderr
new file mode 100644
index 0000000000..c549d75be3
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Linear1.stderr
@@ -0,0 +1,10 @@
+
+Linear1.hs:10:14: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘incorrectDup’: incorrectDup x = (x, x)
+
+Linear1.hs:14:15: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘incorrectDrop’: incorrectDrop x = ()
diff --git a/testsuite/tests/linear/should_fail/Linear11.hs b/testsuite/tests/linear/should_fail/Linear11.hs
new file mode 100644
index 0000000000..67b930ac57
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Linear11.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+module Linear11 where
+
+data Unrestricted a where Unrestricted :: a -> Unrestricted a
+
+incorrectUnrestricted :: a ⊸ Unrestricted a
+incorrectUnrestricted a = Unrestricted a
+
+data NotUnrestricted a where NotUnrestricted :: a ⊸ NotUnrestricted a
+
+incorrectUnrestrictedDup :: NotUnrestricted a ⊸ (a,a)
+incorrectUnrestrictedDup (NotUnrestricted a) = (a,a)
diff --git a/testsuite/tests/linear/should_fail/Linear11.stderr b/testsuite/tests/linear/should_fail/Linear11.stderr
new file mode 100644
index 0000000000..cb52fa16f4
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Linear11.stderr
@@ -0,0 +1,13 @@
+
+Linear11.hs:9:23: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘a’
+ • In an equation for ‘incorrectUnrestricted’:
+ incorrectUnrestricted a = Unrestricted a
+
+Linear11.hs:14:43: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘a’
+ • In the pattern: NotUnrestricted a
+ In an equation for ‘incorrectUnrestrictedDup’:
+ incorrectUnrestrictedDup (NotUnrestricted a) = (a, a)
diff --git a/testsuite/tests/linear/should_fail/Linear13.hs b/testsuite/tests/linear/should_fail/Linear13.hs
new file mode 100644
index 0000000000..7b9e09c52b
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Linear13.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+module Linear13 where
+
+incorrectLet :: a ⊸ ()
+incorrectLet a = let x = a in ()
+
+incorrectLetWithSignature :: (Bool->Bool) #-> ()
+incorrectLetWithSignature x = let y :: Bool->Bool; y = x in ()
+
+incorrectLazyMatch :: (a,b) ⊸ b
+incorrectLazyMatch x = let (a,b) = x in b
+
+incorrectCasePromotion :: (a,b) ⊸ b
+incorrectCasePromotion x = case x of (a,b) -> b
diff --git a/testsuite/tests/linear/should_fail/Linear13.stderr b/testsuite/tests/linear/should_fail/Linear13.stderr
new file mode 100644
index 0000000000..a781c20da6
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Linear13.stderr
@@ -0,0 +1,28 @@
+
+Linear13.hs:6:14: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘a’
+ • In an equation for ‘incorrectLet’:
+ incorrectLet a = let x = a in ()
+
+Linear13.hs:9:27: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘incorrectLetWithSignature’:
+ incorrectLetWithSignature x
+ = let
+ y :: Bool -> Bool
+ y = x
+ in ()
+
+Linear13.hs:12:20: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘incorrectLazyMatch’:
+ incorrectLazyMatch x = let (a, b) = x in b
+
+Linear13.hs:15:24: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘incorrectCasePromotion’:
+ incorrectCasePromotion x = case x of { (a, b) -> b }
diff --git a/testsuite/tests/linear/should_fail/Linear17.hs b/testsuite/tests/linear/should_fail/Linear17.hs
new file mode 100644
index 0000000000..1d8abfdb09
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Linear17.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE RebindableSyntax #-}
+module Linear17 where
+
+-- Rebindable do notation
+
+(>>=) :: a ⊸ (a ⊸ b) ⊸ b
+(>>=) x f = f x
+
+-- `fail` is needed due to pattern matching on ();
+-- ideally, it shouldn't be there.
+fail :: a
+fail = fail
+
+incorrectDo1 = do
+ x <- ()
+ (y,z) <- ((),())
+ () <- y
+ () <- z
+ ()
+
+incorrectDo2 = do
+ x <- ()
+ (y,z) <- ((),x)
+ () <- y
+ ()
+
+incorrectDo3 = do
+ x <- ()
+ (y,z) <- (x,x)
+ () <- y
+ () <- z
+ ()
diff --git a/testsuite/tests/linear/should_fail/Linear17.stderr b/testsuite/tests/linear/should_fail/Linear17.stderr
new file mode 100644
index 0000000000..12193e115b
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Linear17.stderr
@@ -0,0 +1,45 @@
+
+Linear17.hs:17:3: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘x’
+ • In a stmt of a 'do' block: x <- ()
+ In the expression:
+ do x <- ()
+ (y, z) <- ((), ())
+ () <- y
+ () <- z
+ ....
+ In an equation for ‘incorrectDo1’:
+ incorrectDo1
+ = do x <- ()
+ (y, z) <- ((), ())
+ () <- y
+ ....
+
+Linear17.hs:25:6: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘z’
+ • In the pattern: (y, z)
+ In a stmt of a 'do' block: (y, z) <- ((), x)
+ In the expression:
+ do x <- ()
+ (y, z) <- ((), x)
+ () <- y
+ ()
+
+Linear17.hs:30:3: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘x’
+ • In a stmt of a 'do' block: x <- ()
+ In the expression:
+ do x <- ()
+ (y, z) <- (x, x)
+ () <- y
+ () <- z
+ ....
+ In an equation for ‘incorrectDo3’:
+ incorrectDo3
+ = do x <- ()
+ (y, z) <- (x, x)
+ () <- y
+ ....
diff --git a/testsuite/tests/linear/should_fail/Linear2.hs b/testsuite/tests/linear/should_fail/Linear2.hs
new file mode 100644
index 0000000000..bb6f525f01
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Linear2.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+module Linear2 where
+
+dup :: a -> (a,a)
+dup x = (x,x)
+
+incorrectApp1 :: a ⊸ ((a,Int),(a,Int))
+incorrectApp1 x = dup (x,0)
+
+incorrectApp2 :: (a->b) -> a ⊸ b
+incorrectApp2 f x = f x
+
+incorrectIf :: Bool -> Int ⊸ Int
+incorrectIf x n =
+ if x then n else 0
diff --git a/testsuite/tests/linear/should_fail/Linear2.stderr b/testsuite/tests/linear/should_fail/Linear2.stderr
new file mode 100644
index 0000000000..eec52922a0
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Linear2.stderr
@@ -0,0 +1,16 @@
+
+Linear2.hs:9:15: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘incorrectApp1’: incorrectApp1 x = dup (x, 0)
+
+Linear2.hs:12:17: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘incorrectApp2’: incorrectApp2 f x = f x
+
+Linear2.hs:15:15: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘n’
+ • In an equation for ‘incorrectIf’:
+ incorrectIf x n = if x then n else 0
diff --git a/testsuite/tests/linear/should_fail/Linear5.hs b/testsuite/tests/linear/should_fail/Linear5.hs
new file mode 100644
index 0000000000..ad0c80356c
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Linear5.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+module Linear5 where
+
+incorrectEqn :: Bool -> Int ⊸ Int
+incorrectEqn True n = n
+incorrectEqn False n = 0
diff --git a/testsuite/tests/linear/should_fail/Linear5.stderr b/testsuite/tests/linear/should_fail/Linear5.stderr
new file mode 100644
index 0000000000..4de49fb9d9
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Linear5.stderr
@@ -0,0 +1,5 @@
+
+Linear5.hs:7:20: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘n’
+ • In an equation for ‘incorrectEqn’: incorrectEqn False n = 0
diff --git a/testsuite/tests/linear/should_fail/Linear7.hs b/testsuite/tests/linear/should_fail/Linear7.hs
new file mode 100644
index 0000000000..9ee6438b11
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Linear7.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE LambdaCase #-}
+module Linear7 where
+
+incorrectLCase :: Int ⊸ Bool -> Int
+incorrectLCase n = \case
+ True -> n
+ False -> 0
diff --git a/testsuite/tests/linear/should_fail/Linear7.stderr b/testsuite/tests/linear/should_fail/Linear7.stderr
new file mode 100644
index 0000000000..9dc596477d
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Linear7.stderr
@@ -0,0 +1,9 @@
+
+Linear7.hs:7:16: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘n’
+ • In an equation for ‘incorrectLCase’:
+ incorrectLCase n
+ = \case
+ True -> n
+ False -> 0
diff --git a/testsuite/tests/linear/should_fail/Linear9.hs b/testsuite/tests/linear/should_fail/Linear9.hs
new file mode 100644
index 0000000000..011c58e837
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Linear9.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE UnicodeSyntax #-}
+module Linear9 where
+
+fst :: (a,b) -> a
+fst (a,_) = a
+
+incorrectFst :: (a,b) ⊸ a
+incorrectFst (a,_) = a
+
+incorrectFstVar :: (a,b) ⊸ a
+incorrectFstVar (a,b) = a
+
+incorrectFirstDup :: (a,b) ⊸ ((a,a),b)
+incorrectFirstDup (a,b) = ((a,a),b)
+
+incorrectFstFst :: ((a,b),c) ⊸ a
+incorrectFstFst ((a,_),_) = a
+
+data Test a
+ = Foo a a
+ | Bar a
+
+incorrectTestFst :: Test a ⊸ a
+incorrectTestFst (Foo a _) = a
+incorrectTestFst (Bar a) = a
diff --git a/testsuite/tests/linear/should_fail/Linear9.stderr b/testsuite/tests/linear/should_fail/Linear9.stderr
new file mode 100644
index 0000000000..ab13270ee3
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Linear9.stderr
@@ -0,0 +1,43 @@
+
+Linear9.hs:9:17: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from a non-linear pattern
+ • In the pattern: _
+ In the pattern: (a, _)
+ In an equation for ‘incorrectFst’: incorrectFst (a, _) = a
+
+Linear9.hs:12:20: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘b’
+ • In the pattern: (a, b)
+ In an equation for ‘incorrectFstVar’: incorrectFstVar (a, b) = a
+
+Linear9.hs:15:20: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘a’
+ • In the pattern: (a, b)
+ In an equation for ‘incorrectFirstDup’:
+ incorrectFirstDup (a, b) = ((a, a), b)
+
+Linear9.hs:18:21: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from a non-linear pattern
+ • In the pattern: _
+ In the pattern: (a, _)
+ In the pattern: ((a, _), _)
+
+Linear9.hs:18:24: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from a non-linear pattern
+ • In the pattern: _
+ In the pattern: ((a, _), _)
+ In an equation for ‘incorrectFstFst’:
+ incorrectFstFst ((a, _), _) = a
+
+Linear9.hs:25:25: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from a non-linear pattern
+ • In the pattern: _
+ In the pattern: Foo a _
+ In an equation for ‘incorrectTestFst’:
+ incorrectTestFst (Foo a _) = a
diff --git a/testsuite/tests/linear/should_fail/LinearAsPat.hs b/testsuite/tests/linear/should_fail/LinearAsPat.hs
new file mode 100644
index 0000000000..e756f4369f
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearAsPat.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE LinearTypes #-}
+
+module LinearAsPat where
+
+shouldFail :: Bool #-> Bool
+shouldFail x@True = x
diff --git a/testsuite/tests/linear/should_fail/LinearAsPat.stderr b/testsuite/tests/linear/should_fail/LinearAsPat.stderr
new file mode 100644
index 0000000000..7d6cc245cf
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearAsPat.stderr
@@ -0,0 +1,5 @@
+
+LinearAsPat.hs:6:12: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from a non-linear pattern
+ • In an equation for ‘shouldFail’: shouldFail x@True = x
diff --git a/testsuite/tests/linear/should_fail/LinearBottomMult.hs b/testsuite/tests/linear/should_fail/LinearBottomMult.hs
new file mode 100644
index 0000000000..03bf8731a7
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearBottomMult.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE GADTs, LinearTypes, ScopedTypeVariables, EmptyCase #-}
+module LinearBottomMult where
+
+-- Check that _|_ * Many is not a subusage of One
+--
+data Void
+data U a where U :: a -> U a
+
+elim :: U a #-> ()
+elim (U _) = ()
+
+f :: a #-> ()
+f x = elim (U (\(a :: Void) -> case a of {}))
diff --git a/testsuite/tests/linear/should_fail/LinearBottomMult.stderr b/testsuite/tests/linear/should_fail/LinearBottomMult.stderr
new file mode 100644
index 0000000000..fd846070d8
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearBottomMult.stderr
@@ -0,0 +1,6 @@
+
+LinearBottomMult.hs:13:3: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘f’:
+ f x = elim (U (\ (a :: Void) -> case a of))
diff --git a/testsuite/tests/linear/should_fail/LinearConfusedDollar.hs b/testsuite/tests/linear/should_fail/LinearConfusedDollar.hs
new file mode 100644
index 0000000000..2cd1628eeb
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearConfusedDollar.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE LinearTypes #-}
+module LinearConfusedDollar where
+
+-- When ($) becomes polymorphic in the multiplicity, then, this test case won't
+-- hold anymore. But, as it stands, it produces untyped desugared code, hence
+-- must be rejected.
+
+f :: a #-> a
+f x = x
+
+g :: a #-> a
+g x = f $ x
diff --git a/testsuite/tests/linear/should_fail/LinearConfusedDollar.stderr b/testsuite/tests/linear/should_fail/LinearConfusedDollar.stderr
new file mode 100644
index 0000000000..4abdd1c18c
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearConfusedDollar.stderr
@@ -0,0 +1,6 @@
+
+LinearConfusedDollar.hs:12:7: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from an application
+ • In the expression: f $ x
+ In an equation for ‘g’: g x = f $ x
diff --git a/testsuite/tests/linear/should_fail/LinearErrOrigin.hs b/testsuite/tests/linear/should_fail/LinearErrOrigin.hs
new file mode 100644
index 0000000000..1eeb149959
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearErrOrigin.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE LinearTypes #-}
+module LinearErrOrigin where
+
+-- The error message should mention "arising from multiplicity of x".
+
+foo :: (a # p -> b) -> a # q -> b
+foo f x = f x
diff --git a/testsuite/tests/linear/should_fail/LinearErrOrigin.stderr b/testsuite/tests/linear/should_fail/LinearErrOrigin.stderr
new file mode 100644
index 0000000000..10b889a9a8
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearErrOrigin.stderr
@@ -0,0 +1,16 @@
+
+LinearErrOrigin.hs:7:7: error:
+ • Couldn't match type ‘p’ with ‘q’ arising from multiplicity of ‘x’
+ ‘p’ is a rigid type variable bound by
+ the type signature for:
+ foo :: forall a b. (a -> b) -> a -> b
+ at LinearErrOrigin.hs:6:1-35
+ ‘q’ is a rigid type variable bound by
+ the type signature for:
+ foo :: forall a b. (a -> b) -> a -> b
+ at LinearErrOrigin.hs:6:1-35
+ • In an equation for ‘foo’: foo f x = f x
+ • Relevant bindings include
+ f :: a # p -> b (bound at LinearErrOrigin.hs:7:5)
+ foo :: (a # p -> b) -> a # q -> b
+ (bound at LinearErrOrigin.hs:7:1)
diff --git a/testsuite/tests/linear/should_fail/LinearGADTNewtype.hs b/testsuite/tests/linear/should_fail/LinearGADTNewtype.hs
new file mode 100644
index 0000000000..789b8cc3b6
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearGADTNewtype.hs
@@ -0,0 +1,3 @@
+{-# LANGUAGE LinearTypes, GADTs #-}
+newtype A where
+ A :: Int -> A
diff --git a/testsuite/tests/linear/should_fail/LinearGADTNewtype.stderr b/testsuite/tests/linear/should_fail/LinearGADTNewtype.stderr
new file mode 100644
index 0000000000..42207d4f72
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearGADTNewtype.stderr
@@ -0,0 +1,5 @@
+
+LinearGADTNewtype.hs:3:4: error:
+ • A newtype constructor must be linear
+ • In the definition of data constructor ‘A’
+ In the newtype declaration for ‘A’
diff --git a/testsuite/tests/linear/should_fail/LinearIf.hs b/testsuite/tests/linear/should_fail/LinearIf.hs
new file mode 100644
index 0000000000..b19873120c
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearIf.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE RebindableSyntax #-}
+
+module LinearIf where
+
+import Prelude (Bool(..), Char)
+
+ifThenElse :: Bool -> a -> a -> a
+ifThenElse True x _ = x
+ifThenElse False _ y = y
+
+f :: Bool #-> Char #-> Char #-> Char
+f b x y = if b then x else y
+ -- 'f' ought to be unrestricted in all three arguments because it desugars to
+ -- > ifThenElse b x y
diff --git a/testsuite/tests/linear/should_fail/LinearIf.stderr b/testsuite/tests/linear/should_fail/LinearIf.stderr
new file mode 100644
index 0000000000..c34bec5f4d
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearIf.stderr
@@ -0,0 +1,15 @@
+
+LinearIf.hs:13:3: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘b’
+ • In an equation for ‘f’: f b x y = if b then x else y
+
+LinearIf.hs:13:5: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘f’: f b x y = if b then x else y
+
+LinearIf.hs:13:7: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘y’
+ • In an equation for ‘f’: f b x y = if b then x else y
diff --git a/testsuite/tests/linear/should_fail/LinearKind.hs b/testsuite/tests/linear/should_fail/LinearKind.hs
new file mode 100644
index 0000000000..a60554a7a7
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearKind.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE LinearTypes, KindSignatures #-}
+module LinearKind where
+
+data A :: * #-> *
diff --git a/testsuite/tests/linear/should_fail/LinearKind.stderr b/testsuite/tests/linear/should_fail/LinearKind.stderr
new file mode 100644
index 0000000000..5ac2825b21
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearKind.stderr
@@ -0,0 +1,5 @@
+
+LinearKind.hs:4:11: error:
+ • Linear arrows disallowed in kinds: * #-> *
+ • In the kind ‘* #-> *’
+ In the data type declaration for ‘A’
diff --git a/testsuite/tests/linear/should_fail/LinearLazyPat.hs b/testsuite/tests/linear/should_fail/LinearLazyPat.hs
new file mode 100644
index 0000000000..8ed4024c40
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearLazyPat.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE LinearTypes #-}
+module LinearLazyPat where
+
+f :: (a,b) #-> (b,a)
+f ~(x,y) = (y,x)
diff --git a/testsuite/tests/linear/should_fail/LinearLazyPat.stderr b/testsuite/tests/linear/should_fail/LinearLazyPat.stderr
new file mode 100644
index 0000000000..1893d10417
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearLazyPat.stderr
@@ -0,0 +1,6 @@
+
+LinearLazyPat.hs:5:3: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from a non-linear pattern
+ • In the pattern: ~(x, y)
+ In an equation for ‘f’: f ~(x, y) = (y, x)
diff --git a/testsuite/tests/linear/should_fail/LinearLet.hs b/testsuite/tests/linear/should_fail/LinearLet.hs
new file mode 100644
index 0000000000..bf822a8a6e
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearLet.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE LinearTypes #-}
+module LinearLet where
+
+f :: a #-> (a,a)
+f x = let y = x in (y,y)
diff --git a/testsuite/tests/linear/should_fail/LinearLet.stderr b/testsuite/tests/linear/should_fail/LinearLet.stderr
new file mode 100644
index 0000000000..3b94833d7e
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearLet.stderr
@@ -0,0 +1,5 @@
+
+LinearLet.hs:5:3: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘f’: f x = let y = x in (y, y)
diff --git a/testsuite/tests/linear/should_fail/LinearNoExt.hs b/testsuite/tests/linear/should_fail/LinearNoExt.hs
new file mode 100644
index 0000000000..2671246f21
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearNoExt.hs
@@ -0,0 +1,3 @@
+module LinearNoExt where
+
+type T = a #-> a
diff --git a/testsuite/tests/linear/should_fail/LinearNoExt.stderr b/testsuite/tests/linear/should_fail/LinearNoExt.stderr
new file mode 100644
index 0000000000..452409586d
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearNoExt.stderr
@@ -0,0 +1,3 @@
+
+LinearNoExt.hs:3:12: error:
+ Enable LinearTypes to allow linear functions
diff --git a/testsuite/tests/linear/should_fail/LinearPartialSig.hs b/testsuite/tests/linear/should_fail/LinearPartialSig.hs
new file mode 100644
index 0000000000..01dbeddfba
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearPartialSig.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE LinearTypes #-}
+module LinearPartialSig where
+
+-- We should suggest that _ :: Multiplicity
+f :: a # _ -> a
+f x = x
diff --git a/testsuite/tests/linear/should_fail/LinearPartialSig.stderr b/testsuite/tests/linear/should_fail/LinearPartialSig.stderr
new file mode 100644
index 0000000000..4d25260bf2
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearPartialSig.stderr
@@ -0,0 +1,7 @@
+
+LinearPartialSig.hs:5:13: error:
+ • Found type wildcard ‘_’
+ standing for ‘'Many :: GHC.Types.Multiplicity’
+ To use the inferred type, enable PartialTypeSignatures
+ • In the type ‘a # _ -> a’
+ In the type signature: f :: a # _ -> a
diff --git a/testsuite/tests/linear/should_fail/LinearPatSyn.hs b/testsuite/tests/linear/should_fail/LinearPatSyn.hs
new file mode 100644
index 0000000000..3e947dba2e
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearPatSyn.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+module LinearPatSyn where
+
+-- Linearity and pattern synonyms should eventually play well together, but it
+-- seems to require changes to the desugarer. So currently pattern synonyms are
+-- disallowed in linear patterns.
+
+pattern P :: b #-> a #-> (a, b)
+pattern P y x = (x, y)
+
+s :: (a, b) #-> (b, a)
+s (P y x) = (y, x)
diff --git a/testsuite/tests/linear/should_fail/LinearPatSyn.stderr b/testsuite/tests/linear/should_fail/LinearPatSyn.stderr
new file mode 100644
index 0000000000..f7c3aab406
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearPatSyn.stderr
@@ -0,0 +1,6 @@
+
+LinearPatSyn.hs:14:4: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from a non-linear pattern
+ • In the pattern: P y x
+ In an equation for ‘s’: s (P y x) = (y, x)
diff --git a/testsuite/tests/linear/should_fail/LinearPolyType.hs b/testsuite/tests/linear/should_fail/LinearPolyType.hs
new file mode 100644
index 0000000000..bcf46eed9f
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearPolyType.hs
@@ -0,0 +1,16 @@
+-- Source: https://github.com/ghc-proposals/ghc-proposals/pull/111#issuecomment-438125526
+{-# LANGUAGE LinearTypes, GADTs, KindSignatures, DataKinds, TypeFamilies, PolyKinds #-}
+module LinearPolyType where
+
+import GHC.Types
+data SBool :: Bool -> Type where
+ STrue :: SBool True
+ SFalse :: SBool False
+
+type family If b t f where
+ If True t _ = t
+ If False _ f = f
+
+dep :: SBool b -> Int # If b One Many -> Int
+dep STrue x = x
+dep SFalse _ = 0
diff --git a/testsuite/tests/linear/should_fail/LinearPolyType.stderr b/testsuite/tests/linear/should_fail/LinearPolyType.stderr
new file mode 100644
index 0000000000..fab6dfcc9b
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearPolyType.stderr
@@ -0,0 +1,3 @@
+
+LinearPolyType.hs:15:1: error:
+ Multiplicity coercions are currently not supported
diff --git a/testsuite/tests/linear/should_fail/LinearRecordUpdate.hs b/testsuite/tests/linear/should_fail/LinearRecordUpdate.hs
new file mode 100644
index 0000000000..e143dbd604
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearRecordUpdate.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE LinearTypes #-}
+
+module LinearRecordUpdate where
+
+data R = R { x :: Int, y :: Bool }
+
+shouldFail :: R #-> R
+shouldFail r = r { y = False }
diff --git a/testsuite/tests/linear/should_fail/LinearRecordUpdate.stderr b/testsuite/tests/linear/should_fail/LinearRecordUpdate.stderr
new file mode 100644
index 0000000000..aa32a9db68
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearRecordUpdate.stderr
@@ -0,0 +1,5 @@
+
+LinearRecordUpdate.hs:8:12: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘r’
+ • In an equation for ‘shouldFail’: shouldFail r = r {y = False}
diff --git a/testsuite/tests/linear/should_fail/LinearSeq.hs b/testsuite/tests/linear/should_fail/LinearSeq.hs
new file mode 100644
index 0000000000..0f2ed39c93
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearSeq.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE LinearTypes #-}
+
+module LinearSeq where
+
+bad :: a #-> ()
+bad x = seq x ()
diff --git a/testsuite/tests/linear/should_fail/LinearSeq.stderr b/testsuite/tests/linear/should_fail/LinearSeq.stderr
new file mode 100644
index 0000000000..f6b22b5999
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearSeq.stderr
@@ -0,0 +1,5 @@
+
+LinearSeq.hs:6:5: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘bad’: bad x = seq x ()
diff --git a/testsuite/tests/linear/should_fail/LinearSequenceExpr.hs b/testsuite/tests/linear/should_fail/LinearSequenceExpr.hs
new file mode 100644
index 0000000000..ff3ac9cedb
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearSequenceExpr.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE OverloadedLists #-}
+
+module LinearSequenceExpr where
+
+f :: Char #-> Char #-> [Char]
+f x y = [x .. y]
+-- This ought to fail, because `fromList` in base, is unrestricted
diff --git a/testsuite/tests/linear/should_fail/LinearSequenceExpr.stderr b/testsuite/tests/linear/should_fail/LinearSequenceExpr.stderr
new file mode 100644
index 0000000000..a3fdb4d7df
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearSequenceExpr.stderr
@@ -0,0 +1,10 @@
+
+LinearSequenceExpr.hs:7:3: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘f’: f x y = [x .. y]
+
+LinearSequenceExpr.hs:7:5: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from multiplicity of ‘y’
+ • In an equation for ‘f’: f x y = [x .. y]
diff --git a/testsuite/tests/linear/should_fail/LinearVar.hs b/testsuite/tests/linear/should_fail/LinearVar.hs
new file mode 100644
index 0000000000..7b4cde3647
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearVar.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE LinearTypes #-}
+module LinearVar where
+
+f :: a # m -> b
+f = undefined :: a -> b
diff --git a/testsuite/tests/linear/should_fail/LinearVar.stderr b/testsuite/tests/linear/should_fail/LinearVar.stderr
new file mode 100644
index 0000000000..04014ce79b
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearVar.stderr
@@ -0,0 +1,13 @@
+
+LinearVar.hs:5:5: error:
+ • Couldn't match type ‘m’ with ‘'Many’
+ ‘m’ is a rigid type variable bound by
+ the type signature for:
+ f :: forall a b. a -> b
+ at LinearVar.hs:4:1-16
+ Expected type: a # m -> b
+ Actual type: a -> b
+ • In the expression: undefined :: a -> b
+ In an equation for ‘f’: f = undefined :: a -> b
+ • Relevant bindings include
+ f :: a # m -> b (bound at LinearVar.hs:5:1)
diff --git a/testsuite/tests/linear/should_fail/LinearViewPattern.hs b/testsuite/tests/linear/should_fail/LinearViewPattern.hs
new file mode 100644
index 0000000000..737393911b
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearViewPattern.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module LinearViewPattern where
+
+-- This is probably inessential. We are just protecting against potential
+-- incorrect Core being emitted by the desugarer. When we understand linear view
+-- pattern better, we will probably want to remove this test.
+
+f :: Bool #-> Bool
+f (not -> True) = True
diff --git a/testsuite/tests/linear/should_fail/LinearViewPattern.stderr b/testsuite/tests/linear/should_fail/LinearViewPattern.stderr
new file mode 100644
index 0000000000..c0aa969741
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/LinearViewPattern.stderr
@@ -0,0 +1,6 @@
+
+LinearViewPattern.hs:11:4: error:
+ • Couldn't match type ‘'Many’ with ‘'One’
+ arising from a non-linear pattern
+ • In the pattern: not -> True
+ In an equation for ‘f’: f (not -> True) = True
diff --git a/testsuite/tests/linear/should_fail/Makefile b/testsuite/tests/linear/should_fail/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/linear/should_fail/TypeClass.hs b/testsuite/tests/linear/should_fail/TypeClass.hs
new file mode 100644
index 0000000000..9752810dc4
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/TypeClass.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE LinearTypes #-}
+module Foo where
+
+data Either a b = Left a | Right b
+
+either :: (a -> c) -> (b -> c) -> Either a b -> c
+either f g (Left a) = f a
+either f g (Right b) = g b
+
+class Iden p where
+ iden :: p a a
+
+instance Iden (->) where
+ iden x = x
+
+class Cat p where
+ comp :: p b c -> p a b -> p a c
+
+instance Cat (->) where
+ comp f g = \x -> f (g x)
+
+class ArrowChoice a where
+ (+++) :: a b c -> a b' c' -> a (Either b b') (Either c c')
+ (|||) :: a b d -> a c d -> a (Either b c) d
+
+instance ArrowChoice (->) where
+-- This doesn't work as |p| is inferred to be |-o| because of |Left|.
+-- Then GHC complains that |f| is not the same type before it realises
+-- that the overall type must be (->)
+-- f +++ g = (Left `comp` f) ||| (Right `comp` g)
+ f +++ g = (comp @(->) Left f) ||| (comp @(->) Right g)
+ (|||) = either
+
+
+-- This shouldn't work
+foo :: a ⊸ a
+foo = iden
diff --git a/testsuite/tests/linear/should_fail/TypeClass.stderr b/testsuite/tests/linear/should_fail/TypeClass.stderr
new file mode 100644
index 0000000000..97ff625686
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/TypeClass.stderr
@@ -0,0 +1,5 @@
+
+TypeClass.hs:45:7: error:
+ • No instance for (Iden (FUN 'One)) arising from a use of ‘iden’
+ • In the expression: iden
+ In an equation for ‘foo’: foo = iden
diff --git a/testsuite/tests/linear/should_fail/all.T b/testsuite/tests/linear/should_fail/all.T
new file mode 100644
index 0000000000..67906053dc
--- /dev/null
+++ b/testsuite/tests/linear/should_fail/all.T
@@ -0,0 +1,29 @@
+broken_multiplicity_syntax = 94 # https://github.com/tweag/ghc/issues/94
+
+test('TypeClass', normal, compile_fail, [''])
+test('Linear11', normal, compile_fail, [''])
+test('Linear13', normal, compile_fail, [''])
+test('Linear17', normal, compile_fail, [''])
+test('Linear1', normal, compile_fail, [''])
+test('Linear2', normal, compile_fail, [''])
+test('Linear5', normal, compile_fail, [''])
+test('Linear7', normal, compile_fail, [''])
+test('Linear9', normal, compile_fail, [''])
+test('LinearNoExt', normal, compile_fail, [''])
+test('LinearAsPat', normal, compile_fail, [''])
+test('LinearLet', normal, compile_fail, [''])
+test('LinearLazyPat', normal, compile_fail, [''])
+test('LinearRecordUpdate', normal, compile_fail, [''])
+test('LinearSeq', normal, compile_fail, [''])
+test('LinearViewPattern', normal, compile_fail, [''])
+test('LinearConfusedDollar', normal, compile_fail, [''])
+test('LinearPatSyn', normal, compile_fail, [''])
+test('LinearGADTNewtype', normal, compile_fail, [''])
+test('LinearPartialSig', expect_broken(broken_multiplicity_syntax), compile_fail, [''])
+test('LinearKind', normal, compile_fail, [''])
+test('LinearVar', expect_broken(broken_multiplicity_syntax), compile_fail, [''])
+test('LinearErrOrigin', expect_broken(broken_multiplicity_syntax), compile_fail, [''])
+test('LinearPolyType', expect_broken([436, broken_multiplicity_syntax]), compile_fail, ['']) # not supported yet (#354)
+test('LinearBottomMult', normal, compile_fail, [''])
+test('LinearSequenceExpr', normal, compile_fail, [''])
+test('LinearIf', normal, compile_fail, [''])
diff --git a/testsuite/tests/linear/should_run/LinearGhci.script b/testsuite/tests/linear/should_run/LinearGhci.script
new file mode 100644
index 0000000000..78f81ef8d2
--- /dev/null
+++ b/testsuite/tests/linear/should_run/LinearGhci.script
@@ -0,0 +1,11 @@
+data T a = MkT a
+:type +v MkT
+:set -XLinearTypes
+:type +v MkT
+:set -XGADTs
+data T a where MkT :: a #-> a -> T a
+:info T
+data T a b m n r = MkT a b m n r
+:set -fprint-explicit-foralls
+-- check that user variables are not renamed (see dataConMulVars)
+:type +v MkT
diff --git a/testsuite/tests/linear/should_run/LinearGhci.stdout b/testsuite/tests/linear/should_run/LinearGhci.stdout
new file mode 100644
index 0000000000..ed5c9cfe64
--- /dev/null
+++ b/testsuite/tests/linear/should_run/LinearGhci.stdout
@@ -0,0 +1,7 @@
+MkT :: a -> T a
+MkT :: a -> T a
+type T :: * -> *
+data T a where
+ MkT :: a #-> a -> T a
+ -- Defined at <interactive>:6:1
+MkT :: forall a b m n r. a -> b -> m -> n -> r -> T a b m n r
diff --git a/testsuite/tests/linear/should_run/LinearTypeable.hs b/testsuite/tests/linear/should_run/LinearTypeable.hs
new file mode 100644
index 0000000000..69772f7b33
--- /dev/null
+++ b/testsuite/tests/linear/should_run/LinearTypeable.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE LinearTypes, TypeOperators #-}
+module Main (main) where
+
+import Data.Typeable
+import Data.Maybe
+
+x :: Maybe ((Int -> Int) :~: (Int #-> Int))
+x = eqT
+
+main = print (isJust x)
diff --git a/testsuite/tests/linear/should_run/LinearTypeable.stdout b/testsuite/tests/linear/should_run/LinearTypeable.stdout
new file mode 100644
index 0000000000..bc59c12aa1
--- /dev/null
+++ b/testsuite/tests/linear/should_run/LinearTypeable.stdout
@@ -0,0 +1 @@
+False
diff --git a/testsuite/tests/linear/should_run/Makefile b/testsuite/tests/linear/should_run/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/linear/should_run/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/linear/should_run/all.T b/testsuite/tests/linear/should_run/all.T
new file mode 100644
index 0000000000..1fbe20581c
--- /dev/null
+++ b/testsuite/tests/linear/should_run/all.T
@@ -0,0 +1,2 @@
+test('LinearTypeable', normal, compile_and_run, [''])
+test('LinearGhci', normal, ghci_script, ['LinearGhci.script'])
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
index 8d597ad371..b14b69dc04 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
@@ -63,13 +63,15 @@
[]
(Nothing)
(PrefixCon
- [({ DumpParsedAst.hs:7:26-30 }
- (HsTyVar
- (NoExtField)
- (NotPromoted)
- ({ DumpParsedAst.hs:7:26-30 }
- (Unqual
- {OccName: Peano}))))])
+ [(HsScaled
+ (HsLinearArrow)
+ ({ DumpParsedAst.hs:7:26-30 }
+ (HsTyVar
+ (NoExtField)
+ (NotPromoted)
+ ({ DumpParsedAst.hs:7:26-30 }
+ (Unqual
+ {OccName: Peano})))))])
(Nothing)))]
({ <no location info> }
[])))))
@@ -253,26 +255,28 @@
[]
(Nothing)
(PrefixCon
- [({ DumpParsedAst.hs:14:25-29 }
- (HsParTy
- (NoExtField)
- ({ DumpParsedAst.hs:14:26-28 }
- (HsAppTy
- (NoExtField)
- ({ DumpParsedAst.hs:14:26 }
- (HsTyVar
- (NoExtField)
- (NotPromoted)
- ({ DumpParsedAst.hs:14:26 }
- (Unqual
- {OccName: f}))))
- ({ DumpParsedAst.hs:14:28 }
- (HsTyVar
- (NoExtField)
- (NotPromoted)
- ({ DumpParsedAst.hs:14:28 }
- (Unqual
- {OccName: a}))))))))])
+ [(HsScaled
+ (HsLinearArrow)
+ ({ DumpParsedAst.hs:14:25-29 }
+ (HsParTy
+ (NoExtField)
+ ({ DumpParsedAst.hs:14:26-28 }
+ (HsAppTy
+ (NoExtField)
+ ({ DumpParsedAst.hs:14:26 }
+ (HsTyVar
+ (NoExtField)
+ (NotPromoted)
+ ({ DumpParsedAst.hs:14:26 }
+ (Unqual
+ {OccName: f}))))
+ ({ DumpParsedAst.hs:14:28 }
+ (HsTyVar
+ (NoExtField)
+ (NotPromoted)
+ ({ DumpParsedAst.hs:14:28 }
+ (Unqual
+ {OccName: a})))))))))])
(Nothing)))]
({ <no location info> }
[])))))
@@ -386,6 +390,7 @@
({ DumpParsedAst.hs:16:31-39 }
(HsFunTy
(NoExtField)
+ (HsUnrestrictedArrow)
({ DumpParsedAst.hs:16:31 }
(HsTyVar
(NoExtField)
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index a2e4cd1e9e..220a2ecd0b 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -99,12 +99,14 @@
[]
(Nothing)
(PrefixCon
- [({ DumpRenamedAst.hs:9:26-30 }
- (HsTyVar
- (NoExtField)
- (NotPromoted)
- ({ DumpRenamedAst.hs:9:26-30 }
- {Name: DumpRenamedAst.Peano})))])
+ [(HsScaled
+ (HsLinearArrow)
+ ({ DumpRenamedAst.hs:9:26-30 }
+ (HsTyVar
+ (NoExtField)
+ (NotPromoted)
+ ({ DumpRenamedAst.hs:9:26-30 }
+ {Name: DumpRenamedAst.Peano}))))])
(Nothing)))]
({ <no location info> }
[]))))]
@@ -252,6 +254,7 @@
({ DumpRenamedAst.hs:15:20-33 }
(HsFunTy
(NoExtField)
+ (HsUnrestrictedArrow)
({ DumpRenamedAst.hs:15:20 }
(HsTyVar
(NoExtField)
@@ -261,6 +264,7 @@
({ DumpRenamedAst.hs:15:25-33 }
(HsFunTy
(NoExtField)
+ (HsUnrestrictedArrow)
({ DumpRenamedAst.hs:15:25 }
(HsTyVar
(NoExtField)
@@ -304,6 +308,7 @@
({ DumpRenamedAst.hs:18:28-36 }
(HsFunTy
(NoExtField)
+ (HsUnrestrictedArrow)
({ DumpRenamedAst.hs:18:28 }
(HsTyVar
(NoExtField)
@@ -327,12 +332,14 @@
({ DumpRenamedAst.hs:18:42-60 }
(HsFunTy
(NoExtField)
+ (HsUnrestrictedArrow)
({ DumpRenamedAst.hs:18:42-52 }
(HsParTy
(NoExtField)
({ DumpRenamedAst.hs:18:43-51 }
(HsFunTy
(NoExtField)
+ (HsUnrestrictedArrow)
({ DumpRenamedAst.hs:18:43 }
(HsTyVar
(NoExtField)
@@ -362,53 +369,56 @@
[]
(Nothing)
(PrefixCon
- [({ DumpRenamedAst.hs:19:10-34 }
- (HsParTy
- (NoExtField)
- ({ DumpRenamedAst.hs:19:11-33 }
- (HsForAllTy
- (NoExtField)
- (HsForAllInvis
+ [(HsScaled
+ (HsLinearArrow)
+ ({ DumpRenamedAst.hs:19:10-34 }
+ (HsParTy
+ (NoExtField)
+ ({ DumpRenamedAst.hs:19:11-33 }
+ (HsForAllTy
(NoExtField)
- [({ DumpRenamedAst.hs:19:18-19 }
- (UserTyVar
- (NoExtField)
- (SpecifiedSpec)
- ({ DumpRenamedAst.hs:19:18-19 }
- {Name: xx})))])
- ({ DumpRenamedAst.hs:19:22-33 }
- (HsFunTy
+ (HsForAllInvis
(NoExtField)
- ({ DumpRenamedAst.hs:19:22-25 }
- (HsAppTy
- (NoExtField)
- ({ DumpRenamedAst.hs:19:22 }
- (HsTyVar
- (NoExtField)
- (NotPromoted)
- ({ DumpRenamedAst.hs:19:22 }
- {Name: f})))
- ({ DumpRenamedAst.hs:19:24-25 }
- (HsTyVar
- (NoExtField)
- (NotPromoted)
- ({ DumpRenamedAst.hs:19:24-25 }
- {Name: xx})))))
- ({ DumpRenamedAst.hs:19:30-33 }
- (HsAppTy
- (NoExtField)
- ({ DumpRenamedAst.hs:19:30 }
- (HsTyVar
- (NoExtField)
- (NotPromoted)
- ({ DumpRenamedAst.hs:19:30 }
- {Name: g})))
- ({ DumpRenamedAst.hs:19:32-33 }
- (HsTyVar
- (NoExtField)
- (NotPromoted)
- ({ DumpRenamedAst.hs:19:32-33 }
- {Name: xx})))))))))))])
+ [({ DumpRenamedAst.hs:19:18-19 }
+ (UserTyVar
+ (NoExtField)
+ (SpecifiedSpec)
+ ({ DumpRenamedAst.hs:19:18-19 }
+ {Name: xx})))])
+ ({ DumpRenamedAst.hs:19:22-33 }
+ (HsFunTy
+ (NoExtField)
+ (HsUnrestrictedArrow)
+ ({ DumpRenamedAst.hs:19:22-25 }
+ (HsAppTy
+ (NoExtField)
+ ({ DumpRenamedAst.hs:19:22 }
+ (HsTyVar
+ (NoExtField)
+ (NotPromoted)
+ ({ DumpRenamedAst.hs:19:22 }
+ {Name: f})))
+ ({ DumpRenamedAst.hs:19:24-25 }
+ (HsTyVar
+ (NoExtField)
+ (NotPromoted)
+ ({ DumpRenamedAst.hs:19:24-25 }
+ {Name: xx})))))
+ ({ DumpRenamedAst.hs:19:30-33 }
+ (HsAppTy
+ (NoExtField)
+ ({ DumpRenamedAst.hs:19:30 }
+ (HsTyVar
+ (NoExtField)
+ (NotPromoted)
+ ({ DumpRenamedAst.hs:19:30 }
+ {Name: g})))
+ ({ DumpRenamedAst.hs:19:32-33 }
+ (HsTyVar
+ (NoExtField)
+ (NotPromoted)
+ ({ DumpRenamedAst.hs:19:32-33 }
+ {Name: xx}))))))))))))])
({ DumpRenamedAst.hs:19:39-45 }
(HsAppTy
(NoExtField)
@@ -485,24 +495,26 @@
[]
(Nothing)
(PrefixCon
- [({ DumpRenamedAst.hs:21:25-29 }
- (HsParTy
- (NoExtField)
- ({ DumpRenamedAst.hs:21:26-28 }
- (HsAppTy
- (NoExtField)
- ({ DumpRenamedAst.hs:21:26 }
- (HsTyVar
- (NoExtField)
- (NotPromoted)
- ({ DumpRenamedAst.hs:21:26 }
- {Name: f})))
- ({ DumpRenamedAst.hs:21:28 }
- (HsTyVar
- (NoExtField)
- (NotPromoted)
- ({ DumpRenamedAst.hs:21:28 }
- {Name: a})))))))])
+ [(HsScaled
+ (HsLinearArrow)
+ ({ DumpRenamedAst.hs:21:25-29 }
+ (HsParTy
+ (NoExtField)
+ ({ DumpRenamedAst.hs:21:26-28 }
+ (HsAppTy
+ (NoExtField)
+ ({ DumpRenamedAst.hs:21:26 }
+ (HsTyVar
+ (NoExtField)
+ (NotPromoted)
+ ({ DumpRenamedAst.hs:21:26 }
+ {Name: f})))
+ ({ DumpRenamedAst.hs:21:28 }
+ (HsTyVar
+ (NoExtField)
+ (NotPromoted)
+ ({ DumpRenamedAst.hs:21:28 }
+ {Name: a}))))))))])
(Nothing)))]
({ <no location info> }
[]))))]
@@ -608,6 +620,7 @@
({ DumpRenamedAst.hs:23:31-39 }
(HsFunTy
(NoExtField)
+ (HsUnrestrictedArrow)
({ DumpRenamedAst.hs:23:31 }
(HsTyVar
(NoExtField)
diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr
index a23369a65e..689cc4187f 100644
--- a/testsuite/tests/parser/should_compile/KindSigs.stderr
+++ b/testsuite/tests/parser/should_compile/KindSigs.stderr
@@ -274,6 +274,7 @@
({ KindSigs.hs:22:8-44 }
(HsFunTy
(NoExtField)
+ (HsUnrestrictedArrow)
({ KindSigs.hs:22:8-20 }
(HsParTy
(NoExtField)
@@ -297,6 +298,7 @@
({ KindSigs.hs:22:25-44 }
(HsFunTy
(NoExtField)
+ (HsUnrestrictedArrow)
({ KindSigs.hs:22:25-28 }
(HsTyVar
(NoExtField)
diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr
index fe4d5d861f..f794049568 100644
--- a/testsuite/tests/parser/should_compile/T14189.stderr
+++ b/testsuite/tests/parser/should_compile/T14189.stderr
@@ -41,12 +41,14 @@
[]
(Nothing)
(PrefixCon
- [({ T14189.hs:6:18-20 }
- (HsTyVar
- (NoExtField)
- (NotPromoted)
- ({ T14189.hs:6:18-20 }
- {Name: GHC.Types.Int})))])
+ [(HsScaled
+ (HsLinearArrow)
+ ({ T14189.hs:6:18-20 }
+ (HsTyVar
+ (NoExtField)
+ (NotPromoted)
+ ({ T14189.hs:6:18-20 }
+ {Name: GHC.Types.Int}))))])
(Nothing)))
,({ T14189.hs:6:24-25 }
(ConDeclH98
diff --git a/testsuite/tests/polykinds/T6002.hs b/testsuite/tests/polykinds/T6002.hs
index 5a1b0edd3e..f8bf2219bb 100644
--- a/testsuite/tests/polykinds/T6002.hs
+++ b/testsuite/tests/polykinds/T6002.hs
@@ -6,7 +6,7 @@
- phantom types (when GHC 7.4 arrives, the user-defined kinds)
- corresponding singleton types
-These are basically the constructs from Omega,
+These are basically the constructs from Many,
reimplemented in Haskell for our purposes. -}
{-# LANGUAGE GADTs, KindSignatures, StandaloneDeriving,
diff --git a/testsuite/tests/printer/T18052a.stderr b/testsuite/tests/printer/T18052a.stderr
index 99aa8b033f..90eea5bb5a 100644
--- a/testsuite/tests/printer/T18052a.stderr
+++ b/testsuite/tests/printer/T18052a.stderr
@@ -11,12 +11,12 @@ Dependent packages: [base-4.15.0.0, ghc-prim-0.6.1,
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 18, types: 53, coercions: 0, joins: 0/0}
+ = {terms: 24, types: 61, coercions: 0, joins: 0/0}
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 7, types: 8, coercions: 0, joins: 0/0}
T18052a.$b:||: :: forall {a} {b}. a -> b -> (a, b)
[GblId, Arity=2, Unf=OtherCon []]
-T18052a.$b:||: = GHC.Tuple.(,)
+T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y)
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
(+++) :: forall {a}. [a] -> [a] -> [a]
diff --git a/testsuite/tests/roles/should_compile/Roles13.stderr b/testsuite/tests/roles/should_compile/Roles13.stderr
index 5004d1aacc..8b55b600a5 100644
--- a/testsuite/tests/roles/should_compile/Roles13.stderr
+++ b/testsuite/tests/roles/should_compile/Roles13.stderr
@@ -1,19 +1,20 @@
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 98, types: 38, coercions: 5, joins: 0/0}
+ = {terms: 98, types: 38, coercions: 6, joins: 0/0}
-- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0}
convert1 :: Wrap Age -> Wrap Age
[GblId, Arity=1, Unf=OtherCon []]
convert1 = \ (ds :: Wrap Age) -> ds
--- RHS size: {terms: 1, types: 0, coercions: 5, joins: 0/0}
+-- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0}
convert :: Wrap Age -> Int
[GblId, Arity=1, Unf=OtherCon []]
convert
= convert1
- `cast` (<Wrap Age>_R ->_R Roles13.N:Wrap[0] (Roles13.N:Age[0])
+ `cast` (<Wrap Age>_R
+ # <'Many>_N ->_R Roles13.N:Wrap[0] (Roles13.N:Age[0])
:: (Wrap Age -> Wrap Age) ~R# (Wrap Age -> Int))
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
diff --git a/testsuite/tests/simplCore/should_compile/T18013.stderr b/testsuite/tests/simplCore/should_compile/T18013.stderr
index 8d6f2931cd..7b5547efe7 100644
--- a/testsuite/tests/simplCore/should_compile/T18013.stderr
+++ b/testsuite/tests/simplCore/should_compile/T18013.stderr
@@ -129,9 +129,9 @@ Rule fired: Class op fmap (BUILTIN)
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 52, types: 106, coercions: 15, joins: 0/1}
+ = {terms: 52, types: 106, coercions: 17, joins: 0/1}
--- RHS size: {terms: 37, types: 87, coercions: 15, joins: 0/1}
+-- RHS size: {terms: 37, types: 87, coercions: 17, joins: 0/1}
mapMaybeRule
:: forall a b. Rule IO a b -> Rule IO (Maybe a) (Maybe b)
[GblId,
@@ -164,7 +164,7 @@ mapMaybeRule
}
}
})
- `cast` <Co:11>)
+ `cast` <Co:13>)
}
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
diff --git a/testsuite/tests/simplCore/should_compile/T4201.stdout b/testsuite/tests/simplCore/should_compile/T4201.stdout
index ac8cb0b275..14c7c957de 100644
--- a/testsuite/tests/simplCore/should_compile/T4201.stdout
+++ b/testsuite/tests/simplCore/should_compile/T4201.stdout
@@ -1,4 +1,4 @@
[HasNoCafRefs, LambdaFormInfo: LFReEntrant 1, Arity: 1,
Strictness: <S,1*U>,
Unfolding: InlineRule (0, True, True)
- bof `cast` (Sym (N:Foo[0]) ->_R <T>_R)]
+ bof `cast` (Sym (N:Foo[0]) # <'Many>_N ->_R <T>_R)]
diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr
index 9caaa16ff1..67d03b746e 100644
--- a/testsuite/tests/simplCore/should_compile/T7360.stderr
+++ b/testsuite/tests/simplCore/should_compile/T7360.stderr
@@ -4,7 +4,7 @@ Result size of Tidy Core
= {terms: 106, types: 47, coercions: 0, joins: 0/0}
-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
-T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int -> Foo
+T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int #-> Foo
[GblId[DataConWrapper],
Arity=1,
Caf=NoCafRefs,
diff --git a/testsuite/tests/stranal/should_compile/T16029.stdout b/testsuite/tests/stranal/should_compile/T16029.stdout
index 100b0791ca..77957255c8 100644
--- a/testsuite/tests/stranal/should_compile/T16029.stdout
+++ b/testsuite/tests/stranal/should_compile/T16029.stdout
@@ -1,4 +1,4 @@
-T16029.$WMkT [InlPrag=INLINE[final] CONLIKE] :: Int -> Int -> T
+T16029.$WMkT [InlPrag=INLINE[final] CONLIKE] :: Int #-> Int #-> T
Tmpl= \ (dt [Occ=Once!] :: Int) (dt [Occ=Once!] :: Int) ->
= \ (dt [Occ=Once!] :: Int) (dt [Occ=Once!] :: Int) ->
:: GHC.Prim.Int# -> GHC.Prim.Int#
diff --git a/testsuite/tests/th/T10019.stdout b/testsuite/tests/th/T10019.stdout
index fb87a9bd9a..6acec6d98f 100644
--- a/testsuite/tests/th/T10019.stdout
+++ b/testsuite/tests/th/T10019.stdout
@@ -1 +1 @@
-"Constructor from Ghci1.Option: Ghci1.Some :: forall (a_0 :: *) .\n a_0 -> Ghci1.Option a_0"
+"Constructor from Ghci1.Option: Ghci1.Some :: forall (a_0 :: *) .\n a_0 #-> Ghci1.Option a_0"
diff --git a/testsuite/tests/th/T11345.stdout b/testsuite/tests/th/T11345.stdout
index 1230c63897..f710d847c8 100644
--- a/testsuite/tests/th/T11345.stdout
+++ b/testsuite/tests/th/T11345.stdout
@@ -3,8 +3,8 @@ data Main.GADT (a_0 :: *) where
GHC.Types.Int -> Main.GADT GHC.Types.Int
(Main.:***:) :: GHC.Types.Int ->
GHC.Types.Int -> Main.GADT GHC.Types.Int
-Constructor from Main.GADT: (Main.:***:) :: GHC.Types.Int ->
- GHC.Types.Int -> Main.GADT GHC.Types.Int
+Constructor from Main.GADT: (Main.:***:) :: GHC.Types.Int #->
+ GHC.Types.Int #-> Main.GADT GHC.Types.Int
Nothing
Just (Fixity 7 InfixR)
1 :****: 4
diff --git a/testsuite/tests/th/T14888.stderr b/testsuite/tests/th/T14888.stderr
index 4df1e669dc..f58d0c8b45 100644
--- a/testsuite/tests/th/T14888.stderr
+++ b/testsuite/tests/th/T14888.stderr
@@ -7,4 +7,4 @@ T14888.hs:18:22-60: Splicing expression
"class T14888.Functor' (f_0 :: * -> *)
where T14888.fmap' :: forall (a_1 :: *) (b_2 :: *) .
(a_1 -> b_2) -> f_0 a_1 -> f_0 b_2
-instance T14888.Functor' ((->) r_3 :: * -> *)"
+instance T14888.Functor' ((->) r_3)"
diff --git a/testsuite/tests/th/TH_reifyLinear.hs b/testsuite/tests/th/TH_reifyLinear.hs
new file mode 100644
index 0000000000..c551ad9235
--- /dev/null
+++ b/testsuite/tests/th/TH_reifyLinear.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE LinearTypes #-}
+module TH_reifyLinear where
+
+import Language.Haskell.TH
+import System.IO
+
+type T = Int #-> Int
+
+$(
+ do x <- reify ''T
+ runIO $ hPutStrLn stderr $ pprint x
+ return []
+ )
diff --git a/testsuite/tests/th/TH_reifyLinear.stderr b/testsuite/tests/th/TH_reifyLinear.stderr
new file mode 100644
index 0000000000..ed7866bfa8
--- /dev/null
+++ b/testsuite/tests/th/TH_reifyLinear.stderr
@@ -0,0 +1 @@
+type TH_reifyLinear.T = GHC.Types.Int #-> GHC.Types.Int
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 46fbcf7073..bd279e1128 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -64,6 +64,7 @@ test('TH_spliceD2', [], multimod_compile, ['TH_spliceD2', '-v0'])
test('TH_reifyDecl1', normal, compile, ['-v0'])
test('TH_reifyDecl2', normal, compile, ['-v0'])
+test('TH_reifyLinear', normal, compile, ['-v0'])
test('TH_reifyLocalDefs', normal, compile, ['-v0'])
test('TH_reifyLocalDefs2', normal, compile, ['-v0'])
diff --git a/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
index 119c6b91e5..8182d7c992 100644
--- a/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
+++ b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr
@@ -36,10 +36,6 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
where const :: forall a b. a -> b -> a
($) (_ :: [Integer] -> Integer)
where ($) :: forall a b. (a -> b) -> a -> b
- return (_ :: Integer)
- where return :: forall (m :: * -> *) a. Monad m => a -> m a
- pure (_ :: Integer)
- where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
($!) (_ :: [Integer] -> Integer)
where ($!) :: forall a b. (a -> b) -> a -> b
curry (_ :: (t0, [Integer]) -> Integer) (_ :: t0)
@@ -48,6 +44,10 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
where (.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c
flip (_ :: [Integer] -> t0 -> Integer) (_ :: t0)
where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ return (_ :: Integer)
+ where return :: forall (m :: * -> *) a. Monad m => a -> m a
+ pure (_ :: Integer)
+ where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
(>>=) (_ :: [Integer] -> a8) (_ :: a8 -> [Integer] -> Integer)
where (>>=) :: forall (m :: * -> *) a b.
Monad m =>
@@ -114,14 +114,14 @@ abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
where seq :: forall a b. a -> b -> b
($) (_ :: t0 -> [Integer] -> Integer) (_ :: t0)
where ($) :: forall a b. (a -> b) -> a -> b
- return (_ :: [Integer] -> Integer) (_ :: t0)
- where return :: forall (m :: * -> *) a. Monad m => a -> m a
- pure (_ :: [Integer] -> Integer) (_ :: t0)
- where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
uncurry (_ :: a3 -> b3 -> [Integer] -> Integer) (_ :: (a3, b3))
where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
($!) (_ :: t0 -> [Integer] -> Integer) (_ :: t0)
where ($!) :: forall a b. (a -> b) -> a -> b
+ return (_ :: [Integer] -> Integer) (_ :: t0)
+ where return :: forall (m :: * -> *) a. Monad m => a -> m a
+ pure (_ :: [Integer] -> Integer) (_ :: t0)
+ where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
• Found hole: _ :: Integer -> [Integer] -> Integer
@@ -152,10 +152,6 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
where const :: forall a b. a -> b -> a
($) (_ :: Integer -> [Integer] -> Integer)
where ($) :: forall a b. (a -> b) -> a -> b
- return (_ :: [Integer] -> Integer)
- where return :: forall (m :: * -> *) a. Monad m => a -> m a
- pure (_ :: [Integer] -> Integer)
- where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
($!) (_ :: Integer -> [Integer] -> Integer)
where ($!) :: forall a b. (a -> b) -> a -> b
curry (_ :: (t0, Integer) -> [Integer] -> Integer) (_ :: t0)
@@ -164,6 +160,10 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
where (.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c
flip (_ :: Integer -> t0 -> [Integer] -> Integer) (_ :: t0)
where flip :: forall a b c. (a -> b -> c) -> b -> a -> c
+ return (_ :: [Integer] -> Integer)
+ where return :: forall (m :: * -> *) a. Monad m => a -> m a
+ pure (_ :: [Integer] -> Integer)
+ where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
(>>=) (_ :: Integer -> a8)
(_ :: a8 -> Integer -> [Integer] -> Integer)
where (>>=) :: forall (m :: * -> *) a b.
@@ -234,12 +234,12 @@ abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
where seq :: forall a b. a -> b -> b
($) (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0)
where ($) :: forall a b. (a -> b) -> a -> b
- return (_ :: Integer -> [Integer] -> Integer) (_ :: t0)
- where return :: forall (m :: * -> *) a. Monad m => a -> m a
- pure (_ :: Integer -> [Integer] -> Integer) (_ :: t0)
- where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
uncurry (_ :: a3 -> b3 -> Integer -> [Integer] -> Integer)
(_ :: (a3, b3))
where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c
($!) (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0)
where ($!) :: forall a b. (a -> b) -> a -> b
+ return (_ :: Integer -> [Integer] -> Integer) (_ :: t0)
+ where return :: forall (m :: * -> *) a. Monad m => a -> m a
+ pure (_ :: Integer -> [Integer] -> Integer) (_ :: t0)
+ where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index b4ac6c9916..8d7c1f573f 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -386,7 +386,7 @@ test('holes2', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -
test('holes3', normalise_version('base'), compile_fail, ['-fno-max-valid-hole-fits -funclutter-valid-hole-fits'])
test('hole_constraints', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -funclutter-valid-hole-fits'])
test('hole_constraints_nested', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -funclutter-valid-hole-fits'])
-test('valid_hole_fits', [extra_files(['ValidHoleFits.hs'])],
+test('valid_hole_fits', extra_files(['ValidHoleFits.hs']),
multimod_compile, ['valid_hole_fits','-fdefer-type-errors -fno-max-valid-hole-fits'])
test('local_hole_fits', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits'])
test('subsumption_sort_hole_fits', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -fsort-by-subsumption-hole-fits'])
diff --git a/testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr
index 233f8e23d2..adb507ea92 100644
--- a/testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr
+++ b/testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr
@@ -37,12 +37,12 @@ constraint_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
where const :: forall a b. a -> b -> a
($) (_ :: [a] -> a)
where ($) :: forall a b. (a -> b) -> a -> b
+ ($!) (_ :: [a] -> a)
+ where ($!) :: forall a b. (a -> b) -> a -> b
return (_ :: a)
where return :: forall (m :: * -> *) a. Monad m => a -> m a
pure (_ :: a)
where pure :: forall (f :: * -> *) a. Applicative f => a -> f a
- ($!) (_ :: [a] -> a)
- where ($!) :: forall a b. (a -> b) -> a -> b
id (_ :: [a] -> a)
where id :: forall a. a -> a
head (_ :: [[a] -> a])
diff --git a/testsuite/tests/typecheck/should_compile/holes.stderr b/testsuite/tests/typecheck/should_compile/holes.stderr
index 9f4422909f..77a6fc9a40 100644
--- a/testsuite/tests/typecheck/should_compile/holes.stderr
+++ b/testsuite/tests/typecheck/should_compile/holes.stderr
@@ -54,6 +54,8 @@ holes.hs:11:15: warning: [-Wtyped-holes (in -Wdefault)]
LT :: Ordering
EQ :: Ordering
GT :: Ordering
+ One :: GHC.Types.Multiplicity
+ Many :: GHC.Types.Multiplicity
() :: ()
lines :: String -> [String]
unlines :: [String] -> String
diff --git a/testsuite/tests/typecheck/should_compile/holes3.stderr b/testsuite/tests/typecheck/should_compile/holes3.stderr
index fe6aaf391e..874fd4459f 100644
--- a/testsuite/tests/typecheck/should_compile/holes3.stderr
+++ b/testsuite/tests/typecheck/should_compile/holes3.stderr
@@ -57,6 +57,8 @@ holes3.hs:11:15: error:
LT :: Ordering
EQ :: Ordering
GT :: Ordering
+ One :: GHC.Types.Multiplicity
+ Many :: GHC.Types.Multiplicity
() :: ()
lines :: String -> [String]
unlines :: [String] -> String
diff --git a/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
index 51e29fd3a2..9e97fb51ff 100644
--- a/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
+++ b/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr
@@ -71,6 +71,11 @@ refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
with ($) @'GHC.Types.LiftedRep @[Integer] @Integer
(imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
(and originally defined in ‘GHC.Base’))
+ ($!) (_ :: [Integer] -> Integer)
+ where ($!) :: forall a b. (a -> b) -> a -> b
+ with ($!) @'GHC.Types.LiftedRep @[Integer] @Integer
+ (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
+ (and originally defined in ‘GHC.Base’))
return (_ :: Integer)
where return :: forall (m :: * -> *) a. Monad m => a -> m a
with return @((->) [Integer]) @Integer
@@ -81,11 +86,6 @@ refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)]
with pure @((->) [Integer]) @Integer
(imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
(and originally defined in ‘GHC.Base’))
- ($!) (_ :: [Integer] -> Integer)
- where ($!) :: forall a b. (a -> b) -> a -> b
- with ($!) @'GHC.Types.LiftedRep @[Integer] @Integer
- (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
- (and originally defined in ‘GHC.Base’))
id (_ :: [Integer] -> Integer)
where id :: forall a. a -> a
with id @([Integer] -> Integer)
@@ -167,6 +167,11 @@ refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
with ($) @'GHC.Types.LiftedRep @Integer @([Integer] -> Integer)
(imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
(and originally defined in ‘GHC.Base’))
+ ($!) (_ :: Integer -> [Integer] -> Integer)
+ where ($!) :: forall a b. (a -> b) -> a -> b
+ with ($!) @'GHC.Types.LiftedRep @Integer @([Integer] -> Integer)
+ (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
+ (and originally defined in ‘GHC.Base’))
return (_ :: [Integer] -> Integer)
where return :: forall (m :: * -> *) a. Monad m => a -> m a
with return @((->) Integer) @([Integer] -> Integer)
@@ -177,11 +182,6 @@ refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)]
with pure @((->) Integer) @([Integer] -> Integer)
(imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
(and originally defined in ‘GHC.Base’))
- ($!) (_ :: Integer -> [Integer] -> Integer)
- where ($!) :: forall a b. (a -> b) -> a -> b
- with ($!) @'GHC.Types.LiftedRep @Integer @([Integer] -> Integer)
- (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30
- (and originally defined in ‘GHC.Base’))
id (_ :: Integer -> [Integer] -> Integer)
where id :: forall a. a -> a
with id @(Integer -> [Integer] -> Integer)
diff --git a/testsuite/tests/typecheck/should_fail/T17021.stderr b/testsuite/tests/typecheck/should_fail/T17021.stderr
index 712858b19f..12d6d687d8 100644
--- a/testsuite/tests/typecheck/should_fail/T17021.stderr
+++ b/testsuite/tests/typecheck/should_fail/T17021.stderr
@@ -1,14 +1,6 @@
T17021.hs:18:5: error:
- Cannot use function with levity-polymorphic arguments:
- T17021.MkT :: Int -> T
- (Note that levity-polymorphic primops such as 'coerce' and unboxed tuples
- are eta-expanded internally because they must occur fully saturated.
- Use -fprint-typechecker-elaboration to display the full expression.)
- Levity-polymorphic arguments: Int :: TYPE (Id 'LiftedRep)
-
-T17021.hs:18:9: error:
A levity-polymorphic type is not allowed here:
Type: Int
Kind: TYPE (Id 'LiftedRep)
- In the type of expression: 42
+ When trying to create a variable of type: Int
diff --git a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesLevityBinder.stderr b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesLevityBinder.stderr
index 70746fd60a..a33a957e9d 100644
--- a/testsuite/tests/typecheck/should_fail/UnliftedNewtypesLevityBinder.stderr
+++ b/testsuite/tests/typecheck/should_fail/UnliftedNewtypesLevityBinder.stderr
@@ -1,8 +1,6 @@
UnliftedNewtypesLevityBinder.hs:16:7: error:
- Cannot use function with levity-polymorphic arguments:
- IdentC :: a -> Ident a
- (Note that levity-polymorphic primops such as 'coerce' and unboxed tuples
- are eta-expanded internally because they must occur fully saturated.
- Use -fprint-typechecker-elaboration to display the full expression.)
- Levity-polymorphic arguments: a :: TYPE r
+ A levity-polymorphic type is not allowed here:
+ Type: a
+ Kind: TYPE r
+ When trying to create a variable of type: a
diff --git a/testsuite/tests/typecheck/should_run/T14236.stdout b/testsuite/tests/typecheck/should_run/T14236.stdout
index a168ea8d04..ffa0e65dc9 100644
--- a/testsuite/tests/typecheck/should_run/T14236.stdout
+++ b/testsuite/tests/typecheck/should_run/T14236.stdout
@@ -1,3 +1,3 @@
-((->) 'LiftedRep 'LiftedRep Int,Char)
-((->) 'IntRep 'LiftedRep Int#,Char)
+(FUN 'Many 'LiftedRep 'LiftedRep Int,Char)
+(FUN 'Many 'IntRep 'LiftedRep Int#,Char)
Int# -> [Char]
diff --git a/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout b/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout
index 515738e98e..7769b78eb9 100644
--- a/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout
+++ b/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout
@@ -5,7 +5,7 @@ good: Maybe
good: TYPE
good: RuntimeRep
good: 'IntRep
-good: (->) 'LiftedRep 'LiftedRep
+good: FUN 'Many 'LiftedRep 'LiftedRep
good: Proxy * Int
good: Proxy (TYPE 'IntRep) Int#
good: *