Commit 861e836e authored by simonpj's avatar simonpj
Browse files

[project @ 2000-09-28 13:04:14 by simonpj]

------------------------------------
	   Mainly PredTypes (28 Sept 00)
	------------------------------------

Three things in this commit:

	1.  Main thing: tidy up PredTypes
	2.  Move all Keys into PrelNames
	3.  Check for unboxed tuples in function args

1. Tidy up PredTypes
~~~~~~~~~~~~~~~~~~~~
The main thing in this commit is to modify the representation of Types
so that they are a (much) better for the qualified-type world.  This
should simplify Jeff's life as he proceeds with implicit parameters
and functional dependencies.  In particular, PredType, introduced by
Jeff, is now blessed and dignified with a place in TypeRep.lhs:

	data PredType  = Class  Class [Type]
		       | IParam Name  Type

Consider these examples:
	f :: (Eq a) => a -> Int
	g :: (?x :: Int -> Int) => a -> Int
	h :: (r\l) => {r} => {l::Int | r}

Here the "Eq a" and "?x :: Int -> Int" and "r\l" are all called
*predicates*, and are represented by a PredType.  (We don't support
TREX records yet, but the setup is designed to expand to allow them.)

In addition, Type gains an extra constructor:

	data Type = .... | PredTy PredType

so that PredType is injected directly into Type.  So the type
	p => t
is represented by
	PredType p `FunTy` t

I have deleted the hackish IPNote stuff; predicates are dealt with entirely
through PredTys, not through NoteTy at all.


2.  Move Keys into PrelNames
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This is just a housekeeping operation. I've moved all the pre-assigned Uniques
(aka Keys) from Unique.lhs into PrelNames.lhs.  I've also moved knowKeyRdrNames
from PrelInfo down into PrelNames.  This localises in PrelNames lots of stuff
about predefined names.  Previously one had to alter three files to add one,
now only one.

