[Git][ghc/ghc][master] 2 commits: Add tests for 25081
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Jul 29 02:21:30 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
e2f2a56e by Arnaud Spiwack at 2024-07-28T22:21:07-04:00
Add tests for 25081
- - - - -
23f50640 by Arnaud Spiwack at 2024-07-28T22:21:07-04:00
Scale multiplicity in list comprehension
Fixes #25081
- - - - -
6 changed files:
- compiler/GHC/Tc/Gen/Match.hs
- + testsuite/tests/linear/should_compile/LinearListComprehension.hs
- testsuite/tests/linear/should_compile/all.T
- + testsuite/tests/linear/should_fail/T25081.hs
- + testsuite/tests/linear/should_fail/T25081.stderr
- testsuite/tests/linear/should_fail/all.T
Changes:
=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -502,6 +502,32 @@ tcGuardStmt _ stmt _ _
-- coercion matching stuff in them. It's hard to avoid the
-- potential for non-trivial coercions in tcMcStmt
+{-
+Note [Binding in list comprehension isn't linear]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In principle, [ y | () <- xs, y <- [0,1]] could be linear in `xs`.
+But, the way the desugaring works, we get something like
+
+case xs of
+ () : xs ' -> letrec next_stmt = … xs' …
+
+In the current typing rules for letrec in Core, next_stmt is necessarily of
+multiplicity Many and so is every free variable, including xs'. Which, in turns,
+requires xs to be of multiplicity Many.
+
+Rodrigo Mesquita worked out, in his master thesis, how to make letrecs having
+non-Many multiplicities. But it's a fair bit of work to implement.
+
+Since nobody actually cares about [ y | () <- xs, y <- [0,1]] being linear, then
+we just conservatively make it unrestricted instead.
+
+If we're to change that, we have to be careful that [ y | _ <- xs, y <- [0,1]]
+isn't linear in `xs` since the elements of `xs` are ignored. So we'd still have
+to call `tcScalingUsage` on `xs` in `tcLcStmt`, we'd just have to create a fresh
+multiplicity variable. We'd also use the same multiplicity variable in the call
+to `tcCheckPat` instead of `unrestricted`.
+-}
+
tcLcStmt :: TyCon -- The list type constructor ([])
-> TcExprStmtChecker
@@ -513,20 +539,24 @@ tcLcStmt _ _ (LastStmt x body noret _) elt_ty thing_inside
-- A generator, pat <- rhs
tcLcStmt m_tc ctxt (BindStmt _ pat rhs) elt_ty thing_inside
= do { pat_ty <- newFlexiTyVarTy liftedTypeKind
- ; rhs' <- tcCheckMonoExpr rhs (mkTyConApp m_tc [pat_ty])
+ -- About the next `tcScalingUsage ManyTy` and unrestricted
+ -- see Note [Binding in list comprehension isn't linear]
+ ; rhs' <- tcScalingUsage ManyTy $ tcCheckMonoExpr rhs (mkTyConApp m_tc [pat_ty])
; (pat', thing) <- tcCheckPat (StmtCtxt ctxt) pat (unrestricted pat_ty) $
+ tcScalingUsage ManyTy $
thing_inside elt_ty
; return (mkTcBindStmt pat' rhs', thing) }
-- A boolean guard
tcLcStmt _ _ (BodyStmt _ rhs _ _) elt_ty thing_inside
= do { rhs' <- tcCheckMonoExpr rhs boolTy
- ; thing <- thing_inside elt_ty
+ ; thing <- tcScalingUsage ManyTy $ thing_inside elt_ty
; return (BodyStmt boolTy rhs' noSyntaxExpr noSyntaxExpr, thing) }
-- ParStmt: See notes with tcMcStmt and Note [Scoping in parallel list comprehensions]
tcLcStmt m_tc ctxt (ParStmt _ bndr_stmts_s _ _) elt_ty thing_inside
- = do { env <- getLocalRdrEnv
+ = tcScalingUsage ManyTy $ -- parallel list comprehension never desugars to something linear.
+ do { env <- getLocalRdrEnv
; (pairs', thing) <- loop env [] bndr_stmts_s
; return (ParStmt unitTy pairs' noExpr noSyntaxExpr, thing) }
where
@@ -552,7 +582,8 @@ tcLcStmt m_tc ctxt (ParStmt _ bndr_stmts_s _ _) elt_ty thing_inside
tcLcStmt m_tc ctxt (TransStmt { trS_form = form, trS_stmts = stmts
, trS_bndrs = bindersMap
, trS_by = by, trS_using = using }) elt_ty thing_inside
- = do { let (bndr_names, n_bndr_names) = unzip bindersMap
+ = tcScalingUsage ManyTy $ -- Transform statements are too complex: just make everything multiplicity Many
+ do { let (bndr_names, n_bndr_names) = unzip bindersMap
unused_ty = pprPanic "tcLcStmt: inner ty" (ppr bindersMap)
-- The inner 'stmts' lack a LastStmt, so the element type
-- passed in to tcStmtsAndThen is never looked at
=====================================
testsuite/tests/linear/should_compile/LinearListComprehension.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE LinearTypes #-}
+
+module LinearListComprehension where
+
+-- Probably nobody actually cares if monad comprehension realised that it can be
+-- linear in the first statement. But it can, so we might as well.
+
+guard :: a %1 -> (a %1 -> Bool) %1 -> [Int]
+guard x g = [ y | g x, y <- [0,1] ]
+
+-- This isn't correct syntax, but a singleton list comprehension would
+-- presumably work too
+-- last :: a %1 -> [a]
+-- last x = [ x | ]
=====================================
testsuite/tests/linear/should_compile/all.T
=====================================
@@ -45,3 +45,4 @@ test('LinearRecUpd', normal, compile, [''])
test('T23814', normal, compile, [''])
test('LinearLet', normal, compile, [''])
test('LinearLetPoly', normal, compile, [''])
+test('LinearListComprehension', normal, compile, ['-dlinear-core-lint'])
=====================================
testsuite/tests/linear/should_fail/T25081.hs
=====================================
@@ -0,0 +1,37 @@
+{-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE ParallelListComp #-}
+{-# LANGUAGE TransformListComp #-}
+
+module T25081 where
+
+dup_last :: a %1 -> [a]
+dup_last x = [ x | _ <- [0,1]]
+
+dup_bind :: a %1 -> [()]
+dup_bind x = [ () | _ <- [0,1], _ <- [x]]
+
+dup_guard :: a %1 -> (a %1 -> Bool) -> [()]
+dup_guard x g = [ () | _ <- [0,1], g x ]
+
+guard_last :: a %1 -> [a]
+guard_last x = [ x | False]
+
+guard_bind :: a %1 -> [()]
+guard_bind x = [ () | False, _ <- [x]]
+
+guard_guard :: a %1 -> (a %1 -> Bool) %1 -> [()]
+guard_guard x g = [ () | False, g x ]
+
+-- This could, in principle, be linear. But see Note [Binding in list
+-- comprehension isn't linear] in GHC.Tc.Gen.Match.
+first_bind :: [()] %1 -> [Int]
+first_bind xs = [ y | () <- xs, y <- [0,1]]
+
+parallel :: a %1 -> [(a, Bool)]
+parallel x = [(y,z) | y <- [x] | z <- [True]]
+
+parallel_guard :: a %1 -> (a %1 -> Bool) -> [(Int, Bool)]
+parallel_guard x g = [(y, z) | g x, y <- [0,1] | z <- [True, False]]
+
+transform :: a %1 -> (a %1 -> Bool) -> [a]
+transform x g = [y | g x, y <- [0, 1], then take 2]
=====================================
testsuite/tests/linear/should_fail/T25081.stderr
=====================================
@@ -0,0 +1,65 @@
+T25081.hs:8:10: error: [GHC-18872]
+ • Couldn't match type ‘Many’ with ‘One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘dup_last’: dup_last x = [x | _ <- [0, 1]]
+
+T25081.hs:11:10: error: [GHC-18872]
+ • Couldn't match type ‘Many’ with ‘One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘dup_bind’:
+ dup_bind x = [() | _ <- [0, 1], _ <- [x]]
+
+T25081.hs:14:11: error: [GHC-18872]
+ • Couldn't match type ‘Many’ with ‘One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘dup_guard’:
+ dup_guard x g = [() | _ <- [0, 1], g x]
+
+T25081.hs:17:12: error: [GHC-18872]
+ • Couldn't match type ‘Many’ with ‘One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘guard_last’: guard_last x = [x | False]
+
+T25081.hs:20:12: error: [GHC-18872]
+ • Couldn't match type ‘Many’ with ‘One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘guard_bind’:
+ guard_bind x = [() | False, _ <- [x]]
+
+T25081.hs:23:13: error: [GHC-18872]
+ • Couldn't match type ‘Many’ with ‘One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘guard_guard’:
+ guard_guard x g = [() | False, g x]
+
+T25081.hs:23:15: error: [GHC-18872]
+ • Couldn't match type ‘Many’ with ‘One’
+ arising from multiplicity of ‘g’
+ • In an equation for ‘guard_guard’:
+ guard_guard x g = [() | False, g x]
+
+T25081.hs:28:12: error: [GHC-18872]
+ • Couldn't match type ‘Many’ with ‘One’
+ arising from multiplicity of ‘xs’
+ • In an equation for ‘first_bind’:
+ first_bind xs = [y | () <- xs, y <- [0, 1]]
+
+T25081.hs:31:10: error: [GHC-18872]
+ • Couldn't match type ‘Many’ with ‘One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘parallel’:
+ parallel x = [(y, z) | y <- [x] | z <- [True]]
+
+T25081.hs:34:16: error: [GHC-18872]
+ • Couldn't match type ‘Many’ with ‘One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘parallel_guard’:
+ parallel_guard x g
+ = [(y, z) | g x, y <- [0, 1] | z <- [True, False]]
+
+T25081.hs:37:11: error: [GHC-18872]
+ • Couldn't match type ‘Many’ with ‘One’
+ arising from multiplicity of ‘x’
+ • In an equation for ‘transform’:
+ transform x g = [y | g x, y <- [0, 1], then take 2]
+
=====================================
testsuite/tests/linear/should_fail/all.T
=====================================
@@ -51,3 +51,4 @@ test('LinearLet7', normal, compile_fail, [''])
test('LinearLet8', normal, compile_fail, [''])
test('LinearLet9', normal, compile_fail, [''])
test('LinearLet10', normal, compile_fail, [''])
+test('T25081', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec2eafdb65c47c55c4c56fc9d0f42f8696a0be4e...23f50640e705c132f1a0689d4850866d0f0d76a6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec2eafdb65c47c55c4c56fc9d0f42f8696a0be4e...23f50640e705c132f1a0689d4850866d0f0d76a6
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240728/119b0fe8/attachment-0001.html>
More information about the ghc-commits
mailing list