Differential D861 Diff 4019 compiler/prelude/TysWiredIn.hs

Changeset View

Standalone View

View Options

compiler/prelude/TysWiredIn.hs

Show First 20 Lines • Show All 69 Lines • ▼ Show 20 Line(s)11module TysWiredIn (
70 mkPArrTy, 70​ mkPArrTy,
71 parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon, 71​ parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon,
72 parrTyCon_RDR, parrTyConName, 72​ parrTyCon_RDR, parrTyConName,
73 73​
74 -- * Equality predicates 74​ -- * Equality predicates
75 eqTyCon_RDR, eqTyCon, eqTyConName, eqBoxDataCon, 75​ eqTyCon_RDR, eqTyCon, eqTyConName, eqBoxDataCon,
76 coercibleTyCon, coercibleDataCon, coercibleClass, 76​ coercibleTyCon, coercibleDataCon, coercibleClass,
77 77​
78​ -- * Implicit Parameters
79​ ipTyCon, ipDataCon, ipClass,
80​
81​ callStackTyCon,
82​
78 mkWiredInTyConName -- This is used in TcTypeNats to define the 83​ mkWiredInTyConName -- This is used in TcTypeNats to define the
79 -- built-in functions for evaluation. 84​ -- built-in functions for evaluation.
80 ) where 85​ ) where
81 86​
82#include "HsVersions.h" 87​#include "HsVersions.h"
83 88​
84import {-# SOURCE #-} MkId( mkDataConWorkId ) 89​import {-# SOURCE #-} MkId( mkDataConWorkId )
85 90​
86-- friends: 91​-- friends:
87import PrelNames 92​import PrelNames
88import TysPrim 93​import TysPrim
89 94​
90-- others: 95​-- others:
96​import CoAxiom
97​import Coercion
91import Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE ) 98​import Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE )
92import Module ( Module ) 99​import Module ( Module )
93import Type ( mkTyConApp ) 100​import Type ( mkTyConApp )
94import DataCon 101​import DataCon
95import ConLike 102​import ConLike
96import Var 103​import Var
97import TyCon 104​import TyCon
98import Class ( Class, mkClass ) 105​import Class ( Class, mkClass )
▲ Show 20 Lines • Show All 56 Lines • ▼ Show 20 Line(s)151wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because
155 , wordTyCon 162​ , wordTyCon
156 , word8TyCon 163​ , word8TyCon
157 , listTyCon 164​ , listTyCon
158 , parrTyCon 165​ , parrTyCon
159 , eqTyCon 166​ , eqTyCon
160 , coercibleTyCon 167​ , coercibleTyCon
161 , typeNatKindCon 168​ , typeNatKindCon
162 , typeSymbolKindCon 169​ , typeSymbolKindCon
170​ , ipTyCon
163 ] 171​ ]
164 172​
165mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name 173​mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
166mkWiredInTyConName built_in modu fs unique tycon 174​mkWiredInTyConName built_in modu fs unique tycon
167 = mkWiredInName modu (mkTcOccFS fs) unique 175​ = mkWiredInName modu (mkTcOccFS fs) unique
168 (ATyCon tycon) -- Relevant TyCon 176​ (ATyCon tycon) -- Relevant TyCon
169 built_in 177​ built_in
170 178​
171mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name 179​mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
172mkWiredInDataConName built_in modu fs unique datacon 180​mkWiredInDataConName built_in modu fs unique datacon
173 = mkWiredInName modu (mkDataOccFS fs) unique 181​ = mkWiredInName modu (mkDataOccFS fs) unique
174 (AConLike (RealDataCon datacon)) -- Relevant DataCon 182​ (AConLike (RealDataCon datacon)) -- Relevant DataCon
175 built_in 183​ built_in
176 184​
185​mkWiredInCoAxiomName :: BuiltInSyntax -> Module -> FastString -> Unique
186​ -> CoAxiom Branched -> Name
187​mkWiredInCoAxiomName built_in modu fs unique ax
188​ = mkWiredInName modu (mkTcOccFS fs) unique
189​ (ACoAxiom ax) -- Relevant CoAxiom
190​ built_in
191​
177-- See Note [Kind-changing of (~) and Coercible] 192​-- See Note [Kind-changing of (~) and Coercible]
178eqTyConName, eqBoxDataConName :: Name 193​eqTyConName, eqBoxDataConName :: Name
179eqTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "~") eqTyConKey eqTyCon 194​eqTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "~") eqTyConKey eqTyCon
180eqBoxDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Eq#") eqBoxDataConKey eqBoxDataCon 195​eqBoxDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "Eq#") eqBoxDataConKey eqBoxDataCon
181 196​
182-- See Note [Kind-changing of (~) and Coercible] 197​-- See Note [Kind-changing of (~) and Coercible]
183coercibleTyConName, coercibleDataConName :: Name 198​coercibleTyConName, coercibleDataConName :: Name
184coercibleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Coercible") coercibleTyConKey coercibleTyCon 199​coercibleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Coercible") coercibleTyConKey coercibleTyCon
▲ Show 20 Lines • Show All 694 Lines • ▼ Show 20 Line(s)
879* * 894​* *
880 Type equalities 895​ Type equalities
881* * 896​* *
882********************************************************************* -} 897​********************************************************************* -}
883 898​
884eqTyCon :: TyCon 899​eqTyCon :: TyCon
885eqTyCon = mkAlgTyCon eqTyConName 900​eqTyCon = mkAlgTyCon eqTyConName
886 (ForAllTy kv $ mkArrowKinds [k, k] constraintKind) 901​ (ForAllTy kv $ mkArrowKinds [k, k] constraintKind)
887 [kv, a, b] 902​ [kv, a, b]
simonpjUnsubmitted
Not Done

