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

Commits:

2 changed files:

Changes:

  • compiler/GHC/Tc/Gen/App.hs
    ... ... @@ -567,11 +567,11 @@ tcValArgs do_ql (fun, fun_lspan) args = go do_ql 0 args
    567 567
                  = pos
    
    568 568
     
    
    569 569
     
    
    570
    -tcValArg :: QLFlag
    
    571
    -         -> Int                     -- argument position (used only for error message generation)
    
    572
    -         -> (HsExpr GhcRn, SrcSpan) -- Head of the application chain (used only for error message generation)
    
    573
    -         -> HsExprArg 'TcpInst    -- Actual argument
    
    574
    -         -> TcM (HsExprArg 'TcpTc)          -- Resulting argument
    
    570
    +tcValArg :: QLFlag                  -- ^ Are we typechecking with Quick Look turned on?
    
    571
    +         -> Int                     -- ^ Argument position (used only for error message generation)
    
    572
    +         -> (HsExpr GhcRn, SrcSpan) -- ^ Head of the application chain (used only for error message generation)
    
    573
    +         -> HsExprArg 'TcpInst      -- ^ Actual argument
    
    574
    +         -> TcM (HsExprArg 'TcpTc)  -- ^ Resulting argument
    
    575 575
     tcValArg _     _ _ (EPrag l p)         = return (EPrag l (tcExprPrag p))
    
    576 576
     tcValArg _     _ _ (ETypeArg l hty ty) = return (ETypeArg l hty ty)
    
    577 577
     tcValArg do_ql _ _ (EWrap (EHsWrap w)) = do { whenQL do_ql $ qlMonoHsWrapper w
    

  • compiler/GHC/Tc/Utils/Unify.hs
    ... ... @@ -2079,26 +2079,12 @@ getDeepSubsumptionFlag_DataConHead app_head =
    2079 2079
          }
    
    2080 2080
       where
    
    2081 2081
         go :: HsExpr GhcTc -> DeepSubsumptionFlag
    
    2082
    -    go app_head
    
    2083
    -     | XExpr (ConLikeTc (RealDataCon {})) <- app_head
    
    2084
    -     = Deep TopSub
    
    2085
    -     | XExpr (ExpandedThingTc (HSE _ (L _ f))) <- app_head
    
    2086
    -     = go f
    
    2087
    -     | XExpr (WrapExpr _ f) <- app_head
    
    2088
    -     = go f
    
    2089
    -     | HsVar _ f <- app_head
    
    2090
    -     , isDataConId (unLoc f)
    
    2091
    -     = Deep TopSub
    
    2092
    -     | HsApp _ f _ <- app_head
    
    2093
    -     = go (unLoc f)
    
    2094
    -     | HsAppType _ f _ <- app_head
    
    2095
    -     = go (unLoc f)
    
    2096
    -     | OpApp _ _ f _ <- app_head
    
    2097
    -     = go (unLoc f)
    
    2098
    -     | HsPar _ f <- app_head
    
    2099
    -     = go (unLoc f)
    
    2100
    -     | otherwise
    
    2101
    -     = Shallow
    
    2082
    +    go (XExpr (ConLikeTc (RealDataCon {}))) = Deep TopSub
    
    2083
    +    go (XExpr (ExpandedThingTc (HSE _ (L _ f)))) = go f
    
    2084
    +    go (XExpr (WrapExpr _ f)) = go f
    
    2085
    +    go (HsApp _ f _) = go (unLoc f)
    
    2086
    +    go (HsAppType _ f _) = go (unLoc f)
    
    2087
    +    go _ = Shallow
    
    2102 2088
     
    
    2103 2089
     
    
    2104 2090
     -- | 'tc_sub_type_deep' is where the actual work happens for deep subsumption.