[Git][ghc/ghc][master] 2 commits: Add test for #25515

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
41f8365c by Arnaud Spiwack at 2024-11-25T14:03:23-05:00
Add test for #25515

- - - - -
9279619f by Arnaud Spiwack at 2024-11-25T14:03:23-05:00
Desugar record notation with correct multiplicities

Simply uses the multiplicity as stored in the field. As I'm writing
this commit, the only possible multiplicity is 1, but !13525 is
changing this. It's actually easier to take !13525 into account.

Fixes #25515.

- - - - -


3 changed files:

- compiler/GHC/Tc/Gen/Expr.hs
- + testsuite/tests/linear/should_compile/T25515.hs
- testsuite/tests/linear/should_compile/all.T


Changes:

=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -575,12 +575,7 @@ tcExpr expr@(RecordCon { rcon_con = L loc con_name
         ; checkTc (conLikeHasBuilder con_like) $
           nonBidirectionalErr (conLikeName con_like)
 
-        ; rbinds' <- tcRecordBinds con_like (map scaledThing arg_tys) rbinds
-                   -- It is currently not possible for a record to have
-                   -- multiplicities. When they do, `tcRecordBinds` will take
-                   -- scaled types instead. Meanwhile, it's safe to take
-                   -- `scaledThing` above, as we know all the multiplicities are
-                   -- Many.
+        ; rbinds' <- tcRecordBinds con_like arg_tys rbinds
 
         ; let rcon_tc = mkHsWrap con_wrap con_expr
               expr' = RecordCon { rcon_ext = rcon_tc
@@ -1632,7 +1627,7 @@ This extends OK when the field types are universally quantified.
 
 tcRecordBinds
         :: ConLike
-        -> [TcType]     -- Expected type for each field
+        -> [Scaled TcType]     -- Expected type for each field
         -> HsRecordBinds GhcRn
         -> TcM (HsRecordBinds GhcTc)
 
@@ -1661,18 +1656,18 @@ fieldCtxt :: FieldLabelString -> SDoc
 fieldCtxt field_name
   = text "In the" <+> quotes (ppr field_name) <+> text "field of a record"
 
-tcRecordField :: ConLike -> Assoc Name Type
+tcRecordField :: ConLike -> Assoc Name (Scaled Type)
               -> LFieldOcc GhcRn -> LHsExpr GhcRn
               -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
 tcRecordField con_like flds_w_tys (L loc (FieldOcc rdr (L l sel_name))) rhs
-  | Just field_ty <- assocMaybe flds_w_tys sel_name
+  | Just (Scaled field_mult field_ty) <- assocMaybe flds_w_tys sel_name
       = addErrCtxt (fieldCtxt field_lbl) $
-        do { rhs' <- tcCheckPolyExprNC rhs field_ty
+        do { rhs' <- tcScalingUsage field_mult $ tcCheckPolyExprNC rhs field_ty
            ; hasFixedRuntimeRep_syntactic (FRRRecordCon rdr (unLoc rhs'))
                 field_ty
            ; let field_id = mkUserLocal (nameOccName sel_name)
                                         (nameUnique sel_name)
-                                        ManyTy field_ty (locA loc)
+                                        field_mult field_ty (locA loc)
                 -- Yuk: the field_id has the *unique* of the selector Id
                 --          (so we can find it easily)
                 --      but is a LocalId with the appropriate type of the RHS


=====================================
testsuite/tests/linear/should_compile/T25515.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE LinearTypes #-}
+
+module T25515 where
+
+data C = MkC { unc :: Int }
+
+f :: Int %1 -> C
+f x = MkC { unc = x }


=====================================
testsuite/tests/linear/should_compile/all.T
=====================================
@@ -47,3 +47,4 @@ test('LinearLet', normal, compile, [''])
 test('LinearLetPoly', normal, compile, [''])
 test('LinearListComprehension', normal, compile, ['-dlinear-core-lint'])
 test('OmitFieldPat', normal, compile, ['-dcore-lint'])
+test('T25515', normal, compile, ['-dcore-lint'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/caaf53881d5cc82ebff617f39ad5363429d2eccf...9279619f09a9449a35ac467c1c2ff7380fca9d06

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/caaf53881d5cc82ebff617f39ad5363429d2eccf...9279619f09a9449a35ac467c1c2ff7380fca9d06
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/20241125/07607312/attachment-0001.html>