[project @ 2000-11-21 09:57:02 by sewardj]

[ghc-hetmet.git] / ghc / compiler / types / TypeRep.lhs

diff --git a/ghc/compiler/types/TypeRep.lhs b/ghc/compiler/types/TypeRep.lhs
index 6e29873..a533cd5 100644 (file)
--- a/ghc/compiler/types/TypeRep.lhs
+++ b/ghc/compiler/types/TypeRep.lhs
@@ -5,7 +5,7 @@
 
 \begin{code}
 module TypeRep (
-       Type(..), TyNote(..), PredType(..), UsageAnn(..),       -- Representation visible to friends
+       Type(..), TyNote(..), PredType(..),             -- Representation visible to friends
        
        Kind, ThetaType, RhoType, TauType, SigmaType,           -- Synonyms
        TyVarSubst,
@@ -17,29 +17,29 @@ module TypeRep (
        boxedTypeKind, unboxedTypeKind, openTypeKind,   -- :: KX
        mkArrowKind, mkArrowKinds,                      -- :: KX -> KX -> KX
 
+        usageKindCon,                                  -- :: KX
+        usageTypeKind,                                 -- :: KX
+        usOnceTyCon, usManyTyCon,                      -- :: $
+        usOnce, usMany,                                        -- :: $
+
        funTyCon
     ) where
 
 #include "HsVersions.h"
 
 -- friends:
-import Var     ( TyVar, UVar )
+import Var     ( TyVar )
 import VarEnv
 import VarSet
 
-import Name    ( Name, Provenance(..), ExportFlag(..),
-                 mkWiredInTyConName, mkGlobalName, mkKindOccFS, tcName,
-               )
-import OccName ( mkSrcOccFS, tcName )
-import TyCon   ( TyCon, KindCon,
-                 mkFunTyCon, mkKindCon, mkSuperKindCon,
-               )
+import Name    ( Name, tcName )
+import TyCon   ( TyCon, KindCon, mkFunTyCon, mkKindCon, mkSuperKindCon )
 import Class   ( Class )
 
 -- others
-import SrcLoc          ( mkBuiltinSrcLoc )
-import PrelNames       ( pREL_GHC, kindConKey, boxityConKey, boxedConKey, unboxedConKey, 
-                         typeConKey, anyBoxConKey, funTyConKey
+import PrelNames       ( superKindName, superBoxityName, boxedConName, 
+                         unboxedConName, typeConName, openKindConName, funTyConName,
+                         usageKindConName, usOnceTyConName, usManyTyConName
                        )
 \end{code}
 
@@ -127,6 +127,10 @@ data Type
   | PredTy             -- A Haskell predicate
        PredType
 
+  | UsageTy            -- A usage-annotated type
+       Type            --   - Annotation of kind $ (i.e., usage annotation)
+       Type            --   - Annotated type
+
   | NoteTy             -- A type with a note attached
        TyNote
        Type            -- The expanded version
@@ -134,14 +138,6 @@ data Type
 data TyNote
   = SynNote Type       -- The unexpanded version of the type synonym; always a TyConApp
   | FTVNote TyVarSet   -- The free type variables of the noted expression
-  | UsgNote UsageAnn    -- The usage annotation at this node
-  | UsgForAll UVar      -- Annotation variable binder
-
-data UsageAnn
-  = UsOnce             -- Used at most once
-  | UsMany             -- Used possibly many times (no info; this annotation can be omitted)
-  | UsVar    UVar      -- Annotation is variable (unbound OK only inside analysis)
-
 
 type ThetaType           = [PredType]
 type RhoType             = Type
@@ -149,6 +145,10 @@ type TauType         = Type
 type SigmaType    = Type
 \end{code}
 
+INVARIANT: UsageTys are optional, but may *only* appear immediately
+under a FunTy (either argument), or at top-level of a Type permitted
+to be annotated (such as the type of an Id).  NoteTys are transparent
+for the purposes of this rule.
 
 -------------------------------------
                Predicates
@@ -188,9 +188,12 @@ represented by evidence (a dictionary, for example, of type (predRepTy p).
 Kinds
 ~~~~~
 kind :: KX = kind -> kind
+
            | Type boxity       -- (Type *) is printed as just *
                                -- (Type #) is printed as just #
 
+           | UsageKind         -- Printed '$'; used for usage annotations
+
            | OpenKind          -- Can be boxed or unboxed
                                -- Printed '?'
 
@@ -223,26 +226,15 @@ in two situations:
     present in an inferred type.
 
 
-\begin{code}
-mk_kind_name key str = mkGlobalName key pREL_GHC (mkKindOccFS tcName str)
-                                   (LocalDef mkBuiltinSrcLoc NotExported)
-       -- mk_kind_name is a bit of a hack
-       -- The LocalDef means that we print the name without
-       -- a qualifier, which is what we want for these kinds.
-       -- It's used for both Kinds and Boxities
-\end{code}
-
 ------------------------------------------
 Define  KX, the type of a kind
        BX, the type of a boxity
 
 \begin{code}
 superKind :: SuperKind                 -- KX, the type of all kinds
-superKindName = mk_kind_name kindConKey SLIT("KX")
 superKind = TyConApp (mkSuperKindCon superKindName) []
 
 superBoxity :: SuperKind               -- BX, the type of all boxities
-superBoxityName = mk_kind_name boxityConKey SLIT("BX")
 superBoxity = TyConApp (mkSuperKindCon superBoxityName) []
 \end{code}
 
@@ -251,20 +243,16 @@ Define boxities: @*@ and @#@
 
 \begin{code}
 boxedBoxity, unboxedBoxity :: Kind             -- :: BX
-
-boxedConName = mk_kind_name boxedConKey SLIT("*")
 boxedBoxity  = TyConApp (mkKindCon boxedConName superBoxity) []
 
-unboxedConName = mk_kind_name unboxedConKey SLIT("#")
 unboxedBoxity  = TyConApp (mkKindCon unboxedConName superBoxity) []
 \end{code}
 
 ------------------------------------------
-Define kinds: Type, Type *, Type #, and OpenKind
+Define kinds: Type, Type *, Type #, OpenKind, and UsageKind
 
 \begin{code}
 typeCon :: KindCon     -- :: BX -> KX
-typeConName = mk_kind_name typeConKey SLIT("Type")
 typeCon     = mkKindCon typeConName (superBoxity `FunTy` superKind)
 
 boxedTypeKind, unboxedTypeKind, openTypeKind :: Kind   -- Of superkind superKind
@@ -272,9 +260,11 @@ boxedTypeKind, unboxedTypeKind, openTypeKind :: Kind       -- Of superkind superKind
 boxedTypeKind   = TyConApp typeCon [boxedBoxity]
 unboxedTypeKind = TyConApp typeCon [unboxedBoxity]
 
-openKindConName = mk_kind_name anyBoxConKey SLIT("?")
 openKindCon     = mkKindCon openKindConName superKind
 openTypeKind    = TyConApp openKindCon []
+
+usageKindCon     = mkKindCon usageKindConName superKind
+usageTypeKind    = TyConApp usageKindCon []
 \end{code}
 
 ------------------------------------------
@@ -298,8 +288,20 @@ mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind arg_kinds
 We define a few wired-in type constructors here to avoid module knots
 
 \begin{code}
-funTyConName = mkWiredInTyConName funTyConKey pREL_GHC (mkSrcOccFS tcName SLIT("(->)")) funTyCon
 funTyCon = mkFunTyCon funTyConName (mkArrowKinds [boxedTypeKind, boxedTypeKind] boxedTypeKind)
 \end{code}
 
+------------------------------------------
+Usage tycons @.@ and @!@
+
+The usage tycons are of kind usageTypeKind (`$').  The types contain
+no values, and are used purely for usage annotation.  
+
+\begin{code}
+usOnceTyCon     = mkKindCon usOnceTyConName usageTypeKind
+usOnce          = TyConApp usOnceTyCon []
+
+usManyTyCon     = mkKindCon usManyTyConName usageTypeKind
+usMany          = TyConApp usManyTyCon []
+\end{code}