summaryrefslogtreecommitdiff
path: root/compiler/GHC/Hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Hs')
-rw-r--r--compiler/GHC/Hs/Binds.hs4
-rw-r--r--compiler/GHC/Hs/Expr.hs15
-rw-r--r--compiler/GHC/Hs/Instances.hs5
-rw-r--r--compiler/GHC/Hs/Syn/Type.hs5
-rw-r--r--compiler/GHC/Hs/Utils.hs8
5 files changed, 21 insertions, 16 deletions
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index 3a22863537..70e5c3c27a 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -31,7 +31,7 @@ import GHC.Prelude
import Language.Haskell.Syntax.Binds
import {-# SOURCE #-} GHC.Hs.Expr ( pprExpr, pprFunBind, pprPatBind )
-import {-# SOURCE #-} GHC.Hs.Pat (pprLPat )
+import {-# SOURCE #-} GHC.Hs.Pat ( pprLPat )
import Language.Haskell.Syntax.Extension
import GHC.Hs.Extension
@@ -679,7 +679,6 @@ data TcSpecPrags
= IsDefaultMethod -- ^ Super-specialised: a default method should
-- be macro-expanded at every call site
| SpecPrags [LTcSpecPrag]
- deriving Data
-- | Located Type checker Specification Pragmas
type LTcSpecPrag = Located TcSpecPrag
@@ -692,7 +691,6 @@ data TcSpecPrag
InlinePragma
-- ^ The Id to be specialised, a wrapper that specialises the
-- polymorphic function, and inlining spec for the specialised function
- deriving Data
noSpecPrags :: TcSpecPrags
noSpecPrags = SpecPrags []
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index d664456654..ce415ead33 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -8,7 +8,6 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
@@ -60,7 +59,7 @@ import GHC.Utils.Panic.Plain
import GHC.Data.FastString
import GHC.Core.Type
import GHC.Builtin.Types (mkTupleStr)
-import GHC.Tc.Utils.TcType (TcType, TcTyVar)
+import GHC.Tc.Utils.TcType (TcType)
import {-# SOURCE #-} GHC.Tc.Types (TcLclEnv)
import GHCi.RemoteTypes ( ForeignRef )
@@ -169,8 +168,6 @@ instance Outputable SyntaxExprTc where
data HsWrap hs_syn = HsWrap HsWrapper -- the wrapper
(hs_syn GhcTc) -- the thing that is wrapped
-deriving instance (Data (hs_syn GhcTc), Typeable hs_syn) => Data (HsWrap hs_syn)
-
-- ---------------------------------------------------------------------
data HsBracketTc = HsBracketTc
@@ -427,9 +424,9 @@ data XXExprGhcTc
| ConLikeTc -- Result of typechecking a data-con
-- See Note [Typechecking data constructors] in
-- GHC.Tc.Gen.Head
- -- The two arguments describe how to eta-expand
- -- the data constructor when desugaring
- ConLike [TcTyVar] [Scaled TcType]
+ ConLike
+ [Scaled Type] -- ^ for a 'DataCon': constructor argument types
+ -- (ignored for a 'PatSynCon')
---------------------------------------
-- Haskell program coverage (Hpc) Support
@@ -685,7 +682,7 @@ instance Outputable XXExprGhcTc where
-- expression (LHsExpr GhcPs), not the
-- desugared one (LHsExpr GhcTc).
- ppr (ConLikeTc con _ _) = pprPrefixOcc con
+ ppr (ConLikeTc con _) = pprPrefixOcc con
-- Used in error messages generated by
-- the pattern match overlap checker
@@ -1198,7 +1195,7 @@ ppr_cmd (HsCmdArrForm _ (L _ op) ps_fix rn_fix args)
| HsVar _ (L _ v) <- op
= ppr_cmd_infix v
| GhcTc <- ghcPass @p
- , XExpr (ConLikeTc c _ _) <- op
+ , XExpr (ConLikeTc c _) <- op
= ppr_cmd_infix (conLikeName c)
| otherwise
= fall_through
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index 3f4c0b16bd..d0a578dd61 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -33,6 +33,7 @@ import GHC.Hs.Type
import GHC.Hs.Pat
import GHC.Hs.ImpExp
import GHC.Parser.Annotation
+import GHC.Tc.Types.Evidence
-- ---------------------------------------------------------------------
-- Data derivations from GHC.Hs-----------------------------------------
@@ -66,6 +67,10 @@ deriving instance Data (HsBindLR GhcTc GhcTc)
deriving instance Data AbsBinds
deriving instance Data ABExport
+deriving instance Data HsWrapper
+deriving instance (Data (hs_syn GhcTc), Typeable hs_syn) => Data (HsWrap hs_syn)
+deriving instance Data TcSpecPrags
+deriving instance Data TcSpecPrag
-- deriving instance DataId p => Data (RecordPatSynField p)
deriving instance Data (RecordPatSynField GhcPs)
diff --git a/compiler/GHC/Hs/Syn/Type.hs b/compiler/GHC/Hs/Syn/Type.hs
index 63b568df4a..ff7bcfc51f 100644
--- a/compiler/GHC/Hs/Syn/Type.hs
+++ b/compiler/GHC/Hs/Syn/Type.hs
@@ -138,7 +138,7 @@ hsExprType (HsStatic (_, ty) _s) = ty
hsExprType (HsPragE _ _ e) = lhsExprType e
hsExprType (XExpr (WrapExpr (HsWrap wrap e))) = hsWrapperType wrap $ hsExprType e
hsExprType (XExpr (ExpansionExpr (HsExpanded _ tc_e))) = hsExprType tc_e
-hsExprType (XExpr (ConLikeTc con _ _)) = conLikeType con
+hsExprType (XExpr (ConLikeTc con _)) = conLikeType con
hsExprType (XExpr (HsTick _ e)) = lhsExprType e
hsExprType (XExpr (HsBinTick _ _ e)) = lhsExprType e
@@ -186,7 +186,8 @@ hsWrapperType wrap ty = prTypeType $ go wrap (ty,[])
go (WpEvApp _) = liftPRType $ funResultTy
go (WpTyLam tv) = liftPRType $ mkForAllTy tv Inferred
go (WpTyApp ta) = \(ty,tas) -> (ty, ta:tas)
- go (WpLet _) = id
+ go (WpEvLet _) = id
+ go (WpHsLet {}) = id
go (WpMultCoercion _) = id
lhsCmdTopType :: LHsCmdTop GhcTc -> Type
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 4dd0aab928..44182569e2 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -457,7 +457,11 @@ mkHsCharPrimLit :: Char -> HsLit (GhcPass p)
mkHsCharPrimLit c = HsChar NoSourceText c
mkConLikeTc :: ConLike -> HsExpr GhcTc
-mkConLikeTc con = XExpr (ConLikeTc con [] [])
+mkConLikeTc con = XExpr (ConLikeTc con arg_tys)
+ where
+ arg_tys = case con of
+ RealDataCon dc -> dataConOrigArgTys dc
+ PatSynCon {} -> []
{-
************************************************************************
@@ -812,7 +816,7 @@ mkHsWrapPatCo co pat ty | isTcReflCo co = pat
| otherwise = XPat $ CoPat (mkWpCastN co) pat ty
mkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc
-mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr
+mkHsDictLet ev_binds expr = mkLHsWrap (mkWpEvLet ev_binds) expr
{-
l
View Lorry Controller Status