1{-# LANGUAGE AllowAmbiguousTypes #-} -- for pprIfTc, etc. 2{-# LANGUAGE ConstraintKinds #-} 3{-# LANGUAGE DataKinds #-} 4{-# LANGUAGE DeriveDataTypeable #-} 5{-# LANGUAGE EmptyDataDeriving #-} 6{-# LANGUAGE FlexibleContexts #-} 7{-# LANGUAGE FlexibleInstances #-} 8{-# LANGUAGE GADTs #-} 9{-# LANGUAGE MultiParamTypeClasses #-} 10{-# LANGUAGE RankNTypes #-} 11{-# LANGUAGE ScopedTypeVariables #-} 12{-# LANGUAGE TypeApplications #-} 13{-# LANGUAGE TypeFamilyDependencies #-} 14{-# LANGUAGE UndecidableSuperClasses #-} -- for IsPass; see Note [NoGhcTc] 15{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] 16 -- in module Language.Haskell.Syntax.Extension 17 18module GHC.Hs.Extension where 19 20-- This module captures the type families to precisely identify the extension 21-- points for GHC.Hs syntax 22 23import GHC.Prelude 24 25import Data.Data hiding ( Fixity ) 26import Language.Haskell.Syntax.Extension 27import GHC.Types.Name 28import GHC.Types.Name.Reader 29import GHC.Types.Var 30import GHC.Utils.Outputable hiding ((<>)) 31import GHC.Types.SrcLoc (GenLocated(..), unLoc) 32import GHC.Utils.Panic 33import GHC.Parser.Annotation 34 35{- 36Note [IsPass] 37~~~~~~~~~~~~~ 38One challenge with the Trees That Grow approach 39is that we sometimes have different information in different passes. 40For example, we have 41 42 type instance XViaStrategy GhcPs = LHsSigType GhcPs 43 type instance XViaStrategy GhcRn = LHsSigType GhcRn 44 type instance XViaStrategy GhcTc = Type 45 46This means that printing a DerivStrategy (which contains an XViaStrategy) 47might need to print a LHsSigType, or it might need to print a type. Yet we 48want one Outputable instance for a DerivStrategy, instead of one per pass. We 49could have a large constraint, including e.g. (Outputable (XViaStrategy p), 50Outputable (XViaStrategy GhcTc)), and pass that around in every context where 51we might output a DerivStrategy. But a simpler alternative is to pass a 52witness to whichever pass we're in. When we pattern-match on that (GADT) 53witness, we learn the pass identity and can then print away. To wit, we get 54the definition of GhcPass and the functions isPass. These allow us to do away 55with big constraints, passing around all manner of dictionaries we might or 56might not use. It does mean that we have to manually use isPass when printing, 57but these places are few. 58 59See Note [NoGhcTc] about the superclass constraint to IsPass. 60 61Note [NoGhcTc] 62~~~~~~~~~~~~~~ 63An expression is parsed into HsExpr GhcPs, renamed into HsExpr GhcRn, and 64then type-checked into HsExpr GhcTc. Not so for types! These get parsed 65into HsType GhcPs, renamed into HsType GhcRn, and then type-checked into 66Type. We never build an HsType GhcTc. Why do this? Because we need to be 67able to compare type-checked types for equality, and we don't want to do 68this with HsType. 69 70This causes wrinkles within the AST, where we normally think that the whole 71AST travels through the GhcPs --> GhcRn --> GhcTc pipeline as one. So we 72have the NoGhcTc type family, which just replaces GhcTc with GhcRn, so that 73user-written types can be preserved (as HsType GhcRn) even in e.g. HsExpr GhcTc. 74 75For example, this is used in ExprWithTySig: 76 | ExprWithTySig 77 (XExprWithTySig p) 78 79 (LHsExpr p) 80 (LHsSigWcType (NoGhcTc p)) 81 82If we have (e :: ty), we still want to be able to print that (with the :: ty) 83after type-checking. So we retain the LHsSigWcType GhcRn, even in an 84HsExpr GhcTc. That's what NoGhcTc does. 85 86When we're printing the type annotation, we need to know 87(Outputable (LHsSigWcType GhcRn)), even though we've assumed only that 88(OutputableBndrId GhcTc). We thus must be able to prove OutputableBndrId (NoGhcTc p) 89from OutputableBndrId p. The extra constraints in OutputableBndrId and 90the superclass constraints of IsPass allow this. Note that the superclass 91constraint of IsPass is *recursive*: it asserts that IsPass (NoGhcTcPass p) holds. 92For this to make sense, we need -XUndecidableSuperClasses and the other constraint, 93saying that NoGhcTcPass is idempotent. 94 95-} 96 97-- See Note [XRec and Anno in the AST] in GHC.Parser.Annotation 98type instance XRec (GhcPass p) a = GenLocated (Anno a) a 99 100type instance Anno RdrName = SrcSpanAnnN 101type instance Anno Name = SrcSpanAnnN 102type instance Anno Id = SrcSpanAnnN 103 104type IsSrcSpanAnn p a = ( Anno (IdGhcP p) ~ SrcSpanAnn' (EpAnn a), 105 IsPass p) 106 107instance UnXRec (GhcPass p) where 108 unXRec = unLoc 109instance MapXRec (GhcPass p) where 110 mapXRec = fmap 111 112-- instance WrapXRec (GhcPass p) a where 113-- wrapXRec = noLocA 114 115{- 116Note [NoExtCon and strict fields] 117~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 118Currently, any unused TTG extension constructor will generally look like the 119following: 120 121 type instance XXHsDecl (GhcPass _) = NoExtCon 122 data HsDecl p 123 = ... 124 | XHsDecl !(XXHsDecl p) 125 126The field of type `XXHsDecl p` is strict for a good reason: it allows the 127pattern-match coverage checker to conclude that any matches against XHsDecl 128are unreachable whenever `p ~ GhcPass _`. To see why this is the case, consider 129the following function which consumes an HsDecl: 130 131 ex :: HsDecl GhcPs -> HsDecl GhcRn 132 ... 133 ex (XHsDecl nec) = noExtCon nec 134 135Because `p` equals GhcPs (i.e., GhcPass 'Parsed), XHsDecl's field has the type 136NoExtCon. But since (1) the field is strict and (2) NoExtCon is an empty data 137type, there is no possible way to reach the right-hand side of the XHsDecl 138case. As a result, the coverage checker concludes that the XHsDecl case is 139inaccessible, so it can be removed. 140(See Note [Strict argument type constraints] in GHC.HsToCore.Pmc.Solver for 141more on how this works.) 142 143Bottom line: if you add a TTG extension constructor that uses NoExtCon, make 144sure that any uses of it as a field are strict. 145-} 146 147-- | Used as a data type index for the hsSyn AST; also serves 148-- as a singleton type for Pass 149data GhcPass (c :: Pass) where 150 GhcPs :: GhcPass 'Parsed 151 GhcRn :: GhcPass 'Renamed 152 GhcTc :: GhcPass 'Typechecked 153 154-- This really should never be entered, but the data-deriving machinery 155-- needs the instance to exist. 156instance Typeable p => Data (GhcPass p) where 157 gunfold _ _ _ = panic "instance Data GhcPass" 158 toConstr _ = panic "instance Data GhcPass" 159 dataTypeOf _ = panic "instance Data GhcPass" 160 161data Pass = Parsed | Renamed | Typechecked 162 deriving (Data) 163 164-- Type synonyms as a shorthand for tagging 165type GhcPs = GhcPass 'Parsed -- Output of parser 166type GhcRn = GhcPass 'Renamed -- Output of renamer 167type GhcTc = GhcPass 'Typechecked -- Output of typechecker 168 169-- | Allows us to check what phase we're in at GHC's runtime. 170-- For example, this class allows us to write 171-- > f :: forall p. IsPass p => HsExpr (GhcPass p) -> blah 172-- > f e = case ghcPass @p of 173-- > GhcPs -> ... in this RHS we have HsExpr GhcPs... 174-- > GhcRn -> ... in this RHS we have HsExpr GhcRn... 175-- > GhcTc -> ... in this RHS we have HsExpr GhcTc... 176-- which is very useful, for example, when pretty-printing. 177-- See Note [IsPass]. 178class ( NoGhcTcPass (NoGhcTcPass p) ~ NoGhcTcPass p 179 , IsPass (NoGhcTcPass p) 180 ) => IsPass p where 181 ghcPass :: GhcPass p 182 183instance IsPass 'Parsed where 184 ghcPass = GhcPs 185instance IsPass 'Renamed where 186 ghcPass = GhcRn 187instance IsPass 'Typechecked where 188 ghcPass = GhcTc 189 190type instance IdP (GhcPass p) = IdGhcP p 191 192-- | Maps the "normal" id type for a given GHC pass 193type family IdGhcP pass where 194 IdGhcP 'Parsed = RdrName 195 IdGhcP 'Renamed = Name 196 IdGhcP 'Typechecked = Id 197 198-- | Marks that a field uses the GhcRn variant even when the pass 199-- parameter is GhcTc. Useful for storing HsTypes in GHC.Hs.Exprs, say, because 200-- HsType GhcTc should never occur. 201-- See Note [NoGhcTc] 202 203-- Breaking it up this way, GHC can figure out that the result is a GhcPass 204type instance NoGhcTc (GhcPass pass) = GhcPass (NoGhcTcPass pass) 205 206type family NoGhcTcPass (p :: Pass) :: Pass where 207 NoGhcTcPass 'Typechecked = 'Renamed 208 NoGhcTcPass other = other 209 210-- |Constraint type to bundle up the requirement for 'OutputableBndr' on both 211-- the @id@ and the 'NoGhcTc' of it. See Note [NoGhcTc]. 212type OutputableBndrId pass = 213 ( OutputableBndr (IdGhcP pass) 214 , OutputableBndr (IdGhcP (NoGhcTcPass pass)) 215 , Outputable (GenLocated (Anno (IdGhcP pass)) (IdGhcP pass)) 216 , Outputable (GenLocated (Anno (IdGhcP (NoGhcTcPass pass))) (IdGhcP (NoGhcTcPass pass))) 217 , IsPass pass 218 ) 219 220-- useful helper functions: 221pprIfPs :: forall p. IsPass p => (p ~ 'Parsed => SDoc) -> SDoc 222pprIfPs pp = case ghcPass @p of GhcPs -> pp 223 _ -> empty 224 225pprIfRn :: forall p. IsPass p => (p ~ 'Renamed => SDoc) -> SDoc 226pprIfRn pp = case ghcPass @p of GhcRn -> pp 227 _ -> empty 228 229pprIfTc :: forall p. IsPass p => (p ~ 'Typechecked => SDoc) -> SDoc 230pprIfTc pp = case ghcPass @p of GhcTc -> pp 231 _ -> empty 232