summaryrefslogtreecommitdiff
path: root/testsuite/tests/typecheck/should_run
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2021-02-02 10:06:11 -0500
committerBen Gamari <ben@smart-cactus.org>2021-03-07 17:01:40 -0500
commit3e082f8ff5ea2f42c5e6430094683b26b5818fb8 (patch)
tree4c85427ff40740b654cf1911a20a3a478a9fb754 /testsuite/tests/typecheck/should_run
parentcf65cf16c89414273c4f6b2d090d4b2fffb90759 (diff)
downloadhaskell-3e082f8ff5ea2f42c5e6430094683b26b5818fb8.tar.gz
Implement BoxedRep proposalwip/boxed-rep
This implements the BoxedRep proposal, refactoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Updates binary, haddock submodules. Closes #17526. Metric Increase: T12545
Diffstat (limited to 'testsuite/tests/typecheck/should_run')
-rw-r--r--testsuite/tests/typecheck/should_run/EtaExpandLevPoly.hs4
-rw-r--r--testsuite/tests/typecheck/should_run/LevPolyResultInst.hs27
-rw-r--r--testsuite/tests/typecheck/should_run/LevPolyResultInst.stdout2
-rw-r--r--testsuite/tests/typecheck/should_run/T12809.hs2
-rw-r--r--testsuite/tests/typecheck/should_run/T14236.stdout4
-rw-r--r--testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout2
-rw-r--r--testsuite/tests/typecheck/should_run/TypeOf.hs7
-rw-r--r--testsuite/tests/typecheck/should_run/TypeOf.stdout5
-rw-r--r--testsuite/tests/typecheck/should_run/TypeRep.hs4
-rw-r--r--testsuite/tests/typecheck/should_run/TypeRep.stdout4
-rwxr-xr-xtestsuite/tests/typecheck/should_run/all.T1
11 files changed, 49 insertions, 13 deletions
diff --git a/testsuite/tests/typecheck/should_run/EtaExpandLevPoly.hs b/testsuite/tests/typecheck/should_run/EtaExpandLevPoly.hs
index d57d2e1499..82553b4ff2 100644
--- a/testsuite/tests/typecheck/should_run/EtaExpandLevPoly.hs
+++ b/testsuite/tests/typecheck/should_run/EtaExpandLevPoly.hs
@@ -6,12 +6,12 @@ module Main where
import GHC.Exts
data G a where
- MkG :: G (TupleRep [LiftedRep, IntRep])
+ MkG :: G (TupleRep [BoxedRep Lifted, IntRep])
-- tests that we don't eta-expand functions that are levity-polymorphic
-- see CoreArity.mkEtaWW
foo :: forall a (b :: TYPE a). G a -> b -> b
-foo MkG = (\x -> x) :: forall (c :: TYPE (TupleRep [LiftedRep, IntRep])). c -> c
+foo MkG = (\x -> x) :: forall (c :: TYPE (TupleRep [BoxedRep Lifted, IntRep])). c -> c
data H a where
MkH :: H IntRep
diff --git a/testsuite/tests/typecheck/should_run/LevPolyResultInst.hs b/testsuite/tests/typecheck/should_run/LevPolyResultInst.hs
new file mode 100644
index 0000000000..8302a43693
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/LevPolyResultInst.hs
@@ -0,0 +1,27 @@
+{-# language BangPatterns #-}
+{-# language DataKinds #-}
+{-# language MagicHash #-}
+{-# language PolyKinds #-}
+{-# language RankNTypes #-}
+{-# language UnboxedTuples #-}
+
+import GHC.Exts
+
+main :: IO ()
+main = do
+ print (example (\x -> I# x > 7))
+ case indexArray# (example replicateFalse) 0# of
+ (# r #) -> print r
+
+-- Combines base:runST, primitive:newArray, and primitive:unsafeFreezeArray
+replicateFalse :: Int# -> Array# Bool
+replicateFalse n =
+ let !(# _, r #) = runRW#
+ (\s -> case newArray# n False s of
+ (# s', arr #) -> unsafeFreezeArray# arr s'
+ )
+ in r
+
+example :: forall (v :: Levity) (a :: TYPE ('BoxedRep v)). (Int# -> a) -> a
+{-# noinline example #-}
+example f = f 8#
diff --git a/testsuite/tests/typecheck/should_run/LevPolyResultInst.stdout b/testsuite/tests/typecheck/should_run/LevPolyResultInst.stdout
new file mode 100644
index 0000000000..1cc8b5e10d
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/LevPolyResultInst.stdout
@@ -0,0 +1,2 @@
+True
+False
diff --git a/testsuite/tests/typecheck/should_run/T12809.hs b/testsuite/tests/typecheck/should_run/T12809.hs
index 66031a5af7..3e20403add 100644
--- a/testsuite/tests/typecheck/should_run/T12809.hs
+++ b/testsuite/tests/typecheck/should_run/T12809.hs
@@ -32,7 +32,7 @@ g (# b, x #) = show b ++ " " ++ show (I# x)
h :: (# Double, Int# #) -> String
h (# d, x #) = show d ++ " " ++ show (I# x)
-cond :: forall (a :: TYPE (TupleRep [LiftedRep, IntRep])). Bool -> a -> a -> a
+cond :: forall (a :: TYPE (TupleRep [BoxedRep Lifted, IntRep])). Bool -> a -> a -> a
cond True x _ = x
cond False _ x = x
diff --git a/testsuite/tests/typecheck/should_run/T14236.stdout b/testsuite/tests/typecheck/should_run/T14236.stdout
index ffa0e65dc9..73c98017f2 100644
--- a/testsuite/tests/typecheck/should_run/T14236.stdout
+++ b/testsuite/tests/typecheck/should_run/T14236.stdout
@@ -1,3 +1,3 @@
-(FUN 'Many 'LiftedRep 'LiftedRep Int,Char)
-(FUN 'Many 'IntRep 'LiftedRep Int#,Char)
+(FUN 'Many ('BoxedRep 'Lifted) ('BoxedRep 'Lifted) Int,Char)
+(FUN 'Many 'IntRep ('BoxedRep 'Lifted) Int#,Char)
Int# -> [Char]
diff --git a/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout b/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout
index 1303db844c..6ef72dfb83 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: FUN 'Many 'LiftedRep 'LiftedRep
+good: FUN 'Many ('BoxedRep 'Lifted) ('BoxedRep 'Lifted)
good: Proxy * Int
good: Proxy (TYPE 'IntRep) Int#
good: *
diff --git a/testsuite/tests/typecheck/should_run/TypeOf.hs b/testsuite/tests/typecheck/should_run/TypeOf.hs
index cec6833b64..37113bfe80 100644
--- a/testsuite/tests/typecheck/should_run/TypeOf.hs
+++ b/testsuite/tests/typecheck/should_run/TypeOf.hs
@@ -28,9 +28,12 @@ main = do
print $ typeOf (Proxy :: Proxy [1,2,3])
print $ typeOf (Proxy :: Proxy 'EQ)
print $ typeOf (Proxy :: Proxy TYPE)
- print $ typeOf (Proxy :: Proxy (TYPE 'LiftedRep))
+ print $ typeOf (Proxy :: Proxy (TYPE ('BoxedRep 'Lifted)))
print $ typeOf (Proxy :: Proxy *)
print $ typeOf (Proxy :: Proxy ★)
- print $ typeOf (Proxy :: Proxy 'LiftedRep)
+ print $ typeOf (Proxy :: Proxy ('BoxedRep 'Lifted))
+ print $ typeOf (Proxy :: Proxy 'Lifted)
+ print $ typeOf (Proxy :: Proxy 'Unlifted)
+ print $ typeOf (Proxy :: Proxy LiftedRep)
print $ typeOf (Proxy :: Proxy '(1, "hello"))
print $ typeOf (Proxy :: Proxy (~~))
diff --git a/testsuite/tests/typecheck/should_run/TypeOf.stdout b/testsuite/tests/typecheck/should_run/TypeOf.stdout
index 40d2cb5f8f..3344f17193 100644
--- a/testsuite/tests/typecheck/should_run/TypeOf.stdout
+++ b/testsuite/tests/typecheck/should_run/TypeOf.stdout
@@ -19,6 +19,9 @@ Proxy (RuntimeRep -> *) TYPE
Proxy * *
Proxy * *
Proxy * *
-Proxy RuntimeRep 'LiftedRep
+Proxy RuntimeRep ('BoxedRep 'Lifted)
+Proxy Levity 'Lifted
+Proxy Levity 'Unlifted
+Proxy RuntimeRep ('BoxedRep 'Lifted)
Proxy (Natural,Symbol) ('(,) Natural Symbol 1 "hello")
Proxy (* -> * -> Constraint) ((~~) * *)
diff --git a/testsuite/tests/typecheck/should_run/TypeRep.hs b/testsuite/tests/typecheck/should_run/TypeRep.hs
index beae93f6b3..886479fd33 100644
--- a/testsuite/tests/typecheck/should_run/TypeRep.hs
+++ b/testsuite/tests/typecheck/should_run/TypeRep.hs
@@ -53,10 +53,10 @@ main = do
print $ rep @(Proxy [1,2,3])
print $ rep @(Proxy 'EQ)
print $ rep @(Proxy TYPE)
- print $ rep @(Proxy (TYPE 'LiftedRep))
+ print $ rep @(Proxy (TYPE ('BoxedRep 'Lifted)))
print $ rep @(Proxy *)
print $ rep @(Proxy ★)
- print $ rep @(Proxy 'LiftedRep)
+ print $ rep @(Proxy ('BoxedRep 'Lifted))
-- Something lifted and primitive
print $ rep @RealWorld -- #12132
diff --git a/testsuite/tests/typecheck/should_run/TypeRep.stdout b/testsuite/tests/typecheck/should_run/TypeRep.stdout
index a0c03e09d8..cf43264714 100644
--- a/testsuite/tests/typecheck/should_run/TypeRep.stdout
+++ b/testsuite/tests/typecheck/should_run/TypeRep.stdout
@@ -13,7 +13,7 @@ Int -> Int
(%,%) (Eq Int) (Eq [Char])
Int#
(##)
-(#,#) 'IntRep 'LiftedRep Int# Int
+(#,#) 'IntRep ('BoxedRep 'Lifted) Int# Int
Proxy Constraint (Eq Int)
Proxy * (Int,Int)
Proxy Symbol "hello world"
@@ -24,5 +24,5 @@ Proxy (RuntimeRep -> *) TYPE
Proxy * *
Proxy * *
Proxy * *
-Proxy RuntimeRep 'LiftedRep
+Proxy RuntimeRep ('BoxedRep 'Lifted)
RealWorld
diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T
index ef8ae9136d..ef7bedb354 100755
--- a/testsuite/tests/typecheck/should_run/all.T
+++ b/testsuite/tests/typecheck/should_run/all.T
@@ -145,5 +145,6 @@ test('UnliftedNewtypesFamilyRun', normal, compile_and_run, [''])
test('UnliftedNewtypesDependentFamilyRun', normal, compile_and_run, [''])
test('UnliftedNewtypesIdentityRun', normal, compile_and_run, [''])
test('UnliftedNewtypesCoerceRun', normal, compile_and_run, [''])
+test('LevPolyResultInst', normal, compile_and_run, [''])
test('T17104', normal, compile_and_run, [''])
test('T18627', normal, compile_and_run, ['-O']) # Optimisation shows up the bug