merge GHC HEAD
[ghc-hetmet.git] / compiler / prelude / TysWiredIn.lhs
index ccdfbe2..bc45028 100644 (file)
@@ -3,54 +3,64 @@
 %
 \section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types}
 
-This module is about types that can be defined in Haskell, but which
-must be wired into the compiler nonetheless.
-
-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.  C.f module TysPrim
 module TysWiredIn (
+        -- * All wired in things
        wiredInTyCons, 
 
+        -- * Bool
        boolTy, boolTyCon, boolTyCon_RDR, boolTyConName,
        trueDataCon,  trueDataConId,  true_RDR,
        falseDataCon, falseDataConId, false_RDR,
 
+        -- * Char
        charTyCon, charDataCon, charTyCon_RDR,
        charTy, stringTy, charTyConName,
 
-       
+       -- * Double
        doubleTyCon, doubleDataCon, doubleTy, doubleTyConName, 
        
+       -- * Float
        floatTyCon, floatDataCon, floatTy, floatTyConName,
 
+        -- * Int
        intTyCon, intDataCon, intTyCon_RDR, intDataCon_RDR, intTyConName,
        intTy,
 
+        -- * Word
        wordTyCon, wordDataCon, wordTyConName, wordTy,
 
+        -- * List
        listTyCon, nilDataCon, consDataCon,
        listTyCon_RDR, consDataCon_RDR, listTyConName,
        mkListTy,
 
-       -- tuples
-       mkTupleTy,
+       -- * Tuples
+       mkTupleTy, mkBoxedTupleTy,
        tupleTyCon, tupleCon, 
        unitTyCon, unitDataCon, unitDataConId, pairTyCon, 
        unboxedSingletonTyCon, unboxedSingletonDataCon,
        unboxedPairTyCon, unboxedPairDataCon,
-       
-        boxedTupleArr, unboxedTupleArr,
 
+        -- * Unit
        unitTy,
 
-        -- parallel arrays
+        -- * Heterogeneous Metaprogramming
+       mkHetMetCodeTypeTy,
+        hetMetCodeTypeTyConName,
+       hetMetCodeTypeTyCon,     isHetMetCodeTypeTyCon,
+       hetMetCodeTypeTyCon_RDR,
+
+        -- * Parallel arrays
        mkPArrTy,
        parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon,
        parrTyCon_RDR, parrTyConName
     ) where
 
+#include "HsVersions.h"
+
 import {-# SOURCE #-} MkId( mkDataConIds )
 
 -- friends:
@@ -60,29 +70,16 @@ import TysPrim
 -- others:
 import Constants       ( mAX_TUPLE_SIZE )
 import Module          ( Module )
-import RdrName
-import Name            ( Name, BuiltInSyntax(..), nameUnique, nameOccName, 
-                         nameModule, mkWiredInName )
-import OccName         ( mkOccNameFS, tcName, dataName, mkTupleOcc,
-                         mkDataConWorkerOcc )
-import DataCon         ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity )
+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 Type            ( Type, mkTyConTy, mkTyConApp, mkTyVarTy, mkTyVarTys,
-                         TyThing(..) )
-import Coercion         ( unsafeCoercionTyCon, symCoercionTyCon,
-                          transCoercionTyCon, leftCoercionTyCon, 
-                          rightCoercionTyCon, instCoercionTyCon )
-import TypeRep          ( mkArrowKinds, liftedTypeKind, ubxTupleKind )
-import Unique          ( incrUnique, mkTupleTyConUnique,
+import TyCon
+import TypeRep
+import RdrName
+import Name
+import BasicTypes       ( Arity, RecFlag(..), Boxity(..), isBoxed, HsBang(..) )
+import Unique           ( incrUnique, mkTupleTyConUnique,
                          mkTupleDataConUnique, mkPArrDataConUnique )
-import Array
+import Data.Array
 import FastString
 import Outputable
 
@@ -124,56 +121,59 @@ wiredInTyCons = [ unitTyCon       -- Not treated like other tuples, because
              , intTyCon
              , listTyCon
              , parrTyCon
-              , unsafeCoercionTyCon
-              , symCoercionTyCon
-              , transCoercionTyCon
-              , leftCoercionTyCon
-              , rightCoercionTyCon
-              , instCoercionTyCon
+             , hetMetCodeTypeTyCon
              ]
 \end{code}
 
 \begin{code}
 mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
 mkWiredInTyConName built_in modu fs unique tycon
-  = mkWiredInName modu (mkOccNameFS tcName fs) unique
+  = mkWiredInName modu (mkTcOccFS fs) unique
                  (ATyCon tycon)        -- Relevant TyCon
                  built_in
 
 mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name
 mkWiredInDataConName built_in modu fs unique datacon
-  = mkWiredInName modu (mkOccNameFS dataName fs) unique
+  = mkWiredInName modu (mkDataOccFS fs) unique
                  (ADataCon datacon)    -- Relevant DataCon
                  built_in
 
 charTyConName, charDataConName, intTyConName, intDataConName :: Name
-charTyConName    = mkWiredInTyConName   UserSyntax gHC_BASE (fsLit "Char") charTyConKey charTyCon
-charDataConName   = mkWiredInDataConName UserSyntax gHC_BASE (fsLit "C#") charDataConKey charDataCon
-intTyConName     = mkWiredInTyConName   UserSyntax gHC_BASE (fsLit "Int") intTyConKey   intTyCon
-intDataConName   = mkWiredInDataConName UserSyntax gHC_BASE (fsLit "I#") intDataConKey  intDataCon
+charTyConName    = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Char") charTyConKey charTyCon
+charDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "C#") charDataConKey charDataCon
+intTyConName     = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Int") intTyConKey   intTyCon
+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_BASE (fsLit "[]") listTyConKey listTyCon
-nilDataConName           = mkWiredInDataConName BuiltInSyntax gHC_BASE (fsLit "[]") nilDataConKey nilDataCon 
-consDataConName          = mkWiredInDataConName BuiltInSyntax gHC_BASE (fsLit ":") consDataConKey consDataCon
+listTyConName    = mkWiredInTyConName   BuiltInSyntax gHC_TYPES (fsLit "[]") listTyConKey listTyCon
+nilDataConName           = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "[]") nilDataConKey nilDataCon 
+consDataConName          = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit ":") consDataConKey consDataCon
 
 floatTyConName, floatDataConName, doubleTyConName, doubleDataConName :: Name
