Vladislav Zavialov pushed to branch wip/int-index/t26418 at Glasgow Haskell Compiler / GHC

Commits:

9 changed files:

Changes:

  • compiler/GHC/Parser.y
    ... ... @@ -1078,11 +1078,11 @@ qcname_ext_w_wildcard :: { LocatedA ImpExpQcSpec }
    1078 1078 
             |  '..'                     { sL1a $1 (ImpExpQcWildcard (epTok $1) NoEpTok)  }
    1079 1079
    1080 1080 
     qcname_ext :: { LocatedA ImpExpQcSpec }
    1081 
    -        :  qcname                   { sL1a $1 (ImpExpQcName $1) }
    1082 
    -        |  'type' oqtycon           {% do { n <- mkTypeImpExp $2
    1083 
    -                                          ; return $ sLLa $1 $> (ImpExpQcType (epTok $1) n) }}
    1084 
    -        |  'data' qvarcon           {% do { n <- mkDataImpExp $2
    1085 
    -                                          ; return $ sLLa $1 $> (ImpExpQcData (epTok $1) n) }}
    1081 
    +        :  qcname                   { sL1a $1 (mkPlainImpExp $1) }
    1082 
    +        |  'type' oqtycon           {% do { imp_exp <- mkTypeImpExp (epTok $1) $2
    1083 
    +                                          ; return $ sLLa $1 $> imp_exp }}
    1084 
    +        |  'data' qvarcon           {% do { imp_exp <- mkDataImpExp (epTok $1) $2
    1085 
    +                                          ; return $ sLLa $1 $> imp_exp }}
    1086 1086
    1087 1087 
     qcname  :: { LocatedN RdrName }  -- Variable or type constructor
    1088 1088 
             :  qvar                 { $1 } -- Things which look like functions

  • compiler/GHC/Parser/Errors/Ppr.hs
    ... ... @@ -273,9 +273,14 @@ instance Diagnostic PsMessage where
    273 273 
                       2 (pprWithCommas ppr vs)
    274 274 
                     , text "See https://gitlab.haskell.org/ghc/ghc/issues/16754 for details."
    275 275 
                     ]
    276 
    -    PsErrIllegalExplicitNamespace
    276 
    +    PsErrIllegalExplicitNamespace kw
    277 277 
           -> mkSimpleDecorated $
    278 
    -           text "Illegal keyword 'type'"
    278 
    +           text "Illegal keyword" <+> quotes kw_doc
    279 
    +         where
    280 
    +           kw_doc = case kw of
    281 
    +             ExplicitTypeNamespace{} -> text "type"
    282 
    +             ExplicitDataNamespace{} -> text "data"
    283 
    +
    279 284
    280 285 
         PsErrUnallowedPragma prag
    281 286 
           -> mkSimpleDecorated $
    ... ... @@ -619,7 +624,7 @@ instance Diagnostic PsMessage where
    619 624 
         PsErrNoSingleWhereBindInPatSynDecl{}          -> ErrorWithoutFlag
    620 625 
         PsErrDeclSpliceNotAtTopLevel{}                -> ErrorWithoutFlag
    621 626 
         PsErrMultipleNamesInStandaloneKindSignature{} -> ErrorWithoutFlag
    622 
    -    PsErrIllegalExplicitNamespace                 -> ErrorWithoutFlag
    627 
    +    PsErrIllegalExplicitNamespace{}               -> ErrorWithoutFlag
    623 628 
         PsErrUnallowedPragma{}                        -> ErrorWithoutFlag
    624 629 
         PsErrImportPostQualified                      -> ErrorWithoutFlag
    625 630 
         PsErrImportQualifiedTwice                     -> ErrorWithoutFlag
    ... ... @@ -759,7 +764,7 @@ instance Diagnostic PsMessage where
    759 764 
         PsErrNoSingleWhereBindInPatSynDecl{}          -> noHints
    760 765 
         PsErrDeclSpliceNotAtTopLevel{}                -> noHints
    761 766 
         PsErrMultipleNamesInStandaloneKindSignature{} -> noHints
    762 
    -    PsErrIllegalExplicitNamespace                 -> [suggestExtension LangExt.ExplicitNamespaces]
    767 
    +    PsErrIllegalExplicitNamespace{}               -> [suggestExtension LangExt.ExplicitNamespaces]
    763 768 
         PsErrUnallowedPragma{}                        -> noHints
    764 769 
         PsErrImportPostQualified                      -> [suggestExtension LangExt.ImportQualifiedPost]
    765 770 
         PsErrImportQualifiedTwice                     -> noHints

  • compiler/GHC/Parser/Errors/Types.hs
    ... ... @@ -214,7 +214,7 @@ data PsMessage
    214 214 
        | PsErrImportPostQualified
    215 215
    216 216 
        -- | Explicit namespace keyword without 'ExplicitNamespaces'
    217 
    -   | PsErrIllegalExplicitNamespace
    217 
    +   | PsErrIllegalExplicitNamespace !ExplicitNamespaceKeyword
    218 218
    219 219 
        -- | Expecting a type constructor but found a variable
    220 220 
        | PsErrVarForTyCon !RdrName

  • compiler/GHC/Parser/PostProcess.hs
    ... ... @@ -79,6 +79,7 @@ module GHC.Parser.PostProcess (
    79 79 
             ImpExpSubSpec(..),
    80 80 
             ImpExpQcSpec(..),
    81 81 
             mkModuleImpExp,
    82 
    +        mkPlainImpExp,
    82 83 
             mkTypeImpExp,
    83 84 
             mkDataImpExp,
    84 85 
             mkImpExpSubSpec,
    ... ... @@ -3241,9 +3242,7 @@ data ImpExpSubSpec = ImpExpAbs
    3241 3242 
                        | ImpExpList [LocatedA ImpExpQcSpec]
    3242 3243 
                        | ImpExpAllWith [LocatedA ImpExpQcSpec]
    3243 3244
    3244 
    -data ImpExpQcSpec = ImpExpQcName (LocatedN RdrName)
    3245 
    -                  | ImpExpQcType (EpToken "type") (LocatedN RdrName)
    3246 
    -                  | ImpExpQcData (EpToken "data") (LocatedN RdrName)
    3245 
    +data ImpExpQcSpec = ImpExpQcName (Maybe ExplicitNamespaceKeyword) (LocatedN RdrName)
    3247 3246 
                       | ImpExpQcWildcard (EpToken "..") (EpToken ",")
    3248 3247
    3249 3248 
     mkModuleImpExp :: Maybe (LWarningTxt GhcPs) -> (EpToken "(", EpToken ")") -> LocatedA ImpExpQcSpec
    ... ... @@ -3287,30 +3286,37 @@ mkModuleImpExp warning (top, tcp) (L l specname) subs = do
    3287 3286 
                    (PsErrVarForTyCon name)
    3288 3287 
             else return $ ieNameFromSpec specname
    3289 3288
    3290 
    -    ieNameVal (ImpExpQcName ln)   = unLoc ln
    3291 
    -    ieNameVal (ImpExpQcType _ ln) = unLoc ln
    3292 
    -    ieNameVal (ImpExpQcData _ ln) = unLoc ln
    3289 
    +    ieNameVal (ImpExpQcName _ ln) = unLoc ln
    3293 3290 
         ieNameVal ImpExpQcWildcard{}  = panic "ieNameVal got wildcard"
    3294 3291
    3295 3292 
         ieNameFromSpec :: ImpExpQcSpec -> IEWrappedName GhcPs
    3296 
    -    ieNameFromSpec (ImpExpQcName   (L l n)) = IEName noExtField (L l n)
    3297 
    -    ieNameFromSpec (ImpExpQcType r (L l n)) = IEType r (L l n)
    3298 
    -    ieNameFromSpec (ImpExpQcData r (L l n)) = IEData r (L l n)
    3299 
    -    ieNameFromSpec ImpExpQcWildcard{}       = panic "ieName got wildcard"
    3293 
    +    ieNameFromSpec (ImpExpQcName m_kw name) = case m_kw of
    3294 
    +        Nothing                          -> IEName noExtField name
    3295 
    +        Just (ExplicitTypeNamespace tok) -> IEType tok name
    3296 
    +        Just (ExplicitDataNamespace tok) -> IEData tok name
    3297 
    +    ieNameFromSpec ImpExpQcWildcard{} = panic "ieNameFromSpec got wildcard"
    3300 3298
    3301 3299 
         wrapped = map (fmap ieNameFromSpec)
    3302 3300
    3303 
    -mkTypeImpExp :: LocatedN RdrName   -- TcCls or Var name space
    3304 
    -             -> P (LocatedN RdrName)
    3305 
    -mkTypeImpExp name =
    3306 
    -  do requireExplicitNamespaces (getLocA name)
    3307 
    -     return (fmap (`setRdrNameSpace` tcClsName) name)
    3301 
    +mkPlainImpExp :: LocatedN RdrName -> ImpExpQcSpec
    3302 
    +mkPlainImpExp name = ImpExpQcName Nothing name
    3308 3303
    3309 
    -mkDataImpExp :: LocatedN RdrName
    3310 
    -             -> P (LocatedN RdrName)
    3311 
    -mkDataImpExp name =
    3312 
    -  do requireExplicitNamespaces (getLocA name)
    3313 
    -     return name
    3304 
    +mkTypeImpExp :: EpToken "type"
    3305 
    +             -> LocatedN RdrName   -- TcCls or Var name space
    3306 
    +             -> P ImpExpQcSpec
    3307 
    +mkTypeImpExp tok name = do
    3308 
    +  let name' = fmap (`setRdrNameSpace` tcClsName) name
    3309 
    +      ns_kw = ExplicitTypeNamespace tok
    3310 
    +  requireExplicitNamespaces ns_kw
    3311 
    +  return (ImpExpQcName (Just ns_kw) name')
    3312 
    +
    3313 
    +mkDataImpExp :: EpToken "data"
    3314 
    +             -> LocatedN RdrName
    3315 
    +             -> P ImpExpQcSpec
    3316 
    +mkDataImpExp tok name = do
    3317 
    +  let ns_kw = ExplicitDataNamespace tok
    3318 
    +  requireExplicitNamespaces ns_kw
    3319 
    +  return (ImpExpQcName (Just ns_kw) name)
    3314 3320
    3315 3321 
     checkImportSpec :: LocatedLI [LIE GhcPs] -> P (LocatedLI [LIE GhcPs])
    3316 3322 
     checkImportSpec ie@(L _ specs) =
    ... ... @@ -3368,11 +3374,15 @@ failOpFewArgs (L loc op) =
    3368 3374 
          ; addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $
    3369 3375 
              (PsErrOpFewArgs is_star_type op) }
    3370 3376
    3371 
    -requireExplicitNamespaces :: MonadP m => SrcSpan -> m ()
    3372 
    -requireExplicitNamespaces l = do
    3377 
    +requireExplicitNamespaces :: MonadP m => ExplicitNamespaceKeyword -> m ()
    3378 
    +requireExplicitNamespaces kw = do
    3373 3379 
       allowed <- getBit ExplicitNamespacesBit
    3374 3380 
       unless allowed $
    3375 
    -    addError $ mkPlainErrorMsgEnvelope l PsErrIllegalExplicitNamespace
    3381 
    +    addError $ mkPlainErrorMsgEnvelope loc $ PsErrIllegalExplicitNamespace kw
    3382 
    +  where
    3383 
    +    loc = case kw of
    3384 
    +      ExplicitTypeNamespace tok -> getEpTokenSrcSpan tok
    3385 
    +      ExplicitDataNamespace tok -> getEpTokenSrcSpan tok
    3376 3386
    3377 3387 
     warnPatternNamespaceSpecifier :: MonadP m => SrcSpan -> m ()
    3378 3388 
     warnPatternNamespaceSpecifier l = do

  • compiler/GHC/Parser/Types.hs
    ... ... @@ -8,6 +8,7 @@ module GHC.Parser.Types
    8 8 
        , pprSumOrTuple
    9 9 
        , PatBuilder(..)
    10 10 
        , DataConBuilder(..)
    11 
    +   , ExplicitNamespaceKeyword(..)
    11 12 
        )
    12 13 
     where
    13 14
    ... ... @@ -111,3 +112,7 @@ instance Outputable DataConBuilder where
    111 112 
         ppr lhs <+> ppr data_con <+> ppr rhs
    112 113
    113 114 
     type instance Anno [LocatedA (StmtLR GhcPs GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnLW
    115 
    +
    116 
    +data ExplicitNamespaceKeyword
    117 
    +  = ExplicitTypeNamespace !(EpToken "type")
    118 
    +  | ExplicitDataNamespace !(EpToken "data")
    \ No newline at end of file

  • testsuite/tests/parser/should_fail/T16270h.stderr
    1 
    -
    2 
    -T16270h.hs:8:22: error: [GHC-47007]
    3 
    -    Illegal keyword 'type'
    1 
    +T16270h.hs:8:17: error: [GHC-47007]
    2 
    +    Illegal keyword ‘type’
    4 3 
         Suggested fix:
    5 4 
           Perhaps you intended to use the ‘ExplicitNamespaces’ extension (implied by ‘TypeFamilies’ and ‘TypeOperators’)
    6 5
    ... ... @@ -11,3 +10,4 @@ T16270h.hs:10:8: error: [GHC-21926]
    11 10 
     T16270h.hs:11:8: error: [GHC-21926]
    12 11 
         Parse error: ‘pkg!’
    13 12 
         Version number or non-alphanumeric character in package name
    13 
    +

  • testsuite/tests/parser/should_fail/T26418.hs
    1 
    +{-# LANGUAGE PatternSynonyms #-}
    2 
    +{-# LANGUAGE NoExplicitNamespaces #-}
    3 
    +
    4 
    +module T26418 (data HeadC) where
    5 
    +
    6 
    +pattern HeadC :: forall a. a -> [a]
    7 
    +pattern HeadC x <- x:_xs where
    8 
    +  HeadC x = [x]
    9 
    +

  • testsuite/tests/parser/should_fail/T26418.stderr
    1 
    +T26418.hs:4:16: error: [GHC-47007]
    2 
    +    Illegal keyword ‘data’
    3 
    +    Suggested fix:
    4 
    +      Perhaps you intended to use the ‘ExplicitNamespaces’ extension (implied by ‘TypeFamilies’ and ‘TypeOperators’)
    5 
    +

  • testsuite/tests/parser/should_fail/all.T
    ... ... @@ -241,3 +241,4 @@ test('T25258a', normal, compile_fail, [''])
    241 241 
     test('T25258b', normal, compile_fail, [''])
    242 242 
     test('T25258c', normal, compile_fail, [''])
    243 243 
     test('T25530', normal, compile_fail, [''])
    244 
    +test('T26418', normal, compile_fail, [''])

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