update submodules for GHC.HetMet.GArrow -> Control.GArrow renaming

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

diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index 2f1b637..21e51c4 100644 (file)
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -50,9 +50,16 @@ module TysWiredIn (
         -- * Heterogeneous Metaprogramming
        mkHetMetCodeTypeTy,
         hetMetCodeTypeTyConName,
-       hetMetCodeTypeTyCon,     isHetMetCodeTypeTyCon,
+       hetMetCodeTypeTyCon,
+        isHetMetCodeTypeTyCon,
        hetMetCodeTypeTyCon_RDR,
 
+       mkHetMetKappaTy,
+        hetMetKappaTyConName,
+       hetMetKappaTyCon,
+       hetMetKappaTyCon_RDR,
+        isHetMetKappaTyCon,
+
         -- * Parallel arrays
        mkPArrTy,
        parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon,
@@ -70,23 +77,14 @@ import TysPrim
 -- others:
 import Constants       ( mAX_TUPLE_SIZE )
 import Module          ( Module )
+import DataCon          ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity )
+import Var
+import TyCon
+import TypeRep
 import RdrName
 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, HsBang(..) )
-
-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 BasicTypes       ( Arity, RecFlag(..), Boxity(..), isBoxed, HsBang(..) )
+import Unique           ( incrUnique, mkTupleTyConUnique,
                          mkTupleDataConUnique, mkPArrDataConUnique )
 import Data.Array
 import FastString
@@ -131,12 +129,7 @@ wiredInTyCons = [ unitTyCon        -- Not treated like other tuples, because
              , listTyCon
              , parrTyCon
              , hetMetCodeTypeTyCon
-              , unsafeCoercionTyCon
-              , symCoercionTyCon
-              , transCoercionTyCon
-              , leftCoercionTyCon
-              , rightCoercionTyCon
-              , instCoercionTyCon
+             , hetMetKappaTyCon
              ]
 \end{code}
 
@@ -182,13 +175,17 @@ parrDataConName = mkWiredInDataConName UserSyntax
                     gHC_PARR' (fsLit "PArr") parrDataConKey parrDataCon
 
 hetMetCodeTypeTyConName :: Name
-hetMetCodeTypeTyConName        = mkWiredInTyConName   BuiltInSyntax gHC_HETMET_CODETYPES (fsLit "<[]>@")      hetMetCodeTypeTyConKey   hetMetCodeTypeTyCon 
+hetMetCodeTypeTyConName        = mkWiredInTyConName   BuiltInSyntax gHC_HETMET_CODETYPES (fsLit "<{}>@")      hetMetCodeTypeTyConKey   hetMetCodeTypeTyCon 
 hetMetCodeTypeDataConName :: Name
 hetMetCodeTypeDataConName      =
-    mkWiredInDataConName  BuiltInSyntax gHC_HETMET_CODETYPES (fsLit "<[]>")      hetMetCodeTypeDataConKey hetMetCodeTypeDataCon
+    mkWiredInDataConName  BuiltInSyntax gHC_HETMET_CODETYPES (fsLit "<{}>")      hetMetCodeTypeDataConKey hetMetCodeTypeDataCon
+
+hetMetKappaTyConName :: Name
+hetMetKappaTyConName = mkWiredInTyConName   BuiltInSyntax gHC_HETMET_CODETYPES (fsLit "~~>")  hetMetKappaTyConKey hetMetKappaTyCon
 
 boolTyCon_RDR, false_RDR, true_RDR, intTyCon_RDR, charTyCon_RDR,
-    intDataCon_RDR, listTyCon_RDR, consDataCon_RDR, parrTyCon_RDR, hetMetCodeTypeTyCon_RDR :: RdrName
+    intDataCon_RDR, listTyCon_RDR, consDataCon_RDR, parrTyCon_RDR, hetMetCodeTypeTyCon_RDR,
+    hetMetKappaTyCon_RDR :: RdrName
 boolTyCon_RDR   = nameRdrName boolTyConName
 false_RDR      = nameRdrName falseDataConName
 true_RDR       = nameRdrName trueDataConName
@@ -199,6 +196,7 @@ listTyCon_RDR       = nameRdrName listTyConName
 consDataCon_RDR = nameRdrName consDataConName
 parrTyCon_RDR  = nameRdrName parrTyConName
 hetMetCodeTypeTyCon_RDR        = nameRdrName hetMetCodeTypeTyConName
+hetMetKappaTyCon_RDR = nameRdrName hetMetKappaTyConName
 \end{code}
 
 
@@ -225,7 +223,6 @@ pcTyCon is_enum is_rec name tyvars cons
                (DataTyCon cons is_enum)
                NoParentTyCon
                 is_rec
-               True            -- All the wired-in tycons have generics
                False           -- Not in GADT syntax
 
 pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
@@ -290,7 +287,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
@@ -307,8 +304,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
@@ -625,7 +620,6 @@ isPArrFakeCon      :: DataCon -> Bool
 isPArrFakeCon dcon  = dcon == parrFakeCon (dataConSourceArity dcon)
 \end{code}
 
-
 Heterogeneous Metaprogramming
 
 \begin{code}
@@ -633,16 +627,25 @@ Heterogeneous Metaprogramming
 mkHetMetCodeTypeTy    :: TyVar -> Type -> Type
 mkHetMetCodeTypeTy ecn ty = mkTyConApp hetMetCodeTypeTyCon [(mkTyVarTy ecn), ty]
 
+mkHetMetKappaTy    :: Type -> Type -> Type
+mkHetMetKappaTy a b = mkTyConApp hetMetKappaTyCon [a, b]
+
 ecTyVar = head ecTyVars
 
 -- | Represents the type constructor of box types
 hetMetCodeTypeTyCon :: TyCon
 hetMetCodeTypeTyCon  = pcNonRecDataTyCon hetMetCodeTypeTyConName [ecTyVar, betaTyVar] [hetMetCodeTypeDataCon]
 
+hetMetKappaTyCon :: TyCon
+hetMetKappaTyCon  = pcNonRecDataTyCon hetMetKappaTyConName [alphaTyVar, betaTyVar] []
+
 -- | Check whether a type constructor is the constructor for box types
 isHetMetCodeTypeTyCon    :: TyCon -> Bool
 isHetMetCodeTypeTyCon tc  = tyConName tc == hetMetCodeTypeTyConName
 
+isHetMetKappaTyCon    :: TyCon -> Bool
+isHetMetKappaTyCon tc  = tyConName tc == hetMetKappaTyConName
+
 hetMetCodeTypeDataCon :: DataCon
 hetMetCodeTypeDataCon  = pcDataCon 
                 hetMetCodeTypeDataConName