Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC

Commits:

20 changed files:

Changes:

  • compiler/GHC/CmmToAsm.hs
    1 
    -{-# LANGUAGE DeepSubsumption #-}
    2 1 
     -- -----------------------------------------------------------------------------
    3 2 
     --
    4 3 
     -- (c) The University of Glasgow 1993-2004

  • compiler/GHC/Driver/Downsweep.hs
    ... ... @@ -8,7 +8,6 @@
    8 8 
     {-# LANGUAGE LambdaCase #-}
    9 9 
     {-# LANGUAGE BlockArguments #-}
    10 10 
     {-# LANGUAGE ViewPatterns #-}
    11 
    -{-# LANGUAGE DeepSubsumption #-}
    12 11 
     module GHC.Driver.Downsweep
    13 12 
       ( downsweep
    14 13 
       , downsweepThunk

  • compiler/GHC/Hs.hs
    ... ... @@ -36,8 +36,7 @@ module GHC.Hs (
    36 36 
             module GHC.Parser.Annotation,
    37 37
    38 38 
             HsModule(..), AnnsModule(..),
    39 
    -        HsParsedModule(..), XModulePs(..),
    40 
    -
    39 
    +        HsParsedModule(..), XModulePs(..)
    41 40 
     ) where
    42 41
    43 42 
     -- friends:

  • compiler/GHC/Iface/Ext/Ast.hs
    ... ... @@ -1157,7 +1157,8 @@ the typechecker:
    1157 1157 
       * HsDo, where we give the SrcSpan of the entire do block to each
    1158 1158 
         ApplicativeStmt.
    1159 1159 
       * Expanded (via ExpandedThingRn) ExplicitList{}, where we give the SrcSpan of the original
    1160 
    -    list expression to the 'fromListN' call.
    1160 
    +    list expression to the expanded expression. The 'fromListN' is assigned
    1161 
    +    a generated location span
    1161 1162
    1162 1163 
     In order for the implicit function calls to not be confused for actual
    1163 1164 
     occurrences of functions in the source code, most of this extra information

  • compiler/GHC/Tc/Errors/Ppr.hs
    ... ... @@ -8,7 +8,6 @@
    8 8 
     {-# LANGUAGE TypeApplications #-}
    9 9 
     {-# LANGUAGE TypeFamilies #-}
    10 10 
     {-# LANGUAGE OverloadedStrings #-}
    11 
    -{-# LANGUAGE DeepSubsumption #-}
    12 11
    13 12 
     {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic TcRnMessage
    14 13 
     {-# LANGUAGE InstanceSigs #-}

  • compiler/GHC/Tc/Gen/App.hs
    ... ... @@ -53,6 +53,7 @@ import GHC.Builtin.PrimOps( tagToEnumKey )
    53 53 
     import GHC.Builtin.Names
    54 54
    55 55 
     import GHC.Types.Var
    56 
    +import GHC.Types.Id ( isDataConId )
    56 57 
     import GHC.Types.Name
    57 58 
     import GHC.Types.Name.Env
    58 59 
     import GHC.Types.Name.Reader
    ... ... @@ -186,15 +187,14 @@ Note [Instantiation variables are short lived]
    186 187 
     tcExprSigma :: Bool -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
    187 188 
     tcExprSigma inst rn_expr
    188 189 
       = do { (fun@(rn_fun,fun_lspan), rn_args) <- splitHsApps rn_expr
    189 
    -       -- ; ds_flag <- getDeepSubsumptionFlag_DataConHead rn_fun
    190 
    -       -- ; do_ql <- wantQuickLook rn_fun
    191 190 
            ; (tc_fun, fun_sigma) <- tcInferAppHead fun
    192 191 
            ; code_orig <- getSrcCodeOrigin
    193 192 
            ; let fun_orig | not (isGeneratedSrcSpan fun_lspan)
    194 193 
                           = exprCtOrigin rn_fun
    195 194 
                           | otherwise
    196 195 
                           = srcCodeOriginCtOrigin rn_fun code_orig
    197 
    -       ; traceTc "tcExprSigma" (vcat [text "rn_expr:" <+> ppr rn_expr, ppr tc_fun])
    196 
    +       ; traceTc "tcExprSigma" (vcat [ text "rn_expr:" <+> ppr rn_expr
    197 
    +                                     , text "tc_fun" <+> ppr tc_fun ])
    198 198 
            ; (inst_args, app_res_sigma) <- tcInstFun DoQL inst (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_args
    199 199 
            ; tc_args <- tcValArgs DoQL (rn_fun, fun_lspan) inst_args
    200 200 
            ; let tc_expr = rebuildHsApps (tc_fun, fun_lspan) tc_args
    ... ... @@ -486,11 +486,31 @@ getDeepSubsumptionFlag_DataConHead app_head =
    486 486 
          ; return $
    487 487 
              if | user_ds
    488 488 
                 -> Deep DeepSub
    489 
    -            | XExpr (ConLikeTc (RealDataCon {})) <- app_head
    490 
    -            -> Deep TopSub
    491 489 
                 | otherwise
    492 
    -            -> Shallow
    493 
    -    }
    490 
    +            -> go app_head
    491 
    +     }
    492 
    +  where
    493 
    +    go :: HsExpr GhcTc -> DeepSubsumptionFlag
    494 
    +    go app_head
    495 
    +     | XExpr (ConLikeTc (RealDataCon {})) <- app_head
    496 
    +     = Deep TopSub
    497 
    +     | XExpr (ExpandedThingTc _ f) <- app_head
    498 
    +     = go f
    499 
    +     | XExpr (WrapExpr _ f) <- app_head
    500 
    +     = go f
    501 
    +     | HsVar _ f <- app_head
    502 
    +     , isDataConId (unLoc f)
    503 
    +     = Deep TopSub
    504 
    +     | HsApp _ f _ <- app_head
    505 
    +     = go (unLoc f)
    506 
    +     | HsAppType _ f _ <- app_head
    507 
    +     = go (unLoc f)
    508 
    +     | OpApp _ _ f _ <- app_head
    509 
    +     = go (unLoc f)
    510 
    +     | HsPar _ f <- app_head
    511 
    +     = go (unLoc f)
    512 
    +     | otherwise
    513 
    +     = Shallow
    494 514
    495 515 
     finishApp :: (HsExpr GhcTc, SrcSpan) -> [HsExprArg 'TcpTc]
    496 516 
               -> TcRhoType -> HsWrapper

  • compiler/GHC/Tc/Gen/Expr.hs
    ... ... @@ -767,6 +767,8 @@ tcExpr (SectionR {}) ty = pprPanic "tcExpr:SectionR" (ppr ty)
    767 767 
     tcXExpr :: XXExprGhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    768 768 
     tcXExpr (ExpandedThingRn o e) res_ty
    769 769 
        = mkExpandedTc o <$> -- necessary for hpc ticks
    770 
    +         -- Need to call tcExpr and not tcApp
    771 
    +         -- as e can be let statements which tcApp cannot gracefully handle
    770 772 
              tcExpr e res_ty
    771 773
    772 774 
     -- For record selection, same as HsVar case

  • compiler/GHC/Tc/Gen/Head.hs
    ... ... @@ -465,9 +465,11 @@ tcInferAppHead_maybe fun =
    465 465 
         case fun of
    466 466 
           HsVar _ nm                  -> Just <$> tcInferId nm
    467 467 
           XExpr (HsRecSelRn f)        -> Just <$> tcInferRecSelId f
    468 
    -      XExpr (ExpandedThingRn o e) -> Just <$> (addExpansionErrCtxt o (srcCodeOriginErrCtxMsg o) $ -- ANI: TODO this is fishy..
    469 
    -                                              -- We do not want to instantiate c.f. T19167
    470 
    -                                              tcExprSigma False e
    468 
    +      XExpr (ExpandedThingRn o e) -> Just <$> (addExpansionErrCtxt o (srcCodeOriginErrCtxMsg o) $
    469 
    +                                              -- ANI: TODO this is addExpansionErrCtxt is fishy..
    470 
    +                                              -- We do not want to instantiate the type of the head
    471 
    +                                              -- c.f. T19167
    472 
    +                                              (\ (x, y) -> (mkExpandedTc o x, y)) <$> tcExprSigma False e
    471 473 
                                                   )
    472 474 
           ExprWithTySig _ e hs_ty     -> Just <$> tcExprWithSig e hs_ty
    473 475 
           HsOverLit _ lit             -> Just <$> tcInferOverLit lit

  • compiler/GHC/Tc/Utils/Monad.hs
    ... ... @@ -63,7 +63,7 @@ module GHC.Tc.Utils.Monad(
    63 63 
       -- * Error management
    64 64 
       getSrcCodeOrigin,
    65 65 
       getSrcSpanM, setSrcSpan, setSrcSpanA, addLocM,
    66 
    -  inGeneratedCode, -- setInGeneratedCode,
    66 
    +  inGeneratedCode,
    67 67 
       wrapLocM, wrapLocFstM, wrapLocFstMA, wrapLocSndM, wrapLocSndMA, wrapLocM_,
    68 68 
       wrapLocMA_,wrapLocMA,
    69 69 
       getErrsVar, setErrsVar,

  • testsuite/tests/deSugar/should_compile/T10662 deleted
    No preview for this file type
  • testsuite/tests/ghci.debugger/Do deleted
    No preview for this file type
  • testsuite/tests/ghci.debugger/Do.hs deleted
    1 
    -
    2 
    -module Main where
    3 
    -
    4 
    -main :: IO ()
    5 
    -main = do putStrLn "Hello"
    6 
    -          putStrLn "World"

  • testsuite/tests/ghci.debugger/T25996.hs deleted
    1 
    -{-# OPTIONS_GHC -Wall #-}
    2 
    -{-# OPTIONS_GHC -Wno-unused-local-binds #-}
    3 
    -{-# OPTIONS_GHC -Wno-unused-top-binds #-}
    4 
    -
    5 
    -main :: IO ()
    6 
    -main = do
    7 
    -  pure ()
    8 
    -  where
    9 
    -    biz :: IO ()
    10 
    -    biz = do
    11 
    -      pure (10 :: Integer)
    12 
    -      pure ()
    13 
    -
    14 
    -biz' :: IO ()
    15 
    -biz' = do
    16 
    -  pure (10 :: Integer)
    17 
    -  pure ()

  • testsuite/tests/typecheck/should_compile/ExpansionQLIm.hs
    1 
    +module Test where
    2 
    +
    3 
    +
    4 
    +qqqq :: [String]
    5 
    +qqqq = (show (1 :: Int) :) $ ["2"]
    6 
    +
    7 
    +main :: IO ()
    8 
    +main = do
    9 
    +  putStrLn "abc"
    10 
    +  putStrLn $ concat qqqq

  • testsuite/tests/typecheck/should_compile/T25996.hs deleted
    1 
    -
    2 
    -{-# OPTIONS_GHC -Wall #-}
    3 
    -{-# OPTIONS_GHC -Wno-unused-local-binds #-}
    4 
    -{-# OPTIONS_GHC -Wno-unused-top-binds #-}
    5 
    -
    6 
    -module T25996 where
    7 
    -
    8 
    -main :: IO ()
    9 
    -main = do
    10 
    -  pure ()
    11 
    -  where
    12 
    -    biz :: IO ()
    13 
    -    biz = do
    14 
    -      pure (10 :: Integer)
    15 
    -      pure ()
    16 
    -
    17 
    -biz' :: IO ()
    18 
    -biz' = do
    19 
    -  pure (10 :: Integer)
    20 
    -  pure ()

  • testsuite/tests/typecheck/should_compile/all.T
    ... ... @@ -658,8 +658,8 @@ def onlyHsParLocs(x):
    658 658 
         """
    659 659 
         ls = x.split("\n")
    660 660 
         filteredLines = (loc.strip() for (loc,hspar) in zip(ls,ls[5:])
    661 
    -                      if hspar.strip().startswith("(HsPar")
    662 
    -                        and not "<no location info>" in loc)
    661 
    +		      if hspar.strip().startswith("(HsPar")
    662 
    +			and not "<no location info>" in loc)
    663 663 
         return '\n'.join(filteredLines)
    664 664 
     test('T15242', normalise_errmsg_fun(onlyHsParLocs), compile, [''])
    665 665 
     test('T15431', normal, compile, [''])
    ... ... @@ -957,3 +957,4 @@ test('T17705', normal, compile, [''])
    957 957 
     test('T14745', normal, compile, [''])
    958 958 
     test('T26451', normal, compile, [''])
    959 959 
     test('T26582', normal, compile, [''])
    960 
    +test('ExpansionQLIm', normal, compile, [''])

  • testsuite/tests/typecheck/should_fail/T25970.hs deleted
    1 
    -
    2 
    -{-# LANGUAGE TypeFamilies #-}
    3 
    -module T25970 where
    4 
    -
    5 
    -y :: IO ()
    6 
    -y = putStrLn "y"
    7 
    -
    8 
    -
    9 
    -type family K a where
    10 
    -  K a = Bool
    11 
    -
    12 
    -x :: IO (K b)
    13 
    -x = do
    14 
    -  y
    15 
    -  pure () -- The error should point here or on the whole do block
    16 
    -
    17 
    -x' :: IO (K b)
    18 
    -x' = y >> pure ()

  • testsuite/tests/typecheck/should_fail/T25996.hs deleted
    1 
    -
    2 
    -{-# OPTIONS_GHC -Wall #-}
    3 
    -{-# OPTIONS_GHC -Wno-unused-local-binds #-}
    4 
    -{-# OPTIONS_GHC -Wno-unused-top-binds #-}
    5 
    -
    6 
    -module T25996 where
    7 
    -
    8 
    -main :: IO ()
    9 
    -main = do
    10 
    -  pure ()
    11 
    -  where
    12 
    -    biz :: IO ()
    13 
    -    biz = do
    14 
    -      pure (10 :: Integer) -- This warning should be reported only once
    15 
    -      pure ()
    16 
    -
    17 
    -biz' :: IO ()
    18 
    -biz' = do
    19 
    -  pure (10 :: Integer)
    20 
    -  pure ()

  • testsuite/tests/typecheck/should_fail/T7857.stderr
    1 
    -
    2 1 
     T7857.hs:8:11: error: [GHC-39999]
    3 2 
         • Could not deduce ‘PrintfType a0’ arising from a use of ‘printf’
    4 
    -      from the context: PrintfArg t
    5 
    -        bound by the inferred type of g :: PrintfArg t => t -> b
    3 
    +      from the context: PrintfArg q
    4 
    +        bound by the inferred type of g :: PrintfArg q => q -> b
    6 5 
             at T7857.hs:8:1-21
    7 6 
           The type variable ‘a0’ is ambiguous
    8 7 
           Potentially matching instances:
    ... ... @@ -15,3 +14,4 @@ T7857.hs:8:11: error: [GHC-39999]
    15 14 
         • In the second argument of ‘($)’, namely ‘printf "" i’
    16 15 
           In the expression: f $ printf "" i
    17 16 
           In an equation for ‘g’: g i = f $ printf "" i
    17 
    +

  • testsuite/tests/typecheck/should_fail/tcfail181.stderr
    1 1 
     tcfail181.hs:17:9: error: [GHC-39999]
    2 
    -    • Could not deduce ‘Monad m0’ arising from a record update
    2 
    +    • Could not deduce ‘Monad m0’ arising from a use of ‘foo’
    3 3 
           from the context: Monad m
    4 4 
             bound by the inferred type of
    5 5 
                        wog :: Monad m => p -> Something (m Bool) e

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