X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FTysWiredIn.lhs;h=db2ea1b55ed9f9b33cd5a8d5885f376ae7aafde9;hp=3e49d5ed0626c6ff1e46bceecd46453e204aa4f7;hb=f2aaae9757e7532485c97f6c9a9ed5437542d1dd;hpb=04230c64fbd7e35e1e70940eb1ee3122924ffffb

diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index 3e49d5e..db2ea1b 100644
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -3,12 +3,9 @@
 %
 \section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types}
 
-This module tracks the ``state interface'' document, ``GHC prelude:
-types and operations.''
-
 \begin{code}
 -- | This module is about types that can be defined in Haskell, but which
--- must be wired into the compiler nonetheless.
+--   must be wired into the compiler nonetheless.  C.f module TysPrim
 module TysWiredIn (
         -- * All wired in things
 	wiredInTyCons, 
@@ -41,7 +38,7 @@ module TysWiredIn (
 	mkListTy,
 
 	-- * Tuples
-	mkTupleTy,
+	mkTupleTy, mkBoxedTupleTy,
 	tupleTyCon, tupleCon, 
 	unitTyCon, unitDataCon, unitDataConId, pairTyCon, 
 	unboxedSingletonTyCon, unboxedSingletonDataCon,
@@ -56,6 +53,8 @@ module TysWiredIn (
 	parrTyCon_RDR, parrTyConName
     ) where
 
+#include "HsVersions.h"
+
 import {-# SOURCE #-} MkId( mkDataConIds )
 
 -- friends:
@@ -66,18 +65,14 @@ import TysPrim
 import Constants	( mAX_TUPLE_SIZE )
 import Module		( Module )
 import RdrName
-import Name		( Name, BuiltInSyntax(..), nameUnique, nameOccName, 
-			  nameModule, mkWiredInName )
-import OccName		( mkTcOccFS, mkDataOccFS, mkTupleOcc, mkDataConWorkerOcc,
-			  tcName, dataName )
+import Name
 import DataCon		( DataCon, mkDataCon, dataConWorkId, dataConSourceArity )
 import Var
 import TyCon		( TyCon, AlgTyConRhs(DataTyCon), tyConDataCons,
 			  mkTupleTyCon, mkAlgTyCon, tyConName,
 			  TyConParent(NoParentTyCon) )
 
-import BasicTypes	( Arity, RecFlag(..), Boxity(..), isBoxed,
-			  StrictnessMark(..) )
+import BasicTypes	( Arity, RecFlag(..), Boxity(..), isBoxed, HsBang(..) )
 
 import Type		( Type, mkTyConTy, mkTyConApp, mkTyVarTy, mkTyVarTys,
 			  TyThing(..) )
@@ -87,7 +82,7 @@ import Coercion         ( unsafeCoercionTyCon, symCoercionTyCon,
 import TypeRep          ( mkArrowKinds, liftedTypeKind, ubxTupleKind )
 import Unique		( incrUnique, mkTupleTyConUnique,
 			  mkTupleDataConUnique, mkPArrDataConUnique )
-import Array
+import Data.Array
 import FastString
 import Outputable
 
@@ -158,9 +153,9 @@ intTyConName	  = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Int") intTyCo
 intDataConName	  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "I#") intDataConKey  intDataCon
 
 boolTyConName, falseDataConName, trueDataConName :: Name
-boolTyConName	  = mkWiredInTyConName   UserSyntax gHC_BOOL (fsLit "Bool") boolTyConKey boolTyCon
-falseDataConName  = mkWiredInDataConName UserSyntax gHC_BOOL (fsLit "False") falseDataConKey falseDataCon
-trueDataConName	  = mkWiredInDataConName UserSyntax gHC_BOOL (fsLit "True")  trueDataConKey  trueDataCon 
+boolTyConName	  = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Bool") boolTyConKey boolTyCon
+falseDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "False") falseDataConKey falseDataCon
+trueDataConName	  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "True")  trueDataConKey  trueDataCon
 
 listTyConName, nilDataConName, consDataConName :: Name
 listTyConName	  = mkWiredInTyConName   BuiltInSyntax gHC_TYPES (fsLit "[]") listTyConKey listTyCon
@@ -174,8 +169,10 @@ doubleTyConName    = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Double")
 doubleDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") doubleDataConKey doubleDataCon
 
 parrTyConName, parrDataConName :: Name
-parrTyConName	  = mkWiredInTyConName   BuiltInSyntax gHC_PARR (fsLit "[::]") parrTyConKey parrTyCon 
-parrDataConName   = mkWiredInDataConName UserSyntax    gHC_PARR (fsLit "PArr") parrDataConKey parrDataCon
+parrTyConName   = mkWiredInTyConName   BuiltInSyntax 
+                    gHC_PARR' (fsLit "[::]") parrTyConKey parrTyCon 
+parrDataConName = mkWiredInDataConName UserSyntax    
+                    gHC_PARR' (fsLit "PArr") parrDataConKey parrDataCon
 
 boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR,
     intDataCon_RDR, listTyCon_RDR, consDataCon_RDR, parrTyCon_RDR:: RdrName
@@ -188,16 +185,6 @@ intDataCon_RDR	= nameRdrName intDataConName
 listTyCon_RDR	= nameRdrName listTyConName
 consDataCon_RDR = nameRdrName consDataConName
 parrTyCon_RDR	= nameRdrName parrTyConName
-{-
-tySuperKindTyCon_RDR     = nameRdrName tySuperKindTyConName
-coSuperKindTyCon_RDR = nameRdrName coSuperKindTyConName
-liftedTypeKindTyCon_RDR   = nameRdrName liftedTypeKindTyConName
-openTypeKindTyCon_RDR     = nameRdrName openTypeKindTyConName
-unliftedTypeKindTyCon_RDR = nameRdrName unliftedTypeKindTyConName
-ubxTupleKindTyCon_RDR     = nameRdrName ubxTupleKindTyConName
-argTypeKindTyCon_RDR      = nameRdrName argTypeKindTyConName
-funKindTyCon_RDR          = nameRdrName funKindTyConName
--}
 \end{code}
 
 
@@ -222,7 +209,6 @@ pcTyCon is_enum is_rec name tyvars cons
                 tyvars
                 []		-- No stupid theta
 		(DataTyCon cons is_enum)
-		[] 		-- No record selectors
 		NoParentTyCon
                 is_rec
 		True		-- All the wired-in tycons have generics
@@ -243,18 +229,20 @@ pcDataConWithFixity declared_infix dc_name tyvars arg_tys tycon
   = data_con
   where
     data_con = mkDataCon dc_name declared_infix
-                (map (const NotMarkedStrict) arg_tys)
+                (map (const HsNoBang) arg_tys)
                 [] 	-- No labelled fields
                 tyvars
 		[] 	-- No existential type variables
 		[]	-- No equality spec
 		[]	-- No theta
-		arg_tys tycon
+		arg_tys (mkTyConApp tycon (mkTyVarTys tyvars)) 
+		tycon
 		[]	-- No stupid theta
 		(mkDataConIds bogus_wrap_name wrk_name data_con)
 		
 
-    modu      = nameModule dc_name
+    modu     = ASSERT( isExternalName dc_name ) 
+	       nameModule dc_name
     wrk_occ  = mkDataConWorkerOcc (nameOccName dc_name)
     wrk_key  = incrUnique (nameUnique dc_name)
     wrk_name = mkWiredInName modu wrk_occ wrk_key
@@ -329,6 +317,7 @@ unboxedPairDataCon :: DataCon
 unboxedPairDataCon = tupleCon   Unboxed 2
 \end{code}
 
+
 %************************************************************************
 %*									*
 \subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)}