I know this is not done for other types, but give a comment with the class declaration that you are implementing here. That give you a chance to highlight the kinds, name the type variables etc.

Also mention why it is wired in.

A Note, in short.

simonpj: I know this is not done for other types, but give a comment with the class declaration that you…
888 [Nominal, Nominal, Nominal] 903​ [Nominal, Nominal, Nominal]
889 Nothing 904​ Nothing
890 [] -- No stupid theta 905​ [] -- No stupid theta
891 (DataTyCon [eqBoxDataCon] False) 906​ (DataTyCon [eqBoxDataCon] False)
892 NoParentTyCon 907​ NoParentTyCon
893 NonRecursive 908​ NonRecursive
894 False 909​ False
895 Nothing -- No parent for constraint-kinded types 910​ Nothing -- No parent for constraint-kinded types
896 where 911​ where
897 kv = kKiVar 912​ kv = kKiVar
898 k = mkTyVarTy kv 913​ k = mkTyVarTy kv
899 a:b:_ = tyVarList k 914​ [a,b] = mkTemplateTyVars [k,k]
900 915​
gridaphobeAuthorUnsubmitted
Not Done

Here's the call to tyVarList (sorry, got the name wrong in my previous comment).

I'm not performing the substitution myself, it happens at some point during typechecking. The general CoAxiom for IP is IP (ip :: Symbol) a ~ a, but the typechecker will eventually need to instantiate a with the actual type of the implicit parameter (e.g. CallStack). It's this instantiation that I believe was the culprit.

gridaphobe: Here's the call to `tyVarList` (sorry, got the name wrong in my previous comment). I'm not…
simonpjUnsubmitted
Not Done

Oh I see. That is HORRIBLE!

Better: re-do tyVarList thus:

mkTemplateTyVars :: [Kind] -> [TyVar]

implemented much like tyVarList is today, but with varying kinds.

Replace uses of tyVarList with mkTemplateTyVars.

In your use in class IP, don't use alphaTyVars, instead
``
[stv, atv] = mkTemplateTyVars [symbolTypeKind, liftedTypeKind]

