Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
829be066
Commit
829be066
authored
Jan 25, 2013
by
Simon Peyton Jones
Browse files
Use kind 'Symbol' consistently, rather than kind 'String'
parent
09ff0e0d
Changes
5
Hide whitespace changes
Inline
Side-by-side
compiler/prelude/PrelNames.lhs
View file @
829be066
...
...
@@ -1411,11 +1411,11 @@ repTyConKey = mkPreludeTyConUnique 155
rep1TyConKey = mkPreludeTyConUnique 156
-- Type-level naturals
typeNatKindConNameKey, typeS
tring
KindConNameKey,
typeNatKindConNameKey, typeS
ymbol
KindConNameKey,
typeNatAddTyFamNameKey, typeNatMulTyFamNameKey, typeNatExpTyFamNameKey
:: Unique
typeNatKindConNameKey = mkPreludeTyConUnique 160
typeS
tring
KindConNameKey = mkPreludeTyConUnique 161
typeS
ymbol
KindConNameKey = mkPreludeTyConUnique 161
typeNatAddTyFamNameKey = mkPreludeTyConUnique 162
typeNatMulTyFamNameKey = mkPreludeTyConUnique 163
typeNatExpTyFamNameKey = mkPreludeTyConUnique 164
...
...
compiler/prelude/TysWiredIn.lhs
View file @
829be066
...
...
@@ -65,7 +65,7 @@ module TysWiredIn (
unitTy,
-- * Kinds
typeNatKindCon, typeNatKind, typeS
tring
KindCon, typeS
tring
Kind,
typeNatKindCon, typeNatKind, typeS
ymbol
KindCon, typeS
ymbol
Kind,
-- * Parallel arrays
mkPArrTy,
...
...
@@ -152,7 +152,7 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because
, parrTyCon
, eqTyCon
, typeNatKindCon
, typeS
tring
KindCon
, typeS
ymbol
KindCon
]
++ (case cIntegerLibraryType of
IntegerGMP -> [integerTyCon]
...
...
@@ -199,9 +199,9 @@ doubleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Double")
doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") doubleDataConKey doubleDataCon
-- Kinds
typeNatKindConName, typeS
tring
KindConName :: Name
typeNatKindConName, typeS
ymbol
KindConName :: Name
typeNatKindConName = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "Nat") typeNatKindConNameKey typeNatKindCon
typeS
tring
KindConName = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "Symbol") typeS
tring
KindConNameKey typeS
tring
KindCon
typeS
ymbol
KindConName = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "Symbol") typeS
ymbol
KindConNameKey typeS
ymbol
KindCon
-- For integer-gmp only:
integerRealTyConName :: Name
...
...
@@ -304,15 +304,15 @@ pcDataConWithFixity' declared_infix dc_name wrk_key tyvars arg_tys tycon
%************************************************************************
\begin{code}
typeNatKindCon, typeS
tring
KindCon :: TyCon
typeNatKindCon, typeS
ymbol
KindCon :: TyCon
-- data Nat
-- data Symbol
typeNatKindCon = pc
NonRecDataTyCon
typeNatKindConName Nothing [] []
typeS
tring
KindCon = pc
NonRecDataTyCon
typeS
tring
KindConName Nothing [] []
typeNatKindCon = pc
TyCon False NonRecursive True
typeNatKindConName Nothing [] []
typeS
ymbol
KindCon = pc
TyCon False NonRecursive True
typeS
ymbol
KindConName Nothing [] []
typeNatKind, typeS
tring
Kind :: Kind
typeNatKind, typeS
ymbol
Kind :: Kind
typeNatKind = TyConApp (promoteTyCon typeNatKindCon) []
typeS
tring
Kind = TyConApp (promoteTyCon typeS
tring
KindCon) []
typeS
ymbol
Kind = TyConApp (promoteTyCon typeS
ymbol
KindCon) []
\end{code}
...
...
compiler/prelude/TysWiredIn.lhs-boot
View file @
829be066
...
...
@@ -6,6 +6,6 @@ import {-# SOURCE #-} TypeRep (Type)
eqTyCon :: TyCon
typeNatKind, typeS
tring
Kind :: Type
typeNatKind, typeS
ymbol
Kind :: Type
mkBoxedTupleTy :: [Type] -> Type
\end{code}
compiler/typecheck/TcHsType.lhs
View file @
829be066
...
...
@@ -511,8 +511,8 @@ tc_hs_type hs_ty@(HsTyLit (HsNumTy n)) exp_kind
; return (mkNumLitTy n) }
tc_hs_type hs_ty@(HsTyLit (HsStrTy s)) exp_kind
= do { checkExpectedKind hs_ty typeS
tring
Kind exp_kind
; checkWiredInTyCon typeS
tring
KindCon
= do { checkExpectedKind hs_ty typeS
ymbol
Kind exp_kind
; checkWiredInTyCon typeS
ymbol
KindCon
; return (mkStrLitTy s) }
---------------------------
...
...
compiler/types/Type.lhs
View file @
829be066
...
...
@@ -154,7 +154,7 @@ import VarSet
import Class
import TyCon
import TysPrim
import {-# SOURCE #-} TysWiredIn ( eqTyCon, typeNatKind, typeS
tring
Kind )
import {-# SOURCE #-} TysWiredIn ( eqTyCon, typeNatKind, typeS
ymbol
Kind )
import PrelNames ( eqTyConKey, ipClassNameKey,
constraintKindTyConKey, liftedTypeKindTyConKey )
import CoAxiom
...
...
@@ -1630,7 +1630,7 @@ typeLiteralKind :: TyLit -> Kind
typeLiteralKind l =
case l of
NumTyLit _ -> typeNatKind
StrTyLit _ -> typeS
tring
Kind
StrTyLit _ -> typeS
ymbol
Kind
\end{code}
Kind inference
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment