Minor refactoring

[ghc-hetmet.git] / compiler / prelude / TysWiredIn.lhs

diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index 3e49d5e..3689479 100644 (file)
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -3,12 +3,9 @@
 %
 \section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types}
 
 %
 \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
 \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, 
 module TysWiredIn (
         -- * All wired in things
        wiredInTyCons, 

@@ -41,7 +38,7 @@ module TysWiredIn (
        mkListTy,
 
        -- * Tuples
        mkListTy,
 
        -- * Tuples

-       mkTupleTy,
+       mkTupleTy, mkBoxedTupleTy,

        tupleTyCon, tupleCon, 
        unitTyCon, unitDataCon, unitDataConId, pairTyCon, 
        unboxedSingletonTyCon, unboxedSingletonDataCon,
        tupleTyCon, tupleCon, 
        unitTyCon, unitDataCon, unitDataConId, pairTyCon, 
        unboxedSingletonTyCon, unboxedSingletonDataCon,

@@ -56,6 +53,8 @@ module TysWiredIn (
        parrTyCon_RDR, parrTyConName
     ) where
 
        parrTyCon_RDR, parrTyConName
     ) where
 

+#include "HsVersions.h"
+

 import {-# SOURCE #-} MkId( mkDataConIds )
 
 -- friends:
 import {-# SOURCE #-} MkId( mkDataConIds )
 
 -- friends:

@@ -66,10 +65,7 @@ import TysPrim
 import Constants       ( mAX_TUPLE_SIZE )
 import Module          ( Module )
 import RdrName
 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,
 import DataCon         ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity )
 import Var
 import TyCon           ( TyCon, AlgTyConRhs(DataTyCon), tyConDataCons,

@@ -87,7 +83,7 @@ import Coercion         ( unsafeCoercionTyCon, symCoercionTyCon,
 import TypeRep          ( mkArrowKinds, liftedTypeKind, ubxTupleKind )
 import Unique          ( incrUnique, mkTupleTyConUnique,
                          mkTupleDataConUnique, mkPArrDataConUnique )
 import TypeRep          ( mkArrowKinds, liftedTypeKind, ubxTupleKind )
 import Unique          ( incrUnique, mkTupleTyConUnique,
                          mkTupleDataConUnique, mkPArrDataConUnique )

-import Array
+import Data.Array

 import FastString
 import Outputable
 
 import FastString
 import Outputable
 

@@ -222,7 +218,6 @@ pcTyCon is_enum is_rec name tyvars cons
                 tyvars
                 []             -- No stupid theta
                (DataTyCon cons is_enum)
                 tyvars
                 []             -- No stupid theta
                (DataTyCon cons is_enum)

-               []              -- No record selectors

                NoParentTyCon
                 is_rec
                True            -- All the wired-in tycons have generics
                NoParentTyCon
                 is_rec
                True            -- All the wired-in tycons have generics

@@ -249,12 +244,14 @@ pcDataConWithFixity declared_infix dc_name tyvars arg_tys tycon
                []      -- No existential type variables
                []      -- No equality spec
                []      -- No theta
                []      -- 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)
                
 
                []      -- 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
     wrk_occ  = mkDataConWorkerOcc (nameOccName dc_name)
     wrk_key  = incrUnique (nameUnique dc_name)
     wrk_name = mkWiredInName modu wrk_occ wrk_key

@@ -329,6 +326,7 @@ unboxedPairDataCon :: DataCon
 unboxedPairDataCon = tupleCon   Unboxed 2
 \end{code}
 
 unboxedPairDataCon = tupleCon   Unboxed 2
 \end{code}
 

+

 %************************************************************************
 %*                                                                     *
 \subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)}
 %************************************************************************
 %*                                                                     *
 \subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)}

@@ -536,11 +534,17 @@ done by enumeration\srcloc{lib/prelude/InTup?.hs}.
 \end{itemize}
 
 \begin{code}
 \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 :: Type

-unitTy = mkTupleTy Boxed 0 []
+unitTy = mkTupleTy Boxed []

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************