c.f. use of `mkTemplateLocals` in `MkId`.
simonpj: Oh I see. That is HORRIBLE! Better: re-do `tyVarList` thus: ``` mkTemplateTyVars :: [Kind] ->…
901eqBoxDataCon :: DataCon 916​eqBoxDataCon :: DataCon
902eqBoxDataCon = pcDataCon eqBoxDataConName args [TyConApp eqPrimTyCon (map mkTyVarTy args)] eqTyCon 917​eqBoxDataCon = pcDataCon eqBoxDataConName args [TyConApp eqPrimTyCon (map mkTyVarTy args)] eqTyCon
903 where 918​ where
904 kv = kKiVar 919​ kv = kKiVar
905 k = mkTyVarTy kv 920​ k = mkTyVarTy kv
906 a:b:_ = tyVarList k 921​ [a,b] = mkTemplateTyVars [k,k]
907 args = [kv, a, b] 922​ args = [kv, a, b]
908 923​
909 924​
910coercibleTyCon :: TyCon 925​coercibleTyCon :: TyCon
911coercibleTyCon = mkClassTyCon 926​coercibleTyCon = mkClassTyCon
912 coercibleTyConName kind tvs [Nominal, Representational, Representational] 927​ coercibleTyConName kind tvs [Nominal, Representational, Representational]
913 rhs coercibleClass NonRecursive 928​ rhs coercibleClass NonRecursive
914 where kind = (ForAllTy kv $ mkArrowKinds [k, k] constraintKind) 929​ where kind = (ForAllTy kv $ mkArrowKinds [k, k] constraintKind)
915 kv = kKiVar 930​ kv = kKiVar
916 k = mkTyVarTy kv 931​ k = mkTyVarTy kv
917 a:b:_ = tyVarList k 932​ [a,b] = mkTemplateTyVars [k,k]
918 tvs = [kv, a, b] 933​ tvs = [kv, a, b]
919 rhs = DataTyCon [coercibleDataCon] False 934​ rhs = DataTyCon [coercibleDataCon] False
920 935​
921coercibleDataCon :: DataCon 936​coercibleDataCon :: DataCon
922coercibleDataCon = pcDataCon coercibleDataConName args [TyConApp eqReprPrimTyCon (map mkTyVarTy args)] coercibleTyCon 937​coercibleDataCon = pcDataCon coercibleDataConName args [TyConApp eqReprPrimTyCon (map mkTyVarTy args)] coercibleTyCon
923 where 938​ where
924 kv = kKiVar 939​ kv = kKiVar
925 k = mkTyVarTy kv 940​ k = mkTyVarTy kv
926 a:b:_ = tyVarList k 941​ [a,b] = mkTemplateTyVars [k,k]
927 args = [kv, a, b] 942​ args = [kv, a, b]
928 943​
929coercibleClass :: Class 944​coercibleClass :: Class
930coercibleClass = mkClass (tyConTyVars coercibleTyCon) [] [] [] [] [] (mkAnd []) coercibleTyCon 945​coercibleClass = mkClass (tyConTyVars coercibleTyCon) [] [] [] [] [] (mkAnd []) coercibleTyCon
946​
947​{-
948​Note [The Implicit Parameter class]
949​
950​Implicit parameters `?x :: a` are desugared into dictionaries for the
951​class `IP "x" a`, which is defined (in GHC.Classes) as
952​
953​ class IP (x :: Symbol) a | x -> a
954​
955​This class is wired-in so that `error` and `undefined`, which have
956​wired-in types, can use the implicit-call-stack feature to provide
957​a call-stack alongside the error message.
958​-}
959​
960​ipDataConName, ipTyConName, ipCoName :: Name
961​ipDataConName = mkWiredInDataConName UserSyntax gHC_CLASSES (fsLit "IP")
962​ ipDataConKey ipDataCon
963​ipTyConName = mkWiredInTyConName UserSyntax gHC_CLASSES (fsLit "IP")
964​ ipTyConKey ipTyCon
965​ipCoName = mkWiredInCoAxiomName BuiltInSyntax gHC_CLASSES (fsLit "NTCo:IP")
966​ ipCoNameKey (toBranchedAxiom ipCoAxiom)
967​
968​-- See Note [The Implicit Parameter class]
969​ipTyCon :: TyCon
970​ipTyCon = mkClassTyCon ipTyConName kind [ip,a] [] rhs ipClass NonRecursive
971​ where
972​ kind = mkArrowKinds [typeSymbolKind, liftedTypeKind] constraintKind
973​ [ip,a] = mkTemplateTyVars [typeSymbolKind, liftedTypeKind]
974​ rhs = NewTyCon ipDataCon (mkTyVarTy a) ([], mkTyVarTy a) ipCoAxiom
975​
976​ipCoAxiom :: CoAxiom Unbranched
977​ipCoAxiom = mkNewTypeCo ipCoName ipTyCon [ip,a] [Nominal, Nominal] (mkTyVarTy a)
978​ where
979​ [ip,a] = mkTemplateTyVars [typeSymbolKind, liftedTypeKind]
980​
981​ipDataCon :: DataCon
982​ipDataCon = pcDataCon ipDataConName [ip,a] ts ipTyCon
983​ where
984​ [ip,a] = mkTemplateTyVars [typeSymbolKind, liftedTypeKind]
985​ ts = [mkTyVarTy a]
986​
987​ipClass :: Class
988​ipClass = mkClass (tyConTyVars ipTyCon) [([ip], [a])] [] [] [] [] (mkAnd [])
989​ ipTyCon
990​ where
991​ [ip, a] = tyConTyVars ipTyCon
992​
993​-- this is a fake version of the CallStack TyCon so we can refer to it
994​-- in MkCore.errorTy
995​callStackTyCon :: TyCon
996​callStackTyCon = pcNonRecDataTyCon callStackTyConName Nothing [] []