3.  Unboxed tuples
~~~~~~~~~~~~~~~~~~
Add a static check for unboxed tuple arguments.  E.g.
	data T = T (# Int, Int #)
is illegal
parent 0be02ed6
......@@ -5,9 +5,11 @@ The Name/Var/Type group is a bit complicated. Here's the deal
Things in brackets are what the module *uses*.
A 'loop' indicates a use from a module compiled later
PrelNames
then
Name, PrimRep, FieldLabel (loop Type.Type)
then
Var (loop CoreSyn.CoreExpr, loop IdInfo.IdInfo,
Var (Name, loop CoreSyn.CoreExpr, loop IdInfo.IdInfo,
loop Type.GenType, loop Type.Kind)
then
VarEnv, VarSet, ThinAir
......@@ -46,5 +48,6 @@ then
Rules (Unfolding), Subst (Unfolding, CoreFVs), CoreTidy (noUnfolding)
then
MkId (CoreUnfold.mkUnfolding, Subst)
then
PrelInfo (MkId)
......@@ -89,7 +89,7 @@ import FieldLabel ( FieldLabel, FieldLabelTag, mkFieldLabel, fieldLabelName,
)
import CoreSyn
import Maybes
import Unique
import PrelNames
import Maybe ( isJust )
import Outputable
import Util ( assoc )
......
......@@ -58,7 +58,8 @@ import RdrName ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc, rdrNameModule )
import CmdLineOpts ( opt_Static, opt_PprStyle_NoPrags, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
import SrcLoc ( noSrcLoc, mkBuiltinSrcLoc, SrcLoc )
import Unique ( pprUnique, Unique, Uniquable(..), hasKey, unboundKey, u2i )
import Unique ( Unique, Uniquable(..), u2i, hasKey, pprUnique )
import PrelNames ( unboundKey )
import Maybes ( expectJust )
import UniqFM
import Outputable
......
......@@ -37,165 +37,12 @@ module Unique (
-- [the Oh-So-Wonderful Haskell module system wins again...]
mkAlphaTyVarUnique,
mkPrimOpIdUnique,
mkTupleDataConUnique,
mkTupleTyConUnique,
mkTupleTyConUnique, mkTupleDataConUnique,
mkPreludeMiscIdUnique, mkPreludeDataConUnique,
mkPreludeTyConUnique, mkPreludeClassUnique,
getBuiltinUniques, mkBuiltinUnique,
mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
absentErrorIdKey, -- alphabetical...
addrDataConKey,
addrPrimTyConKey,
addrTyConKey,
appendIdKey,
arrayPrimTyConKey,
assertIdKey,
augmentIdKey,
bcoPrimTyConKey,
bindIOIdKey,
boolTyConKey,
boundedClassKey,
boxedConKey,
buildIdKey,
byteArrayPrimTyConKey,
byteArrayTyConKey,
cCallableClassKey,
cReturnableClassKey,
charDataConKey,
charPrimTyConKey,
charTyConKey,
concatIdKey,
consDataConKey,
deRefStablePtrIdKey,
doubleDataConKey,
doublePrimTyConKey,
doubleTyConKey,
enumClassKey,
enumFromClassOpKey,
enumFromThenClassOpKey,
enumFromThenToClassOpKey,
enumFromToClassOpKey,
eqClassKey,
eqClassOpKey,
eqStringIdKey,
errorIdKey,
falseDataConKey,
failMClassOpKey,
filterIdKey,
floatDataConKey,
floatPrimTyConKey,
floatTyConKey,
floatingClassKey,
foldlIdKey,
foldrIdKey,
foreignObjDataConKey,
foreignObjPrimTyConKey,
foreignObjTyConKey,
fractionalClassKey,
fromEnumClassOpKey,
fromIntClassOpKey,
fromIntegerClassOpKey,
fromRationalClassOpKey,
funTyConKey,
functorClassKey,
geClassOpKey,
getTagIdKey,
intDataConKey,
intPrimTyConKey,
intTyConKey,
int8TyConKey,
int16TyConKey,
int32TyConKey,
int64PrimTyConKey,
int64TyConKey,
smallIntegerDataConKey,
largeIntegerDataConKey,
integerMinusOneIdKey,
integerPlusOneIdKey,
integerPlusTwoIdKey,
int2IntegerIdKey,
integerTyConKey,
integerZeroIdKey,
integralClassKey,
irrefutPatErrorIdKey,
ixClassKey,
listTyConKey,
mainKey,
makeStablePtrIdKey,
mapIdKey,
minusClassOpKey,
monadClassKey,
monadPlusClassKey,
mutableArrayPrimTyConKey,
mutableByteArrayPrimTyConKey,
mutableByteArrayTyConKey,
mutVarPrimTyConKey,
nilDataConKey,
noMethodBindingErrorIdKey,
nonExhaustiveGuardsErrorIdKey,
numClassKey,
anyBoxConKey,
ordClassKey,
orderingTyConKey,
otherwiseIdKey,
parErrorIdKey,
parIdKey,
patErrorIdKey,
plusIntegerIdKey,
ratioDataConKey,
ratioTyConKey,
rationalTyConKey,
readClassKey,
realClassKey,
realFloatClassKey,
realFracClassKey,
realWorldPrimIdKey,
realWorldTyConKey,
recConErrorIdKey,
recSelErrIdKey,
recUpdErrorIdKey,
returnIOIdKey,
returnMClassOpKey,
runSTRepIdKey,
showClassKey,
ioTyConKey,
ioDataConKey,
stablePtrDataConKey,
stablePtrPrimTyConKey,
stablePtrTyConKey,
stableNameDataConKey,
stableNamePrimTyConKey,
stableNameTyConKey,
statePrimTyConKey,
timesIntegerIdKey,
typeConKey,
kindConKey,
boxityConKey,
mVarPrimTyConKey,
thenMClassOpKey,
threadIdPrimTyConKey,
toEnumClassOpKey,
traceIdKey,
trueDataConKey,
unboundKey,
unboxedConKey,
unpackCStringUtf8IdKey,
unpackCStringAppendIdKey,
unpackCStringFoldrIdKey,
unpackCStringIdKey,
unsafeCoerceIdKey,
ushowListIdKey,
weakPrimTyConKey,
wordDataConKey,
wordPrimTyConKey,
wordTyConKey,
word8TyConKey,
word16TyConKey,
word32TyConKey,
word64PrimTyConKey,
word64TyConKey,
zipIdKey
mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3
) where
#include "HsVersions.h"
......@@ -484,204 +331,3 @@ getBuiltinUniques :: Int -> [Unique]
getBuiltinUniques n = map (mkUnique 'B') [1 .. n]
\end{code}
%************************************************************************
%* *
\subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@}
%* *
%************************************************************************
\begin{code}
boundedClassKey = mkPreludeClassUnique 1
enumClassKey = mkPreludeClassUnique 2
eqClassKey = mkPreludeClassUnique 3
floatingClassKey = mkPreludeClassUnique 5
fractionalClassKey = mkPreludeClassUnique 6
integralClassKey = mkPreludeClassUnique 7
monadClassKey = mkPreludeClassUnique 8
monadPlusClassKey = mkPreludeClassUnique 9
functorClassKey = mkPreludeClassUnique 10
numClassKey = mkPreludeClassUnique 11
ordClassKey = mkPreludeClassUnique 12
readClassKey = mkPreludeClassUnique 13
realClassKey = mkPreludeClassUnique 14
realFloatClassKey = mkPreludeClassUnique 15
realFracClassKey = mkPreludeClassUnique 16
showClassKey = mkPreludeClassUnique 17
cCallableClassKey = mkPreludeClassUnique 18
cReturnableClassKey = mkPreludeClassUnique 19
ixClassKey = mkPreludeClassUnique 20
\end{code}
%************************************************************************
%* *
\subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@}
%* *
%************************************************************************
\begin{code}
addrPrimTyConKey = mkPreludeTyConUnique 1
addrTyConKey = mkPreludeTyConUnique 2
arrayPrimTyConKey = mkPreludeTyConUnique 3
boolTyConKey = mkPreludeTyConUnique 4
byteArrayPrimTyConKey = mkPreludeTyConUnique 5
charPrimTyConKey = mkPreludeTyConUnique 7
charTyConKey = mkPreludeTyConUnique 8
doublePrimTyConKey = mkPreludeTyConUnique 9
doubleTyConKey = mkPreludeTyConUnique 10
floatPrimTyConKey = mkPreludeTyConUnique 11
floatTyConKey = mkPreludeTyConUnique 12
funTyConKey = mkPreludeTyConUnique 13
intPrimTyConKey = mkPreludeTyConUnique 14
intTyConKey = mkPreludeTyConUnique 15
int8TyConKey = mkPreludeTyConUnique 16
int16TyConKey = mkPreludeTyConUnique 17
int32TyConKey = mkPreludeTyConUnique 18
int64PrimTyConKey = mkPreludeTyConUnique 19
int64TyConKey = mkPreludeTyConUnique 20
integerTyConKey = mkPreludeTyConUnique 21
listTyConKey = mkPreludeTyConUnique 22
foreignObjPrimTyConKey = mkPreludeTyConUnique 23
foreignObjTyConKey = mkPreludeTyConUnique 24
weakPrimTyConKey = mkPreludeTyConUnique 25
mutableArrayPrimTyConKey = mkPreludeTyConUnique 26
mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 27
orderingTyConKey = mkPreludeTyConUnique 28
mVarPrimTyConKey = mkPreludeTyConUnique 29
ratioTyConKey = mkPreludeTyConUnique 30
rationalTyConKey = mkPreludeTyConUnique 31
realWorldTyConKey = mkPreludeTyConUnique 32
stablePtrPrimTyConKey = mkPreludeTyConUnique 33
stablePtrTyConKey = mkPreludeTyConUnique 34
statePrimTyConKey = mkPreludeTyConUnique 35
stableNamePrimTyConKey = mkPreludeTyConUnique 50
stableNameTyConKey = mkPreludeTyConUnique 51
mutableByteArrayTyConKey = mkPreludeTyConUnique 52
mutVarPrimTyConKey = mkPreludeTyConUnique 53
ioTyConKey = mkPreludeTyConUnique 55
byteArrayTyConKey = mkPreludeTyConUnique 56
wordPrimTyConKey = mkPreludeTyConUnique 57
wordTyConKey = mkPreludeTyConUnique 58
word8TyConKey = mkPreludeTyConUnique 59
word16TyConKey = mkPreludeTyConUnique 60
word32TyConKey = mkPreludeTyConUnique 61
word64PrimTyConKey = mkPreludeTyConUnique 62
word64TyConKey = mkPreludeTyConUnique 63
boxedConKey = mkPreludeTyConUnique 64
unboxedConKey = mkPreludeTyConUnique 65
anyBoxConKey = mkPreludeTyConUnique 66
kindConKey = mkPreludeTyConUnique 67
boxityConKey = mkPreludeTyConUnique 68
typeConKey = mkPreludeTyConUnique 69
threadIdPrimTyConKey = mkPreludeTyConUnique 70
bcoPrimTyConKey = mkPreludeTyConUnique 71
\end{code}
%************************************************************************
%* *
\subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@}
%* *
%************************************************************************
\begin{code}
addrDataConKey = mkPreludeDataConUnique 0
charDataConKey = mkPreludeDataConUnique 1
consDataConKey = mkPreludeDataConUnique 2
doubleDataConKey = mkPreludeDataConUnique 3
falseDataConKey = mkPreludeDataConUnique 4
floatDataConKey = mkPreludeDataConUnique 5
intDataConKey = mkPreludeDataConUnique 6
smallIntegerDataConKey = mkPreludeDataConUnique 7
largeIntegerDataConKey = mkPreludeDataConUnique 8
foreignObjDataConKey = mkPreludeDataConUnique 9
nilDataConKey = mkPreludeDataConUnique 10
ratioDataConKey = mkPreludeDataConUnique 11
stablePtrDataConKey = mkPreludeDataConUnique 12
stableNameDataConKey = mkPreludeDataConUnique 13
trueDataConKey = mkPreludeDataConUnique 14
wordDataConKey = mkPreludeDataConUnique 15
ioDataConKey = mkPreludeDataConUnique 16
\end{code}
%************************************************************************
%* *
\subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)}
%* *
%************************************************************************
\begin{code}
absentErrorIdKey = mkPreludeMiscIdUnique 1
appendIdKey = mkPreludeMiscIdUnique 2
augmentIdKey = mkPreludeMiscIdUnique 3
buildIdKey = mkPreludeMiscIdUnique 4
errorIdKey = mkPreludeMiscIdUnique 5
foldlIdKey = mkPreludeMiscIdUnique 6
foldrIdKey = mkPreludeMiscIdUnique 7
recSelErrIdKey = mkPreludeMiscIdUnique 8
integerMinusOneIdKey = mkPreludeMiscIdUnique 9
integerPlusOneIdKey = mkPreludeMiscIdUnique 10
integerPlusTwoIdKey = mkPreludeMiscIdUnique 11
integerZeroIdKey = mkPreludeMiscIdUnique 12
int2IntegerIdKey = mkPreludeMiscIdUnique 13
irrefutPatErrorIdKey = mkPreludeMiscIdUnique 15
eqStringIdKey = mkPreludeMiscIdUnique 16
noMethodBindingErrorIdKey = mkPreludeMiscIdUnique 17
nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 18
parErrorIdKey = mkPreludeMiscIdUnique 20
parIdKey = mkPreludeMiscIdUnique 21
patErrorIdKey = mkPreludeMiscIdUnique 22
realWorldPrimIdKey = mkPreludeMiscIdUnique 23
recConErrorIdKey = mkPreludeMiscIdUnique 24
recUpdErrorIdKey = mkPreludeMiscIdUnique 25
traceIdKey = mkPreludeMiscIdUnique 26
unpackCStringUtf8IdKey = mkPreludeMiscIdUnique 27
unpackCStringAppendIdKey = mkPreludeMiscIdUnique 28
unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 29
unpackCStringIdKey = mkPreludeMiscIdUnique 30
ushowListIdKey = mkPreludeMiscIdUnique 31
unsafeCoerceIdKey = mkPreludeMiscIdUnique 32
concatIdKey = mkPreludeMiscIdUnique 33
filterIdKey = mkPreludeMiscIdUnique 34
zipIdKey = mkPreludeMiscIdUnique 35
bindIOIdKey = mkPreludeMiscIdUnique 36
returnIOIdKey = mkPreludeMiscIdUnique 37
deRefStablePtrIdKey = mkPreludeMiscIdUnique 38
makeStablePtrIdKey = mkPreludeMiscIdUnique 39
getTagIdKey = mkPreludeMiscIdUnique 40
plusIntegerIdKey = mkPreludeMiscIdUnique 41
timesIntegerIdKey = mkPreludeMiscIdUnique 42
\end{code}
Certain class operations from Prelude classes. They get their own
uniques so we can look them up easily when we want to conjure them up
during type checking.
\begin{code}
fromIntClassOpKey = mkPreludeMiscIdUnique 101
fromIntegerClassOpKey = mkPreludeMiscIdUnique 102
minusClassOpKey = mkPreludeMiscIdUnique 103
fromRationalClassOpKey = mkPreludeMiscIdUnique 104
enumFromClassOpKey = mkPreludeMiscIdUnique 105
enumFromThenClassOpKey = mkPreludeMiscIdUnique 106
enumFromToClassOpKey = mkPreludeMiscIdUnique 107
enumFromThenToClassOpKey = mkPreludeMiscIdUnique 108
eqClassOpKey = mkPreludeMiscIdUnique 109
geClassOpKey = mkPreludeMiscIdUnique 110
failMClassOpKey = mkPreludeMiscIdUnique 112
thenMClassOpKey = mkPreludeMiscIdUnique 113 -- (>>=)
-- Just a place holder for unbound variables produced by the renamer:
unboundKey = mkPreludeMiscIdUnique 114
fromEnumClassOpKey = mkPreludeMiscIdUnique 115
mainKey = mkPreludeMiscIdUnique 116
returnMClassOpKey = mkPreludeMiscIdUnique 117
otherwiseIdKey = mkPreludeMiscIdUnique 118
toEnumClassOpKey = mkPreludeMiscIdUnique 119
mapIdKey = mkPreludeMiscIdUnique 120
\end{code}
\begin{code}
assertIdKey = mkPreludeMiscIdUnique 121
runSTRepIdKey = mkPreludeMiscIdUnique 122
\end{code}
......@@ -54,7 +54,7 @@ import IdInfo ( ArityInfo(..), InlinePragInfo(..), OccInfo(..), IdFlavour(..),
insideLam, workerExists, isNeverInlinePrag
)
import Type ( splitFunTy_maybe, isUnLiftedType )
import Unique ( Unique, buildIdKey, augmentIdKey, hasKey )
import PrelNames ( hasKey, buildIdKey, augmentIdKey )
import Bag
import Outputable
......
......@@ -404,11 +404,13 @@ subst_ty subst ty
where
go (TyConApp tc tys) = let args = map go tys
in args `seqList` TyConApp tc args
go (PredTy p) = PredTy $! (substPred subst p)
go (NoteTy (SynNote ty1) ty2) = NoteTy (SynNote $! (go ty1)) $! (go ty2)
go (NoteTy (FTVNote _) ty2) = go ty2 -- Discard the free tyvar note
go (NoteTy (UsgNote usg) ty2) = (NoteTy $! UsgNote usg) $! go ty2 -- Keep usage annot
go (NoteTy (UsgForAll uv) ty2) = (NoteTy $! UsgForAll uv) $! go ty2 -- Keep uvar bdr
go (NoteTy (IPNote nm) ty2) = (NoteTy $! IPNote nm) $! go ty2 -- Keep ip note
go (NoteTy (UsgNote usg) ty2) = (NoteTy $! UsgNote usg) $! go ty2 -- Keep usage annot
go (NoteTy (UsgForAll uv) ty2) = (NoteTy $! UsgForAll uv) $! go ty2 -- Keep uvar bdr
go (FunTy arg res) = (FunTy $! (go arg)) $! (go res)
go (AppTy fun arg) = mkAppTy (go fun) $! (go arg)
......
......@@ -24,7 +24,7 @@ import Type ( splitAlgTyConApp, mkTyVarTys, splitTyConApp_maybe )
import TysWiredIn ( nilDataCon, consDataCon,
mkListTy, mkTupleTy, tupleCon
)
import Unique ( unboundKey )
import PrelNames ( unboundKey )
import TyCon ( tyConDataCons, tupleTyConBoxity, isTupleTyCon )
import BasicTypes ( Boxity(..) )
import SrcLoc ( noSrcLoc )
......
......@@ -41,7 +41,7 @@ import TysWiredIn ( unitDataConId,
)
import Literal ( mkMachInt )
import CStrings ( CLabelString )
import Unique ( Unique, hasKey, ioTyConKey )
import PrelNames ( Unique, hasKey, ioTyConKey )
import VarSet ( varSetElems )
import Outputable
\end{code}
......
......@@ -44,7 +44,7 @@ import Type ( splitFunTys,
import TysWiredIn ( tupleCon, listTyCon, charDataCon, intDataCon, isIntegerTy )
import BasicTypes ( RecFlag(..), Boxity(..) )
import Maybes ( maybeToBool )
import Unique ( hasKey, ratioTyConKey )
import PrelNames ( hasKey, ratioTyConKey )
import Util ( zipEqual, zipWithEqual )
import Outputable
......
......@@ -40,10 +40,10 @@ import TysWiredIn ( unitTy, addrTy, stablePtrTyCon,
addrDataCon
)
import TysPrim ( addrPrimTy )
import Unique ( Uniquable(..), hasKey,
import PrelNames ( Uniquable(..), hasKey,
ioTyConKey, deRefStablePtrIdKey, returnIOIdKey,
bindIOIdKey, makeStablePtrIdKey
)
)
import Outputable
import Maybe ( fromJust )
......
......@@ -19,7 +19,7 @@ import Type ( Type )
import DsMonad
import DsUtils
import PrelInfo ( nON_EXHAUSTIVE_GUARDS_ERROR_ID )
import Unique ( otherwiseIdKey, trueDataConKey, hasKey )
import PrelNames ( otherwiseIdKey, trueDataConKey, hasKey )
\end{code}
@dsGuarded@ is used for both @case@ expressions and pattern bindings.
......
......@@ -26,7 +26,7 @@ import Type ( mkTyVarTy, mkFunTys, mkFunTy, Type )
import TysPrim ( alphaTyVar )
import TysWiredIn ( nilDataCon, consDataCon )
import Match ( matchSimply )
import Unique ( foldrIdKey, buildIdKey )
import PrelNames ( foldrIdKey, buildIdKey )
\end{code}
List comprehensions may be desugared in one of two ways: ``ordinary''
......
......@@ -63,7 +63,7 @@ import TysWiredIn ( nilDataCon, consDataCon,
)
import BasicTypes ( Boxity(..) )
import UniqSet ( mkUniqSet, minusUniqSet, isEmptyUniqSet, UniqSet )
import Unique ( unpackCStringIdKey, unpackCStringUtf8IdKey,
import PrelNames ( unpackCStringIdKey, unpackCStringUtf8IdKey,
plusIntegerIdKey, timesIntegerIdKey )
import Outputable
import UnicodeUtil ( stringToUtf8 )
......
......@@ -16,6 +16,7 @@ import {-# SOURCE #-} HsMatches ( pprMatches, Match, pprGRHSs, GRHSs )
-- friends:
import HsTypes ( HsType )
import CoreSyn ( CoreExpr )
import PprCore ( {- Instances -} )
--others:
import Name ( Name, isUnboundName )
......
......@@ -31,14 +31,13 @@ import Type ( Type, Kind, PredType(..), UsageAnn(..), ClassContext,
)
import TypeRep ( Type(..), TyNote(..) ) -- toHsType sees the representation
import TyCon ( isTupleTyCon, tupleTyConBoxity, tyConArity, tyConClass_maybe )
import PrelInfo ( mkTupConRdrName )
import RdrName ( RdrName )
import Name ( toRdrName )
import OccName ( NameSpace )
import Var ( TyVar, tyVarKind )
import PprType ( {- instance Outputable Kind -}, pprParendKind )
import BasicTypes ( Arity, Boxity(..), tupleParens )
import Unique ( hasKey, listTyConKey, Uniquable(..) )
import PrelNames ( mkTupConRdrName, listTyConKey, hasKey, Uniquable(..) )
import Maybes ( maybeToBool )
import FiniteMap
import Outputable
......@@ -289,16 +288,15 @@ toHsType' (AppTy fun arg) = HsAppTy (toHsType fun) (toHsType arg)
toHsType' (NoteTy (SynNote ty) _) = toHsType ty -- Use synonyms if possible!!
toHsType' (NoteTy _ ty) = toHsType ty
toHsType' (PredTy p) = HsPredTy (toHsPred p)
toHsType' ty@(TyConApp tc tys) -- Must be saturated because toHsType's arg is of kind *
| not saturated = generic_case
| isTupleTyCon tc = HsTupleTy (HsTupCon (toRdrName tc) (tupleTyConBoxity tc)) tys'
| tc `hasKey` listTyConKey = HsListTy (head tys')
| maybeToBool maybe_class = HsPredTy (HsPClass (toRdrName clas) tys')
| otherwise = generic_case
where
generic_case = foldl HsAppTy (HsTyVar (toRdrName tc)) tys'
maybe_class = tyConClass_maybe tc
Just clas = maybe_class
tys' = map toHsType tys
saturated = length tys == tyConArity tc
......
......@@ -198,8 +198,11 @@ checkPat e [] = case e of
HsPar e -> checkPat e [] `thenP` (returnP . ParPatIn)
ExplicitList es -> mapP (\e -> checkPat e []) es `thenP` \ps ->
returnP (ListPatIn ps)
ExplicitTuple es b -> mapP (\e -> checkPat e []) es `thenP` \ps ->
returnP (TuplePatIn ps b)
ExplicitTuple es Boxed -> mapP (\e -> checkPat e []) es `thenP` \ps ->
returnP (TuplePatIn ps Boxed)
-- Unboxed tuples are illegal in patterns
RecordCon c fs -> mapP checkPatField fs `thenP` \fs ->
returnP (RecPatIn c fs)
_ -> patFail
......
......@@ -13,9 +13,6 @@ module PrelInfo (
-- if it's used at all then it's Name will be just as
-- it is here, unique and all. Includes all the
derivingOccurrences, -- For a given class C, this tells what other
derivableClassKeys, -- things are needed as a result of a
-- deriving(C) clause
......@@ -27,9 +24,10 @@ module PrelInfo (
-- Random other things
maybeCharLikeCon, maybeIntLikeCon,
needsDataDeclCtxtClassKeys, cCallishClassKeys, cCallishTyKeys,
isNoDictClass, isNumericClass, isStandardClass, isCcallishClass,
isCreturnableClass, numericTyKeys, fractionalClassKeys,
-- Class categories
isCcallishClass, isCreturnableClass, isNoDictClass,
isNumericClass, isStandardClass
) where
......@@ -47,13 +45,11 @@ import TysWiredIn
-- others:
import RdrName ( RdrName )
import Name ( Name, mkKnownKeyGlobal, getName )
import Class ( Class, classKey )
import TyCon ( tyConDataConsIfAvailable, TyCon )
import Class ( Class, classKey )
import Type ( funTyCon )
import Bag
import BasicTypes ( Boxity(..) )
import Unique -- *Key stuff
import UniqFM ( UniqFM, listToUFM )
import Util ( isIn )
\end{code}
......@@ -80,7 +76,7 @@ builtinNames
, listToBag (map (getName . mkPrimOpId) allThePrimOps)
-- Other names with magic keys
, listToBag knownKeyNames
, listToBag (map mkKnownKeyGlobal knownKeyRdrNames)
]
\end{code}
......@@ -191,108 +187,6 @@ data_tycons
%* *
%************************************************************************
Ids, Synonyms, Classes and ClassOps with builtin keys.
\begin{code}
knownKeyNames :: [Name]
knownKeyNames
= map mkKnownKeyGlobal
[
-- Type constructors (synonyms especially)
(ioTyCon_RDR, ioTyConKey)
, (main_RDR, mainKey)
, (orderingTyCon_RDR, orderingTyConKey)
, (rationalTyCon_RDR, rationalTyConKey)
, (ratioDataCon_RDR, ratioDataConKey)