- ghc-commits - Haskell.org

[Git][ghc/ghc][wip/aidylns/RecConWildE] RecConWildE
by Adriaan Leijnse (＠aidylns) 09 Jun '25

09 Jun '25

Adriaan Leijnse pushed to branch wip/aidylns/RecConWildE at Glasgow Haskell Compiler / GHC Commits: 7411211a by Adriaan Leijnse at 2025-06-09T15:06:48+02:00 RecConWildE - - - - - 9 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/ThToHs.hs - libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs - libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs - + testsuite/tests/th/T24537.hs - + testsuite/tests/th/T24537.stdout - testsuite/tests/th/all.T Changes: ===================================== compiler/GHC/Builtin/Names/TH.hs ===================================== @@ -60,7 +60,7 @@ templateHaskellNames = [ lamCasesEName, tupEName, unboxedTupEName, unboxedSumEName, condEName, multiIfEName, letEName, caseEName, doEName, mdoEName, compEName, fromEName, fromThenEName, fromToEName, fromThenToEName, - listEName, sigEName, recConEName, recUpdEName, staticEName, unboundVarEName, + listEName, sigEName, recConEName, recConWildEName, recUpdEName, staticEName, unboundVarEName, labelEName, implicitParamVarEName, getFieldEName, projectionEName, typeEName, forallEName, forallVisEName, constrainedEName, -- FieldExp @@ -347,10 +347,11 @@ fromThenEName = libFun (fsLit "fromThenE") fromThenEIdKey fromToEName = libFun (fsLit "fromToE") fromToEIdKey fromThenToEName = libFun (fsLit "fromThenToE") fromThenToEIdKey -- end ArithSeq -listEName, sigEName, recConEName, recUpdEName :: Name +listEName, sigEName, recConEName, recConWildEName, recUpdEName :: Name listEName = libFun (fsLit "listE") listEIdKey sigEName = libFun (fsLit "sigE") sigEIdKey recConEName = libFun (fsLit "recConE") recConEIdKey +recConWildEName = libFun (fsLit "recConWildE") recConWildEIdKey recUpdEName = libFun (fsLit "recUpdE") recUpdEIdKey staticEName = libFun (fsLit "staticE") staticEIdKey unboundVarEName = libFun (fsLit "unboundVarE") unboundVarEIdKey @@ -892,7 +893,7 @@ varEIdKey, conEIdKey, litEIdKey, appEIdKey, appTypeEIdKey, infixEIdKey, fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey, listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey, staticEIdKey, unboundVarEIdKey, labelEIdKey, implicitParamVarEIdKey, mdoEIdKey, - getFieldEIdKey, projectionEIdKey, typeEIdKey, forallEIdKey, + getFieldEIdKey, projectionEIdKey, typeEIdKey, recConWildEIdKey, forallEIdKey, forallVisEIdKey, constrainedEIdKey :: Unique varEIdKey = mkPreludeMiscIdUnique 270 conEIdKey = mkPreludeMiscIdUnique 271 @@ -934,6 +935,7 @@ typeEIdKey = mkPreludeMiscIdUnique 306 forallEIdKey = mkPreludeMiscIdUnique 802 forallVisEIdKey = mkPreludeMiscIdUnique 803 constrainedEIdKey = mkPreludeMiscIdUnique 804 +recConWildEIdKey = mkPreludeMiscIdUnique 805 -- type FieldExp = ... fieldExpIdKey :: Unique ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1666,7 +1666,7 @@ repE (ExplicitSum _ alt arity e) repE (RecordCon { rcon_con = c, rcon_flds = flds }) = do { x <- lookupWithUserRdrLOcc c; fs <- repFields flds; - repRecCon x fs } + repRecCon x fs $ fmap (\(L _ (RecFieldsDotDot n)) -> n) $ rec_dotdot flds } repE (RecordUpd { rupd_expr = e, rupd_flds = RegularRecUpdFields { recUpdFields = flds } }) = do { x <- repLE e; fs <- repUpdFields flds; @@ -1833,7 +1833,7 @@ repLGRHS (L _ (GRHS _ ss rhs)) ; return (gs, guarded) } repFields :: HsRecordBinds GhcRn -> MetaM (Core [M TH.FieldExp]) -repFields (HsRecFields { rec_flds = flds }) +repFields (HsRecFields { rec_flds = flds }) -- The select on field names here caused a bug in TH after rec_dotdot was added. = repListM fieldExpTyConName rep_fld flds where rep_fld :: LHsRecField GhcRn (LHsExpr GhcRn) @@ -2580,8 +2580,14 @@ repListExp (MkC es) = rep2 listEName [es] repSigExp :: Core (M TH.Exp) -> Core (M TH.Type) -> MetaM (Core (M TH.Exp)) repSigExp (MkC e) (MkC t) = rep2 sigEName [e,t] -repRecCon :: Core TH.Name -> Core [M TH.FieldExp]-> MetaM (Core (M TH.Exp)) -repRecCon (MkC c) (MkC fs) = rep2 recConEName [c,fs] +repRecCon :: Core TH.Name -> Core [M TH.FieldExp] -> Maybe Int -> MetaM (Core (M TH.Exp)) +repRecCon (MkC c) (MkC fs) hasWildCard = + case hasWildCard of + { Nothing -> rep2 recConEName [c,fs] + ; Just n -> do + MkC n' <- coreIntLit n + rep2 recConWildEName [c,fs,n'] + } repRecUpd :: Core (M TH.Exp) -> Core [M TH.FieldExp] -> MetaM (Core (M TH.Exp)) repRecUpd (MkC e) (MkC fs) = rep2 recUpdEName [e,fs] ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -1180,9 +1180,8 @@ cvtl e = wrapLA (cvt e) cvt (SigE e t) = do { e' <- cvtl e; t' <- cvtSigType t ; let pe = parenthesizeHsExpr sigPrec e' ; return $ ExprWithTySig noAnn pe (mkHsWildCardBndrs t') } - cvt (RecConE c flds) = do { c' <- cNameN c - ; flds' <- mapM (cvtFld (wrapParLA mkFieldOcc)) flds - ; return $ mkRdrRecordCon c' (HsRecFields noExtField flds' Nothing) noAnn } + cvt (RecConE c flds) = thToHsRecCon c flds Nothing + cvt (RecConWildE c flds n) = thToHsRecCon c flds (Just (L noAnn (RecFieldsDotDot n))) cvt (RecUpdE e flds) = do { e' <- cvtl e ; flds' <- mapM (cvtFld (wrapParLA mkFieldOcc)) @@ -1226,6 +1225,11 @@ cvtl e = wrapLA (cvt e) mkHsForAllVisTele noAnn tvs' ; return $ HsForAll noExtField tele body' } +thToHsRecCon c flds maybeDotDot = do + { c' <- cNameN c + ; flds' <- mapM (cvtFld (wrapParLA mkFieldOcc)) flds + ; return $ mkRdrRecordCon c' (HsRecFields noExtField flds' maybeDotDot) noAnn } + {- | #16895 Ensure an infix expression's operator is a variable/constructor. Consider this example: ===================================== libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs ===================================== @@ -231,8 +231,9 @@ pprExp _ (ArithSeqE d) = ppr d pprExp _ (ListE es) = brackets (commaSep es) pprExp i (SigE e t) = parensIf (i > noPrec) $ pprExp sigPrec e <+> dcolon <+> pprType sigPrec t -pprExp _ (RecConE nm fs) = pprName' Applied nm <> braces (pprFields fs) -pprExp _ (RecUpdE e fs) = pprExp appPrec e <> braces (pprFields fs) +pprExp _ (RecConE nm fs) = pprName' Applied nm <> braces (pprFields Nothing fs) +pprExp _ (RecConWildE nm fs n) = pprName' Applied nm <> braces (pprFields (Just n) fs) +pprExp _ (RecUpdE e fs) = pprExp appPrec e <> braces (pprFields Nothing fs) -- FIXME: this can also have dots in surface syntax pprExp i (StaticE e) = parensIf (i >= appPrec) $ text "static"<+> pprExp appPrec e pprExp _ (UnboundVarE v) = pprName' Applied v @@ -250,8 +251,16 @@ pprExp i (ForallE tvars body) = pprExp i (ConstrainedE ctx body) = parensIf (i >= funPrec) $ sep [pprCtxWith pprExp ctx, pprExp qualPrec body] -pprFields :: [(Name,Exp)] -> Doc -pprFields = sep . punctuate comma . map (\(s,e) -> pprName' Applied s <+> equals <+> ppr e) +-- See Note [DotDot fields] in Language.Haskell.Syntax.Pat. +pprFields :: Maybe Int -> [(Name,Exp)] -> Doc +pprFields dotdot fs = + sep + . punctuate comma + . (case dotdot of + Nothing -> id + Just n -> (`mappend` [text ".."]) . take n) + . map (\(s,e) -> pprName' Applied s <+> equals <+> ppr e) + $ fs pprMaybeExp :: Precedence -> Maybe Exp -> Doc pprMaybeExp _ Nothing = empty ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs ===================================== @@ -378,6 +378,9 @@ sigE e t = do { e1 <- e; t1 <- t; pure (SigE e1 t1) } recConE :: Quote m => Name -> [m (Name,Exp)] -> m Exp recConE c fs = do { flds <- sequenceA fs; pure (RecConE c flds) } +recConWildE :: Quote m => Name -> [m (Name,Exp)] -> Int -> m Exp +recConWildE c fs n = do { flds <- sequenceA fs; pure (RecConWildE c flds n) } + recUpdE :: Quote m => m Exp -> [m (Name,Exp)] -> m Exp recUpdE e fs = do { e1 <- e; flds <- sequenceA fs; pure (RecUpdE e1 flds) } ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs ===================================== @@ -1885,6 +1885,11 @@ data Exp | ListE [ Exp ] -- ^ @{ [1,2,3] }@ | SigE Exp Type -- ^ @{ e :: t }@ | RecConE Name [FieldExp] -- ^ @{ T { x = y, z = w } }@ + -- Record constructor without a wild card. + | RecConWildE Name [FieldExp] Int -- ^ @{ T { x = y, z = w, ... } }@ + -- I.e. like `RecConE` but with a wild card. + -- See Note [DotDot fields] in Language.Haskell.Syntax.Pat + -- for the meaning of the Int parameter. | RecUpdE Exp [FieldExp] -- ^ @{ (f x) { z = w } }@ | StaticE Exp -- ^ @{ static e }@ | UnboundVarE Name -- ^ @{ _x }@ ===================================== testsuite/tests/th/T24537.hs ===================================== @@ -0,0 +1,16 @@ +{-# Language TemplateHaskell #-} +{-# Language RecordWildCards #-} +module Main where + +import Language.Haskell.TH.Ppr + +data G = H { field0 :: Int, field1 :: String } + +main :: IO () +main = do + let pr mq = do + q <- mq + print q + print . pprint $ q + pr [e|let field0 = 3 in H {field0,..}|] + pr [e|let { field0 = 3; field1 = "a" } in H {field0,..}|] ===================================== testsuite/tests/th/T24537.stdout ===================================== @@ -0,0 +1,4 @@ +LetE [ValD (VarP field0_0) (NormalB (LitE (IntegerL 3))) []] (RecConWildE Main.H [(Main.field0,VarE field0_0)] 1) +"let field0_0 = 3\n in Main.H{Main.field0 = field0_0, ..}" +LetE [ValD (VarP field0_2) (NormalB (LitE (IntegerL 3))) [],ValD (VarP field1_1) (NormalB (LitE (StringL "a"))) []] (RecConWildE Main.H [(Main.field0,VarE field0_2),(Main.field1,VarE field1_1)] 1) +"let {field0_0 = 3; field1_1 = \"a\"}\n in Main.H{Main.field0 = field0_0, ..}" ===================================== testsuite/tests/th/all.T ===================================== @@ -637,3 +637,4 @@ test('T25083', [extra_files(['T25083_A.hs', 'T25083_B.hs'])], multimod_compile_a test('T25174', normal, compile, ['']) test('T25179', normal, compile, ['']) test('FunNameTH', normal, compile, ['']) +test('T24537', normal, compile_and_run, ['-v0 -ddump-splices -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7411211a90559d864b62cf0f2951940… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7411211a90559d864b62cf0f2951940… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/aidylns/RecConWildE] RecConWildE
by Adriaan Leijnse (＠aidylns) 09 Jun '25

09 Jun '25

Adriaan Leijnse pushed to branch wip/aidylns/RecConWildE at Glasgow Haskell Compiler / GHC Commits: cd6d8aae by Adriaan Leijnse at 2025-06-09T14:37:50+02:00 RecConWildE - - - - - 8 changed files: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/ThToHs.hs - libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs - libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs - libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs - + testsuite/tests/th/T24537.stdout - testsuite/tests/th/all.T Changes: ===================================== compiler/GHC/Builtin/Names/TH.hs ===================================== @@ -60,7 +60,7 @@ templateHaskellNames = [ lamCasesEName, tupEName, unboxedTupEName, unboxedSumEName, condEName, multiIfEName, letEName, caseEName, doEName, mdoEName, compEName, fromEName, fromThenEName, fromToEName, fromThenToEName, - listEName, sigEName, recConEName, recUpdEName, staticEName, unboundVarEName, + listEName, sigEName, recConEName, recConWildEName, recUpdEName, staticEName, unboundVarEName, labelEName, implicitParamVarEName, getFieldEName, projectionEName, typeEName, forallEName, forallVisEName, constrainedEName, -- FieldExp @@ -347,10 +347,11 @@ fromThenEName = libFun (fsLit "fromThenE") fromThenEIdKey fromToEName = libFun (fsLit "fromToE") fromToEIdKey fromThenToEName = libFun (fsLit "fromThenToE") fromThenToEIdKey -- end ArithSeq -listEName, sigEName, recConEName, recUpdEName :: Name +listEName, sigEName, recConEName, recConWildEName, recUpdEName :: Name listEName = libFun (fsLit "listE") listEIdKey sigEName = libFun (fsLit "sigE") sigEIdKey recConEName = libFun (fsLit "recConE") recConEIdKey +recConWildEName = libFun (fsLit "recConWildE") recConWildEIdKey recUpdEName = libFun (fsLit "recUpdE") recUpdEIdKey staticEName = libFun (fsLit "staticE") staticEIdKey unboundVarEName = libFun (fsLit "unboundVarE") unboundVarEIdKey @@ -892,7 +893,7 @@ varEIdKey, conEIdKey, litEIdKey, appEIdKey, appTypeEIdKey, infixEIdKey, fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey, listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey, staticEIdKey, unboundVarEIdKey, labelEIdKey, implicitParamVarEIdKey, mdoEIdKey, - getFieldEIdKey, projectionEIdKey, typeEIdKey, forallEIdKey, + getFieldEIdKey, projectionEIdKey, typeEIdKey, recConWildEIdKey, forallEIdKey, forallVisEIdKey, constrainedEIdKey :: Unique varEIdKey = mkPreludeMiscIdUnique 270 conEIdKey = mkPreludeMiscIdUnique 271 @@ -934,6 +935,7 @@ typeEIdKey = mkPreludeMiscIdUnique 306 forallEIdKey = mkPreludeMiscIdUnique 802 forallVisEIdKey = mkPreludeMiscIdUnique 803 constrainedEIdKey = mkPreludeMiscIdUnique 804 +recConWildEIdKey = mkPreludeMiscIdUnique 805 -- type FieldExp = ... fieldExpIdKey :: Unique ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1666,7 +1666,7 @@ repE (ExplicitSum _ alt arity e) repE (RecordCon { rcon_con = c, rcon_flds = flds }) = do { x <- lookupWithUserRdrLOcc c; fs <- repFields flds; - repRecCon x fs } + repRecCon x fs $ fmap (\(L _ (RecFieldsDotDot n)) -> n) $ rec_dotdot flds } repE (RecordUpd { rupd_expr = e, rupd_flds = RegularRecUpdFields { recUpdFields = flds } }) = do { x <- repLE e; fs <- repUpdFields flds; @@ -1833,7 +1833,7 @@ repLGRHS (L _ (GRHS _ ss rhs)) ; return (gs, guarded) } repFields :: HsRecordBinds GhcRn -> MetaM (Core [M TH.FieldExp]) -repFields (HsRecFields { rec_flds = flds }) +repFields (HsRecFields { rec_flds = flds }) -- The select on field names here caused a bug in TH after rec_dotdot was added. = repListM fieldExpTyConName rep_fld flds where rep_fld :: LHsRecField GhcRn (LHsExpr GhcRn) @@ -2580,8 +2580,14 @@ repListExp (MkC es) = rep2 listEName [es] repSigExp :: Core (M TH.Exp) -> Core (M TH.Type) -> MetaM (Core (M TH.Exp)) repSigExp (MkC e) (MkC t) = rep2 sigEName [e,t] -repRecCon :: Core TH.Name -> Core [M TH.FieldExp]-> MetaM (Core (M TH.Exp)) -repRecCon (MkC c) (MkC fs) = rep2 recConEName [c,fs] +repRecCon :: Core TH.Name -> Core [M TH.FieldExp] -> Maybe Int -> MetaM (Core (M TH.Exp)) +repRecCon (MkC c) (MkC fs) hasWildCard = + case hasWildCard of + { Nothing -> rep2 recConEName [c,fs] + ; Just n -> do + MkC n' <- coreIntLit n + rep2 recConWildEName [c,fs,n'] + } repRecUpd :: Core (M TH.Exp) -> Core [M TH.FieldExp] -> MetaM (Core (M TH.Exp)) repRecUpd (MkC e) (MkC fs) = rep2 recUpdEName [e,fs] ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -1180,9 +1180,8 @@ cvtl e = wrapLA (cvt e) cvt (SigE e t) = do { e' <- cvtl e; t' <- cvtSigType t ; let pe = parenthesizeHsExpr sigPrec e' ; return $ ExprWithTySig noAnn pe (mkHsWildCardBndrs t') } - cvt (RecConE c flds) = do { c' <- cNameN c - ; flds' <- mapM (cvtFld (wrapParLA mkFieldOcc)) flds - ; return $ mkRdrRecordCon c' (HsRecFields noExtField flds' Nothing) noAnn } + cvt (RecConE c flds) = thToHsRecCon c flds Nothing + cvt (RecConWildE c flds n) = thToHsRecCon c flds (Just (L noAnn (RecFieldsDotDot n))) cvt (RecUpdE e flds) = do { e' <- cvtl e ; flds' <- mapM (cvtFld (wrapParLA mkFieldOcc)) @@ -1226,6 +1225,11 @@ cvtl e = wrapLA (cvt e) mkHsForAllVisTele noAnn tvs' ; return $ HsForAll noExtField tele body' } +thToHsRecCon c flds maybeDotDot = do + { c' <- cNameN c + ; flds' <- mapM (cvtFld (wrapParLA mkFieldOcc)) flds + ; return $ mkRdrRecordCon c' (HsRecFields noExtField flds' maybeDotDot) noAnn } + {- | #16895 Ensure an infix expression's operator is a variable/constructor. Consider this example: ===================================== libraries/ghc-boot-th/GHC/Boot/TH/Ppr.hs ===================================== @@ -231,8 +231,9 @@ pprExp _ (ArithSeqE d) = ppr d pprExp _ (ListE es) = brackets (commaSep es) pprExp i (SigE e t) = parensIf (i > noPrec) $ pprExp sigPrec e <+> dcolon <+> pprType sigPrec t -pprExp _ (RecConE nm fs) = pprName' Applied nm <> braces (pprFields fs) -pprExp _ (RecUpdE e fs) = pprExp appPrec e <> braces (pprFields fs) +pprExp _ (RecConE nm fs) = pprName' Applied nm <> braces (pprFields Nothing fs) +pprExp _ (RecConWildE nm fs n) = pprName' Applied nm <> braces (pprFields (Just n) fs) +pprExp _ (RecUpdE e fs) = pprExp appPrec e <> braces (pprFields Nothing fs) -- FIXME: this can also have dots in surface syntax pprExp i (StaticE e) = parensIf (i >= appPrec) $ text "static"<+> pprExp appPrec e pprExp _ (UnboundVarE v) = pprName' Applied v @@ -250,8 +251,16 @@ pprExp i (ForallE tvars body) = pprExp i (ConstrainedE ctx body) = parensIf (i >= funPrec) $ sep [pprCtxWith pprExp ctx, pprExp qualPrec body] -pprFields :: [(Name,Exp)] -> Doc -pprFields = sep . punctuate comma . map (\(s,e) -> pprName' Applied s <+> equals <+> ppr e) +-- See Note [DotDot fields] in Language.Haskell.Syntax.Pat. +pprFields :: Maybe Int -> [(Name,Exp)] -> Doc +pprFields dotdot fs = + sep + . punctuate comma + . (case dotdot of + Nothing -> id + Just n -> (`mappend` [text ".."]) . take n) + . map (\(s,e) -> pprName' Applied s <+> equals <+> ppr e) + $ fs pprMaybeExp :: Precedence -> Maybe Exp -> Doc pprMaybeExp _ Nothing = empty ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs ===================================== @@ -378,6 +378,9 @@ sigE e t = do { e1 <- e; t1 <- t; pure (SigE e1 t1) } recConE :: Quote m => Name -> [m (Name,Exp)] -> m Exp recConE c fs = do { flds <- sequenceA fs; pure (RecConE c flds) } +recConWildE :: Quote m => Name -> [m (Name,Exp)] -> Int -> m Exp +recConWildE c fs n = do { flds <- sequenceA fs; pure (RecConWildE c flds n) } + recUpdE :: Quote m => m Exp -> [m (Name,Exp)] -> m Exp recUpdE e fs = do { e1 <- e; flds <- sequenceA fs; pure (RecUpdE e1 flds) } ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs ===================================== @@ -1885,6 +1885,11 @@ data Exp | ListE [ Exp ] -- ^ @{ [1,2,3] }@ | SigE Exp Type -- ^ @{ e :: t }@ | RecConE Name [FieldExp] -- ^ @{ T { x = y, z = w } }@ + -- Record constructor without a wild card. + | RecConWildE Name [FieldExp] Int -- ^ @{ T { x = y, z = w, ... } }@ + -- I.e. like `RecConE` but with a wild card. + -- See Note [DotDot fields] in Language.Haskell.Syntax.Pat + -- for the meaning of the Int parameter. | RecUpdE Exp [FieldExp] -- ^ @{ (f x) { z = w } }@ | StaticE Exp -- ^ @{ static e }@ | UnboundVarE Name -- ^ @{ _x }@ ===================================== testsuite/tests/th/T24537.stdout ===================================== @@ -0,0 +1,4 @@ +LetE [ValD (VarP field0_0) (NormalB (LitE (IntegerL 3))) []] (RecConWildE Main.H [(Main.field0,VarE field0_0)] 1) +"let field0_0 = 3\n in Main.H{Main.field0 = field0_0, ..}" +LetE [ValD (VarP field0_2) (NormalB (LitE (IntegerL 3))) [],ValD (VarP field1_1) (NormalB (LitE (StringL "a"))) []] (RecConWildE Main.H [(Main.field0,VarE field0_2),(Main.field1,VarE field1_1)] 1) +"let {field0_0 = 3; field1_1 = \"a\"}\n in Main.H{Main.field0 = field0_0, ..}" ===================================== testsuite/tests/th/all.T ===================================== @@ -637,3 +637,4 @@ test('T25083', [extra_files(['T25083_A.hs', 'T25083_B.hs'])], multimod_compile_a test('T25174', normal, compile, ['']) test('T25179', normal, compile, ['']) test('FunNameTH', normal, compile, ['']) +test('T24537', normal, compile_and_run, ['-v0 -ddump-splices -dsuppress-uniques']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd6d8aae6cf0532e1954261aba371ff… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd6d8aae6cf0532e1954261aba371ff… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/aidylns/RecConWildE
by Adriaan Leijnse (＠aidylns) 09 Jun '25

09 Jun '25

Adriaan Leijnse pushed new branch wip/aidylns/RecConWildE at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/aidylns/RecConWildE You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: haddock: Parse math even after ordinary characters
by Marge Bot (＠marge-bot) 09 Jun '25

09 Jun '25

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6558467c by Ryan Hendrickson at 2025-06-06T05:46:58-04:00 haddock: Parse math even after ordinary characters Fixes a bug where math sections were not recognized if preceded by a character that isn't special (like space or a markup character). - - - - - 265d0024 by ARATA Mizuki at 2025-06-06T05:47:48-04:00 AArch64 NCG: Fix sub-word arithmetic right shift As noted in Note [Signed arithmetic on AArch64], we should zero-extend sub-word values. Fixes #26061 - - - - - 05e9be18 by Simon Hengel at 2025-06-06T05:48:35-04:00 Allow Unicode in "message" and "hints" with -fdiagnostics-as-json (fixes #26075) - - - - - bfa6b70f by ARATA Mizuki at 2025-06-06T05:49:24-04:00 x86 NCG: Fix code generation of bswap64 on i386 Co-authored-by: sheaf <sam.derbyshire(a)gmail.com> Fix #25601 - - - - - 35826d8b by Matthew Pickering at 2025-06-08T22:00:41+01:00 Hadrian: Add option to generate .hie files for stage1 libraries The +hie_files flavour transformer can be enabled to produce hie files for stage1 libraries. The hie files are produced in the "extra-compilation-artifacts" folder and copied into the resulting bindist. At the moment the hie files are not produced for the release flavour, they add about 170M to the final bindist. Towards #16901 - - - - - 70cdcb7b by Ryan Hendrickson at 2025-06-09T08:16:00-04:00 Fix various failures to -fprint-unicode-syntax - - - - - 36 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Types/Error.hs - hadrian/doc/flavours.md - hadrian/doc/user-settings.md - hadrian/src/Context.hs - hadrian/src/Context/Path.hs - hadrian/src/Flavour.hs - hadrian/src/Flavour/Type.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Flavours/Release.hs - + testsuite/tests/cmm/should_run/T25601.hs - + testsuite/tests/cmm/should_run/T25601.stdout - + testsuite/tests/cmm/should_run/T25601a.cmm - testsuite/tests/cmm/should_run/all.T - + testsuite/tests/codeGen/should_run/T26061.hs - + testsuite/tests/codeGen/should_run/T26061.stdout - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/driver/json.stderr - testsuite/tests/driver/json_warn.stderr - testsuite/tests/ghci/scripts/T12550.stdout - testsuite/tests/ghci/scripts/T8959b.stderr - testsuite/tests/ghci/scripts/all.T - + testsuite/tests/ghci/scripts/print-unicode-syntax.script - + testsuite/tests/ghci/scripts/print-unicode-syntax.stderr - + testsuite/tests/ghci/scripts/print-unicode-syntax.stdout - testsuite/tests/ghci/should_run/T11825.stdout - utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs - utils/haddock/haddock-library/test/Documentation/Haddock/ParserSpec.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eec6dd1bca51e5cec11a1f2f740dfb… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eec6dd1bca51e5cec11a1f2f740dfb… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26107] Fix EPT enforcement when mixing unboxed tuples and non-tuples
by Krzysztof Gogolewski (＠monoidal) 09 Jun '25

09 Jun '25

Krzysztof Gogolewski pushed to branch wip/T26107 at Glasgow Haskell Compiler / GHC Commits: 4187c2e3 by Krzysztof Gogolewski at 2025-06-09T13:00:25+02:00 Fix EPT enforcement when mixing unboxed tuples and non-tuples The code was assuming that an alternative cannot be returning a normal datacon and an unboxed tuple at the same time. However, as seen in #26107, this can happen when using a GADT to refine the representation type. The solution is just to conservatively return TagDunno. - - - - - 3 changed files: - compiler/GHC/Stg/EnforceEpt/Types.hs - + testsuite/tests/rep-poly/T26107.hs - testsuite/tests/rep-poly/all.T Changes: ===================================== compiler/GHC/Stg/EnforceEpt/Types.hs ===================================== @@ -39,8 +39,8 @@ type InferStgAlt = GenStgAlt 'InferTaggedBinders combineAltInfo :: TagInfo -> TagInfo -> TagInfo combineAltInfo TagDunno _ = TagDunno combineAltInfo _ TagDunno = TagDunno -combineAltInfo (TagTuple {}) TagProper = panic "Combining unboxed tuple with non-tuple result" -combineAltInfo TagProper (TagTuple {}) = panic "Combining unboxed tuple with non-tuple result" +combineAltInfo (TagTuple {}) TagProper = TagDunno -- This can happen with rep-polymorphic result, see #26107 +combineAltInfo TagProper (TagTuple {}) = TagDunno -- This can happen with rep-polymorphic result, see #26107 combineAltInfo TagProper TagProper = TagProper combineAltInfo (TagTuple is1) (TagTuple is2) = TagTuple (zipWithEqual combineAltInfo is1 is2) combineAltInfo (TagTagged) ti = ti ===================================== testsuite/tests/rep-poly/T26107.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE GADTs, UnboxedTuples #-} +module T26107 where + +import Data.Kind +import GHC.Exts + +type T :: TYPE rep -> Type +data T a where + A :: T Bool + B :: T (# #) + +f :: forall rep (a :: TYPE rep). T a -> a +f A = True +f B = (# #) ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -41,6 +41,7 @@ test('T23883a', normal, compile_fail, ['']) test('T23883b', normal, compile_fail, ['']) test('T23883c', normal, compile_fail, ['']) test('T23903', normal, compile_fail, ['']) +test('T26107', normal, compile, ['-O']) test('EtaExpandDataCon', normal, compile, ['-O']) test('EtaExpandStupid1', normal, compile, ['-Wno-deprecated-flags']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4187c2e389759c1b1393e8d24d68f7d… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4187c2e389759c1b1393e8d24d68f7d… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/T26107
by Krzysztof Gogolewski (＠monoidal) 09 Jun '25

09 Jun '25

Krzysztof Gogolewski pushed new branch wip/T26107 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T26107 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/amg/castz] WIP: introduce cast zapping as an alternative to coercion zapping
by Adam Gundry (＠adamgundry) 09 Jun '25

