Correct checkStrictBinds for generalised type
authorarchblob <fcsernik@gmail.com>
Tue, 19 Aug 2014 11:51:38 +0000 (06:51 -0500)
committerAustin Seipp <austin@well-typed.com>
Tue, 19 Aug 2014 11:52:15 +0000 (06:52 -0500)
See Trac #9140.

Auditors: simonpj

Signed-off-by: Austin Seipp <austin@well-typed.com>
compiler/typecheck/TcBinds.lhs
testsuite/tests/ghci/scripts/T9140.script [new file with mode: 0644]
testsuite/tests/ghci/scripts/T9140.stdout [new file with mode: 0644]
testsuite/tests/ghci/scripts/all.T

index 34db200..14a5704 100644 (file)
@@ -1454,8 +1454,8 @@ checkStrictBinds top_lvl rec_group orig_binds tc_binds poly_ids
     any_strict_pat     = any (isStrictHsBind   . unLoc) orig_binds
     any_pat_looks_lazy = any (looksLazyPatBind . unLoc) orig_binds
 
-    is_unlifted id = case tcSplitForAllTys (idType id) of
-                       (_, rho) -> isUnLiftedType rho
+    is_unlifted id = case tcSplitSigmaTy (idType id) of
+                       (_, _, rho) -> isUnLiftedType rho
 
     is_monomorphic (L _ (AbsBinds { abs_tvs = tvs, abs_ev_vars = evs }))
                      = null tvs && null evs
diff --git a/testsuite/tests/ghci/scripts/T9140.script b/testsuite/tests/ghci/scripts/T9140.script
new file mode 100644 (file)
index 0000000..833ea87
--- /dev/null
@@ -0,0 +1,5 @@
+:set -XUnboxedTuples -XBangPatterns
+let a = (# 1 #)
+let a = (# 1, 3 #)
+:set -XBangPatterns
+let !a = (# 1, 3 #)
diff --git a/testsuite/tests/ghci/scripts/T9140.stdout b/testsuite/tests/ghci/scripts/T9140.stdout
new file mode 100644 (file)
index 0000000..a5cb42f
--- /dev/null
@@ -0,0 +1,14 @@
+
+<interactive>:3:5:
+    You can't mix polymorphic and unlifted bindings
+      a = (# 1 #)
+      Probable fix: use a bang pattern
+
+<interactive>:4:5:
+    You can't mix polymorphic and unlifted bindings
+      a = (# 1, 3 #)
+      Probable fix: use a bang pattern
+
+Top level:
+    GHCi can't bind a variable of unlifted type:
+      a :: (# Integer, Integer #)
index d5a313a..f02a3c0 100755 (executable)
@@ -177,3 +177,4 @@ test('T8959', normal, ghci_script, ['T8959.script'])
 test('T8959b', expect_broken(8959), ghci_script, ['T8959b.script'])
 test('T9181', normal, ghci_script, ['T9181.script'])
 test('T9086b', normal, ghci_script, ['T9086b.script'])
+test('T9140', combined_output, ghci_script, ['T9140.script'])