-floatTyConName    = mkWiredInTyConName   UserSyntax gHC_FLOAT (fsLit "Float") floatTyConKey floatTyCon
-floatDataConName   = mkWiredInDataConName UserSyntax gHC_FLOAT (fsLit "F#") floatDataConKey floatDataCon
-doubleTyConName    = mkWiredInTyConName   UserSyntax gHC_FLOAT (fsLit "Double") doubleTyConKey doubleTyCon
-doubleDataConName  = mkWiredInDataConName UserSyntax gHC_FLOAT (fsLit "D#") doubleDataConKey doubleDataCon
+floatTyConName    = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Float") floatTyConKey floatTyCon
+floatDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "F#") floatDataConKey floatDataCon
+doubleTyConName    = mkWiredInTyConName   UserSyntax gHC_TYPES (fsLit "Double") doubleTyConKey doubleTyCon
+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
+
+hetMetCodeTypeTyConName :: Name
+hetMetCodeTypeTyConName        = mkWiredInTyConName   BuiltInSyntax gHC_HETMET_CODETYPES (fsLit "<[]>@")      hetMetCodeTypeTyConKey   hetMetCodeTypeTyCon 
+hetMetCodeTypeDataConName :: Name
+hetMetCodeTypeDataConName      =
+    mkWiredInDataConName  BuiltInSyntax gHC_HETMET_CODETYPES (fsLit "<[]>")      hetMetCodeTypeDataConKey hetMetCodeTypeDataCon
 
 boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR,
-    intDataCon_RDR, listTyCon_RDR, consDataCon_RDR, parrTyCon_RDR:: RdrName
+    intDataCon_RDR, listTyCon_RDR, consDataCon_RDR, parrTyCon_RDR, hetMetCodeTypeTyCon_RDR :: RdrName
 boolTyCon_RDR   = nameRdrName boolTyConName
 false_RDR      = nameRdrName falseDataConName
 true_RDR       = nameRdrName trueDataConName
@@ -183,16 +183,7 @@ 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
--}
+hetMetCodeTypeTyCon_RDR        = nameRdrName hetMetCodeTypeTyConName
 \end{code}
 
 
@@ -217,10 +208,8 @@ 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
                False           -- Not in GADT syntax
 
 pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
@@ -238,18 +227,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
@@ -283,7 +274,7 @@ unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mA
 mk_tuple :: Boxity -> Int -> (TyCon,DataCon)
 mk_tuple boxity arity = (tycon, tuple_con)
   where
-       tycon   = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con boxity gen_info 
+       tycon   = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con boxity 
        modu    = mkTupleModule boxity arity
        tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
                                (ATyCon tycon) BuiltInSyntax
@@ -300,8 +291,6 @@ mk_tuple boxity arity = (tycon, tuple_con)
                                  (ADataCon tuple_con) BuiltInSyntax
        tc_uniq   = mkTupleTyConUnique   boxity arity
        dc_uniq   = mkTupleDataConUnique boxity arity