09 Jun '25

Adam Gundry pushed to branch wip/amg/castz at Glasgow Haskell Compiler / GHC Commits: c1cfc9c4 by Adam Gundry at 2025-06-09T12:09:38+02:00 WIP: introduce cast zapping as an alternative to coercion zapping - - - - - 51 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/LateCC/OverloadedCalls.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Seq.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Stats.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Ppr.hs - compiler/GHC/Core/TyCo/Ppr.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Foreign/Prim.hs - compiler/GHC/HsToCore/Foreign/Wasm.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/Types/EvTerm.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Id/Make.hs - docs/core-spec/CoreLint.ott - docs/core-spec/CoreSyn.ott - docs/core-spec/OpSem.ott The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1cfc9c438a263d8ee536675e41440c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1cfc9c438a263d8ee536675e41440c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/wasm-bytearray-marshall] wasm: Add JSUint8Array to ByteArray conversion functions
by Matthew Pickering (＠mpickering) 09 Jun '25

09 Jun '25

Matthew Pickering pushed to branch wip/wasm-bytearray-marshall at Glasgow Haskell Compiler / GHC Commits: 96d12714 by Matthew Pickering at 2025-06-09T09:58:59+01:00 wasm: Add JSUint8Array to ByteArray conversion functions With these functions you can more directly pass ByteArray#-like objects to functions compiled using the wasm backend. For example, a foreign export can expect a JSUint8Array ``` foreign export javascript "hs_round" roundTrip :: JSUint8Array -> JSUint8Array ``` and then the function can be called from javascript and passed a Uint8Array. ``` var uint8Array = new Uint8Array(arrayBuffer); wasi.instance.exports.hs_round(uint8Array); ``` - - - - - 3 changed files: - libraries/ghc-experimental/ghc-experimental.cabal.in - + libraries/ghc-experimental/src/GHC/Wasm/Uint8Array.hs - testsuite/tests/jsffi/textconv.hs Changes: ===================================== libraries/ghc-experimental/ghc-experimental.cabal.in ===================================== @@ -40,6 +40,7 @@ library Prelude.Experimental if arch(wasm32) exposed-modules: GHC.Wasm.Prim + GHC.Wasm.Uint8Array other-extensions: build-depends: base >=4.20 && < 4.22, ghc-internal == @ProjectVersionForLib@.* ===================================== libraries/ghc-experimental/src/GHC/Wasm/Uint8Array.hs ===================================== @@ -0,0 +1,48 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +-- | Utilities to marshall a javascript 'Uint8Array' to a 'ByteArray' +module GHC.Wasm.Uint8Array + ( toJSUint8Array, fromJSUint8Array, JSUint8Array(..), byteLength + ) where + +import Data.Array.Byte +import GHC.Wasm.Prim +import GHC.Ptr +import GHC.Exts +import System.IO.Unsafe +import GHC.IO + +newtype JSUint8Array = JSUint8Array { unJSUint8Array :: JSVal } + +foreign import javascript unsafe + "$1.byteLength" + byteLength :: JSUint8Array -> Int + +withByteArrayContents :: ByteArray -> (Ptr () -> Int -> IO a) -> IO a +withByteArrayContents (ByteArray arr#) f = IO $ \s0 -> + keepAlive# arr# s0 (unIO $ f (Ptr (byteArrayContents# arr#)) (I# (sizeofByteArray# arr#) )) + +fromJSUint8ArrayLen :: Int -> JSUint8Array -> ByteArray +fromJSUint8ArrayLen (I# len) arr = unsafePerformIO $ IO $ + \s -> case newByteArray# len s of + (# s', mb #) -> + let a = mutableByteArrayContents# mb + in case unIO (memorySetUint8Array (Ptr a) (I# len) arr) s' of + (# s'', () #) -> case unsafeFreezeByteArray# mb s'' of + (# s''', arr' #) -> (# s''', ByteArray arr' #) + +toJSUint8Array :: ByteArray -> JSUint8Array +toJSUint8Array ba = + unsafePerformIO $ withByteArrayContents ba uint8ArrayFromMemory + +fromJSUint8Array :: JSUint8Array -> ByteArray +fromJSUint8Array src_buf = fromJSUint8ArrayLen (byteLength src_buf) src_buf + +foreign import javascript unsafe + "(new Uint8Array(__exports.memory.buffer, $1, $2)).set($3)" + memorySetUint8Array :: Ptr a -> Int -> JSUint8Array -> IO () + +foreign import javascript unsafe + "new Uint8Array(new Uint8Array(__exports.memory.buffer, $1, $2))" + uint8ArrayFromMemory :: Ptr a -> Int -> IO JSUint8Array + ===================================== testsuite/tests/jsffi/textconv.hs ===================================== @@ -14,36 +14,24 @@ import qualified Data.Text.IO.Utf8 as T import GHC.Exts import GHC.IO import GHC.Wasm.Prim - -newtype JSUint8Array = JSUint8Array JSVal +import GHC.Wasm.Uint8Array foreign import javascript unsafe "(new TextEncoder()).encode($1)" - js_str_encode :: JSString -> IO JSUint8Array - -foreign import javascript unsafe "$1.byteLength" - js_buf_len :: JSUint8Array -> IO Int - -foreign import javascript unsafe "(new Uint8Array(__exports.memory.buffer, $2, $1.byteLength)).set($1)" - js_from_buf :: JSUint8Array -> Ptr a -> IO () + js_str_encode :: JSString -> JSUint8Array -foreign import javascript unsafe "(new TextDecoder('utf-8', {fatal: true})).decode(new Uint8Array(__exports.memory.buffer, $1, $2))" - js_to_str :: Ptr a -> Int -> IO JSString +foreign import javascript unsafe "(new TextDecoder('utf-8', {fatal: true})).decode($1)" + js_to_str :: JSUint8Array -> JSString textFromJSString :: JSString -> Text -textFromJSString str = unsafeDupablePerformIO $ do - buf <- js_str_encode str - I# len# <- js_buf_len buf - IO $ \s0 -> case newByteArray# len# s0 of - (# s1, mba# #) -> case unIO (js_from_buf buf (Ptr (mutableByteArrayContents# mba#))) s1 of - (# s2, _ #) -> case unIO (freeJSVal (coerce buf)) s2 of - (# s3, _ #) -> case unsafeFreezeByteArray# mba# s3 of - (# s4, ba# #) -> (# s4, Text (ByteArray ba#) 0 (I# len#) #) +textFromJSString str = + let buf = js_str_encode str + in Text (fromJSUint8Array buf) 0 (byteLength buf) +-- NOTE: Do not copy this into your program, you need to take into account the +-- offset to do this converson properly textToJSString :: Text -> JSString -textToJSString (Text (ByteArray ba#) (I# off#) (I# len#)) = unsafeDupablePerformIO $ - IO $ \s0 -> case newPinnedByteArray# len# s0 of - (# s1, mba# #) -> case copyByteArray# ba# off# mba# 0# len# s1 of - s2 -> keepAlive# mba# s2 $ unIO $ js_to_str (Ptr (mutableByteArrayContents# mba#)) $ I# len# +textToJSString (Text ba 0 len) = js_to_str (toJSUint8Array ba) +textToJSString _ = error "non-zero offset not supported" foreign export javascript "main sync" main :: IO () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/96d12714484b1d93b564fc046f0e1a2… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/96d12714484b1d93b564fc046f0e1a2… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/libffi-3.5.0
by Cheng Shao (＠TerrorJack) 09 Jun '25

