Alan Zimmerman pushed to branch wip/az/exactprint-annotation-rationalisation at Glasgow Haskell Compiler / GHC

Commits:

8 changed files:

Changes:

  • compiler/GHC/Hs.hs
    ... ... @@ -82,17 +82,18 @@ deriving instance Data (HsModule GhcPs)
    82 82
     
    
    83 83
     data AnnsModule
    
    84 84
       = AnnsModule {
    
    85
    -    am_sig :: EpToken "signature",
    
    86
    -    am_mod :: EpToken "module",
    
    87
    -    am_where :: EpToken "where",
    
    88
    -    am_decls :: [TrailingAnn],                 -- ^ Semis before the start of top decls
    
    89
    -    am_cs :: [LEpaComment],                    -- ^ Comments before start of top decl,
    
    85
    +    am_sig     :: EpToken "signature",
    
    86
    +    am_mod     :: EpToken "module",
    
    87
    +    am_where   :: EpToken "where",
    
    88
    +    am_exports :: Maybe (EpToken "(", EpToken ")", [EpToken ","]),
    
    89
    +    am_decls   :: [TrailingAnn],               -- ^ Semis before the start of top decls
    
    90
    +    am_cs      :: [LEpaComment],               -- ^ Comments before start of top decl,
    
    90 91
                                                    --   used in exact printing only
    
    91 92
         am_eof :: Maybe (RealSrcSpan, RealSrcSpan) -- ^ End of file and end of prior token
    
    92 93
         } deriving (Data, Eq)
    
    93 94
     
    
    94 95
     instance NoAnn AnnsModule where
    
    95
    -  noAnn = AnnsModule NoEpTok NoEpTok NoEpTok [] [] Nothing
    
    96
    +  noAnn = AnnsModule NoEpTok NoEpTok NoEpTok Nothing [] [] Nothing
    
    96 97
     
    
    97 98
     instance Outputable (HsModule GhcPs) where
    
    98 99
         ppr (HsModule { hsmodExt = XModulePs { hsmodHaddockModHeader = mbDoc }
    

  • compiler/GHC/Hs/ImpExp.hs
    ... ... @@ -74,7 +74,7 @@ type instance XCImportDecl GhcRn = XImportDeclPass
    74 74
     type instance XCImportDecl  GhcTc = DataConCantHappen
    
    75 75
     
    
    76 76
     data XImportDeclPass = XImportDeclPass
    
    77
    -    { ideclAnn        :: EpAnn EpAnnImportDecl
    
    77
    +    { ideclAnn        :: EpAnnImportDecl
    
    78 78
         , ideclSourceText :: SourceText -- Note [Pragma source text] in "GHC.Types.SourceText"
    
    79 79
         , ideclGenerated   :: Bool -- ^ See Note [Generated imports]
    
    80 80
         }
    
    ... ... @@ -93,7 +93,8 @@ Plugins may also introduce generated imports.
    93 93
     type instance XXImportDecl  (GhcPass _) = DataConCantHappen
    
    94 94
     
    
    95 95
     type instance Anno ModuleName = SrcSpanAnnA
    
    96
    -type instance Anno [LocatedA (IE (GhcPass p))] = SrcSpanAnnLI
    
    96
    +-- type instance Anno [LocatedA (IE (GhcPass p))] = SrcSpanAnnLI
    
    97
    +type instance Anno [LocatedA (IE (GhcPass p))] = SrcSpanAnnA
    
    97 98
     
    
    98 99
     deriving instance Data (IEWrappedName GhcPs)
    
    99 100
     deriving instance Data (IEWrappedName GhcRn)
    
    ... ... @@ -115,6 +116,8 @@ deriving instance Eq (NamespaceSpecifier GhcTc)
    115 116
     
    
    116 117
     -- API Annotations types
    
    117 118
     
    
    119
    +type AnnListImportDecl = AnnList (EpToken "hiding", [EpToken ","])
    
    120
    +
    
    118 121
     data EpAnnImportDecl = EpAnnImportDecl
    
    119 122
       { importDeclAnnImport    :: EpToken "import" -- ^ The location of the @import@ keyword
    
    120 123
       , importDeclAnnPragma    :: Maybe (EpaLocation, EpToken "#-}") -- ^ The locations of @{-# SOURCE@ and @#-}@ respectively
    
    ... ... @@ -123,11 +126,12 @@ data EpAnnImportDecl = EpAnnImportDecl
    123 126
       , importDeclAnnQualified :: Maybe (EpToken "qualified") -- ^ The location of the @qualified@ keyword
    
    124 127
       , importDeclAnnPackage   :: Maybe EpaLocation -- ^ The location of the package name (when using @-XPackageImports@)
    
    125 128
       , importDeclAnnAs        :: Maybe (EpToken "as") -- ^ The location of the @as@ keyword
    
    129
    +  , importDeclImportList   :: Maybe AnnListImportDecl
    
    126 130
       } deriving (Data)
    
    127 131
     
    
    128 132
     
    
    129 133
     instance NoAnn EpAnnImportDecl where
    
    130
    -  noAnn = EpAnnImportDecl noAnn  Nothing Nothing  noAnn  Nothing  Nothing  Nothing
    
    134
    +  noAnn = EpAnnImportDecl noAnn  Nothing Nothing  noAnn  Nothing  Nothing  Nothing Nothing
    
    131 135
     
    
    132 136
     data EpAnnLevel = EpAnnLevelSplice (EpToken "splice")
    
    133 137
                     | EpAnnLevelQuote (EpToken "quote")
    

  • compiler/GHC/Parser.y
    ... ... @@ -879,12 +879,12 @@ unitdecl :: { LHsUnitDecl PackageName }
    879 879
                        NotBoot -> HsSrcFile
    
    880 880
                        IsBoot  -> HsBootFile)
    
    881 881
                      (reLoc $3)
    
    882
    -                 (sL1 $1 (HsModule (XModulePs noAnn (thdOf3 $7) $4 Nothing) (Just $3) $5 (fst $ sndOf3 $7) (snd $ sndOf3 $7))) }
    
    882
    +                 (sL1 $1 (HsModule (XModulePs noAnn (thdOf3 $7) $4 Nothing) (Just $3) (snd $5) (fst $ sndOf3 $7) (snd $ sndOf3 $7))) }
    
    883 883
             | 'signature' modid maybe_warning_pragma maybeexports 'where' body
    
    884 884
                  { sL1 $1 $ DeclD
    
    885 885
                      HsigFile
    
    886 886
                      (reLoc $2)
    
    887
    -                 (sL1 $1 (HsModule (XModulePs noAnn (thdOf3 $6) $3 Nothing) (Just $2) $4 (fst $ sndOf3 $6) (snd $ sndOf3 $6))) }
    
    887
    +                 (sL1 $1 (HsModule (XModulePs noAnn (thdOf3 $6) $3 Nothing) (Just $2) (snd $4) (fst $ sndOf3 $6) (snd $ sndOf3 $6))) }
    
    888 888
             | 'dependency' unitid mayberns
    
    889 889
                  { sL1 $1 $ IncludeD (IncludeDecl { idUnitId = $2
    
    890 890
                                                   , idModRenaming = $3
    
    ... ... @@ -908,9 +908,9 @@ signature :: { Located (HsModule GhcPs) }
    908 908
            : 'signature' modid maybe_warning_pragma maybeexports 'where' body
    
    909 909
                  {% fileSrcSpan >>= \ loc ->
    
    910 910
                     acs loc (\loc cs-> (L loc (HsModule (XModulePs
    
    911
    -                                               (EpAnn (spanAsAnchor loc) (AnnsModule (epTok $1) NoEpTok (epTok $5) (fstOf3 $6) [] Nothing) cs)
    
    911
    +                                                     (EpAnn (spanAsAnchor loc) (AnnsModule (epTok $1) NoEpTok (epTok $5) (fst $4) (fstOf3 $6) [] Nothing) cs)
    
    912 912
                                                    (thdOf3 $6) $3 Nothing)
    
    913
    -                                            (Just $2) $4 (fst $ sndOf3 $6)
    
    913
    +                                           (Just $2) (snd $4) (fst $ sndOf3 $6)
    
    914 914
                                                 (snd $ sndOf3 $6)))
    
    915 915
                         ) }
    
    916 916
     
    
    ... ... @@ -918,15 +918,15 @@ module :: { Located (HsModule GhcPs) }
    918 918
            : 'module' modid maybe_warning_pragma maybeexports 'where' body
    
    919 919
                  {% fileSrcSpan >>= \ loc ->
    
    920 920
                     acsFinal (\cs eof -> (L loc (HsModule (XModulePs
    
    921
    -                                                     (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok $1) (epTok $5) (fstOf3 $6) [] eof) cs)
    
    921
    +                                                       (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok $1) (epTok $5) (fst $4) (fstOf3 $6) [] eof) cs)
    
    922 922
                                                          (thdOf3 $6) $3 Nothing)
    
    923
    -                                                  (Just $2) $4 (fst $ sndOf3 $6)
    
    923
    +                                             (Just $2) (snd $4) (fst $ sndOf3 $6)
    
    924 924
                                                       (snd $ sndOf3 $6))
    
    925 925
                         )) }
    
    926 926
             | body2
    
    927 927
                     {% fileSrcSpan >>= \ loc ->
    
    928 928
                        acsFinal (\cs eof -> (L loc (HsModule (XModulePs
    
    929
    -                                                        (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok NoEpTok NoEpTok (fstOf3 $1) [] eof) cs)
    
    929
    +                                                        (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok NoEpTok NoEpTok Nothing (fstOf3 $1) [] eof) cs)
    
    930 930
                                                             (thdOf3 $1) Nothing Nothing)
    
    931 931
                                                          Nothing Nothing
    
    932 932
                                                          (fst $ sndOf3 $1) (snd $ sndOf3 $1)))) }
    
    ... ... @@ -966,16 +966,16 @@ header :: { Located (HsModule GhcPs) }
    966 966
             : 'module' modid maybe_warning_pragma maybeexports 'where' header_body
    
    967 967
                     {% fileSrcSpan >>= \ loc ->
    
    968 968
                        acs loc (\loc cs -> (L loc (HsModule (XModulePs
    
    969
    -                                                   (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok  $1) (epTok $5) [] [] Nothing) cs)
    
    969
    +                                                         (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok  $1) (epTok $5) (fst $4) [] [] Nothing) cs)
    
    970 970
                                                        EpNoLayout $3 Nothing)
    
    971
    -                                                (Just $2) $4 $6 []
    
    971
    +                                               (Just $2) (snd $4) $6 []
    
    972 972
                               ))) }
    
    973 973
             | 'signature' modid maybe_warning_pragma maybeexports 'where' header_body
    
    974 974
                     {% fileSrcSpan >>= \ loc ->
    
    975 975
                        acs loc (\loc cs -> (L loc (HsModule (XModulePs
    
    976
    -                                                   (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok $1) (epTok $5) [] [] Nothing) cs)
    
    976
    +                                                         (EpAnn (spanAsAnchor loc) (AnnsModule NoEpTok (epTok $1) (epTok $5) (fst $4) [] [] Nothing) cs)
    
    977 977
                                                        EpNoLayout $3 Nothing)
    
    978
    -                                                (Just $2) $4 $6 []
    
    978
    +                                               (Just $2) (snd $4) $6 []
    
    979 979
                               ))) }
    
    980 980
             | header_body2
    
    981 981
                     {% fileSrcSpan >>= \ loc ->
    
    ... ... @@ -999,10 +999,10 @@ header_top_importdecls :: { [LImportDecl GhcPs] }
    999 999
     -----------------------------------------------------------------------------
    
    1000 1000
     -- The Export List
    
    1001 1001
     
    
    1002
    -maybeexports :: { (Maybe (LocatedLI [LIE GhcPs])) }
    
    1003
    -        :  '(' exportlist ')'       {% fmap Just $ amsr (sLL $1 $> (fromOL $ snd $2))
    
    1004
    -                                        (AnnList Nothing (ListParens (epTok $1) (epTok $3)) [] (noAnn,fst $2) []) }
    
    1005
    -        |  {- empty -}              { Nothing }
    
    1002
    +maybeexports :: { (Maybe (EpToken "(", EpToken ")", [EpToken ","]), Maybe (LocatedA [LIE GhcPs])) }
    
    1003
    +        :  '(' exportlist ')'       { (Just ((epTok $1),(epTok $3) ,fst $2)
    
    1004
    +                                      ,  Just (sLLa $1 $> (fromOL $ snd $2))) }
    
    1005
    +        |  {- empty -}              { (Nothing, Nothing) }
    
    1006 1006
     
    
    1007 1007
     exportlist :: { ([EpToken ","], OrdList (LIE GhcPs)) }
    
    1008 1008
             : exportlist1     { ([], $1) }
    
    ... ... @@ -1149,17 +1149,18 @@ importdecl :: { LImportDecl GhcPs }
    1149 1149
                                  , importDeclAnnQualified = fst $ qualSpec
    
    1150 1150
                                  , importDeclAnnPackage   = fst $6
    
    1151 1151
                                  , importDeclAnnAs        = fst $10
    
    1152
    +                             , importDeclImportList   = fst $ unLoc $11
    
    1152 1153
                                  }
    
    1153 1154
                       ; let loc = (comb6 $1 $7 $8 $9 (snd $10) $11);
    
    1154
    -                  ; fmap reLoc $ acs loc (\loc cs -> L loc $
    
    1155
    -                      ImportDecl { ideclExt = XImportDeclPass (EpAnn (spanAsAnchor loc) anns cs) (snd $ fst $2) False
    
    1155
    +                  ; amsA' $ L loc $
    
    1156
    +                      ImportDecl { ideclExt = XImportDeclPass anns (snd $ fst $2) False
    
    1156 1157
                                       , ideclName = $7, ideclPkgQual = snd $6
    
    1157 1158
                                       , ideclSource = snd $2
    
    1158 1159
                                       , ideclLevelSpec = snd $ levelSpec
    
    1159 1160
                                       , ideclSafe = snd $4
    
    1160 1161
                                       , ideclQualified = snd $ qualSpec
    
    1161 1162
                                       , ideclAs = unLoc (snd $10)
    
    1162
    -                                  , ideclImportList = unLoc $11 })
    
    1163
    +                                  , ideclImportList = snd $ unLoc $11 }
    
    1163 1164
                       }
    
    1164 1165
                     }
    
    1165 1166
     
    
    ... ... @@ -1195,17 +1196,19 @@ maybeas :: { (Maybe (EpToken "as"),Located (Maybe (LocatedA ModuleName))) }
    1195 1196
                                                      ,sLL $1 $> (Just $2)) }
    
    1196 1197
             | {- empty -}                          { (Nothing,noLoc Nothing) }
    
    1197 1198
     
    
    1198
    -maybeimpspec :: { Located (Maybe (ImportListInterpretation, LocatedLI [LIE GhcPs])) }
    
    1199
    -        : impspec                  { fmap Just $1 }
    
    1200
    -        | {- empty -}              { noLoc Nothing }
    
    1201
    -
    
    1202
    -impspec :: { Located (ImportListInterpretation, LocatedLI [LIE GhcPs]) }
    
    1203
    -        :  '(' importlist ')'               {% do { es <- amsr (sLL $1 $> $ fromOL $ snd $2)
    
    1204
    -                                                               (AnnList Nothing (ListParens (epTok $1) (epTok $3)) [] (noAnn,fst $2) [])
    
    1205
    -                                                  ; return $ sLL $1 $> (Exactly, es)} }
    
    1206
    -        |  'hiding' '(' importlist ')'      {% do { es <- amsr (sLL $1 $> $ fromOL $ snd $3)
    
    1207
    -                                                               (AnnList Nothing (ListParens (epTok $2) (epTok $4)) [] (epTok $1,fst $3) [])
    
    1208
    -                                                  ; return $ sLL $1 $> (EverythingBut, es)} }
    
    1199
    +maybeimpspec :: { Located (Maybe AnnListImportDecl, Maybe (ImportListInterpretation, LocatedA [LIE GhcPs])) }
    
    1200
    +        : impspec                  { sL1 $1 (Just (fst $ unLoc $1), Just (snd $ unLoc $1)) }
    
    1201
    +        | {- empty -}              { noLoc (Nothing, Nothing) }
    
    1202
    +
    
    1203
    +impspec :: { Located (AnnListImportDecl, (ImportListInterpretation, LocatedA [LIE GhcPs])) }
    
    1204
    +        :  '(' importlist ')'               {% do { es <- amsA' (sLL $1 $> $ fromOL $ snd $2)
    
    1205
    +                                                  ; return $ sLL $1 $>
    
    1206
    +                                                      (AnnList Nothing (ListParens (epTok $1) (epTok $3)) [] (noAnn,fst $2) [],
    
    1207
    +                                                       (Exactly , es))} }
    
    1208
    +        |  'hiding' '(' importlist ')'      {% do { es <- amsA' (sLL $1 $> $ fromOL $ snd $3)
    
    1209
    +                                                  ; return $ sLL $1 $>
    
    1210
    +                                                      (AnnList Nothing (ListParens (epTok $2) (epTok $4)) [] (epTok $1,fst $3) [],
    
    1211
    +                                                       (EverythingBut , es))} }
    
    1209 1212
     
    
    1210 1213
     importlist :: { ([EpToken ","], OrdList (LIE GhcPs)) }
    
    1211 1214
             : importlist1     { ([], $1) }
    

  • compiler/GHC/Parser/Annotation.hs
    ... ... @@ -28,9 +28,9 @@ module GHC.Parser.Annotation (
    28 28
     
    
    29 29
       -- ** Annotations in 'GenLocated'
    
    30 30
       LocatedA, LocatedL, LocatedC, LocatedN, LocatedAn, LocatedP,
    
    31
    -  LocatedLC, LocatedLS, LocatedLW, LocatedLI,
    
    31
    +  LocatedLC, LocatedLS, LocatedLW,
    
    32 32
       SrcSpanAnnA, SrcSpanAnnL, SrcSpanAnnP, SrcSpanAnnC, SrcSpanAnnN,
    
    33
    -  SrcSpanAnnLC, SrcSpanAnnLW, SrcSpanAnnLS, SrcSpanAnnLI,
    
    33
    +  SrcSpanAnnLC, SrcSpanAnnLW, SrcSpanAnnLS,
    
    34 34
       LocatedE,
    
    35 35
     
    
    36 36
       -- ** Annotation data types used in 'GenLocated'
    
    ... ... @@ -433,7 +433,7 @@ type LocatedL = GenLocated SrcSpanAnnL
    433 433
     type LocatedLC = GenLocated SrcSpanAnnLC
    
    434 434
     type LocatedLS = GenLocated SrcSpanAnnLS
    
    435 435
     type LocatedLW = GenLocated SrcSpanAnnLW
    
    436
    -type LocatedLI = GenLocated SrcSpanAnnLI
    
    436
    +-- type LocatedLI = GenLocated SrcSpanAnnLI
    
    437 437
     type LocatedP = GenLocated SrcSpanAnnP
    
    438 438
     type LocatedC = GenLocated SrcSpanAnnC
    
    439 439
     
    
    ... ... @@ -444,7 +444,7 @@ type SrcSpanAnnL = EpAnn (AnnList ())
    444 444
     type SrcSpanAnnLC = EpAnn (AnnList [EpToken ","])
    
    445 445
     type SrcSpanAnnLS = EpAnn (AnnList ())
    
    446 446
     type SrcSpanAnnLW = EpAnn (AnnList (EpToken "where"))
    
    447
    -type SrcSpanAnnLI = EpAnn (AnnList (EpToken "hiding", [EpToken ","]))
    
    447
    +-- type SrcSpanAnnLI = EpAnn (AnnList (EpToken "hiding", [EpToken ","]))
    
    448 448
     type SrcSpanAnnP = EpAnn AnnPragma
    
    449 449
     type SrcSpanAnnC = EpAnn AnnContext
    
    450 450
     
    

  • compiler/GHC/Parser/PostProcess/Haddock.hs
    ... ... @@ -303,7 +303,7 @@ lexLHsDocString = fmap lexHsDocString
    303 303
     --    import I (a, b, c)         -- do not use here!
    
    304 304
     --
    
    305 305
     -- Imports cannot have documentation comments anyway.
    
    306
    -instance HasHaddock (LocatedLI [LocatedA (IE GhcPs)]) where
    
    306
    +instance HasHaddock (LocatedA [LocatedA (IE GhcPs)]) where
    
    307 307
       addHaddock (L l_exports exports) =
    
    308 308
         extendHdkA (locA l_exports) $ do
    
    309 309
           exports' <- addHaddockInterleaveItems EpNoLayout mkDocIE exports
    

  • compiler/GHC/Rename/Names.hs
    ... ... @@ -1188,9 +1188,9 @@ filterImports
    1188 1188
         -> ModIface
    
    1189 1189
         -> ImpDeclSpec
    
    1190 1190
              -- ^ Import spec
    
    1191
    -    -> Maybe (ImportListInterpretation, LocatedLI [LIE GhcPs])
    
    1191
    +    -> Maybe (ImportListInterpretation, LocatedA [LIE GhcPs])
    
    1192 1192
              -- ^ Whether this is a "hiding" import list
    
    1193
    -    -> RnM (Maybe (ImportListInterpretation, LocatedLI [LIE GhcRn]), -- Import spec w/ Names
    
    1193
    +    -> RnM (Maybe (ImportListInterpretation, LocatedA [LIE GhcRn]), -- Import spec w/ Names
    
    1194 1194
                 ImpUserList,                      -- same, but designed for storage in interfaces
    
    1195 1195
                 GlobalRdrEnv)                   -- Same again, but in GRE form
    
    1196 1196
     filterImports hsc_env iface decl_spec Nothing
    

  • compiler/GHC/Tc/Gen/Export.hs
    ... ... @@ -193,7 +193,7 @@ type ExportOccMap = OccEnv (Name, IE GhcPs)
    193 193
             --   that have the same occurrence name
    
    194 194
     
    
    195 195
     rnExports :: Bool       -- False => no 'module M(..) where' header at all
    
    196
    -          -> Maybe (LocatedLI [LIE GhcPs]) -- Nothing => no explicit export list
    
    196
    +          -> Maybe (LocatedA [LIE GhcPs]) -- Nothing => no explicit export list
    
    197 197
               -> RnM TcGblEnv
    
    198 198
     
    
    199 199
             -- Complains if two distinct exports have same OccName
    
    ... ... @@ -302,7 +302,7 @@ the default export. In the latter case the warning text is stored in the
    302 302
     of a user-defined warning on default.
    
    303 303
     -}
    
    304 304
     
    
    305
    -exports_from_avail :: Maybe (LocatedLI [LIE GhcPs])
    
    305
    +exports_from_avail :: Maybe (LocatedA [LIE GhcPs])
    
    306 306
                              -- ^ 'Nothing' means no explicit export list
    
    307 307
                        -> GlobalRdrEnv
    
    308 308
                        -> ImportAvails
    

  • compiler/GHC/Tc/Module.hs
    ... ... @@ -559,7 +559,7 @@ tcRnImports hsc_env import_decls
    559 559
     -}
    
    560 560
     
    
    561 561
     tcRnSrcDecls :: Bool  -- False => no 'module M(..) where' header at all
    
    562
    -             -> Maybe (LocatedLI [LIE GhcPs])
    
    562
    +             -> Maybe (LocatedA [LIE GhcPs])
    
    563 563
                  -> [LHsDecl GhcPs]               -- Declarations
    
    564 564
                  -> TcM TcGblEnv
    
    565 565
     tcRnSrcDecls explicit_mod_hdr export_ies decls
    
    ... ... @@ -1885,7 +1885,7 @@ checkMainType tcg_env
    1885 1885
            ; return lie } } } }
    
    1886 1886
     
    
    1887 1887
     checkMain :: Bool  -- False => no 'module M(..) where' header at all
    
    1888
    -          -> Maybe (LocatedLI [LIE GhcPs])  -- Export specs of Main module
    
    1888
    +          -> Maybe (LocatedA [LIE GhcPs])  -- Export specs of Main module
    
    1889 1889
               -> TcM TcGblEnv
    
    1890 1890
     -- If we are in module Main, check that 'main' is exported,
    
    1891 1891
     -- and generate the runMainIO binding that calls it