projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
update submodule pointer
[ghc-hetmet.git] / compiler / prelude / TysWiredIn.lhs
diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index 80530b9..2f1b637 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}
 
-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,
@@ -50,6 +47,12 @@ module TysWiredIn (
         -- * Unit
        unitTy,
 
+        -- * Heterogeneous Metaprogramming
+       mkHetMetCodeTypeTy,
+        hetMetCodeTypeTyConName,
+       hetMetCodeTypeTyCon,     isHetMetCodeTypeTyCon,
+       hetMetCodeTypeTyCon_RDR,
+
         -- * Parallel arrays
        mkPArrTy,
        parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon,
@@ -69,16 +72,13 @@ import Constants    ( mAX_TUPLE_SIZE )
 import Module          ( Module )
 import RdrName
 import Name
-import OccName         ( mkTcOccFS, mkDataOccFS, mkTupleOcc, mkDataConWorkerOcc,
-                         tcName, dataName )
 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(..) )
@@ -88,7 +88,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
 
@@ -130,6 +130,7 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because
              , intTyCon
              , listTyCon
              , parrTyCon
+             , hetMetCodeTypeTyCon
               , unsafeCoercionTyCon
               , symCoercionTyCon
               , transCoercionTyCon
@@ -159,9 +160,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
@@ -175,11 +176,19 @@ 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
+
+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
@@ -189,16 +198,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}
 
 
@@ -223,7 +223,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
@@ -244,7 +243,7 @@ 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
@@ -332,6 +331,7 @@ unboxedPairDataCon :: DataCon
 unboxedPairDataCon = tupleCon   Unboxed 2
 \end{code}
 
+
 %************************************************************************
 %*                                                                     *
 \subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)}
@@ -539,11 +539,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}
 
 %************************************************************************
@@ -610,7 +616,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
 
@@ -620,3 +626,28 @@ 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}
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)