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

Commits:

11 changed files:

Changes:

  • compiler/GHC/Rename/HsType.hs
    1 1 
     {-# LANGUAGE TypeFamilies        #-}
    2 
    +{-# LANGUAGE MultiWayIf          #-}
    2 3
    3 4 
     {-
    4 5 
     (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
    ... ... @@ -42,7 +43,7 @@ module GHC.Rename.HsType (
    42 43
    43 44 
     import GHC.Prelude
    44 45
    45 
    -import {-# SOURCE #-} GHC.Rename.Splice( rnSpliceType, checkThLocalTyName )
    46 
    +import {-# SOURCE #-} GHC.Rename.Splice( rnSpliceType, checkThLocalTyName, checkThLocalNameNoLift )
    46 47
    47 48 
     import GHC.Core.TyCo.FVs ( tyCoVarsOfTypeList )
    48 49 
     import GHC.Core.TyCon    ( isKindName )
    ... ... @@ -537,10 +538,18 @@ rnHsTyKi env tv@(HsTyVar _ ip (L loc rdr_name))
    537 538 
                -- of PolyKinds (see #14710)
    538 539 
            ; name <- rnTyVar env rdr_name
    539 540 
            ; this_mod <- getModule
    540 
    -       ; when (nameIsLocalOrFrom this_mod name) $
    541 
    -         checkThLocalTyName name
    541 
    +       ; explicit_level_imports <- xoptM LangExt.ExplicitLevelImports
    542 
    +       ; let loc_name_with_rdr = L loc $ WithUserRdr rdr_name name
    543 
    +       ; if  | explicit_level_imports
    544 
    +             -- See Note [Strict level checks with ExplicitLevelImports]
    545 
    +             -> checkThLocalNameNoLift loc_name_with_rdr
    546 
    +
    547 
    +             | nameIsLocalOrFrom this_mod name
    548 
    +             -> checkThLocalTyName name
    549 
    +
    550 
    +             | otherwise -> pure ()
    542 551 
            ; checkPromotedDataConName env tv Prefix ip name
    543 
    -       ; return (HsTyVar noAnn ip (L loc $ WithUserRdr rdr_name name), unitFV name) }
    552 
    +       ; return (HsTyVar noAnn ip loc_name_with_rdr, unitFV name) }
    544 553
    545 554 
     rnHsTyKi env ty@(HsOpTy _ prom ty1 l_op ty2)
    546 555 
       = setSrcSpan (getLocA l_op) $
    ... ... @@ -685,6 +694,37 @@ rnHsTyLit tyLit@(HsNumTy x i) = do
    685 694 
       pure (HsNumTy x i)
    686 695 
     rnHsTyLit (HsCharTy x c) = pure (HsCharTy x c)
    687 696
    697 
    +{-
    698 
    +Note [Strict level checks with ExplicitLevelImports]
    699 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    700 
    +Since the proposed change specification of `ExplicitLevelImports` [1] talks about
    701 
    +all identifiers as if they were created equally in the context of TemplateHaskell,
    702 
    +we want to adhere to that specification and at the same time use this unique
    703 
    +chance of being able to guard the "correct" behaviour behind an extension, without
    704 
    +breaking too many users. That is why, if ExplicitLevelImports is on, we
    705 
    +- do not allow non-well-levelled types to be imported
    706 
    +- do not allow locally defined type names to be used in an ill-levelled way, more
    707 
    +  most importantly, we do not allow locally defined names to be used in quotes.
    708 
    +
    709 
    +When doing level checks, we historically have been glancing over some
    710 
    +not-well-levelled programs - e.g. the following program was historically
    711 
    +accepted from the perspective of the stage restriction:
    712 
    +
    713 
    +type T = ExpQ
    714 
    +x = $(_ :: T)
    715 
    +
    716 
    +However, when type-checking the splice `$(_ :: T)`, we found that `T`
    717 
    +had not yet been made part of the type-checking environment - we would
    718 
    +insert an ad-hoc check in `notFound` which would report the staging error.
    719 
    +
    720 
    +See Note [Out of scope might be a staging error]
    721 
    +
    722 
    +This is obviously not very rigorous - our "specification" of a program
    723 
    +being well-staged becomes "if the type checker needs the thing to be in scope
    724 
    +and it is not, the program is not well-staged, otherwise it is".
    725 
    +
    726 
    +[1]: https://github.com/ghc-proposals/ghc-proposals/blob/8e4d0e9340c04b904373f9dfe5cbcebc354cd01f/proposals/0682-explicit-level-imports.rst
    727 
    +-}
    688 728
    689 729 
     rnHsMultAnnWith :: (LocatedA (mult GhcPs) -> RnM (LocatedA (mult GhcRn), FreeVars))
    690 730 
                       -> HsMultAnnOf (LocatedA (mult GhcPs)) GhcPs

  • compiler/GHC/Rename/Splice.hs-boot
    ... ... @@ -16,3 +16,5 @@ rnSpliceDecl :: SpliceDecl GhcPs -> RnM (SpliceDecl GhcRn, FreeVars)
    16 16 
     rnTopSpliceDecls :: HsUntypedSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars)
    17 17
    18 18 
     checkThLocalTyName :: Name -> RnM ()
    19 
    +
    20 
    +checkThLocalNameNoLift :: LIdOccP GhcRn -> RnM ()

  • testsuite/tests/th/T26098A_quote.hs
    1 
    +module T26098A_quote where
    2 
    +
    3 
    +data T = MkT
    4 
    +

  • testsuite/tests/th/T26098A_splice.hs
    1 
    +module T26098A_splice where
    2 
    +
    3 
    +import Language.Haskell.TH
    4 
    +
    5 
    +data T = MkT
    6 
    +
    7 
    +type Foo = ExpQ

  • testsuite/tests/th/T26098_local.hs
    1 
    +{-# LANGUAGE ExplicitLevelImports #-}
    2 
    +module T26098_local where
    3 
    +
    4 
    +import Language.Haskell.TH
    5 
    +import Data.Char
    6 
    +import Data.Proxy
    7 
    +
    8 
    +tardy :: forall a. Proxy a -> IO Type
    9 
    +tardy _ = [t| a |]
    10 
    +
    11 
    +tardy2 :: forall a. Proxy a -> IO Exp
    12 
    +tardy2 _ = [| id @a |]
    13 
    +
    14 
    +tardy3 :: forall a. Proxy a -> Code IO (a -> a)
    15 
    +tardy3 _ = [|| id @a ||]
    16 
    +
    17 
    +main :: IO ()
    18 
    +main = do
    19 
    +    tardy (Proxy @Int) >>= putStrLn . filt . show
    20 
    +    tardy2 (Proxy @Int) >>= putStrLn . filt . show
    21 
    +    examineCode (tardy3 (Proxy @Int)) >>= putStrLn . filt . show . unType
    22 
    +
    23 
    +-- ad-hoc filter uniques, a_12313 -> a
    24 
    +filt :: String -> String
    25 
    +filt = go where
    26 
    +    go []           = []
    27 
    +    go ('_' : rest) = go (dropWhile isDigit rest)
    28 
    +    go (c:cs)       = c : go cs
    29 
    +
    30 
    +type T = ExpQ
    31 
    +
    32 
    +blup = $(3 :: T)

  • testsuite/tests/th/T26098_local.stderr
    1 
    +T26098_local.hs:9:15: error: [GHC-28914]
    2 
    +    • Level error: ‘a’ is bound at level 0 but used at level 1
    3 
    +    • In the Template Haskell quotation: [t| a |]
    4 
    +
    5 
    +T26098_local.hs:12:19: error: [GHC-28914]
    6 
    +    • Level error: ‘a’ is bound at level 0 but used at level 1
    7 
    +    • In the Template Haskell quotation: [| id @a |]
    8 
    +
    9 
    +T26098_local.hs:15:20: error: [GHC-28914]
    10 
    +    • Level error: ‘a’ is bound at level 0 but used at level 1
    11 
    +    • In the Template Haskell typed quotation: [|| id @a ||]
    12 
    +
    13 
    +T26098_local.hs:32:15: error: [GHC-28914]
    14 
    +    • Level error: ‘T’ is bound at level 0 but used at level -1
    15 
    +    • In the untyped splice: $(3 :: T)
    16 
    +

  • testsuite/tests/th/T26098_quote.hs
    1 
    +{-# LANGUAGE ExplicitLevelImports, DataKinds, TemplateHaskell #-}
    2 
    +module T26098_quote where
    3 
    +
    4 
    +import splice T26098A_quote
    5 
    +import T26098A_quote
    6 
    +import Language.Haskell.TH
    7 
    +
    8 
    +c :: Q Type
    9 
    +c = [t|T|]
    10 
    +
    11 
    +d :: Q Type
    12 
    +d = [t|'MkT|]

  • testsuite/tests/th/T26098_quote.stderr
    1 
    +T26098_quote.hs:9:8: error: [GHC-28914]
    2 
    +    • Level error: ‘T’ is bound at levels {-1, 0} but used at level 1
    3 
    +    • Available from the imports:
    4 
    +      • imported from ‘T26098A_quote’ at T26098_quote.hs:5:1-20
    5 
    +      • imported from ‘T26098A_quote’ at -1 at T26098_quote.hs:4:1-27
    6 
    +    • In the Template Haskell quotation: [t| T |]
    7 
    +
    8 
    +T26098_quote.hs:12:8: error: [GHC-28914]
    9 
    +    • Level error: ‘MkT’ is bound at levels {-1, 0} but used at level 1
    10 
    +    • Available from the imports:
    11 
    +      • imported from ‘T26098A_quote’ at T26098_quote.hs:5:1-20
    12 
    +      • imported from ‘T26098A_quote’ at -1 at T26098_quote.hs:4:1-27
    13 
    +    • In the Template Haskell quotation: [t| 'MkT |]
    14 
    +

  • testsuite/tests/th/T26098_splice.hs
    1 
    +{-# LANGUAGE ExplicitLevelImports, TemplateHaskell #-}
    2 
    +module T26098_splice where
    3 
    +
    4 
    +import T26098A_splice
    5 
    +import quote T26098A_splice
    6 
    +
    7 
    +import splice Prelude
    8 
    +
    9 
    +x = $(undefined :: Foo)

  • testsuite/tests/th/T26098_splice.stderr
    1 
    +T26098_splice.hs:9:20: error: [GHC-28914]
    2 
    +    • Level error: ‘Foo’ is bound at levels {0, 1} but used at level -1
    3 
    +    • Available from the imports:
    4 
    +      • imported from ‘T26098A_splice’ at 1 at T26098_splice.hs:5:1-27
    5 
    +      • imported from ‘T26098A_splice’ at T26098_splice.hs:4:1-21
    6 
    +    • In the untyped splice: $(undefined :: Foo)
    7 
    +

  • testsuite/tests/th/all.T
    ... ... @@ -624,6 +624,9 @@ test('T24997', normal, compile_and_run, [''])
    624 624 
     test('T25256', normal, compile_and_run, [''])
    625 625 
     test('T24572a', normal, compile, [''])
    626 626 
     test('T24572b', normal, compile_fail, [''])
    627 
    +test('T26098_splice', [extra_files(['T26098A_splice.hs'])], multimod_compile_fail, ['T26098_splice', '-v0 ' + config.ghc_th_way_flags])
    628 
    +test('T26098_quote', [extra_files(['T26098A_quote.hs'])], multimod_compile_fail, ['T26098_quote', '-v0 ' + config.ghc_th_way_flags])
    629 
    +test('T26098_local', normal, compile_fail, [''])
    627 630 
     test('T24572c', normal, compile_fail, [''])
    628 631 
     test('T26568', normal, compile_fail, [''])
    629 632 
     test('T24572d', normal, compile, [''])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help