(might_be_a_function thunk_ty)
might_be_a_function :: Type -> Bool
+-- Return False only if we are *sure* it's a data type
+-- Look through newtypes etc as much as poss
might_be_a_function ty
- | Just (tc,_) <- splitTyConApp_maybe (repType ty),
- not (isFunTyCon tc) && not (isAbstractTyCon tc) = False
- -- don't forget to check for abstract types, which might
- -- be functions too.
- | otherwise = True
+ = case splitTyConApp_maybe (repType ty) of
+ Just (tc, _) -> not (isDataTyCon tc)
+ Nothing -> True
\end{code}
@mkConLFInfo@ is similar, for constructors.
import CoreSyn -- lots of things
import CoreUtils
+import TcHsSyn ( mkArbitraryType ) -- Mis-placed?
import OccurAnal
import CostCentre
import Module
mk_bind ((tyvars, global, local, prags), n) -- locals !! n == local
= -- Need to make fresh locals to bind in the selector, because
- -- some of the tyvars will be bound to voidTy
+ -- some of the tyvars will be bound to 'Any'
do { locals' <- newSysLocalsDs (map substitute local_tys)
; tup_id <- newSysLocalDs (substitute tup_ty)
; mb_specs <- mapM (dsSpec all_tyvars dicts tyvars global local core_bind)
; returnDs ((global', rhs) : spec_binds) }
where
mk_ty_arg all_tyvar | all_tyvar `elem` tyvars = mkTyVarTy all_tyvar
- | otherwise = voidTy
+ | otherwise = mkArbitraryType all_tyvar
ty_args = map mk_ty_arg all_tyvars
substitute = substTyWith all_tyvars ty_args
(mkVarApps (Var spec_id) bndrs)
}
where
- -- Bind to voidTy any of all_ptvs that aren't
+ -- Bind to Any any of all_ptvs that aren't
-- relevant for this particular function
fix_up body | null void_tvs = body
| otherwise = mkTyApps (mkLams void_tvs body)
- (map (const voidTy) void_tvs)
+ (map mkArbitraryType void_tvs)
void_tvs = all_tvs \\ tvs
msg = hang (ptext SLIT("Specialisation too complicated to desugar; ignored"))
= IfaceForeign { ifName = getOccName tycon,
ifExtName = tyConExtName tycon }
- | isPrimTyCon tycon || isFunTyCon tycon
- -- Needed in GHCi for ':info Int#', for example
- = IfaceData { ifName = getOccName tycon,
- ifTyVars = toIfaceTvBndrs (take (tyConArity tycon) alphaTyVars),
- ifCtxt = [],
- ifCons = IfAbstractTyCon,
- ifGadtSyntax = False,
- ifGeneric = False,
- ifRec = NonRecursive,
- ifFamInst = Nothing }
-
| otherwise = pprPanic "toIfaceDecl" (ppr tycon)
where
tyvars = tyConTyVars tycon
mkTupleTyConUnique
)
import BasicTypes ( Boxity(..), Arity )
-import Name ( Name, mkInternalName, mkExternalName, nameModule )
+import Name ( Name, mkInternalName, mkExternalName )
import SrcLoc ( noSrcLoc )
import FastString
\end{code}
realWorldTyConKey = mkPreludeTyConUnique 34
stablePtrPrimTyConKey = mkPreludeTyConUnique 35
stablePtrTyConKey = mkPreludeTyConUnique 36
+
+anyPrimTyConKey = mkPreludeTyConUnique 37
+anyPrimTyCon1Key = mkPreludeTyConUnique 38
+
statePrimTyConKey = mkPreludeTyConUnique 50
stableNamePrimTyConKey = mkPreludeTyConUnique 51
stableNameTyConKey = mkPreludeTyConUnique 52
-- Super Kinds constructors
tySuperKindTyConKey = mkPreludeTyConUnique 85
-coSuperKindTyConKey = mkPreludeTyConUnique 86
+coSuperKindTyConKey = mkPreludeTyConUnique 86
-- Kind constructors
liftedTypeKindTyConKey = mkPreludeTyConUnique 87
word32PrimTyCon, word32PrimTy,
int64PrimTyCon, int64PrimTy,
- word64PrimTyCon, word64PrimTy
+ word64PrimTyCon, word64PrimTy,
+
+ anyPrimTyCon, anyPrimTy, anyPrimTyCon1, mkAnyPrimTyCon
) where
#include "HsVersions.h"
import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
unliftedTypeKind,
liftedTypeKind, openTypeKind,
- Kind, mkArrowKinds,
+ Kind, mkArrowKinds, mkArrowKind,
TyThing(..)
)
import SrcLoc ( noSrcLoc )
-import Unique ( mkAlphaTyVarUnique )
+import Unique ( mkAlphaTyVarUnique, pprUnique )
import PrelNames
import FastString ( FastString, mkFastString )
import Outputable
, wordPrimTyCon
, word32PrimTyCon
, word64PrimTyCon
+ , anyPrimTyCon, anyPrimTyCon1
]
mkPrimTc :: FastString -> Unique -> TyCon -> Name
bcoPrimTyConName = mkPrimTc FSLIT("BCO#") bcoPrimTyConKey bcoPrimTyCon
weakPrimTyConName = mkPrimTc FSLIT("Weak#") weakPrimTyConKey weakPrimTyCon
threadIdPrimTyConName = mkPrimTc FSLIT("ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon
+anyPrimTyConName = mkPrimTc FSLIT("Any") anyPrimTyConKey anyPrimTyCon
+anyPrimTyCon1Name = mkPrimTc FSLIT("Any1") anyPrimTyCon1Key anyPrimTyCon
\end{code}
%************************************************************************
%************************************************************************
%* *
+ Any
+%* *
+%************************************************************************
+
+The type constructor Any is type to which you can unsafely coerce any
+lifted type, and back.
+
+ * It is lifted, and hence represented by a pointer
+
+ * It does not claim to be a *data* type, and that's important for
+ the code generator, because the code gen may *enter* a data value
+ but never enters a function value.
+
+It's also used to instantiate un-constrained type variables after type
+checking. For example
+ lenth Any []
+Annoyingly, we sometimes need Anys of other kinds, such as (*->*) etc.
+This is a bit like tuples. We define a couple of useful ones here,
+and make others up on the fly. If any of these others end up being exported
+into interface files, we'll get a crash; at least until we add interface-file
+syntax to support them.
+
+\begin{code}
+anyPrimTy = mkTyConApp anyPrimTyCon []
+
+anyPrimTyCon :: TyCon -- Kind *
+anyPrimTyCon = mkLiftedPrimTyCon anyPrimTyConName liftedTypeKind 0 PtrRep
+
+anyPrimTyCon1 :: TyCon -- Kind *->*
+anyPrimTyCon1 = mkLiftedPrimTyCon anyPrimTyCon1Name kind 0 PtrRep
+ where
+ kind = mkArrowKind liftedTypeKind liftedTypeKind
+
+mkAnyPrimTyCon :: Unique -> Kind -> TyCon
+-- Grotesque hack alert: the client gives the unique; so equality won't work
+mkAnyPrimTyCon uniq kind
+ = pprTrace "Urk! Inventing strangely-kinded Any TyCon:" (ppr uniq <+> ppr kind)
+ tycon
+ where
+ name = mkPrimTc (mkFastString ("Any" ++ showSDoc (pprUnique uniq))) uniq tycon
+ tycon = mkLiftedPrimTyCon name kind 0 PtrRep
+\end{code}
+
+
+%************************************************************************
+%* *
\subsection[TysPrim-arrays]{The primitive array types}
%* *
%************************************************************************
unboxedPairTyCon, unboxedPairDataCon,
unitTy,
- voidTy,
-- parallel arrays
mkPArrTy,
%************************************************************************
\begin{code}
--- The Void type is represented as a data type with no constructors
--- It's a built in type (i.e. there's no way to define it in Haskell;
--- the nearest would be
---
--- data Void = -- No constructors!
---
--- ) It's lifted; there is only one value of this
--- type, namely "void", whose semantics is just bottom.
---
--- Haskell 98 drops the definition of a Void type, so we just 'simulate'
--- voidTy using ().
-voidTy = unitTy
-\end{code}
-
-
-\begin{code}
charTy = mkTyConTy charTyCon
charTyCon = pcNonRecDataTyCon charTyConName [] [charDataCon]
mkHsAppTy, mkSimpleHsAlt,
nlHsIntLit, mkVanillaTuplePat,
+ mkArbitraryType, -- Put this elsewhere?
-- re-exported from TcMonad
TcId, TcIdSet, TcDictBinds,
-- Make up an arbitrary type whose kind is the same as the tyvar.
-- We'll use this to instantiate the (unbound) tyvar.
mkArbitraryType tv
- | liftedTypeKind `isSubKind` kind = voidTy -- The vastly common case
+ | liftedTypeKind `isSubKind` kind = anyPrimTy -- The vastly common case
| otherwise = mkTyConApp tycon []
where
kind = tyVarKind tv
(args,res) = splitKindFunTys kind
- tycon | eqKind kind (tyConKind listTyCon) -- *->*
- = listTyCon -- No tuples this size
+ tycon | eqKind kind (tyConKind anyPrimTyCon1) -- *->*
+ = anyPrimTyCon1 -- No tuples this size
| all isLiftedTypeKind args && isLiftedTypeKind res
= tupleTyCon Boxed (length args) -- *-> ... ->*->*
+ -- Horrible hack to make less use of mkAnyPrimTyCon
| otherwise
- = pprTrace "Urk! Inventing strangely-kinded void TyCon:" (ppr tc_name $$ ppr kind) $
- mkPrimTyCon tc_name kind 0 VoidRep
+ = mkAnyPrimTyCon (getUnique tv) kind
-- Same name as the tyvar, apart from making it start with a colon (sigh)
-- I dread to think what will happen if this gets out into an
-- interface file. Catastrophe likely. Major sigh.
-
- tc_name = mkInternalName (getUnique tv) (mkDerivedTyConOcc (getOccName tv)) noSrcLoc
\end{code}
import BasicTypes
import Name
import PrelNames
-import Maybe
import Maybes
import Outputable
import FastString
isAlgTyCon other = False
isDataTyCon :: TyCon -> Bool
--- isDataTyCon returns True for data types that are represented by
--- heap-allocated constructors.
+-- isDataTyCon returns True for data types that are definitely
+-- represented by heap-allocated constructors.
-- These are srcutinised by Core-level @case@ expressions, and they
-- get info tables allocated for them.
-- True for all @data@ types
DataTyCon {} -> True
OpenNewTyCon -> False
NewTyCon {} -> False
- AbstractTyCon -> pprPanic "isDataTyCon" (ppr tc)
+ AbstractTyCon -> False -- We don't know, so return False
isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
isDataTyCon other = False
projects / ghc-hetmet.git / commitdiff