2 % (c) The GRASP Project, Glasgow University, 1994-1995
4 \section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types}
6 This module is about types that can be defined in Haskell, but which
7 must be wired into the compiler nonetheless.
9 This module tracks the ``state interface'' document, ``GHC prelude:
10 types and operations.''
13 #include "HsVersions.h"
32 getStatePairingConInfo,
48 tupleTyCon, tupleCon, unitTyCon, unitDataCon, pairTyCon, pairDataCon,
58 stateAndAddrPrimTyCon,
59 stateAndArrayPrimTyCon,
60 stateAndByteArrayPrimTyCon,
61 stateAndCharPrimTyCon,
62 stateAndDoublePrimTyCon,
63 stateAndFloatPrimTyCon,
65 stateAndForeignObjPrimTyCon,
66 stateAndMutableArrayPrimTyCon,
67 stateAndMutableByteArrayPrimTyCon,
69 stateAndStablePtrPrimTyCon,
70 stateAndSynchVarPrimTyCon,
71 stateAndWordPrimTyCon,
90 IMPORT_DELOOPER(TyLoop) --( mkDataCon, mkTupleCon, StrictnessMark(..) )
91 IMPORT_DELOOPER(IdLoop) ( SpecEnv, nullSpecEnv,
92 mkTupleCon, mkDataCon,
100 import Kind ( mkBoxedTypeKind, mkArrowKind )
101 import Name --( mkWiredInTyConName, mkWiredInIdName, mkTupNameStr )
102 import TyCon ( mkDataTyCon, mkTupleTyCon, mkSynTyCon,
103 NewOrData(..), TyCon, SYN_IE(Arity)
105 import Type ( mkTyConTy, applyTyCon, mkSigmaTy, mkTyVarTys,
106 mkFunTy, mkFunTys, maybeAppTyCon,
107 GenType(..), SYN_IE(ThetaType), SYN_IE(TauType) )
108 import TyVar ( tyVarKind, alphaTyVars, alphaTyVar, betaTyVar )
109 import Lex ( mkTupNameStr )
111 import Util ( assoc, panic )
113 --nullSpecEnv = error "TysWiredIn:nullSpecEnv = "
114 addOneToSpecEnv = error "TysWiredIn:addOneToSpecEnv = "
115 pc_gen_specs = error "TysWiredIn:pc_gen_specs "
116 mkSpecInfo = error "TysWiredIn:SpecInfo"
118 alpha_tyvar = [alphaTyVar]
120 alpha_beta_tyvars = [alphaTyVar, betaTyVar]
122 pcDataTyCon, pcNewTyCon
123 :: Unique{-TyConKey-} -> Module -> FAST_STRING
124 -> [TyVar] -> [Id] -> TyCon
126 pcDataTyCon = pc_tycon DataType
127 pcNewTyCon = pc_tycon NewType
129 pc_tycon new_or_data key mod str tyvars cons
132 tycon = mkDataTyCon name tycon_kind
133 tyvars [{-no context-}] cons [{-no derivings-}]
135 name = mkWiredInTyConName key mod str tycon
136 tycon_kind = foldr (mkArrowKind . tyVarKind) mkBoxedTypeKind tyvars
138 pcSynTyCon key mod str kind arity tyvars expansion
141 tycon = mkSynTyCon name kind arity tyvars expansion
142 name = mkWiredInTyConName key mod str tycon
144 pcDataCon :: Unique{-DataConKey-} -> Module -> FAST_STRING
145 -> [TyVar] -> ThetaType -> [TauType] -> TyCon -> SpecEnv -> Id
146 pcDataCon key mod str tyvars context arg_tys tycon specenv
149 data_con = mkDataCon name
150 [ NotMarkedStrict | a <- arg_tys ]
151 [ {- no labelled fields -} ]
152 tyvars context [] [] arg_tys tycon
153 name = mkWiredInIdName key mod str data_con
155 pcGenerateDataSpecs :: Type -> SpecEnv
156 pcGenerateDataSpecs ty
157 = pc_gen_specs --False err err err ty
159 err = panic "PrelUtils:GenerateDataSpecs"
162 %************************************************************************
164 \subsection[TysWiredIn-tuples]{The tuple types}
166 %************************************************************************
169 tupleTyCon :: Arity -> TyCon
173 tycon = mkTupleTyCon uniq name arity
174 uniq = mkTupleTyConUnique arity
175 name = mkWiredInTyConName uniq mod_name (mkTupNameStr arity) tycon
176 mod_name | arity == 0 = pREL_BASE
177 | otherwise = pREL_TUP
179 tupleCon :: Arity -> Id
183 tuple_con = mkTupleCon arity name ty
184 uniq = mkTupleDataConUnique arity
185 name = mkWiredInIdName uniq mod_name (mkTupNameStr arity) tuple_con
186 mod_name | arity == 0 = pREL_BASE
187 | otherwise = pREL_TUP
188 ty = mkSigmaTy tyvars [] (mkFunTys tyvar_tys (applyTyCon tycon tyvar_tys))
189 tyvars = take arity alphaTyVars
190 tyvar_tys = mkTyVarTys tyvars
191 tycon = tupleTyCon arity
193 unitTyCon = tupleTyCon 0
194 pairTyCon = tupleTyCon 2
196 unitDataCon = tupleCon 0
197 pairDataCon = tupleCon 2
201 %************************************************************************
203 \subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)}
205 %************************************************************************
208 charTy = mkTyConTy charTyCon
210 charTyCon = pcDataTyCon charTyConKey pREL_BASE SLIT("Char") [] [charDataCon]
211 charDataCon = pcDataCon charDataConKey pREL_BASE SLIT("C#") [] [] [charPrimTy] charTyCon nullSpecEnv
213 stringTy = mkListTy charTy -- convenience only
217 intTy = mkTyConTy intTyCon
219 intTyCon = pcDataTyCon intTyConKey pREL_BASE SLIT("Int") [] [intDataCon]
220 intDataCon = pcDataCon intDataConKey pREL_BASE SLIT("I#") [] [] [intPrimTy] intTyCon nullSpecEnv
224 wordTy = mkTyConTy wordTyCon
226 wordTyCon = pcDataTyCon wordTyConKey fOREIGN SLIT("Word") [] [wordDataCon]
227 wordDataCon = pcDataCon wordDataConKey fOREIGN SLIT("W#") [] [] [wordPrimTy] wordTyCon nullSpecEnv
231 addrTy = mkTyConTy addrTyCon
233 addrTyCon = pcDataTyCon addrTyConKey fOREIGN SLIT("Addr") [] [addrDataCon]
234 addrDataCon = pcDataCon addrDataConKey fOREIGN SLIT("A#") [] [] [addrPrimTy] addrTyCon nullSpecEnv
238 floatTy = mkTyConTy floatTyCon
240 floatTyCon = pcDataTyCon floatTyConKey pREL_BASE SLIT("Float") [] [floatDataCon]
241 floatDataCon = pcDataCon floatDataConKey pREL_BASE SLIT("F#") [] [] [floatPrimTy] floatTyCon nullSpecEnv
245 doubleTy = mkTyConTy doubleTyCon
247 doubleTyCon = pcDataTyCon doubleTyConKey pREL_BASE SLIT("Double") [] [doubleDataCon]
248 doubleDataCon = pcDataCon doubleDataConKey pREL_BASE SLIT("D#") [] [] [doublePrimTy] doubleTyCon nullSpecEnv
252 mkStateTy ty = applyTyCon stateTyCon [ty]
253 realWorldStateTy = mkStateTy realWorldTy -- a common use
255 stateTyCon = pcDataTyCon stateTyConKey sT_BASE SLIT("State") alpha_tyvar [stateDataCon]
257 = pcDataCon stateDataConKey sT_BASE SLIT("S#")
258 alpha_tyvar [] [mkStatePrimTy alphaTy] stateTyCon nullSpecEnv
263 = pcDataTyCon stablePtrTyConKey fOREIGN SLIT("StablePtr")
264 alpha_tyvar [stablePtrDataCon]
267 = pcDataCon stablePtrDataConKey fOREIGN SLIT("StablePtr")
268 alpha_tyvar [] [mkStablePtrPrimTy alphaTy] stablePtrTyCon nullSpecEnv
273 = pcDataTyCon foreignObjTyConKey fOREIGN SLIT("ForeignObj")
274 [] [foreignObjDataCon]
277 = pcDataCon foreignObjDataConKey fOREIGN SLIT("ForeignObj")
278 [] [] [foreignObjPrimTy] foreignObjTyCon nullSpecEnv
281 %************************************************************************
283 \subsection[TysWiredIn-Integer]{@Integer@ and its related ``pairing'' types}
285 %************************************************************************
287 @Integer@ and its pals are not really primitive. @Integer@ itself, first:
289 integerTy :: GenType t u
290 integerTy = mkTyConTy integerTyCon
292 integerTyCon = pcDataTyCon integerTyConKey pREL_BASE SLIT("Integer") [] [integerDataCon]
294 integerDataCon = pcDataCon integerDataConKey pREL_BASE SLIT("J#")
295 [] [] [intPrimTy, intPrimTy, byteArrayPrimTy] integerTyCon nullSpecEnv
298 And the other pairing types:
300 return2GMPsTyCon = pcDataTyCon return2GMPsTyConKey
301 pREL_NUM SLIT("Return2GMPs") [] [return2GMPsDataCon]
304 = pcDataCon return2GMPsDataConKey pREL_NUM SLIT("Return2GMPs") [] []
305 [intPrimTy, intPrimTy, byteArrayPrimTy,
306 intPrimTy, intPrimTy, byteArrayPrimTy] return2GMPsTyCon nullSpecEnv
308 returnIntAndGMPTyCon = pcDataTyCon returnIntAndGMPTyConKey
309 pREL_NUM SLIT("ReturnIntAndGMP") [] [returnIntAndGMPDataCon]
311 returnIntAndGMPDataCon
312 = pcDataCon returnIntAndGMPDataConKey pREL_NUM SLIT("ReturnIntAndGMP") [] []
313 [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy] returnIntAndGMPTyCon nullSpecEnv
316 %************************************************************************
318 \subsection[TysWiredIn-state-pairing]{``State-pairing'' types}
320 %************************************************************************
322 These boring types pair a \tr{State#} with another primitive type.
323 They are not really primitive, so they are given here, not in
326 We fish one of these \tr{StateAnd<blah>#} things with
327 @getStatePairingConInfo@ (given a little way down).
331 = pcDataTyCon stateAndPtrPrimTyConKey sT_BASE SLIT("StateAndPtr#")
332 alpha_beta_tyvars [stateAndPtrPrimDataCon]
333 stateAndPtrPrimDataCon
334 = pcDataCon stateAndPtrPrimDataConKey sT_BASE SLIT("StateAndPtr#")
335 alpha_beta_tyvars [] [mkStatePrimTy alphaTy, betaTy]
336 stateAndPtrPrimTyCon nullSpecEnv
338 stateAndCharPrimTyCon
339 = pcDataTyCon stateAndCharPrimTyConKey sT_BASE SLIT("StateAndChar#")
340 alpha_tyvar [stateAndCharPrimDataCon]
341 stateAndCharPrimDataCon
342 = pcDataCon stateAndCharPrimDataConKey sT_BASE SLIT("StateAndChar#")
343 alpha_tyvar [] [mkStatePrimTy alphaTy, charPrimTy]
344 stateAndCharPrimTyCon nullSpecEnv
347 = pcDataTyCon stateAndIntPrimTyConKey sT_BASE SLIT("StateAndInt#")
348 alpha_tyvar [stateAndIntPrimDataCon]
349 stateAndIntPrimDataCon
350 = pcDataCon stateAndIntPrimDataConKey sT_BASE SLIT("StateAndInt#")
351 alpha_tyvar [] [mkStatePrimTy alphaTy, intPrimTy]
352 stateAndIntPrimTyCon nullSpecEnv
354 stateAndWordPrimTyCon
355 = pcDataTyCon stateAndWordPrimTyConKey sT_BASE SLIT("StateAndWord#")
356 alpha_tyvar [stateAndWordPrimDataCon]
357 stateAndWordPrimDataCon
358 = pcDataCon stateAndWordPrimDataConKey sT_BASE SLIT("StateAndWord#")
359 alpha_tyvar [] [mkStatePrimTy alphaTy, wordPrimTy]
360 stateAndWordPrimTyCon nullSpecEnv
362 stateAndAddrPrimTyCon
363 = pcDataTyCon stateAndAddrPrimTyConKey sT_BASE SLIT("StateAndAddr#")
364 alpha_tyvar [stateAndAddrPrimDataCon]
365 stateAndAddrPrimDataCon
366 = pcDataCon stateAndAddrPrimDataConKey sT_BASE SLIT("StateAndAddr#")
367 alpha_tyvar [] [mkStatePrimTy alphaTy, addrPrimTy]
368 stateAndAddrPrimTyCon nullSpecEnv
370 stateAndStablePtrPrimTyCon
371 = pcDataTyCon stateAndStablePtrPrimTyConKey fOREIGN SLIT("StateAndStablePtr#")
372 alpha_beta_tyvars [stateAndStablePtrPrimDataCon]
373 stateAndStablePtrPrimDataCon
374 = pcDataCon stateAndStablePtrPrimDataConKey fOREIGN SLIT("StateAndStablePtr#")
376 [mkStatePrimTy alphaTy, applyTyCon stablePtrPrimTyCon [betaTy]]
377 stateAndStablePtrPrimTyCon nullSpecEnv
379 stateAndForeignObjPrimTyCon
380 = pcDataTyCon stateAndForeignObjPrimTyConKey fOREIGN SLIT("StateAndForeignObj#")
381 alpha_tyvar [stateAndForeignObjPrimDataCon]
382 stateAndForeignObjPrimDataCon
383 = pcDataCon stateAndForeignObjPrimDataConKey fOREIGN SLIT("StateAndForeignObj#")
385 [mkStatePrimTy alphaTy, applyTyCon foreignObjPrimTyCon []]
386 stateAndForeignObjPrimTyCon nullSpecEnv
388 stateAndFloatPrimTyCon
389 = pcDataTyCon stateAndFloatPrimTyConKey sT_BASE SLIT("StateAndFloat#")
390 alpha_tyvar [stateAndFloatPrimDataCon]
391 stateAndFloatPrimDataCon
392 = pcDataCon stateAndFloatPrimDataConKey sT_BASE SLIT("StateAndFloat#")
393 alpha_tyvar [] [mkStatePrimTy alphaTy, floatPrimTy]
394 stateAndFloatPrimTyCon nullSpecEnv
396 stateAndDoublePrimTyCon
397 = pcDataTyCon stateAndDoublePrimTyConKey sT_BASE SLIT("StateAndDouble#")
398 alpha_tyvar [stateAndDoublePrimDataCon]
399 stateAndDoublePrimDataCon
400 = pcDataCon stateAndDoublePrimDataConKey sT_BASE SLIT("StateAndDouble#")
401 alpha_tyvar [] [mkStatePrimTy alphaTy, doublePrimTy]
402 stateAndDoublePrimTyCon nullSpecEnv
406 stateAndArrayPrimTyCon
407 = pcDataTyCon stateAndArrayPrimTyConKey aRR_BASE SLIT("StateAndArray#")
408 alpha_beta_tyvars [stateAndArrayPrimDataCon]
409 stateAndArrayPrimDataCon
410 = pcDataCon stateAndArrayPrimDataConKey aRR_BASE SLIT("StateAndArray#")
411 alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkArrayPrimTy betaTy]
412 stateAndArrayPrimTyCon nullSpecEnv
414 stateAndMutableArrayPrimTyCon
415 = pcDataTyCon stateAndMutableArrayPrimTyConKey aRR_BASE SLIT("StateAndMutableArray#")
416 alpha_beta_tyvars [stateAndMutableArrayPrimDataCon]
417 stateAndMutableArrayPrimDataCon
418 = pcDataCon stateAndMutableArrayPrimDataConKey aRR_BASE SLIT("StateAndMutableArray#")
419 alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkMutableArrayPrimTy alphaTy betaTy]
420 stateAndMutableArrayPrimTyCon nullSpecEnv
422 stateAndByteArrayPrimTyCon
423 = pcDataTyCon stateAndByteArrayPrimTyConKey aRR_BASE SLIT("StateAndByteArray#")
424 alpha_tyvar [stateAndByteArrayPrimDataCon]
425 stateAndByteArrayPrimDataCon
426 = pcDataCon stateAndByteArrayPrimDataConKey aRR_BASE SLIT("StateAndByteArray#")
427 alpha_tyvar [] [mkStatePrimTy alphaTy, byteArrayPrimTy]
428 stateAndByteArrayPrimTyCon nullSpecEnv
430 stateAndMutableByteArrayPrimTyCon
431 = pcDataTyCon stateAndMutableByteArrayPrimTyConKey aRR_BASE SLIT("StateAndMutableByteArray#")
432 alpha_tyvar [stateAndMutableByteArrayPrimDataCon]
433 stateAndMutableByteArrayPrimDataCon
434 = pcDataCon stateAndMutableByteArrayPrimDataConKey aRR_BASE SLIT("StateAndMutableByteArray#")
435 alpha_tyvar [] [mkStatePrimTy alphaTy, applyTyCon mutableByteArrayPrimTyCon alpha_ty]
436 stateAndMutableByteArrayPrimTyCon nullSpecEnv
438 stateAndSynchVarPrimTyCon
439 = pcDataTyCon stateAndSynchVarPrimTyConKey cONC_BASE SLIT("StateAndSynchVar#")
440 alpha_beta_tyvars [stateAndSynchVarPrimDataCon]
441 stateAndSynchVarPrimDataCon
442 = pcDataCon stateAndSynchVarPrimDataConKey cONC_BASE SLIT("StateAndSynchVar#")
443 alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkSynchVarPrimTy alphaTy betaTy]
444 stateAndSynchVarPrimTyCon nullSpecEnv
447 The ccall-desugaring mechanism uses this function to figure out how to
448 rebox the result. It's really a HACK, especially the part about
449 how many types to drop from \tr{tys_applied}.
452 getStatePairingConInfo
453 :: Type -- primitive type
454 -> (Id, -- state pair constructor for prim type
455 Type) -- type of state pair
457 getStatePairingConInfo prim_ty
458 = case (maybeAppTyCon prim_ty) of
459 Nothing -> panic "getStatePairingConInfo:1"
460 Just (prim_tycon, tys_applied) ->
462 (pair_con, pair_tycon, num_tys) = assoc "getStatePairingConInfo" tbl prim_tycon
463 pair_ty = applyTyCon pair_tycon (realWorldTy : drop num_tys tys_applied)
468 (charPrimTyCon, (stateAndCharPrimDataCon, stateAndCharPrimTyCon, 0)),
469 (intPrimTyCon, (stateAndIntPrimDataCon, stateAndIntPrimTyCon, 0)),
470 (wordPrimTyCon, (stateAndWordPrimDataCon, stateAndWordPrimTyCon, 0)),
471 (addrPrimTyCon, (stateAndAddrPrimDataCon, stateAndAddrPrimTyCon, 0)),
472 (stablePtrPrimTyCon, (stateAndStablePtrPrimDataCon, stateAndStablePtrPrimTyCon, 0)),
473 (foreignObjPrimTyCon, (stateAndForeignObjPrimDataCon, stateAndForeignObjPrimTyCon, 0)),
474 (floatPrimTyCon, (stateAndFloatPrimDataCon, stateAndFloatPrimTyCon, 0)),
475 (doublePrimTyCon, (stateAndDoublePrimDataCon, stateAndDoublePrimTyCon, 0)),
476 (arrayPrimTyCon, (stateAndArrayPrimDataCon, stateAndArrayPrimTyCon, 0)),
477 (mutableArrayPrimTyCon, (stateAndMutableArrayPrimDataCon, stateAndMutableArrayPrimTyCon, 1)),
478 (byteArrayPrimTyCon, (stateAndByteArrayPrimDataCon, stateAndByteArrayPrimTyCon, 0)),
479 (mutableByteArrayPrimTyCon, (stateAndMutableByteArrayPrimDataCon, stateAndMutableByteArrayPrimTyCon, 1)),
480 (synchVarPrimTyCon, (stateAndSynchVarPrimDataCon, stateAndSynchVarPrimTyCon, 1))
481 -- (PtrPrimTyCon, (stateAndPtrPrimDataCon, stateAndPtrPrimTyCon, 0)),
485 %************************************************************************
487 \subsection[TysWiredIn-ST]{The basic @_ST@ state-transformer type}
489 %************************************************************************
491 This is really just an ordinary synonym, except it is ABSTRACT.
494 mkStateTransformerTy s a = applyTyCon stTyCon [s, a]
496 stTyCon = pcNewTyCon stTyConKey sT_BASE SLIT("ST") alpha_beta_tyvars [stDataCon]
498 stDataCon = pcDataCon stDataConKey sT_BASE SLIT("ST")
499 alpha_beta_tyvars [] [ty] stTyCon nullSpecEnv
501 ty = mkFunTy (mkStateTy alphaTy) (mkTupleTy 2 [betaTy, mkStateTy alphaTy])
504 %************************************************************************
506 \subsection[TysWiredIn-IO]{The @PrimIO@ monadic-I/O type}
508 %************************************************************************
511 mkPrimIoTy a = mkStateTransformerTy realWorldTy a
515 primIoTyConKey sT_BASE SLIT("PrimIO")
516 (mkBoxedTypeKind `mkArrowKind` mkBoxedTypeKind)
517 1 alpha_tyvar (mkPrimIoTy alphaTy)
520 %************************************************************************
522 \subsection[TysWiredIn-Bool]{The @Bool@ type}
524 %************************************************************************
526 An ordinary enumeration type, but deeply wired in. There are no
527 magical operations on @Bool@ (just the regular Prelude code).
529 {\em BEGIN IDLE SPECULATION BY SIMON}
531 This is not the only way to encode @Bool@. A more obvious coding makes
532 @Bool@ just a boxed up version of @Bool#@, like this:
535 data Bool = MkBool Bool#
538 Unfortunately, this doesn't correspond to what the Report says @Bool@
539 looks like! Furthermore, we get slightly less efficient code (I
540 think) with this coding. @gtInt@ would look like this:
543 gtInt :: Int -> Int -> Bool
544 gtInt x y = case x of I# x# ->
546 case (gtIntPrim x# y#) of
550 Notice that the result of the @gtIntPrim@ comparison has to be turned
551 into an integer (here called @b#@), and returned in a @MkBool@ box.
553 The @if@ expression would compile to this:
556 MkBool b# -> case b# of { 1# -> e1; 0# -> e2 }
559 I think this code is a little less efficient than the previous code,
560 but I'm not certain. At all events, corresponding with the Report is
561 important. The interesting thing is that the language is expressive
562 enough to describe more than one alternative; and that a type doesn't
563 necessarily need to be a straightforwardly boxed version of its
564 primitive counterpart.
566 {\em END IDLE SPECULATION BY SIMON}
569 boolTy = mkTyConTy boolTyCon
571 boolTyCon = pcDataTyCon boolTyConKey pREL_BASE SLIT("Bool") [] [falseDataCon, trueDataCon]
573 falseDataCon = pcDataCon falseDataConKey pREL_BASE SLIT("False") [] [] [] boolTyCon nullSpecEnv
574 trueDataCon = pcDataCon trueDataConKey pREL_BASE SLIT("True") [] [] [] boolTyCon nullSpecEnv
577 %************************************************************************
579 \subsection[TysWiredIn-List]{The @List@ type (incl ``build'' magic)}
581 %************************************************************************
583 Special syntax, deeply wired in, but otherwise an ordinary algebraic
586 data [] a = [] | a : (List a)
588 data (,) a b = (,,) a b
593 mkListTy :: GenType t u -> GenType t u
594 mkListTy ty = applyTyCon listTyCon [ty]
596 alphaListTy = mkSigmaTy alpha_tyvar [] (applyTyCon listTyCon alpha_ty)
598 listTyCon = pcDataTyCon listTyConKey pREL_BASE SLIT("[]")
599 alpha_tyvar [nilDataCon, consDataCon]
601 nilDataCon = pcDataCon nilDataConKey pREL_BASE SLIT("[]") alpha_tyvar [] [] listTyCon
602 (pcGenerateDataSpecs alphaListTy)
603 consDataCon = pcDataCon consDataConKey pREL_BASE SLIT(":")
604 alpha_tyvar [] [alphaTy, applyTyCon listTyCon alpha_ty] listTyCon
605 (pcGenerateDataSpecs alphaListTy)
606 -- Interesting: polymorphic recursion would help here.
607 -- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy
608 -- gets the over-specific type (Type -> Type)
611 %************************************************************************
613 \subsection[TysWiredIn-Tuples]{The @Tuple@ types}
615 %************************************************************************
617 The tuple types are definitely magic, because they form an infinite
622 They have a special family of type constructors, of type @TyCon@
623 These contain the tycon arity, but don't require a Unique.
626 They have a special family of constructors, of type
627 @Id@. Again these contain their arity but don't need a Unique.
630 There should be a magic way of generating the info tables and
631 entry code for all tuples.
633 But at the moment we just compile a Haskell source
634 file\srcloc{lib/prelude/...} containing declarations like:
637 data Tuple2 a b = Tup2 a b
638 data Tuple3 a b c = Tup3 a b c
639 data Tuple4 a b c d = Tup4 a b c d
642 The print-names associated with the magic @Id@s for tuple constructors
643 ``just happen'' to be the same as those generated by these
647 The instance environment should have a magic way to know
648 that each tuple type is an instances of classes @Eq@, @Ix@, @Ord@ and
649 so on. \ToDo{Not implemented yet.}
652 There should also be a way to generate the appropriate code for each
653 of these instances, but (like the info tables and entry code) it is
654 done by enumeration\srcloc{lib/prelude/InTup?.hs}.
658 mkTupleTy :: Int -> [GenType t u] -> GenType t u
660 mkTupleTy arity tys = applyTyCon (tupleTyCon arity) tys
662 unitTy = mkTupleTy 0 []
665 %************************************************************************
667 \subsection[TysWiredIn-_Lift]{@_Lift@ type: to support array indexing}
669 %************************************************************************
671 Again, deeply turgid: \tr{data _Lift a = _Lift a}.
674 mkLiftTy ty = applyTyCon liftTyCon [ty]
678 = mkSigmaTy tvs theta (applyTyCon liftTyCon [tau])
680 (tvs, theta, tau) = splitSigmaTy ty
683 = case (maybeAppDataTyConExpandingDicts tau) of
684 Just (tycon, tys, _) -> tycon == liftTyCon
687 (tvs, theta, tau) = splitSigmaTy ty
691 alphaLiftTy = mkSigmaTy alpha_tyvar [] (applyTyCon liftTyCon alpha_ty)
694 = pcDataTyCon liftTyConKey pREL_BASE SLIT("Lift") alpha_tyvar [liftDataCon]
697 = pcDataCon liftDataConKey pREL_BASE SLIT("Lift")
698 alpha_tyvar [] alpha_ty liftTyCon
699 ((pcGenerateDataSpecs alphaLiftTy) `addOneToSpecEnv`
700 (mkSpecInfo [Just realWorldStatePrimTy] 0 bottom))
702 bottom = panic "liftDataCon:State# _RealWorld"