@@ -536,11 +525,17 @@ done by enumeration\srcloc{lib/prelude/InTup?.hs}.
 \end{itemize}
 
 \begin{code}
-mkTupleTy :: Boxity -> Int -> [Type] -> Type
-mkTupleTy boxity arity tys = mkTyConApp (tupleTyCon boxity arity) tys
+mkTupleTy :: Boxity -> [Type] -> Type
+-- Special case for *boxed* 1-tuples, which are represented by the type itself
+mkTupleTy boxity [ty] | Boxed <- boxity = ty
+mkTupleTy boxity tys = mkTyConApp (tupleTyCon boxity (length tys)) tys
+
+-- | Build the type of a small tuple that holds the specified type of thing
+mkBoxedTupleTy :: [Type] -> Type
+mkBoxedTupleTy tys = mkTupleTy Boxed tys
 
 unitTy :: Type
-unitTy = mkTupleTy Boxed 0 []
+unitTy = mkTupleTy Boxed []
 \end{code}
 
 %************************************************************************
@@ -607,7 +602,7 @@ mkPArrFakeCon arity  = data_con
 	tyvar     = head alphaTyVars
 	tyvarTys  = replicate arity $ mkTyVarTy tyvar
         nameStr   = mkFastString ("MkPArr" ++ show arity)
-	name      = mkWiredInName gHC_PARR (mkDataOccFS nameStr) unique
+	name      = mkWiredInName gHC_PARR' (mkDataOccFS nameStr) unique
 				  (ADataCon data_con) UserSyntax
 	unique      = mkPArrDataConUnique arity