09 Jun '25

Cheng Shao pushed new branch wip/libffi-3.5.0 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/libffi-3.5.0 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/amg/castz] WIP: switch from CastZ to Cast + CastCoercion
by Adam Gundry (＠adamgundry) 09 Jun '25

09 Jun '25

Adam Gundry pushed to branch wip/amg/castz at Glasgow Haskell Compiler / GHC Commits: dcd2ea0e by Adam Gundry at 2025-06-09T08:50:31+02:00 WIP: switch from CastZ to Cast + CastCoercion - - - - - 64 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/LateCC/OverloadedCalls.hs - compiler/GHC/Core/LateCC/TopLevelBinds.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/CallArity.hs - compiler/GHC/Core/Opt/CallerCC.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/CprAnal.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/LiberateCase.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/StaticArgs.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/Seq.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Stats.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Ppr.hs - compiler/GHC/Core/TyCo/Ppr.hs-boot - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Rep.hs-boot - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Foreign/Prim.hs - compiler/GHC/HsToCore/Foreign/Wasm.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/Types/EvTerm.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Id/Make.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dcd2ea0e7965d6bfd6ebf49822896ee… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dcd2ea0e7965d6bfd6ebf49822896ee… You're receiving this email because of your account on gitlab.haskell.org.

1 0