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

Commits:

7 changed files:

Changes:

  • compiler/GHC/Hs/ImpExp.hs
    ... ... @@ -149,10 +149,14 @@ instance (OutputableBndrId p
    149 149 
         ppr (ImportDecl { ideclExt = impExt, ideclName = mod'
    150 150 
                         , ideclPkgQual = pkg
    151 151 
                         , ideclSource = from, ideclSafe = safe
    152 
    +                    , ideclLevelSpec = level
    152 153 
                         , ideclQualified = qual
    153 154 
                         , ideclAs = as, ideclImportList = spec })
    154 
    -      = hang (hsep [text "import", ppr_imp impExt from, pp_implicit impExt, pp_safe safe,
    155 
    -                    pp_qual qual False, ppr pkg, ppr mod', pp_qual qual True, pp_as as])
    155 
    +      = hang (hsep [text "import", ppr_imp impExt from, pp_implicit impExt,
    156 
    +                    pp_level level False, pp_safe safe, pp_qual qual False,
    157 
    +                    ppr pkg, ppr mod',
    158 
    +                    pp_level level True, pp_qual qual True,
    159 
    +                    pp_as as])
    156 160 
                  4 (pp_spec spec)
    157 161 
           where
    158 162 
             pp_implicit ext =
    ... ... @@ -169,6 +173,15 @@ instance (OutputableBndrId p
    169 173 
             pp_qual QualifiedPost False = empty -- Postpositive qualifier/prepositive position.
    170 174 
             pp_qual NotQualified _ = empty
    171 175
    176 
    +        pp_level (LevelStylePre  sty) False = pp_level_style sty
    177 
    +        pp_level (LevelStylePost   _) False = empty
    178 
    +        pp_level (LevelStylePre    _) True = empty
    179 
    +        pp_level (LevelStylePost sty) True = pp_level_style sty
    180 
    +        pp_level NotLevelled _ = empty
    181 
    +
    182 
    +        pp_level_style ImportDeclQuote = text "quote"
    183 
    +        pp_level_style ImportDeclSplice = text "splice"
    184 
    +
    172 185 
             pp_safe False   = empty
    173 186 
             pp_safe True    = text "safe"
    174 187

  • compiler/GHC/Parser.y
    ... ... @@ -1123,7 +1123,7 @@ importdecls_semi
    1123 1123 
             | {- empty -}           { [] }
    1124 1124
    1125 1125 
     importdecl :: { LImportDecl GhcPs }
    1126 
    -        : 'import' maybe_src maybe_splice maybe_safe optqualified maybe_pkg modid maybe_splice optqualified maybeas maybeimpspec
    1126 
    +        : 'import' maybe_src maybe_level maybe_safe optqualified maybe_pkg modid maybe_level optqualified maybeas maybeimpspec
    1127 1127 
                     {% do {
    1128 1128 
                       ; let { ; mPreQual = $5
    1129 1129 
                               ; mPostQual = $9
    ... ... @@ -1163,7 +1163,7 @@ maybe_safe :: { (Maybe (EpToken "safe"),Bool) }
    1163 1163 
             : 'safe'                                { (Just (epTok $1),True) }
    1164 1164 
             | {- empty -}                           { (Nothing,      False) }
    1165 1165
    1166 
    -maybe_splice :: { (Maybe EpAnnLevel) }
    1166 
    +maybe_level :: { (Maybe EpAnnLevel) }
    1167 1167 
             : 'splice'                              { (Just (EpAnnLevelSplice (epTok $1))) }
    1168 1168 
             | 'quote'                               { (Just (EpAnnLevelQuote (epTok $1))) }
    1169 1169 
             | {- empty -}                           { (Nothing) }

  • testsuite/tests/printer/Makefile
    ... ... @@ -901,3 +901,14 @@ Test25467:
    901 901 
     Test25885:
    902 902 
     	$(CHECK_PPR)   $(LIBDIR) Test25885.hs
    903 903 
     	$(CHECK_EXACT) $(LIBDIR) Test25885.hs
    904 
    +
    905 
    +.PHONY: TestLevelImports
    906 
    +TestLevelImports:
    907 
    +	$(CHECK_PPR)   $(LIBDIR) TestLevelImports.hs
    908 
    +	$(CHECK_EXACT) $(LIBDIR) TestLevelImports.hs
    909 
    +
    910 
    +
    911 
    +.PHONY: TestNamedDefaults
    912 
    +TestNamedDefaults:
    913 
    +	$(CHECK_PPR)   $(LIBDIR) TestNamedDefaults.hs
    914 
    +	$(CHECK_EXACT) $(LIBDIR) TestNamedDefaults.hs

  • testsuite/tests/printer/TestLevelImports.hs
    1 
    +
    2 
    +{-# LANGUAGE TemplateHaskell #-}
    3 
    +{-# LANGUAGE ImportQualifiedPost #-}
    4 
    +{-# LANGUAGE NoImplicitPrelude #-}
    5 
    +{-# LANGUAGE ExplicitLevelImports #-}
    6 
    +{-# LANGUAGE NoMonomorphismRestriction #-}
    7 
    +
    8 
    +module TestLevelImports where
    9 
    +-- Based on test SI26 and SI01
    10 
    +
    11 
    +------------------------------------------------
    12 
    +-- SI26
    13 
    +
    14 
    +-- Test using 'quote' as a post-qualifier in imports
    15 
    +import Prelude quote
    16 
    +import Prelude quote qualified as P
    17 
    +import quote Prelude qualified as P2
    18 
    +import quote qualified Prelude as P3
    19 
    +
    20 
    +-- Test using 'splice' as a post-qualifier in imports
    21 
    +import Language.Haskell.TH.Syntax splice
    22 
    +
    23 
    +import splice Language.Haskell.TH.Syntax qualified as TH
    24 
    +import Language.Haskell.TH.Syntax splice qualified as TH2
    25 
    +
    26 
    +-- Using a splice imported thing, inside an untyped and typed splice works
    27 
    +import splice SI01A
    28 
    +
    29 
    +-- Use the imported modules
    30 
    +testQuote = [| id |]
    31 
    +testQuote2 = [| P.id |]
    32 
    +testQuote3 = [| P2.id |]
    33 
    +
    34 
    +testSplice = $(lift "Hello from splice")
    35 
    +testSplice2 = $(TH.lift "Hello from splice2")
    36 
    +testSplice3 = $(TH2.lift "Hello from splice3")
    37 
    +
    38 
    +------------------------------------------------
    39 
    +-- SI01
    40 
    +
    41 
    +main :: IO ()
    42 
    +main = $( sid [| pure () |]) >> $$( sid [|| pure () ||])

  • testsuite/tests/printer/TestNamedDefaults.hs
    1 
    +{-# LANGUAGE NamedDefaults #-}
    2 
    +module NamedDefaults (
    3 
    +    Stringify(..),
    4 
    +    default Stringify,
    5 
    +    Bingify(..),
    6 
    +    default Bingify
    7 
    +  ) where
    8 
    +
    9 
    +class Stringify a where
    10 
    +  stringify :: a -> String
    11 
    +
    12 
    +instance Stringify Int where
    13 
    +  stringify n = "Int"
    14 
    +
    15 
    +instance Stringify Bool where
    16 
    +  stringify b = "Bool"
    17 
    +
    18 
    +instance Stringify [Char] where
    19 
    +  stringify s = "String"
    20 
    +
    21 
    +class Bingify a where
    22 
    +  bingify :: a -> String
    23 
    +
    24 
    +instance Bingify Int where
    25 
    +  bingify n = "Int"
    26 
    +
    27 
    +instance Bingify Bool where
    28 
    +  bingify b = "Bool"
    29 
    +
    30 
    +instance Bingify [Char] where
    31 
    +  bingify s = "String"
    32 
    +
    33 
    +default Stringify (Int)
    34 
    +default Bingify (Int)
    35 
    +

  • testsuite/tests/printer/all.T
    ... ... @@ -215,4 +215,7 @@ test('Test25467', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25467'])
    215 215 
     test('T24237', normal, compile_fail, [''])
    216 216
    217 217 
     test('Test25454', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25454'])
    218 
    -test('Test25885', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25885'])
    \ No newline at end of file
    218 
    +test('Test25885', [ignore_stderr, req_ppr_deps], makefile_test, ['Test25885'])
    219 
    +
    220 
    +test('TestLevelImports', [ignore_stderr, req_ppr_deps], makefile_test, ['TestLevelImports'])
    221 
    +test('TestNamedDefaults', [ignore_stderr, req_ppr_deps], makefile_test, ['TestNamedDefaults'])
    \ No newline at end of file

  • utils/check-exact/ExactPrint.hs
    ... ... @@ -802,6 +802,7 @@ markLensBracketsC' a l =
    802 802 
           c' <- markEpUniToken c
    803 803 
           return (set l (ListBanana o c') a)
    804 804 
         ListNone -> return (set l ListNone a)
    805 
    +
    805 806 
     -- -------------------------------------
    806 807
    807 808 
     markEpToken :: forall m w tok . (Monad m, Monoid w, KnownSymbol tok)
    ... ... @@ -937,6 +938,7 @@ lam_where k annsModule = fmap (\newAnns -> annsModule { am_where = newAnns })
    937 938 
     --   { importDeclAnnImport    :: EpToken "import" -- ^ The location of the @import@ keyword
    938 939 
     --   , importDeclAnnPragma    :: Maybe (EpaLocation, EpToken "#-}") -- ^ The locations of @{-# SOURCE@ and @#-}@ respectively
    939 940 
     --   , importDeclAnnSafe      :: Maybe (EpToken "safe") -- ^ The location of the @safe@ keyword
    941 
    +--   , importDeclAnnLevel     :: Maybe EpAnnLevel -- ^ The location of the @splice@ or @quote@ keyword
    940 942 
     --   , importDeclAnnQualified :: Maybe (EpToken "qualified") -- ^ The location of the @qualified@ keyword
    941 943 
     --   , importDeclAnnPackage   :: Maybe EpaLocation -- ^ The location of the package name (when using @-XPackageImports@)
    942 944 
     --   , importDeclAnnAs        :: Maybe (EpToken "as") -- ^ The location of the @as@ keyword
    ... ... @@ -954,6 +956,10 @@ limportDeclAnnSafe :: Lens EpAnnImportDecl (Maybe (EpToken "safe"))
    954 956 
     limportDeclAnnSafe k annImp = fmap (\new -> annImp { importDeclAnnSafe = new })
    955 957 
                                          (k (importDeclAnnSafe annImp))
    956 958
    959 
    +limportDeclAnnLevel :: Lens EpAnnImportDecl (Maybe EpAnnLevel)
    960 
    +limportDeclAnnLevel k annImp = fmap (\new -> annImp { importDeclAnnLevel = new })
    961 
    +                                     (k (importDeclAnnLevel annImp))
    962 
    +
    957 963 
     limportDeclAnnQualified :: Lens EpAnnImportDecl (Maybe (EpToken "qualified"))
    958 964 
     limportDeclAnnQualified k annImp = fmap (\new -> annImp { importDeclAnnQualified = new })
    959 965 
                                          (k (importDeclAnnQualified annImp))
    ... ... @@ -1625,9 +1631,15 @@ instance ExactPrint (ImportDecl GhcPs) where
    1625 1631 
                   printStringAtLsDelta (SameLine 1) "#-}"
    1626 1632 
                   return Nothing
    1627 1633 
             NoSourceText -> return (importDeclAnnPragma an)
    1634 
    +    -- pre level
    1635 
    +    ann0' <- case st of
    1636 
    +        LevelStylePre _ -> markLensFun' ann0 limportDeclAnnLevel (\mt -> mapM markEpAnnLevel mt)
    1637 
    +        _ -> return ann0
    1638 
    +
    1639 
    +
    1628 1640 
         ann1 <- if safeflag
    1629 
    -      then markLensFun' ann0 limportDeclAnnSafe (\mt -> mapM markEpToken mt)
    1630 
    -      else return ann0
    1641 
    +      then markLensFun' ann0' limportDeclAnnSafe (\mt -> mapM markEpToken mt)
    1642 
    +      else return ann0'
    1631 1643 
         ann2 <-
    1632 1644 
           case qualFlag of
    1633 1645 
             QualifiedPre  -- 'qualified' appears in prepositive position.
    ... ... @@ -1640,11 +1652,16 @@ instance ExactPrint (ImportDecl GhcPs) where
    1640 1652 
            _ -> return ann2
    1641 1653 
         modname' <- markAnnotated modname
    1642 1654
    1655 
    +    -- post level
    1656 
    +    ann3' <- case st of
    1657 
    +        LevelStylePost _ -> markLensFun' ann3 limportDeclAnnLevel (\mt -> mapM markEpAnnLevel mt)
    1658 
    +        _ -> return ann3
    1659 
    +
    1643 1660 
         ann4 <-
    1644 1661 
           case qualFlag of
    1645 1662 
             QualifiedPost  -- 'qualified' appears in postpositive position.
    1646 
    -          -> markLensFun' ann3 limportDeclAnnQualified (\ml -> mapM markEpToken ml)
    1647 
    -        _ -> return ann3
    1663 
    +          -> markLensFun' ann3' limportDeclAnnQualified (\ml -> mapM markEpToken ml)
    1664 
    +        _ -> return ann3'
    1648 1665
    1649 1666 
         (importDeclAnnAs', mAs') <-
    1650 1667 
           case mAs of
    ... ... @@ -1669,6 +1686,9 @@ instance ExactPrint (ImportDecl GhcPs) where
    1669 1686 
         return (ImportDecl (XImportDeclPass (EpAnn anc' an2 cs') msrc impl)
    1670 1687 
                          modname' mpkg src st safeflag qualFlag mAs' hiding')
    1671 1688
    1689 
    +markEpAnnLevel :: (Monad m, Monoid w) => EpAnnLevel -> EP w m EpAnnLevel
    1690 
    +markEpAnnLevel (EpAnnLevelSplice tok) = EpAnnLevelSplice <$> markEpToken tok
    1691 
    +markEpAnnLevel (EpAnnLevelQuote tok) = EpAnnLevelQuote <$> markEpToken tok
    1672 1692
    1673 1693 
     -- ---------------------------------------------------------------------
    1674 1694
    ... ... @@ -2717,8 +2737,8 @@ instance ExactPrint (DefaultDecl GhcPs) where
    2717 2737
    2718 2738 
       exact (DefaultDecl (d,op,cp) cl tys) = do
    2719 2739 
         d' <- markEpToken d
    2720 
    -    op' <- markEpToken op
    2721 2740 
         cl' <- markAnnotated cl
    2741 
    +    op' <- markEpToken op
    2722 2742 
         tys' <- markAnnotated tys
    2723 2743 
         cp' <- markEpToken cp
    2724 2744 
         return (DefaultDecl (d',op',cp') cl' tys')

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