-       gen_info  = True                -- Tuples all have generics..
-                                       -- hmm: that's a *lot* of code
 
 unitTyCon :: TyCon
 unitTyCon     = tupleTyCon Boxed 0
@@ -324,6 +313,7 @@ unboxedPairDataCon :: DataCon
 unboxedPairDataCon = tupleCon   Unboxed 2
 \end{code}
 
+
 %************************************************************************
 %*                                                                     *
 \subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)}
@@ -474,6 +464,7 @@ listTyCon = pcRecDataTyCon listTyConName alpha_tyvar [nilDataCon, consDataCon]
 
 nilDataCon :: DataCon
 nilDataCon  = pcDataCon nilDataConName alpha_tyvar [] listTyCon
+
 consDataCon :: DataCon
 consDataCon = pcDataConWithFixity True {- Declared infix -}
               consDataConName
@@ -530,11 +521,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}
 
 %************************************************************************
@@ -546,19 +543,17 @@ unitTy = mkTupleTy Boxed 0 []
 Special syntax for parallel arrays needs some wired in definitions.
 
 \begin{code}
--- construct a type representing the application of the parallel array
--- constructor 
---
+-- | Construct a type representing the application of the parallel array constructor 
 mkPArrTy    :: Type -> Type
 mkPArrTy ty  = mkTyConApp parrTyCon [ty]
 
--- represents the type constructor of parallel arrays
+-- | Represents the type constructor of parallel arrays
 --
---  * this must match the definition in `PrelPArr'
+--  * This must match the definition in @PrelPArr@
 --
 -- NB: Although the constructor is given here, it will not be accessible in
 --     user code as it is not in the environment of any compiled module except
---     `PrelPArr'.
+--     @PrelPArr@.
 --
 parrTyCon :: TyCon
 parrTyCon  = pcNonRecDataTyCon parrTyConName alpha_tyvar [parrDataCon]
@@ -573,14 +568,13 @@ parrDataCon  = pcDataCon
                    alpha_ty] 
                 parrTyCon
 
--- check whether a type constructor is the constructor for parallel arrays
---
+-- | Check whether a type constructor is the constructor for parallel arrays
 isPArrTyCon    :: TyCon -> Bool
 isPArrTyCon tc  = tyConName tc == parrTyConName
 
--- fake array constructors
+-- | Fake array constructors
 --
---  * these constructors are never really used to represent array values;
+-- * These constructors are never really used to represent array values;
 --   however, they are very convenient during desugaring (and, in particular,
 --   in the pattern matching compiler) to treat array pattern just like
 --   yet another constructor pattern
@@ -604,14 +598,37 @@ mkPArrFakeCon arity  = data_con
        tyvar     = head alphaTyVars
        tyvarTys  = replicate arity $ mkTyVarTy tyvar
         nameStr   = mkFastString ("MkPArr" ++ show arity)
-       name      = mkWiredInName gHC_PARR (mkOccNameFS dataName nameStr) unique
+       name      = mkWiredInName gHC_PARR' (mkDataOccFS nameStr) unique
                                  (ADataCon data_con) UserSyntax
        unique      = mkPArrDataConUnique arity
 
--- checks whether a data constructor is a fake constructor for parallel arrays
---
+-- | Checks whether a data constructor is a fake constructor for parallel arrays
 isPArrFakeCon      :: DataCon -> Bool
 isPArrFakeCon dcon  = dcon == parrFakeCon (dataConSourceArity dcon)
 \end{code}
 
+Heterogeneous Metaprogramming
+
+\begin{code}
+-- | Construct a type representing the application of the box type
+mkHetMetCodeTypeTy    :: TyVar -> Type -> Type
+mkHetMetCodeTypeTy ecn ty = mkTyConApp hetMetCodeTypeTyCon [(mkTyVarTy ecn), ty]
+
+ecTyVar = head ecTyVars
+
+-- | Represents the type constructor of box types
+hetMetCodeTypeTyCon :: TyCon
+hetMetCodeTypeTyCon  = pcNonRecDataTyCon hetMetCodeTypeTyConName [ecTyVar, betaTyVar] [hetMetCodeTypeDataCon]
+
+-- | Check whether a type constructor is the constructor for box types
+isHetMetCodeTypeTyCon    :: TyCon -> Bool
+isHetMetCodeTypeTyCon tc  = tyConName tc == hetMetCodeTypeTyConName
 
+hetMetCodeTypeDataCon :: DataCon
+hetMetCodeTypeDataCon  = pcDataCon 
+                hetMetCodeTypeDataConName 
+                [betaTyVar]            -- forall'ed type variables
+                [betaTy] 
+                hetMetCodeTypeTyCon
+
+\end{code}