Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c673ecf0 by Simon Peyton Jones at 2026-09-05T07:22:59-04:00 Move HsStatic free-var test to typechecker A `static` form should have no free *term* variables, but it can have free *type* variables. Alas, the renamer does not really know what is a term variable and what is a type variable, because of required type arguments. This patch moves the test to the typechecker, which does know. Addresses #27664 - - - - - 9 changed files: - + changelog.d/T27764 - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - testsuite/tests/rename/should_fail/RnStaticPointersFail01.stderr - testsuite/tests/rename/should_fail/RnStaticPointersFail03.stderr - testsuite/tests/rename/should_fail/T26545.stderr - + testsuite/tests/typecheck/should_compile/T27664.hs - testsuite/tests/typecheck/should_compile/all.T Changes: ===================================== changelog.d/T27764 ===================================== @@ -0,0 +1,8 @@ +section: compiler +synopsis: Fix bug in ``static`` forms +issues: #27664 +mrs: !16624 +description: A ``static`` form should have no free *term* variables, but it + can have free *type* variables. Alas, the renamer does not really know what + is a term variable and what is a type variable, because of required type + arguments. This patch moves the test to the typechecker, which does know. ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -39,6 +39,7 @@ import GHC.Tc.Types.ErrCtxt import GHC.Types.Id.Info ( RecSelParent ) import GHC.Types.Name import GHC.Types.Name.Reader +import GHC.Types.Name.Set( FreeNames ) import GHC.Types.Basic import GHC.Types.Fixity import GHC.Types.SourceText @@ -363,7 +364,9 @@ type instance XArithSeq GhcTc = PostTcExpr type instance XProc (GhcPass _) = (EpToken "proc", TokRarrow) type instance XStatic GhcPs = EpToken "static" -type instance XStatic GhcRn = NoExtField +type instance XStatic GhcRn = FreeNames + -- Free variables of the body; we can't tell if they are + -- type or term variables until we are typechecking type instance XStatic GhcTc = (Type, HsExpr GhcTc) -- Type of expression, and the (fromStaticPtr function) -- These are stored for convenience as the wiring in ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -667,18 +667,7 @@ rnExpr e@(HsStatic _ expr) -- Rename the payload ; (expr',fvs) <- rnLExpr expr - -- Check that the free variables of the static form are top-level defined - -- It's OK to use nonDetEltsUniqSet here as the only side effects of - -- checkClosedInStaticForm are error messages. - -- See (SF2) Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable - ; mapM_ check_fv (nonDetEltsUniqSet fvs) - - ; return (HsStatic noExtField expr', fvs) } - where - check_fv :: Name -> RnM () - -- Check for free vars not defined at top level - check_fv n = unless (isExternalName n) $ - addErrTc (TcRnStaticFormNotClosed n) + ; return (HsStatic fvs expr', fvs) } {- ************************************************************************ ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -602,13 +602,19 @@ tcExpr (HsProc x pat cmd) res_ty -- and wrap (static e) in a call to -- fromStaticPtr :: IsStatic p => StaticPtr a -> p a -tcExpr (HsStatic _ expr) res_ty +tcExpr (HsStatic free_names expr) res_ty = do { res_ty <- expTypeToType res_ty ; (co, (p_ty, expr_ty)) <- matchExpectedAppTy res_ty ; (expr', lie) <- captureConstraints $ addErrCtxt (StaticFormCtxt expr) $ tcCheckPolyExprNC expr expr_ty + -- Check that the free variables of the static form are top-level defined + -- It's OK to use nonDetEltsUniqSet here as the only side effects of + -- checkClosedInStaticForm are error messages. + -- See (SF2) Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable + ; mapM_ check_free_name (nonDetEltsUniqSet free_names) + -- Emit an implication that captures the constraints of `expr`, -- but with a `ic_info` of StaticFormSkol -- See #13499 for an explanation of why this is the right thing to do: @@ -637,6 +643,24 @@ tcExpr (HsStatic _ expr) res_ty HsStatic (static_expr_ty, mkHsWrap wrap fromStaticPtr) expr'' } + where + check_free_name :: Name -> TcM () + -- Check for free /term/ vars not defined at top level + -- We use isExternalName as a proxy for top-level-defined + check_free_name n + = do { mb_thing <- tcLookupLcl_maybe n + ; case mb_thing of + Nothing -> return () -- Imports, tycons, classes allowed + Just (ATcId {}) -> unless (isExternalName n) $ + addErrTc (TcRnStaticFormNotClosed n) + + Just (ATyVar {}) -> return () -- Free type variables are allowed + + -- Not really expecting these, but we'll get an error from + -- elsewhere, so don't produce an error here + Just (ATcTyCon {}) -> return () + Just (APromotionErr {}) -> return () + Just (AGlobal {}) -> return () } tcExpr (HsEmbTy _ _) _ = failWith (TcRnIllegalTypeExpr TypeKeywordSyntax) tcExpr (HsQual _ _ _) _ = failWith (TcRnIllegalTypeExpr ContextArrowSyntax) ===================================== testsuite/tests/rename/should_fail/RnStaticPointersFail01.stderr ===================================== @@ -1,3 +1,5 @@ RnStaticPointersFail01.hs:5:7: error: [GHC-88431] - ‘x’ is used in a static form but it is not defined at top level + • ‘x’ is used in a static form but it is not defined at top level + • In the expression: static x + In an equation for ‘f’: f x = static x ===================================== testsuite/tests/rename/should_fail/RnStaticPointersFail03.stderr ===================================== @@ -1,12 +1,34 @@ RnStaticPointersFail03.hs:8:7: error: [GHC-88431] - ‘x’ is used in a static form but it is not defined at top level + • ‘x’ is used in a static form but it is not defined at top level + • In the expression: static (x . id) + In an equation for ‘f’: f x = static (x . id) RnStaticPointersFail03.hs:10:8: error: [GHC-88431] - ‘k’ is used in a static form but it is not defined at top level + • ‘k’ is used in a static form but it is not defined at top level + • In the expression: static (k . id) + In an equation for ‘f0’: + f0 x + = static (k . id) + where + k = const (const () x) RnStaticPointersFail03.hs:14:8: error: [GHC-88431] - ‘k’ is used in a static form but it is not defined at top level + • ‘k’ is used in a static form but it is not defined at top level + • In the expression: static (k . id) + In an equation for ‘f1’: + f1 x + = static (k . id) + where + k = id RnStaticPointersFail03.hs:19:15: error: [GHC-88431] - ‘g’ is used in a static form but it is not defined at top level + • ‘g’ is used in a static form but it is not defined at top level + • In the first argument of ‘const’, namely ‘(static (g undefined))’ + In the expression: const (static (g undefined)) (h x) + In an equation for ‘f2’: + f2 x + = const (static (g undefined)) (h x) + where + g = h + h = typeOf ===================================== testsuite/tests/rename/should_fail/T26545.stderr ===================================== @@ -1,3 +1,6 @@ T26545.hs:12:23: error: [GHC-88431] - ‘v’ is used in a static form but it is not defined at top level + • ‘v’ is used in a static form but it is not defined at top level + • In the expression: static (I# (v +# 1#)) + In the expression: let v = f 3# in static (I# (v +# 1#)) + In an equation for ‘h’: h x = let v = f 3# in static (I# (v +# 1#)) ===================================== testsuite/tests/typecheck/should_compile/T27664.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE StaticPointers, ScopedTypeVariables #-} +module Repro where + +import Data.Typeable +import GHC.StaticPtr + +f1 :: forall a. Typeable a => StaticPtr (a -> a) +f1 = static (id :: a -> a) + +f2 :: forall a. Typeable a => StaticPtr (a -> a) +f2 = static (id) :: StaticPtr (a->a) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -969,3 +969,4 @@ test('ExpansionQLIm', normal, compile, ['']) test('T23135', normal, compile, ['']) test('LazyFieldAnnotations', normal, compile, ['']) test('T27557', normal, compile, ['']) +test('T27664', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c673ecf057deee858acbbaa7e6c92078... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c673ecf057deee858acbbaa7e6c92078... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help