summaryrefslogtreecommitdiff
path: root/compiler/Language
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/Language')
-rw-r--r--compiler/Language/Haskell/Syntax/Decls.hs28
-rw-r--r--compiler/Language/Haskell/Syntax/Expr.hs17
-rw-r--r--compiler/Language/Haskell/Syntax/Extension.hs2
-rw-r--r--compiler/Language/Haskell/Syntax/ImpExp.hs2
-rw-r--r--compiler/Language/Haskell/Syntax/Pat.hs7
5 files changed, 47 insertions, 9 deletions
diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs
index 0af2cfbf94..52475a9dfe 100644
--- a/compiler/Language/Haskell/Syntax/Decls.hs
+++ b/compiler/Language/Haskell/Syntax/Decls.hs
@@ -45,7 +45,7 @@ module Language.Haskell.Syntax.Decls (
FamilyDecl(..), LFamilyDecl,
-- ** Instance declarations
- InstDecl(..), LInstDecl, FamilyInfo(..),
+ InstDecl(..), LInstDecl, FamilyInfo(..), familyInfoTyConFlavour,
TyFamInstDecl(..), LTyFamInstDecl,
TyFamDefltDecl, LTyFamDefltDecl,
DataFamInstDecl(..), LDataFamInstDecl,
@@ -99,12 +99,14 @@ import Language.Haskell.Syntax.Extension
import Language.Haskell.Syntax.Type
import Language.Haskell.Syntax.Basic (Role)
-import GHC.Types.Basic (TopLevelFlag, OverlapMode, RuleName, Activation)
+import GHC.Types.Basic (TopLevelFlag, OverlapMode, RuleName, Activation
+ ,TyConFlavour(..), TypeOrData(..))
import GHC.Types.ForeignCall (CType, CCallConv, Safety, Header, CLabelString, CCallTarget, CExportSpec)
import GHC.Types.Fixity (LexicalFixity)
import GHC.Core.Type (Specificity)
import GHC.Unit.Module.Warnings (WarningTxt)
+import GHC.Utils.Panic.Plain ( assert )
import GHC.Hs.Doc (LHsDoc) -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST
@@ -863,6 +865,28 @@ data FamilyInfo pass
-- said "type family Foo x where .."
| ClosedTypeFamily (Maybe [LTyFamInstEqn pass])
+familyInfoTyConFlavour
+ :: Maybe tc -- ^ Just cls <=> this is an associated family of class cls
+ -> FamilyInfo pass
+ -> TyConFlavour tc
+familyInfoTyConFlavour mb_parent_tycon info =
+ case info of
+ DataFamily -> OpenFamilyFlavour IAmData mb_parent_tycon
+ OpenTypeFamily -> OpenFamilyFlavour IAmType mb_parent_tycon
+ ClosedTypeFamily _ -> assert (isNothing mb_parent_tycon)
+ -- See Note [Closed type family mb_parent_tycon]
+ ClosedTypeFamilyFlavour
+
+{- Note [Closed type family mb_parent_tycon]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There's no way to write a closed type family inside a class declaration:
+
+ class C a where
+ type family F a where -- error: parse error on input ‘where’
+
+In fact, it is not clear what the meaning of such a declaration would be.
+Therefore, 'mb_parent_tycon' of any closed type family has to be Nothing.
+-}
{- *********************************************************************
* *
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs
index 1af91044dd..46419787f8 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -5,6 +5,7 @@
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
@@ -39,7 +40,6 @@ import GHC.Data.FastString (FastString)
-- libraries:
import Data.Data hiding (Fixity(..))
import Data.Bool
-import Data.Either
import Data.Eq
import Data.Maybe
import Data.List.NonEmpty ( NonEmpty )
@@ -147,6 +147,19 @@ type LHsRecProj p arg = XRec p (RecProj p arg)
type RecUpdProj p = RecProj p (LHsExpr p)
type LHsRecUpdProj p = XRec p (RecUpdProj p)
+-- | Haskell Record Update Fields.
+data LHsRecUpdFields p where
+ -- | A regular (non-overloaded) record update.
+ RegularRecUpdFields
+ :: { xRecUpdFields :: XLHsRecUpdLabels p
+ , recUpdFields :: [LHsRecUpdField p p] }
+ -> LHsRecUpdFields p
+ -- | An overloaded record update.
+ OverloadedRecUpdFields
+ :: { xOLRecUpdFields :: XLHsOLRecUpdLabels p
+ , olRecUpdFields :: [LHsRecUpdProj p] }
+ -> LHsRecUpdFields p
+
{-
************************************************************************
* *
@@ -463,7 +476,7 @@ data HsExpr p
| RecordUpd
{ rupd_ext :: XRecordUpd p
, rupd_expr :: LHsExpr p
- , rupd_flds :: Either [LHsRecUpdField p] [LHsRecUpdProj p]
+ , rupd_flds :: LHsRecUpdFields p
}
-- For a type family, the arg types are of the *instance* tycon,
-- not the family tycon
diff --git a/compiler/Language/Haskell/Syntax/Extension.hs b/compiler/Language/Haskell/Syntax/Extension.hs
index 9ad16c0cd7..b184f1f46b 100644
--- a/compiler/Language/Haskell/Syntax/Extension.hs
+++ b/compiler/Language/Haskell/Syntax/Extension.hs
@@ -432,6 +432,8 @@ type family XDo x
type family XExplicitList x
type family XRecordCon x
type family XRecordUpd x
+type family XLHsRecUpdLabels x
+type family XLHsOLRecUpdLabels x
type family XGetField x
type family XProjection x
type family XExprWithTySig x
diff --git a/compiler/Language/Haskell/Syntax/ImpExp.hs b/compiler/Language/Haskell/Syntax/ImpExp.hs
index fcb8ede0e7..08be638003 100644
--- a/compiler/Language/Haskell/Syntax/ImpExp.hs
+++ b/compiler/Language/Haskell/Syntax/ImpExp.hs
@@ -127,7 +127,7 @@ data IE pass
-- ^ Imported or exported Thing With given imported or exported
--
-- The thing is a Class/Type and the imported or exported things are
- -- methods/constructors and record fields; see Note [IEThingWith]
+ -- its children.
-- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen',
-- 'GHC.Parser.Annotation.AnnClose',
-- 'GHC.Parser.Annotation.AnnComma',
diff --git a/compiler/Language/Haskell/Syntax/Pat.hs b/compiler/Language/Haskell/Syntax/Pat.hs
index 66b9708bfe..5e6f12c4b8 100644
--- a/compiler/Language/Haskell/Syntax/Pat.hs
+++ b/compiler/Language/Haskell/Syntax/Pat.hs
@@ -280,13 +280,13 @@ type LHsFieldBind p id arg = XRec p (HsFieldBind id arg)
type LHsRecField p arg = XRec p (HsRecField p arg)
-- | Located Haskell Record Update Field
-type LHsRecUpdField p = XRec p (HsRecUpdField p)
+type LHsRecUpdField p q = XRec p (HsRecUpdField p q)
-- | Haskell Record Field
type HsRecField p arg = HsFieldBind (LFieldOcc p) arg
-- | Haskell Record Update Field
-type HsRecUpdField p = HsFieldBind (LAmbiguousFieldOcc p) (LHsExpr p)
+type HsRecUpdField p q = HsFieldBind (LAmbiguousFieldOcc p) (LHsExpr q)
-- | Haskell Field Binding
--
@@ -353,7 +353,7 @@ data HsFieldBind lhs rhs = HsFieldBind {
--
-- hfbLHS = Unambiguous "x" $sel:x:MkS :: AmbiguousFieldOcc Id
--
--- See also Note [Disambiguating record fields] in GHC.Tc.Gen.Head.
+-- See also Note [Disambiguating record updates] in GHC.Rename.Pat.
hsRecFields :: forall p arg.UnXRec p => HsRecFields p arg -> [XCFieldOcc p]
hsRecFields rbinds = Data.List.map (hsRecFieldSel . unXRec @p) (rec_flds rbinds)
@@ -363,4 +363,3 @@ hsRecFieldsArgs rbinds = Data.List.map (hfbRHS . unXRec @p) (rec_flds rbinds)
hsRecFieldSel :: forall p arg. UnXRec p => HsRecField p arg -> XCFieldOcc p
hsRecFieldSel = foExt . unXRec @p . hfbLHS
-
View Lorry Controller Status