summaryrefslogtreecommitdiff
path: root/ghc/compiler/prelude
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/compiler/prelude')
-rw-r--r--ghc/compiler/prelude/PrelInfo.lhs27
-rw-r--r--ghc/compiler/prelude/PrelLoop.lhi26
-rw-r--r--ghc/compiler/prelude/PrelMods.lhs6
-rw-r--r--ghc/compiler/prelude/PrelVals.lhs25
-rw-r--r--ghc/compiler/prelude/PrimOp.lhs49
-rw-r--r--ghc/compiler/prelude/PrimRep.lhs11
-rw-r--r--ghc/compiler/prelude/StdIdInfo.lhs68
-rw-r--r--ghc/compiler/prelude/TysPrim.hi-boot3
-rw-r--r--ghc/compiler/prelude/TysPrim.lhs49
-rw-r--r--ghc/compiler/prelude/TysWiredIn.hi-boot11
-rw-r--r--ghc/compiler/prelude/TysWiredIn.lhs238
11 files changed, 218 insertions, 295 deletions
diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs
index 4a894b80cc..60673c3bd2 100644
--- a/ghc/compiler/prelude/PrelInfo.lhs
+++ b/ghc/compiler/prelude/PrelInfo.lhs
@@ -4,12 +4,10 @@
\section[PrelInfo]{The @PrelInfo@ interface to the compiler's prelude knowledge}
\begin{code}
-#include "HsVersions.h"
-
module PrelInfo (
-- finite maps for built-in things (for the renamer and typechecker):
builtinNames, derivingOccurrences,
- SYN_IE(BuiltinNames),
+ BuiltinNames,
maybeCharLikeTyCon, maybeIntLikeTyCon,
@@ -37,13 +35,9 @@ module PrelInfo (
isNumericClass, isStandardClass, isCcallishClass
) where
-IMP_Ubiq()
+#include "HsVersions.h"
-#if __GLASGOW_HASKELL__ >= 202
import IdUtils ( primOpName )
-#else
-IMPORT_DELOOPER(PrelLoop) ( primOpName )
-#endif
-- friends:
import PrelMods -- Prelude module names
@@ -54,13 +48,13 @@ import TysPrim -- TYPES
import TysWiredIn
-- others:
-import SpecEnv ( SpecEnv )
import RdrHsSyn ( RdrName(..), varQual, tcQual, qual )
import BasicTypes ( IfaceFlavour )
-import Id ( GenId, SYN_IE(Id) )
+import Id ( GenId, Id )
import Name ( Name, OccName(..), Provenance(..),
- getName, mkGlobalName, modAndOcc )
-import Class ( Class(..), GenClass, classKey )
+ getName, mkGlobalName, modAndOcc
+ )
+import Class ( Class, classKey )
import TyCon ( tyConDataCons, mkFunTyCon, TyCon )
import Type
import Bag
@@ -254,7 +248,7 @@ Ids, Synonyms, Classes and ClassOps with builtin keys.
\begin{code}
mkKnownKeyGlobal :: (RdrName, Unique) -> Name
mkKnownKeyGlobal (Qual mod occ hif, uniq)
- = mkGlobalName uniq mod occ (Implicit hif)
+ = mkGlobalName uniq mod occ NoProvenance
allClass_NAME = mkKnownKeyGlobal (allClass_RDR, allClassKey)
ioTyCon_NAME = mkKnownKeyGlobal (ioTyCon_RDR, ioTyConKey)
@@ -375,8 +369,8 @@ realFracClass_RDR = tcQual (pREL_NUM, SLIT("RealFrac"))
realFloatClass_RDR = tcQual (pREL_NUM, SLIT("RealFloat"))
readClass_RDR = tcQual (pREL_READ, SLIT("Read"))
ixClass_RDR = tcQual (iX, SLIT("Ix"))
-ccallableClass_RDR = tcQual (cCALL, SLIT("CCallable"))
-creturnableClass_RDR = tcQual (cCALL, SLIT("CReturnable"))
+ccallableClass_RDR = tcQual (gHC__, SLIT("CCallable"))
+creturnableClass_RDR = tcQual (gHC__, SLIT("CReturnable"))
fromInt_RDR = varQual (pREL_BASE, SLIT("fromInt"))
fromInteger_RDR = varQual (pREL_BASE, SLIT("fromInteger"))
@@ -541,7 +535,8 @@ cCallishClassKeys = [ cCallableClassKey, cReturnableClassKey ]
-- Renamer always imports these data decls replete with constructors
-- so that desugarer can always see the constructor. Ugh!
-cCallishTyKeys = [ addrTyConKey, wordTyConKey, byteArrayTyConKey, mutableByteArrayTyConKey ]
+cCallishTyKeys = [ addrTyConKey, wordTyConKey, byteArrayTyConKey,
+ mutableByteArrayTyConKey, foreignObjTyConKey ]
standardClassKeys
= derivableClassKeys ++ numericClassKeys ++ cCallishClassKeys
diff --git a/ghc/compiler/prelude/PrelLoop.lhi b/ghc/compiler/prelude/PrelLoop.lhi
deleted file mode 100644
index 9d5d407aba..0000000000
--- a/ghc/compiler/prelude/PrelLoop.lhi
+++ /dev/null
@@ -1,26 +0,0 @@
-Breaks the PrelVal loop and the PrelInfo loop caused by primOpNameInfo.
-
-\begin{code}
-interface PrelLoop where
-
---import PreludePS ( _PackedString )
-import FastString ( FastSring )
-
-import Class ( GenClass )
-import CoreUnfold ( mkMagicUnfolding, Unfolding )
-import IdUtils ( primOpName )
-import Name ( Name, ExportFlag )
-import PrimOp ( PrimOp )
-import RnHsSyn ( RnName )
-import Type ( mkSigmaTy, mkFunTy, mkFunTys, GenType )
-import TyVar ( GenTyVar )
-import Unique ( Unique )
-import Usage ( GenUsage )
-
-mkMagicUnfolding :: Unique -> Unfolding
-mkSigmaTy :: [a] -> [(GenClass (GenTyVar (GenUsage Unique)) Unique, GenType a b)] -> GenType a b -> GenType a b
-mkFunTys :: [GenType a b] -> GenType a b -> GenType a b
-mkFunTy :: GenType a b -> GenType a b -> GenType a b
-
-primOpName :: PrimOp -> Name
-\end{code}
diff --git a/ghc/compiler/prelude/PrelMods.lhs b/ghc/compiler/prelude/PrelMods.lhs
index 4e20de102d..1973663de9 100644
--- a/ghc/compiler/prelude/PrelMods.lhs
+++ b/ghc/compiler/prelude/PrelMods.lhs
@@ -10,8 +10,6 @@ defined here so as to avod
and gobbled whoever was writing the above :-) -- SOF ]
\begin{code}
-#include "HsVersions.h"
-
module PrelMods
(
gHC__, pRELUDE, pREL_BASE,
@@ -23,9 +21,9 @@ module PrelMods
cCALL , aDDR
) where
-CHK_Ubiq() -- debugging consistency check
+#include "HsVersions.h"
-import BasicTypes( SYN_IE(Module) )
+import BasicTypes( Module )
\end{code}
\begin{code}
diff --git a/ghc/compiler/prelude/PrelVals.lhs b/ghc/compiler/prelude/PrelVals.lhs
index d5ecd9c8ac..5520a0b325 100644
--- a/ghc/compiler/prelude/PrelVals.lhs
+++ b/ghc/compiler/prelude/PrelVals.lhs
@@ -4,23 +4,14 @@
\section[PrelVals]{Prelude values the compiler ``knows about''}
\begin{code}
-#include "HsVersions.h"
-
module PrelVals where
-IMP_Ubiq()
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
-IMPORT_DELOOPER(IdLoop) ( UnfoldingGuidance(..), mkUnfolding, nullSpecEnv, SpecEnv )
-#else
-import {-# SOURCE #-} CoreUnfold ( UnfoldingGuidance(..), mkUnfolding )
-import {-# SOURCE #-} SpecEnv ( SpecEnv, nullSpecEnv )
-#endif
+#include "HsVersions.h"
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
-IMPORT_DELOOPER(PrelLoop)
-#endif
+import {-# SOURCE #-} CoreUnfold ( UnfoldingGuidance(..), mkUnfolding )
-import Id ( SYN_IE(Id), GenId, mkImported, mkTemplateLocals )
+import Id ( Id, mkImported, mkTemplateLocals )
+import SpecEnv ( SpecEnv, emptySpecEnv )
-- friends:
import PrelMods
@@ -32,7 +23,7 @@ import CmdLineOpts ( maybe_CompilingGhcInternals )
import CoreSyn -- quite a bit
import IdInfo -- quite a bit
import Literal ( mkMachInt )
-import Name ( mkWiredInIdName, SYN_IE(Module) )
+import Name ( mkWiredInIdName, Module )
import PragmaInfo
import PrimOp ( PrimOp(..) )
#if __GLASGOW_HASKELL__ >= 202
@@ -40,7 +31,7 @@ import Type
#else
import Type ( mkTyVarTy )
#endif
-import TyVar ( openAlphaTyVar, alphaTyVar, betaTyVar, gammaTyVar, SYN_IE(TyVar) )
+import TyVar ( openAlphaTyVar, alphaTyVar, betaTyVar, gammaTyVar, TyVar )
import Unique -- lots of *Keys
import Util ( panic )
\end{code}
@@ -651,9 +642,9 @@ types passed to the pre-processor with the -genSPECS arg (see ghc.lprl).
ToDo: Create single mkworld definition which is grabbed here and in ghc.lprl
\begin{code}
-pcGenerateSpecs :: Unique -> Id -> IdInfo -> Type -> SpecEnv
+pcGenerateSpecs :: Unique -> Id -> IdInfo -> Type -> IdSpecEnv
pcGenerateSpecs key id info ty
- = nullSpecEnv
+ = emptySpecEnv
{- LATER:
diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
index 72445f6d92..84af9e0a94 100644
--- a/ghc/compiler/prelude/PrimOp.lhs
+++ b/ghc/compiler/prelude/PrimOp.lhs
@@ -4,8 +4,6 @@
\section[PrimOp]{Primitive operations (machine-level)}
\begin{code}
-#include "HsVersions.h"
-
module PrimOp (
PrimOp(..), allThePrimOps,
tagOf_PrimOp, -- ToDo: rm
@@ -29,7 +27,7 @@ module PrimOp (
pprPrimOp, showPrimOp
) where
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
import PrimRep -- most of it
import TysPrim
@@ -38,17 +36,18 @@ import TysWiredIn
import CStrings ( identToC )
import Constants ( mIN_MP_INT_SIZE, mP_STRUCT_SIZE )
import HeapOffs ( addOff, intOff, totHdrSize, HeapOffset )
-import Outputable ( PprStyle, Outputable(..), codeStyle, ifaceStyle )
+import Outputable
import PprType ( pprParendGenType, GenTyVar{-instance Outputable-} )
-import Pretty
import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
import TyCon ( TyCon{-instances-} )
-import Type ( mkForAllTys, mkFunTy, mkFunTys, applyTyCon, typePrimRep,
- getAppDataTyConExpandingDicts, SYN_IE(Type)
+import Type ( mkForAllTys, mkFunTy, mkFunTys, mkTyConApp, typePrimRep,
+ splitAlgTyConApp, Type
)
import TyVar --( alphaTyVar, betaTyVar, gammaTyVar, GenTyVar{-instance Eq-} )
import Unique ( Unique{-instance Eq-} )
import Util ( panic#, assoc, panic{-ToDo:rm-} )
+
+import GlaExts ( Int(..), Int#, (==#) )
\end{code}
%************************************************************************
@@ -1404,7 +1403,7 @@ primOpInfo ErrorIOPrimOp
primOpInfo (CCallOp _ _ _ arg_tys result_ty)
= AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
where
- (result_tycon, tys_applied, _) = getAppDataTyConExpandingDicts result_ty
+ (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty
#ifdef DEBUG
primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
@@ -1728,10 +1727,10 @@ primOpType op
Coercing str ty1 ty2 -> mkFunTy ty1 ty2
PrimResult str tyvars arg_tys prim_tycon kind res_tys ->
- mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon prim_tycon res_tys))
+ mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp prim_tycon res_tys))
AlgResult str tyvars arg_tys tycon res_tys ->
- mkForAllTys tyvars (mkFunTys arg_tys (applyTyCon tycon res_tys))
+ mkForAllTys tyvars (mkFunTys arg_tys (mkTyConApp tycon res_tys))
\end{code}
\begin{code}
@@ -1798,12 +1797,12 @@ compare_fun_ty ty = mkFunTys [ty, ty] boolTy
Output stuff:
\begin{code}
-pprPrimOp :: PprStyle -> PrimOp -> Doc
-showPrimOp :: PprStyle -> PrimOp -> String
+pprPrimOp :: PrimOp -> SDoc
+showPrimOp :: PrimOp -> String
-showPrimOp sty op = render (pprPrimOp sty op)
+showPrimOp op = showSDoc (pprPrimOp op)
-pprPrimOp sty (CCallOp fun is_casm may_gc arg_tys res_ty)
+pprPrimOp (CCallOp fun is_casm may_gc arg_tys res_ty)
= let
before
= if is_casm then
@@ -1815,24 +1814,22 @@ pprPrimOp sty (CCallOp fun is_casm may_gc arg_tys res_ty)
= if is_casm then text "''" else empty
pp_tys
- = hsep (map (pprParendGenType sty) (res_ty:arg_tys))
+ = hsep (map pprParendGenType (res_ty:arg_tys))
in
hcat [text before, ptext fun, after, space, brackets pp_tys]
-pprPrimOp sty other_op
- | codeStyle sty -- For C just print the primop itself
- = identToC str
-
- | ifaceStyle sty -- For interfaces Print it qualified with GHC.
- = ptext SLIT("GHC.") <> ptext str
-
- | otherwise -- Unqualified is good enough
- = ptext str
+pprPrimOp other_op
+ = getPprStyle $ \ sty ->
+ if codeStyle sty then -- For C just print the primop itself
+ identToC str
+ else if ifaceStyle sty then -- For interfaces Print it qualified with GHC.
+ ptext SLIT("GHC.") <> ptext str
+ else -- Unqualified is good enough
+ ptext str
where
str = primOp_str other_op
-
instance Outputable PrimOp where
- ppr sty op = pprPrimOp sty op
+ ppr op = pprPrimOp op
\end{code}
diff --git a/ghc/compiler/prelude/PrimRep.lhs b/ghc/compiler/prelude/PrimRep.lhs
index 6317a13b76..f0c128d517 100644
--- a/ghc/compiler/prelude/PrimRep.lhs
+++ b/ghc/compiler/prelude/PrimRep.lhs
@@ -8,8 +8,6 @@ At various places in the back end, we want to be to tag things with a
types.
\begin{code}
-#include "HsVersions.h"
-
module PrimRep (
PrimRep(..),
@@ -19,13 +17,10 @@ module PrimRep (
guessPrimRep, decodePrimRep
) where
-IMP_Ubiq()
+#include "HsVersions.h"
-import Pretty -- pretty-printing code
import Util
-#if __GLASGOW_HASKELL__ >= 202
import Outputable
-#endif
-- Oh dear.
#include "../../includes/GhcConstants.h"
@@ -152,11 +147,11 @@ retPrimRepSize = getPrimRepSize RetRep
\begin{code}
instance Outputable PrimRep where
- ppr sty kind = text (showPrimRep kind)
+ ppr kind = text (showPrimRep kind)
showPrimRep :: PrimRep -> String
-- dumping PrimRep tag for unfoldings
-ppPrimRep :: PrimRep -> Doc
+ppPrimRep :: PrimRep -> SDoc
guessPrimRep :: String -> PrimRep -- a horrible "inverse" function
decodePrimRep :: Char -> PrimRep -- of equal nature
diff --git a/ghc/compiler/prelude/StdIdInfo.lhs b/ghc/compiler/prelude/StdIdInfo.lhs
index 53e81c7c74..58c2811861 100644
--- a/ghc/compiler/prelude/StdIdInfo.lhs
+++ b/ghc/compiler/prelude/StdIdInfo.lhs
@@ -12,17 +12,14 @@ have a standard form, namely:
* primitive operations
\begin{code}
-#include "HsVersions.h"
-
module StdIdInfo (
addStandardIdInfo
) where
-IMP_Ubiq()
+#include "HsVersions.h"
import Type
import TyVar ( alphaTyVar )
-import CmdLineOpts ( opt_PprUserLength )
import CoreSyn
import Literal
import CoreUnfold ( mkUnfolding, PragmaInfo(..) )
@@ -34,19 +31,16 @@ import Id ( GenId, mkTemplateLocals, idType,
isAlgCon, isMethodSelId_maybe, isSuperDictSelId_maybe,
isRecordSelector, isPrimitiveId_maybe,
addIdUnfolding, addIdArity,
- SYN_IE(Id)
+ Id
)
import IdInfo ( ArityInfo, exactArity )
-import Class ( GenClass, classBigSig, classDictArgTys )
-import TyCon ( isNewTyCon, isDataTyCon, isAlgTyCon )
+import Class ( classBigSig, classTyCon )
+import TyCon ( isNewTyCon, isDataTyCon, isAlgTyCon, tyConDataCons )
import FieldLabel ( FieldLabel )
import PrelVals ( pAT_ERROR_ID )
import Maybes
-import Outputable ( PprStyle(..), Outputable(..) )
-import Pretty
-import Util ( assertPanic, pprTrace,
- assoc
- )
+import Outputable
+import Util ( assoc )
\end{code}
@@ -93,10 +87,10 @@ addStandardIdInfo con_id
(tyvars, theta, con_tyvars, con_theta, arg_tys, tycon) = dataConSig con_id
- dict_tys = [mkDictTy clas ty | (clas,ty) <- theta]
- con_dict_tys = [mkDictTy clas ty | (clas,ty) <- con_theta]
+ dict_tys = [mkDictTy clas tys | (clas,tys) <- theta]
+ con_dict_tys = [mkDictTy clas tys | (clas,tys) <- con_theta]
n_dicts = length dict_tys
- result_ty = applyTyCon tycon (mkTyVarTys tyvars)
+ result_ty = mkTyConApp tycon (mkTyVarTys tyvars)
locals = mkTemplateLocals (dict_tys ++ con_dict_tys ++ arg_tys)
data_args = drop n_dicts locals
@@ -116,7 +110,7 @@ addStandardIdInfo con_id
mkValLam locals $
foldr mk_case con_app strict_args
- mk_case arg body | isUnboxedType (idType arg)
+ mk_case arg body | isUnpointedType (idType arg)
= body -- "!" on unboxed arg does nothing
| otherwise
= Case (Var arg) (AlgAlts [] (BindDefault arg body))
@@ -153,9 +147,9 @@ addStandardIdInfo sel_id
(tyvars, theta, tau) = splitSigmaTy (idType sel_id)
field_lbl = recordSelectorFieldLabel sel_id
- (data_ty,rhs_ty) = expectJust "StdIdInfoRec" (getFunTy_maybe tau)
+ (data_ty,rhs_ty) = expectJust "StdIdInfoRec" (splitFunTy_maybe tau)
-- tau is of form (T a b c -> field-type)
- (tycon, _, data_cons) = getAppDataTyCon data_ty
+ (tycon, _, data_cons) = splitAlgTyConApp data_ty
tyvar_tys = mkTyVarTys tyvars
[data_id] = mkTemplateLocals [data_ty]
@@ -173,15 +167,15 @@ addStandardIdInfo sel_id
field_lbls = dataConFieldLabels data_con
maybe_the_arg_id = assocMaybe (field_lbls `zip` arg_ids) field_lbl
- error_expr = mkApp (Var pAT_ERROR_ID) [] [rhs_ty] [LitArg msg_lit]
- full_msg = show (sep [text "No match in record selector", ppr (PprForUser opt_PprUserLength) sel_id])
+ error_expr = mkApp (Var pAT_ERROR_ID) [rhs_ty] [LitArg msg_lit]
+ full_msg = showSDoc (sep [text "No match in record selector", ppr sel_id])
msg_lit = NoRepStr (_PK_ full_msg)
\end{code}
%************************************************************************
%* *
-\subsection{Super selectors}
+\subsection{Dictionary selectors}
%* *
%************************************************************************
@@ -219,8 +213,8 @@ addStandardIdInfo prim_id
unfolding = mkUnfolding IWantToBeINLINEd {- Always inline PrimOps -} rhs
- (tyvars, tau) = splitForAllTy (idType prim_id)
- (arg_tys, _) = splitFunTy tau
+ (tyvars, tau) = splitForAllTys (idType prim_id)
+ (arg_tys, _) = splitFunTys tau
args = mkTemplateLocals arg_tys
rhs = mkLam tyvars args $
@@ -238,7 +232,7 @@ addStandardIdInfo prim_id
\begin{code}
addStandardIdInfo id
- = pprTrace "addStandardIdInfo missing:" (ppr PprDebug id) id
+ = pprTrace "addStandardIdInfo missing:" (ppr id) id
\end{code}
@@ -256,21 +250,19 @@ mk_selector_unfolding clas sel_id
= mkUnfolding IWantToBeINLINEd {- Always inline selectors -} rhs
-- The always-inline thing means we don't need any other IdInfo
where
- rhs = mk_dict_selector [alphaTyVar] dict_id arg_ids the_arg_id
- tyvar_ty = mkTyVarTy alphaTyVar
- [dict_id] = mkTemplateLocals [mkDictTy clas tyvar_ty]
- arg_tys = classDictArgTys clas tyvar_ty
- arg_ids = mkTemplateLocals arg_tys
- the_arg_id = assoc "StdIdInfo:mk_sel" ((sc_sel_ids ++ op_sel_ids) `zip` arg_ids) sel_id
+ (tyvars, _, sc_sel_ids, op_sel_ids, defms) = classBigSig clas
- (_, _, sc_sel_ids, op_sel_ids, defms) = classBigSig clas
+ tycon = classTyCon clas
+ [data_con] = tyConDataCons tycon
+ tyvar_tys = mkTyVarTys tyvars
+ arg_tys = dataConArgTys data_con tyvar_tys
+ the_arg_id = assoc "StdIdInfo:mk_sel" ((sc_sel_ids ++ op_sel_ids) `zip` arg_ids) sel_id
-mk_dict_selector tyvars dict_id [arg_id] the_arg_id
- = mkLam tyvars [dict_id] (Var dict_id)
+ (dict_id:arg_ids) = mkTemplateLocals (mkDictTy clas tyvar_tys : arg_tys)
-mk_dict_selector tyvars dict_id arg_ids the_arg_id
- = mkLam tyvars [dict_id] $
- Case (Var dict_id) (AlgAlts [(tup_con, arg_ids, Var the_arg_id)] NoDefault)
- where
- tup_con = tupleCon (length arg_ids)
+ rhs | isNewTyCon tycon = mkLam tyvars [dict_id] $
+ Coerce (CoerceOut data_con) (head arg_tys) (Var dict_id)
+ | otherwise = mkLam tyvars [dict_id] $
+ Case (Var dict_id) $
+ AlgAlts [(data_con, arg_ids, Var the_arg_id)] NoDefault
\end{code}
diff --git a/ghc/compiler/prelude/TysPrim.hi-boot b/ghc/compiler/prelude/TysPrim.hi-boot
index deb8bf07a1..3cd8184ee4 100644
--- a/ghc/compiler/prelude/TysPrim.hi-boot
+++ b/ghc/compiler/prelude/TysPrim.hi-boot
@@ -2,4 +2,5 @@ _interface_ TysPrim 1
_exports_
TysPrim voidTy;
_declarations_
-1 voidTy _:_ Type.Type ;;
+-- Not needed by Type.lhs any more
+-- 1 voidTy _:_ Type.Type ;;
diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs
index 36134a2099..660b2a591c 100644
--- a/ghc/compiler/prelude/TysPrim.lhs
+++ b/ghc/compiler/prelude/TysPrim.lhs
@@ -7,20 +7,17 @@ This module tracks the ``state interface'' document, ``GHC prelude:
types and operations.''
\begin{code}
-#include "HsVersions.h"
-
module TysPrim where
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
import Kind ( mkUnboxedTypeKind, mkBoxedTypeKind, mkTypeKind, mkArrowKind )
import Name ( mkWiredInTyConName )
import PrimRep ( PrimRep(..) ) -- getPrimRepInfo uses PrimRep repn
import TyCon ( mkPrimTyCon, mkDataTyCon, TyCon )
-import BasicTypes ( NewOrData(..) )
-import Type ( applyTyCon, mkTyVarTys, mkTyConTy, SYN_IE(Type) )
+import BasicTypes ( NewOrData(..), RecFlag(..) )
+import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, Type )
import TyVar ( GenTyVar(..), alphaTyVars )
-import Usage ( usageOmega )
import PrelMods ( gHC__ )
import Unique
\end{code}
@@ -47,22 +44,22 @@ pcPrimTyCon key str arity primrep
the_tycon = mkPrimTyCon name arity primrep
-charPrimTy = applyTyCon charPrimTyCon []
+charPrimTy = mkTyConTy charPrimTyCon
charPrimTyCon = pcPrimTyCon charPrimTyConKey SLIT("Char#") 0 CharRep
-intPrimTy = applyTyCon intPrimTyCon []
+intPrimTy = mkTyConTy intPrimTyCon
intPrimTyCon = pcPrimTyCon intPrimTyConKey SLIT("Int#") 0 IntRep
-wordPrimTy = applyTyCon wordPrimTyCon []
+wordPrimTy = mkTyConTy wordPrimTyCon
wordPrimTyCon = pcPrimTyCon wordPrimTyConKey SLIT("Word#") 0 WordRep
-addrPrimTy = applyTyCon addrPrimTyCon []
+addrPrimTy = mkTyConTy addrPrimTyCon
addrPrimTyCon = pcPrimTyCon addrPrimTyConKey SLIT("Addr#") 0 AddrRep
-floatPrimTy = applyTyCon floatPrimTyCon []
+floatPrimTy = mkTyConTy floatPrimTyCon
floatPrimTyCon = pcPrimTyCon floatPrimTyConKey SLIT("Float#") 0 FloatRep
-doublePrimTy = applyTyCon doublePrimTyCon []
+doublePrimTy = mkTyConTy doublePrimTyCon
doublePrimTyCon = pcPrimTyCon doublePrimTyConKey SLIT("Double#") 0 DoubleRep
\end{code}
@@ -100,7 +97,7 @@ where s is a type variable. The only purpose of the type parameter is to
keep different state threads separate. It is represented by nothing at all.
\begin{code}
-mkStatePrimTy ty = applyTyCon statePrimTyCon [ty]
+mkStatePrimTy ty = mkTyConApp statePrimTyCon [ty]
statePrimTyCon = pcPrimTyCon statePrimTyConKey SLIT("State#") 1 VoidRep
\end{code}
@@ -110,7 +107,7 @@ We never manipulate values of type RealWorld; it's only used in the type
system, to parameterise State#.
\begin{code}
-realWorldTy = applyTyCon realWorldTyCon []
+realWorldTy = mkTyConTy realWorldTyCon
realWorldTyCon = mk_no_constr_tycon realWorldTyConKey SLIT("RealWorld")
realWorldStatePrimTy = mkStatePrimTy realWorldTy
\end{code}
@@ -137,11 +134,13 @@ mk_no_constr_tycon key str
where
name = mkWiredInTyConName key gHC__ str the_tycon
the_tycon = mkDataTyCon name mkBoxedTypeKind
- [{-no tyvars-}]
- [{-no context-}]
- [{-no data cons!-}] -- we tell you *nothing* about this guy
- [{-no derivings-}]
+ [] -- No tyvars
+ [] -- No context
+ [] -- No constructors; we tell you *nothing* about this guy
+ [] -- No derivings
+ Nothing -- Not a dictionary
DataType
+ NonRecursive
\end{code}
%************************************************************************
@@ -159,10 +158,10 @@ mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConKey SLIT("MutableArray#
mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConKey SLIT("MutableByteArray#") 1 ByteArrayRep
-mkArrayPrimTy elt = applyTyCon arrayPrimTyCon [elt]
-byteArrayPrimTy = applyTyCon byteArrayPrimTyCon []
-mkMutableArrayPrimTy s elt = applyTyCon mutableArrayPrimTyCon [s, elt]
-mkMutableByteArrayPrimTy s = applyTyCon mutableByteArrayPrimTyCon [s]
+mkArrayPrimTy elt = mkTyConApp arrayPrimTyCon [elt]
+byteArrayPrimTy = mkTyConTy byteArrayPrimTyCon
+mkMutableArrayPrimTy s elt = mkTyConApp mutableArrayPrimTyCon [s, elt]
+mkMutableByteArrayPrimTy s = mkTyConApp mutableByteArrayPrimTyCon [s]
\end{code}
%************************************************************************
@@ -174,7 +173,7 @@ mkMutableByteArrayPrimTy s = applyTyCon mutableByteArrayPrimTyCon [s]
\begin{code}
synchVarPrimTyCon = pcPrimTyCon synchVarPrimTyConKey SLIT("SynchVar#") 2 PtrRep
-mkSynchVarPrimTy s elt = applyTyCon synchVarPrimTyCon [s, elt]
+mkSynchVarPrimTy s elt = mkTyConApp synchVarPrimTyCon [s, elt]
\end{code}
%************************************************************************
@@ -186,7 +185,7 @@ mkSynchVarPrimTy s elt = applyTyCon synchVarPrimTyCon [s, elt]
\begin{code}
stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConKey SLIT("StablePtr#") 1 StablePtrRep
-mkStablePtrPrimTy ty = applyTyCon stablePtrPrimTyCon [ty]
+mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty]
\end{code}
%************************************************************************
@@ -210,6 +209,6 @@ There are no primitive operations on @ForeignObj#@s (although equality
could possibly be added?)
\begin{code}
-foreignObjPrimTy = applyTyCon foreignObjPrimTyCon []
+foreignObjPrimTy = mkTyConTy foreignObjPrimTyCon
foreignObjPrimTyCon = pcPrimTyCon foreignObjPrimTyConKey SLIT("ForeignObj#") 0 ForeignObjRep
\end{code}
diff --git a/ghc/compiler/prelude/TysWiredIn.hi-boot b/ghc/compiler/prelude/TysWiredIn.hi-boot
index c808a8e739..11753ec2e4 100644
--- a/ghc/compiler/prelude/TysWiredIn.hi-boot
+++ b/ghc/compiler/prelude/TysWiredIn.hi-boot
@@ -1,6 +1,11 @@
_interface_ TysWiredIn 1
_exports_
-TysWiredIn tupleCon tupleTyCon;
+TysWiredIn tupleCon ;
_declarations_
-1 tupleCon _:_ BasicTypes.Arity -> Id.Id ;;
-1 tupleTyCon _:_ BasicTypes.Arity -> TyCon.TyCon ;;
+-- Let's try not having this either!
+-- 1 tupleTyCon _:_ BasicTypes.Arity -> TyCon.TyCon ;;
+
+-- Needed by TyCon.lhs
+1 tupleCon _:_ BasicTypes.Arity -> Id!Id ;;
+
+
diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs
index 2c39168334..2f78305668 100644
--- a/ghc/compiler/prelude/TysWiredIn.lhs
+++ b/ghc/compiler/prelude/TysWiredIn.lhs
@@ -10,8 +10,6 @@ This module tracks the ``state interface'' document, ``GHC prelude:
types and operations.''
\begin{code}
-#include "HsVersions.h"
-
module TysWiredIn (
addrDataCon,
addrTy,
@@ -92,65 +90,53 @@ module TysWiredIn (
wordTyCon
) where
---ToDo:rm
---import Pretty
---import Util
---import PprType
---import Kind
-
-IMP_Ubiq()
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
-IMPORT_DELOOPER(TyLoop) ( mkDataCon, mkTupleCon, StrictnessMark(..) )
-IMPORT_DELOOPER(IdLoop) ( SpecEnv, nullSpecEnv,
- mkTupleCon, mkDataCon,
- StrictnessMark(..) )
-#else
+#include "HsVersions.h"
+
import {-# SOURCE #-} Id ( Id, mkDataCon, mkTupleCon, StrictnessMark(..) )
-import {-# SOURCE #-} SpecEnv ( SpecEnv, nullSpecEnv )
-#endif
-- friends:
import PrelMods
import TysPrim
-- others:
-import FieldLabel () --
import Kind ( mkBoxedTypeKind, mkArrowKind )
import Name ( mkWiredInTyConName, mkWiredInIdName )
import TyCon ( mkDataTyCon, mkTupleTyCon, mkSynTyCon,
- TyCon, SYN_IE(Arity)
+ TyCon, Arity
)
-import BasicTypes ( SYN_IE(Module), NewOrData(..) )
-import Type ( SYN_IE(Type), mkTyConTy, applyTyCon, mkSigmaTy, mkTyVarTys,
- mkFunTy, mkFunTys, maybeAppTyCon, maybeAppDataTyCon,
- GenType(..), SYN_IE(ThetaType), SYN_IE(TauType) )
-import TyVar ( GenTyVar, SYN_IE(TyVar), tyVarKind, alphaTyVars, alphaTyVar, betaTyVar )
+import BasicTypes ( Module, NewOrData(..), RecFlag(..) )
+import Type ( Type, mkTyConTy, mkTyConApp, mkSigmaTy, mkTyVarTys,
+ mkFunTy, mkFunTys, splitTyConApp_maybe, splitAlgTyConApp_maybe,
+ GenType(..), ThetaType, TauType )
+import TyVar ( GenTyVar, TyVar, tyVarKind, alphaTyVars, alphaTyVar, betaTyVar )
import Lex ( mkTupNameStr )
import Unique
import Util ( assoc, panic )
---nullSpecEnv = error "TysWiredIn:nullSpecEnv = "
-addOneToSpecEnv = error "TysWiredIn:addOneToSpecEnv = "
-pc_gen_specs = error "TysWiredIn:pc_gen_specs "
-mkSpecInfo = error "TysWiredIn:SpecInfo"
-
alpha_tyvar = [alphaTyVar]
alpha_ty = [alphaTy]
alpha_beta_tyvars = [alphaTyVar, betaTyVar]
-pcDataTyCon, pcNewTyCon
+pcRecDataTyCon, pcNonRecDataTyCon, pcNonRecNewTyCon
:: Unique{-TyConKey-} -> Module -> FAST_STRING
-> [TyVar] -> [Id] -> TyCon
-pcDataTyCon = pc_tycon DataType
-pcNewTyCon = pc_tycon NewType
+pcRecDataTyCon = pc_tycon DataType Recursive
+pcNonRecDataTyCon = pc_tycon DataType NonRecursive
+pcNonRecNewTyCon = pc_tycon NewType NonRecursive
-pc_tycon new_or_data key mod str tyvars cons
+pc_tycon new_or_data is_rec key mod str tyvars cons
= tycon
where
tycon = mkDataTyCon name tycon_kind
- tyvars [{-no context-}] cons [{-no derivings-}]
+ tyvars
+ [] -- No context
+ cons
+ [] -- No derivings
+ Nothing -- Not a dictionary
new_or_data
+ is_rec
+
name = mkWiredInTyConName key mod str tycon
tycon_kind = foldr (mkArrowKind . tyVarKind) mkBoxedTypeKind tyvars
@@ -161,8 +147,8 @@ pcSynTyCon key mod str kind arity tyvars expansion
name = mkWiredInTyConName key mod str tycon
pcDataCon :: Unique{-DataConKey-} -> Module -> FAST_STRING
- -> [TyVar] -> ThetaType -> [TauType] -> TyCon -> SpecEnv -> Id
-pcDataCon key mod str tyvars context arg_tys tycon specenv
+ -> [TyVar] -> ThetaType -> [TauType] -> TyCon -> Id
+pcDataCon key mod str tyvars context arg_tys tycon
= data_con
where
data_con = mkDataCon name
@@ -170,12 +156,6 @@ pcDataCon key mod str tyvars context arg_tys tycon specenv
[ {- no labelled fields -} ]
tyvars context [] [] arg_tys tycon
name = mkWiredInIdName key mod str data_con
-
-pcGenerateDataSpecs :: Type -> SpecEnv
-pcGenerateDataSpecs ty
- = pc_gen_specs --False err err err ty
- where
- err = panic "PrelUtils:GenerateDataSpecs"
\end{code}
%************************************************************************
@@ -204,7 +184,7 @@ tupleCon arity
name = mkWiredInIdName uniq mod_name (mkTupNameStr arity) tuple_con
mod_name | arity == 0 = pREL_BASE
| otherwise = pREL_TUP
- ty = mkSigmaTy tyvars [] (mkFunTys tyvar_tys (applyTyCon tycon tyvar_tys))
+ ty = mkSigmaTy tyvars [] (mkFunTys tyvar_tys (mkTyConApp tycon tyvar_tys))
tyvars = take arity alphaTyVars
tyvar_tys = mkTyVarTys tyvars
tycon = tupleTyCon arity
@@ -226,8 +206,8 @@ pairDataCon = tupleCon 2
\begin{code}
charTy = mkTyConTy charTyCon
-charTyCon = pcDataTyCon charTyConKey pREL_BASE SLIT("Char") [] [charDataCon]
-charDataCon = pcDataCon charDataConKey pREL_BASE SLIT("C#") [] [] [charPrimTy] charTyCon nullSpecEnv
+charTyCon = pcNonRecDataTyCon charTyConKey pREL_BASE SLIT("Char") [] [charDataCon]
+charDataCon = pcDataCon charDataConKey pREL_BASE SLIT("C#") [] [] [charPrimTy] charTyCon
stringTy = mkListTy charTy -- convenience only
\end{code}
@@ -235,12 +215,12 @@ stringTy = mkListTy charTy -- convenience only
\begin{code}
intTy = mkTyConTy intTyCon
-intTyCon = pcDataTyCon intTyConKey pREL_BASE SLIT("Int") [] [intDataCon]
-intDataCon = pcDataCon intDataConKey pREL_BASE SLIT("I#") [] [] [intPrimTy] intTyCon nullSpecEnv
+intTyCon = pcNonRecDataTyCon intTyConKey pREL_BASE SLIT("Int") [] [intDataCon]
+intDataCon = pcDataCon intDataConKey pREL_BASE SLIT("I#") [] [] [intPrimTy] intTyCon
-isIntTy :: GenType (GenTyVar flexi) uvar -> Bool
+isIntTy :: GenType flexi -> Bool
isIntTy ty
- = case (maybeAppDataTyCon ty) of
+ = case (splitAlgTyConApp_maybe ty) of
Just (tycon, [], _) -> uniqueOf tycon == intTyConKey
_ -> False
@@ -255,59 +235,59 @@ min_int = toInteger minInt
\begin{code}
wordTy = mkTyConTy wordTyCon
-wordTyCon = pcDataTyCon wordTyConKey fOREIGN SLIT("Word") [] [wordDataCon]
-wordDataCon = pcDataCon wordDataConKey fOREIGN SLIT("W#") [] [] [wordPrimTy] wordTyCon nullSpecEnv
+wordTyCon = pcNonRecDataTyCon wordTyConKey fOREIGN SLIT("Word") [] [wordDataCon]
+wordDataCon = pcDataCon wordDataConKey fOREIGN SLIT("W#") [] [] [wordPrimTy] wordTyCon
\end{code}
\begin{code}
addrTy = mkTyConTy addrTyCon
-addrTyCon = pcDataTyCon addrTyConKey aDDR SLIT("Addr") [] [addrDataCon]
-addrDataCon = pcDataCon addrDataConKey aDDR SLIT("A#") [] [] [addrPrimTy] addrTyCon nullSpecEnv
+addrTyCon = pcNonRecDataTyCon addrTyConKey aDDR SLIT("Addr") [] [addrDataCon]
+addrDataCon = pcDataCon addrDataConKey aDDR SLIT("A#") [] [] [addrPrimTy] addrTyCon
\end{code}
\begin{code}
floatTy = mkTyConTy floatTyCon
-floatTyCon = pcDataTyCon floatTyConKey pREL_BASE SLIT("Float") [] [floatDataCon]
-floatDataCon = pcDataCon floatDataConKey pREL_BASE SLIT("F#") [] [] [floatPrimTy] floatTyCon nullSpecEnv
+floatTyCon = pcNonRecDataTyCon floatTyConKey pREL_BASE SLIT("Float") [] [floatDataCon]
+floatDataCon = pcDataCon floatDataConKey pREL_BASE SLIT("F#") [] [] [floatPrimTy] floatTyCon
\end{code}
\begin{code}
doubleTy = mkTyConTy doubleTyCon
-doubleTyCon = pcDataTyCon doubleTyConKey pREL_BASE SLIT("Double") [] [doubleDataCon]
-doubleDataCon = pcDataCon doubleDataConKey pREL_BASE SLIT("D#") [] [] [doublePrimTy] doubleTyCon nullSpecEnv
+doubleTyCon = pcNonRecDataTyCon doubleTyConKey pREL_BASE SLIT("Double") [] [doubleDataCon]
+doubleDataCon = pcDataCon doubleDataConKey pREL_BASE SLIT("D#") [] [] [doublePrimTy] doubleTyCon
\end{code}
\begin{code}
-mkStateTy ty = applyTyCon stateTyCon [ty]
+mkStateTy ty = mkTyConApp stateTyCon [ty]
realWorldStateTy = mkStateTy realWorldTy -- a common use
-stateTyCon = pcDataTyCon stateTyConKey sT_BASE SLIT("State") alpha_tyvar [stateDataCon]
+stateTyCon = pcNonRecDataTyCon stateTyConKey sT_BASE SLIT("State") alpha_tyvar [stateDataCon]
stateDataCon
= pcDataCon stateDataConKey sT_BASE SLIT("S#")
- alpha_tyvar [] [mkStatePrimTy alphaTy] stateTyCon nullSpecEnv
+ alpha_tyvar [] [mkStatePrimTy alphaTy] stateTyCon
\end{code}
\begin{code}
stablePtrTyCon
- = pcDataTyCon stablePtrTyConKey fOREIGN SLIT("StablePtr")
+ = pcNonRecDataTyCon stablePtrTyConKey fOREIGN SLIT("StablePtr")
alpha_tyvar [stablePtrDataCon]
where
stablePtrDataCon
= pcDataCon stablePtrDataConKey fOREIGN SLIT("StablePtr")
- alpha_tyvar [] [mkStablePtrPrimTy alphaTy] stablePtrTyCon nullSpecEnv
+ alpha_tyvar [] [mkStablePtrPrimTy alphaTy] stablePtrTyCon
\end{code}
\begin{code}
foreignObjTyCon
- = pcDataTyCon foreignObjTyConKey fOREIGN SLIT("ForeignObj")
+ = pcNonRecDataTyCon foreignObjTyConKey fOREIGN SLIT("ForeignObj")
[] [foreignObjDataCon]
where
foreignObjDataCon
= pcDataCon foreignObjDataConKey fOREIGN SLIT("ForeignObj")
- [] [] [foreignObjPrimTy] foreignObjTyCon nullSpecEnv
+ [] [] [foreignObjPrimTy] foreignObjTyCon
\end{code}
%************************************************************************
@@ -318,37 +298,37 @@ foreignObjTyCon
@Integer@ and its pals are not really primitive. @Integer@ itself, first:
\begin{code}
-integerTy :: GenType t u
+integerTy :: GenType t
integerTy = mkTyConTy integerTyCon
-integerTyCon = pcDataTyCon integerTyConKey pREL_BASE SLIT("Integer") [] [integerDataCon]
+integerTyCon = pcNonRecDataTyCon integerTyConKey pREL_BASE SLIT("Integer") [] [integerDataCon]
integerDataCon = pcDataCon integerDataConKey pREL_BASE SLIT("J#")
- [] [] [intPrimTy, intPrimTy, byteArrayPrimTy] integerTyCon nullSpecEnv
+ [] [] [intPrimTy, intPrimTy, byteArrayPrimTy] integerTyCon
-isIntegerTy :: GenType (GenTyVar flexi) uvar -> Bool
+isIntegerTy :: GenType flexi -> Bool
isIntegerTy ty
- = case (maybeAppDataTyCon ty) of
+ = case (splitAlgTyConApp_maybe ty) of
Just (tycon, [], _) -> uniqueOf tycon == integerTyConKey
_ -> False
\end{code}
And the other pairing types:
\begin{code}
-return2GMPsTyCon = pcDataTyCon return2GMPsTyConKey
+return2GMPsTyCon = pcNonRecDataTyCon return2GMPsTyConKey
pREL_NUM SLIT("Return2GMPs") [] [return2GMPsDataCon]
return2GMPsDataCon
= pcDataCon return2GMPsDataConKey pREL_NUM SLIT("Return2GMPs") [] []
[intPrimTy, intPrimTy, byteArrayPrimTy,
- intPrimTy, intPrimTy, byteArrayPrimTy] return2GMPsTyCon nullSpecEnv
+ intPrimTy, intPrimTy, byteArrayPrimTy] return2GMPsTyCon
-returnIntAndGMPTyCon = pcDataTyCon returnIntAndGMPTyConKey
+returnIntAndGMPTyCon = pcNonRecDataTyCon returnIntAndGMPTyConKey
pREL_NUM SLIT("ReturnIntAndGMP") [] [returnIntAndGMPDataCon]
returnIntAndGMPDataCon
= pcDataCon returnIntAndGMPDataConKey pREL_NUM SLIT("ReturnIntAndGMP") [] []
- [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy] returnIntAndGMPTyCon nullSpecEnv
+ [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy] returnIntAndGMPTyCon
\end{code}
%************************************************************************
@@ -366,120 +346,120 @@ We fish one of these \tr{StateAnd<blah>#} things with
\begin{code}
stateAndPtrPrimTyCon
- = pcDataTyCon stateAndPtrPrimTyConKey sT_BASE SLIT("StateAndPtr#")
+ = pcNonRecDataTyCon stateAndPtrPrimTyConKey sT_BASE SLIT("StateAndPtr#")
alpha_beta_tyvars [stateAndPtrPrimDataCon]
stateAndPtrPrimDataCon
= pcDataCon stateAndPtrPrimDataConKey sT_BASE SLIT("StateAndPtr#")
alpha_beta_tyvars [] [mkStatePrimTy alphaTy, betaTy]
- stateAndPtrPrimTyCon nullSpecEnv
+ stateAndPtrPrimTyCon
stateAndCharPrimTyCon
- = pcDataTyCon stateAndCharPrimTyConKey sT_BASE SLIT("StateAndChar#")
+ = pcNonRecDataTyCon stateAndCharPrimTyConKey sT_BASE SLIT("StateAndChar#")
alpha_tyvar [stateAndCharPrimDataCon]
stateAndCharPrimDataCon
= pcDataCon stateAndCharPrimDataConKey sT_BASE SLIT("StateAndChar#")
alpha_tyvar [] [mkStatePrimTy alphaTy, charPrimTy]
- stateAndCharPrimTyCon nullSpecEnv
+ stateAndCharPrimTyCon
stateAndIntPrimTyCon
- = pcDataTyCon stateAndIntPrimTyConKey sT_BASE SLIT("StateAndInt#")
+ = pcNonRecDataTyCon stateAndIntPrimTyConKey sT_BASE SLIT("StateAndInt#")
alpha_tyvar [stateAndIntPrimDataCon]
stateAndIntPrimDataCon
= pcDataCon stateAndIntPrimDataConKey sT_BASE SLIT("StateAndInt#")
alpha_tyvar [] [mkStatePrimTy alphaTy, intPrimTy]
- stateAndIntPrimTyCon nullSpecEnv
+ stateAndIntPrimTyCon
stateAndWordPrimTyCon
- = pcDataTyCon stateAndWordPrimTyConKey sT_BASE SLIT("StateAndWord#")
+ = pcNonRecDataTyCon stateAndWordPrimTyConKey sT_BASE SLIT("StateAndWord#")
alpha_tyvar [stateAndWordPrimDataCon]
stateAndWordPrimDataCon
= pcDataCon stateAndWordPrimDataConKey sT_BASE SLIT("StateAndWord#")
alpha_tyvar [] [mkStatePrimTy alphaTy, wordPrimTy]
- stateAndWordPrimTyCon nullSpecEnv
+ stateAndWordPrimTyCon
stateAndAddrPrimTyCon
- = pcDataTyCon stateAndAddrPrimTyConKey sT_BASE SLIT("StateAndAddr#")
+ = pcNonRecDataTyCon stateAndAddrPrimTyConKey sT_BASE SLIT("StateAndAddr#")
alpha_tyvar [stateAndAddrPrimDataCon]
stateAndAddrPrimDataCon
= pcDataCon stateAndAddrPrimDataConKey sT_BASE SLIT("StateAndAddr#")
alpha_tyvar [] [mkStatePrimTy alphaTy, addrPrimTy]
- stateAndAddrPrimTyCon nullSpecEnv
+ stateAndAddrPrimTyCon
stateAndStablePtrPrimTyCon
- = pcDataTyCon stateAndStablePtrPrimTyConKey fOREIGN SLIT("StateAndStablePtr#")
+ = pcNonRecDataTyCon stateAndStablePtrPrimTyConKey fOREIGN SLIT("StateAndStablePtr#")
alpha_beta_tyvars [stateAndStablePtrPrimDataCon]
stateAndStablePtrPrimDataCon
= pcDataCon stateAndStablePtrPrimDataConKey fOREIGN SLIT("StateAndStablePtr#")
alpha_beta_tyvars []
- [mkStatePrimTy alphaTy, applyTyCon stablePtrPrimTyCon [betaTy]]
- stateAndStablePtrPrimTyCon nullSpecEnv
+ [mkStatePrimTy alphaTy, mkTyConApp stablePtrPrimTyCon [betaTy]]
+ stateAndStablePtrPrimTyCon
stateAndForeignObjPrimTyCon
- = pcDataTyCon stateAndForeignObjPrimTyConKey fOREIGN SLIT("StateAndForeignObj#")
+ = pcNonRecDataTyCon stateAndForeignObjPrimTyConKey fOREIGN SLIT("StateAndForeignObj#")
alpha_tyvar [stateAndForeignObjPrimDataCon]
stateAndForeignObjPrimDataCon
= pcDataCon stateAndForeignObjPrimDataConKey fOREIGN SLIT("StateAndForeignObj#")
alpha_tyvar []
- [mkStatePrimTy alphaTy, applyTyCon foreignObjPrimTyCon []]
- stateAndForeignObjPrimTyCon nullSpecEnv
+ [mkStatePrimTy alphaTy, mkTyConTy foreignObjPrimTyCon]
+ stateAndForeignObjPrimTyCon
stateAndFloatPrimTyCon
- = pcDataTyCon stateAndFloatPrimTyConKey sT_BASE SLIT("StateAndFloat#")
+ = pcNonRecDataTyCon stateAndFloatPrimTyConKey sT_BASE SLIT("StateAndFloat#")
alpha_tyvar [stateAndFloatPrimDataCon]
stateAndFloatPrimDataCon
= pcDataCon stateAndFloatPrimDataConKey sT_BASE SLIT("StateAndFloat#")
alpha_tyvar [] [mkStatePrimTy alphaTy, floatPrimTy]
- stateAndFloatPrimTyCon nullSpecEnv
+ stateAndFloatPrimTyCon
stateAndDoublePrimTyCon
- = pcDataTyCon stateAndDoublePrimTyConKey sT_BASE SLIT("StateAndDouble#")
+ = pcNonRecDataTyCon stateAndDoublePrimTyConKey sT_BASE SLIT("StateAndDouble#")
alpha_tyvar [stateAndDoublePrimDataCon]
stateAndDoublePrimDataCon
= pcDataCon stateAndDoublePrimDataConKey sT_BASE SLIT("StateAndDouble#")
alpha_tyvar [] [mkStatePrimTy alphaTy, doublePrimTy]
- stateAndDoublePrimTyCon nullSpecEnv
+ stateAndDoublePrimTyCon
\end{code}
\begin{code}
stateAndArrayPrimTyCon
- = pcDataTyCon stateAndArrayPrimTyConKey aRR_BASE SLIT("StateAndArray#")
+ = pcNonRecDataTyCon stateAndArrayPrimTyConKey aRR_BASE SLIT("StateAndArray#")
alpha_beta_tyvars [stateAndArrayPrimDataCon]
stateAndArrayPrimDataCon
= pcDataCon stateAndArrayPrimDataConKey aRR_BASE SLIT("StateAndArray#")
alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkArrayPrimTy betaTy]
- stateAndArrayPrimTyCon nullSpecEnv
+ stateAndArrayPrimTyCon
stateAndMutableArrayPrimTyCon
- = pcDataTyCon stateAndMutableArrayPrimTyConKey aRR_BASE SLIT("StateAndMutableArray#")
+ = pcNonRecDataTyCon stateAndMutableArrayPrimTyConKey aRR_BASE SLIT("StateAndMutableArray#")
alpha_beta_tyvars [stateAndMutableArrayPrimDataCon]
stateAndMutableArrayPrimDataCon
= pcDataCon stateAndMutableArrayPrimDataConKey aRR_BASE SLIT("StateAndMutableArray#")
alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkMutableArrayPrimTy alphaTy betaTy]
- stateAndMutableArrayPrimTyCon nullSpecEnv
+ stateAndMutableArrayPrimTyCon
stateAndByteArrayPrimTyCon
- = pcDataTyCon stateAndByteArrayPrimTyConKey aRR_BASE SLIT("StateAndByteArray#")
+ = pcNonRecDataTyCon stateAndByteArrayPrimTyConKey aRR_BASE SLIT("StateAndByteArray#")
alpha_tyvar [stateAndByteArrayPrimDataCon]
stateAndByteArrayPrimDataCon
= pcDataCon stateAndByteArrayPrimDataConKey aRR_BASE SLIT("StateAndByteArray#")
alpha_tyvar [] [mkStatePrimTy alphaTy, byteArrayPrimTy]
- stateAndByteArrayPrimTyCon nullSpecEnv
+ stateAndByteArrayPrimTyCon
stateAndMutableByteArrayPrimTyCon
- = pcDataTyCon stateAndMutableByteArrayPrimTyConKey aRR_BASE SLIT("StateAndMutableByteArray#")
+ = pcNonRecDataTyCon stateAndMutableByteArrayPrimTyConKey aRR_BASE SLIT("StateAndMutableByteArray#")
alpha_tyvar [stateAndMutableByteArrayPrimDataCon]
stateAndMutableByteArrayPrimDataCon
= pcDataCon stateAndMutableByteArrayPrimDataConKey aRR_BASE SLIT("StateAndMutableByteArray#")
- alpha_tyvar [] [mkStatePrimTy alphaTy, applyTyCon mutableByteArrayPrimTyCon alpha_ty]
- stateAndMutableByteArrayPrimTyCon nullSpecEnv
+ alpha_tyvar [] [mkStatePrimTy alphaTy, mkTyConApp mutableByteArrayPrimTyCon alpha_ty]
+ stateAndMutableByteArrayPrimTyCon
stateAndSynchVarPrimTyCon
- = pcDataTyCon stateAndSynchVarPrimTyConKey cONC_BASE SLIT("StateAndSynchVar#")
+ = pcNonRecDataTyCon stateAndSynchVarPrimTyConKey cONC_BASE SLIT("StateAndSynchVar#")
alpha_beta_tyvars [stateAndSynchVarPrimDataCon]
stateAndSynchVarPrimDataCon
= pcDataCon stateAndSynchVarPrimDataConKey cONC_BASE SLIT("StateAndSynchVar#")
alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkSynchVarPrimTy alphaTy betaTy]
- stateAndSynchVarPrimTyCon nullSpecEnv
+ stateAndSynchVarPrimTyCon
\end{code}
The ccall-desugaring mechanism uses this function to figure out how to
@@ -493,12 +473,12 @@ getStatePairingConInfo
Type) -- type of state pair
getStatePairingConInfo prim_ty
- = case (maybeAppTyCon prim_ty) of
+ = case (splitTyConApp_maybe prim_ty) of
Nothing -> panic "getStatePairingConInfo:1"
Just (prim_tycon, tys_applied) ->
let
(pair_con, pair_tycon, num_tys) = assoc "getStatePairingConInfo" tbl prim_tycon
- pair_ty = applyTyCon pair_tycon (realWorldTy : drop num_tys tys_applied)
+ pair_ty = mkTyConApp pair_tycon (realWorldTy : drop num_tys tys_applied)
in
(pair_con, pair_ty)
where
@@ -530,24 +510,24 @@ The only reason this is wired in is because we have to represent the
type of runST.
\begin{code}
-mkStateTransformerTy s a = applyTyCon stTyCon [s, a]
+mkStateTransformerTy s a = mkTyConApp stTyCon [s, a]
-stTyCon = pcNewTyCon stTyConKey sT_BASE SLIT("ST") alpha_beta_tyvars [stDataCon]
+stTyCon = pcNonRecNewTyCon stTyConKey sT_BASE SLIT("ST") alpha_beta_tyvars [stDataCon]
stDataCon = pcDataCon stDataConKey sT_BASE SLIT("ST")
- alpha_beta_tyvars [] [ty] stTyCon nullSpecEnv
+ alpha_beta_tyvars [] [ty] stTyCon
where
ty = mkFunTy (mkStatePrimTy alphaTy) (mkSTretTy alphaTy betaTy)
-mkSTretTy alpha beta = applyTyCon stRetTyCon [alpha,beta]
+mkSTretTy alpha beta = mkTyConApp stRetTyCon [alpha,beta]
stRetTyCon
- = pcDataTyCon stRetTyConKey sT_BASE SLIT("STret")
+ = pcNonRecDataTyCon stRetTyConKey sT_BASE SLIT("STret")
alpha_beta_tyvars [stRetDataCon]
stRetDataCon
= pcDataCon stRetDataConKey sT_BASE SLIT("STret")
alpha_beta_tyvars [] [mkStatePrimTy alphaTy, betaTy]
- stRetTyCon nullSpecEnv
+ stRetTyCon
\end{code}
%************************************************************************
@@ -601,10 +581,10 @@ primitive counterpart.
\begin{code}
boolTy = mkTyConTy boolTyCon
-boolTyCon = pcDataTyCon boolTyConKey pREL_BASE SLIT("Bool") [] [falseDataCon, trueDataCon]
+boolTyCon = pcNonRecDataTyCon boolTyConKey pREL_BASE SLIT("Bool") [] [falseDataCon, trueDataCon]
-falseDataCon = pcDataCon falseDataConKey pREL_BASE SLIT("False") [] [] [] boolTyCon nullSpecEnv
-trueDataCon = pcDataCon trueDataConKey pREL_BASE SLIT("True") [] [] [] boolTyCon nullSpecEnv
+falseDataCon = pcDataCon falseDataConKey pREL_BASE SLIT("False") [] [] [] boolTyCon
+trueDataCon = pcDataCon trueDataConKey pREL_BASE SLIT("True") [] [] [] boolTyCon
\end{code}
%************************************************************************
@@ -623,19 +603,17 @@ data (,) a b = (,,) a b
\end{verbatim}
\begin{code}
-mkListTy :: GenType t u -> GenType t u
-mkListTy ty = applyTyCon listTyCon [ty]
+mkListTy :: GenType t -> GenType t
+mkListTy ty = mkTyConApp listTyCon [ty]
-alphaListTy = mkSigmaTy alpha_tyvar [] (applyTyCon listTyCon alpha_ty)
+alphaListTy = mkSigmaTy alpha_tyvar [] (mkTyConApp listTyCon alpha_ty)
-listTyCon = pcDataTyCon listTyConKey pREL_BASE SLIT("[]")
+listTyCon = pcRecDataTyCon listTyConKey pREL_BASE SLIT("[]")
alpha_tyvar [nilDataCon, consDataCon]
nilDataCon = pcDataCon nilDataConKey pREL_BASE SLIT("[]") alpha_tyvar [] [] listTyCon
- (pcGenerateDataSpecs alphaListTy)
consDataCon = pcDataCon consDataConKey pREL_BASE SLIT(":")
- alpha_tyvar [] [alphaTy, applyTyCon listTyCon alpha_ty] listTyCon
- (pcGenerateDataSpecs alphaListTy)
+ alpha_tyvar [] [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon
-- Interesting: polymorphic recursion would help here.
-- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy
-- gets the over-specific type (Type -> Type)
@@ -688,9 +666,9 @@ done by enumeration\srcloc{lib/prelude/InTup?.hs}.
\end{itemize}
\begin{code}
-mkTupleTy :: Int -> [GenType t u] -> GenType t u
+mkTupleTy :: Int -> [GenType t] -> GenType t
-mkTupleTy arity tys = applyTyCon (tupleTyCon arity) tys
+mkTupleTy arity tys = mkTyConApp (tupleTyCon arity) tys
unitTy = mkTupleTy 0 []
\end{code}
@@ -704,16 +682,16 @@ unitTy = mkTupleTy 0 []
Again, deeply turgid: \tr{data _Lift a = _Lift a}.
\begin{code}
-mkLiftTy ty = applyTyCon liftTyCon [ty]
+mkLiftTy ty = mkTyConApp liftTyCon [ty]
{-
mkLiftTy ty
- = mkSigmaTy tvs theta (applyTyCon liftTyCon [tau])
+ = mkSigmaTy tvs theta (mkTyConApp liftTyCon [tau])
where
(tvs, theta, tau) = splitSigmaTy ty
isLiftTy ty
- = case (maybeAppDataTyConExpandingDicts tau) of
+ = case (splitAlgTyConApp_maybeExpandingDicts tau) of
Just (tycon, tys, _) -> tycon == liftTyCon
Nothing -> False
where
@@ -721,16 +699,14 @@ isLiftTy ty
-}
-alphaLiftTy = mkSigmaTy alpha_tyvar [] (applyTyCon liftTyCon alpha_ty)
+alphaLiftTy = mkSigmaTy alpha_tyvar [] (mkTyConApp liftTyCon alpha_ty)
liftTyCon
- = pcDataTyCon liftTyConKey pREL_BASE SLIT("Lift") alpha_tyvar [liftDataCon]
+ = pcNonRecDataTyCon liftTyConKey pREL_BASE SLIT("Lift") alpha_tyvar [liftDataCon]
liftDataCon
= pcDataCon liftDataConKey pREL_BASE SLIT("Lift")
alpha_tyvar [] alpha_ty liftTyCon
- ((pcGenerateDataSpecs alphaLiftTy) `addOneToSpecEnv`
- (mkSpecInfo [Just realWorldStatePrimTy] 0 bottom))
where
bottom = panic "liftDataCon:State# _RealWorld"
\end{code}
View Lorry Controller Status