# Changeset View

Changeset View

# Standalone View

Standalone View

# compiler/prelude/TysWiredIn.hs

Show First 20 Lines • Show All 69 Lines • ▼ Show 20 Line(s) | 11 | module 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 | | |||

84 | import {-# SOURCE #-} MkId( mkDataConWorkId ) | 89 | import {-# SOURCE #-} MkId( mkDataConWorkId ) | ||

85 | 90 | | |||

86 | -- friends: | 91 | -- friends: | ||

87 | import PrelNames | 92 | import PrelNames | ||

88 | import TysPrim | 93 | import TysPrim | ||

89 | 94 | | |||

90 | -- others: | 95 | -- others: | ||

96 | import CoAxiom | ||||

97 | import Coercion | ||||

91 | import Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE ) | 98 | import Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE ) | ||

92 | import Module ( Module ) | 99 | import Module ( Module ) | ||

93 | import Type ( mkTyConApp ) | 100 | import Type ( mkTyConApp ) | ||

94 | import DataCon | 101 | import DataCon | ||

95 | import ConLike | 102 | import ConLike | ||

96 | import Var | 103 | import Var | ||

97 | import TyCon | 104 | import TyCon | ||

98 | import Class ( Class, mkClass ) | 105 | import Class ( Class, mkClass ) | ||

▲ Show 20 Lines • Show All 56 Lines • ▼ Show 20 Line(s) | 151 | wiredInTyCons = [ 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 | | |||

165 | mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name | 173 | mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name | ||

166 | mkWiredInTyConName 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 | | |||

171 | mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name | 179 | mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name | ||

172 | mkWiredInDataConName 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] | ||

178 | eqTyConName, eqBoxDataConName :: Name | 193 | eqTyConName, eqBoxDataConName :: Name | ||

179 | eqTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "~") eqTyConKey eqTyCon | 194 | eqTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "~") eqTyConKey eqTyCon | ||

180 | eqBoxDataConName = 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] | ||

183 | coercibleTyConName, coercibleDataConName :: Name | 198 | coercibleTyConName, coercibleDataConName :: Name | ||

184 | coercibleTyConName = 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 | | |||

884 | eqTyCon :: TyCon | 899 | eqTyCon :: TyCon | ||

885 | eqTyCon = 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] | ||

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 | | |||

Here's the call to I'm not performing the substitution myself, it happens at some point during typechecking. The general CoAxiom for IP is gridaphobe: Here's the call to `tyVarList` (sorry, got the name wrong in my previous comment).
I'm not… | |||||

Oh I see. That is HORRIBLE! Better: re-do mkTemplateTyVars :: [Kind] -> [TyVar] implemented much like Replace uses of In your use in class IP, don't use alphaTyVars, instead c.f. use of `mkTemplateLocals` in `MkId`. simonpj: Oh I see. That is HORRIBLE!
Better: re-do `tyVarList` thus:
```
mkTemplateTyVars :: [Kind] ->… | |||||

901 | eqBoxDataCon :: DataCon | 916 | eqBoxDataCon :: DataCon | ||

902 | eqBoxDataCon = 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 | | |||

910 | coercibleTyCon :: TyCon | 925 | coercibleTyCon :: TyCon | ||

911 | coercibleTyCon = 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 | | |||

921 | coercibleDataCon :: DataCon | 936 | coercibleDataCon :: DataCon | ||

922 | coercibleDataCon = 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 | | |||

929 | coercibleClass :: Class | 944 | coercibleClass :: Class | ||

930 | coercibleClass = 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 [] [] |

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.