Add the ability to derive instances of Functor, Foldable, Traversable

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

diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index bf46465..235bc3c 100644 (file)
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -131,6 +131,9 @@ basicKnownKeyNames
        realFloatClassName,             -- numeric
        dataClassName, 
        isStringClassName,
+       applicativeClassName,
+       foldableClassName,
+       traversableClassName,
 
        -- Numeric stuff
        negateName, minusName, 
@@ -164,7 +167,7 @@ basicKnownKeyNames
 
        -- Read stuff
        readClassName, 
-       
+
        -- Stable pointers
        newStablePtrName,
 
@@ -204,11 +207,8 @@ basicKnownKeyNames
        randomClassName, randomGenClassName, monadPlusClassName,
 
         -- Annotation type checking
-        toAnnotationWrapperName,
+        toAnnotationWrapperName
 
-       -- Booleans
-       andName, orName
-       
        -- The Either type
        , eitherTyConName, leftDataConName, rightDataConName
 
@@ -236,10 +236,11 @@ pRELUDE           = mkBaseModule_ pRELUDE_NAME
 
 gHC_PRIM, gHC_TYPES, gHC_BOOL, gHC_UNIT, gHC_ORDERING, gHC_GENERICS, gHC_CLASSES, gHC_BASE, gHC_ENUM,
     gHC_SHOW, gHC_READ, gHC_NUM, gHC_INTEGER, gHC_INTEGER_INTERNALS, gHC_LIST, gHC_PARR,
-    gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_STRING, gHC_PACK, gHC_CONC, gHC_IO_BASE,
+    gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_STRING, dATA_FOLDABLE, dATA_TRAVERSABLE,
+    gHC_PACK, gHC_CONC, gHC_IO_BASE,
     gHC_ST, gHC_ARR, gHC_STABLE, gHC_ADDR, gHC_PTR, gHC_ERR, gHC_REAL,
     gHC_FLOAT, gHC_TOP_HANDLER, sYSTEM_IO, dYNAMIC, tYPEABLE, gENERICS,
-    dOTNET, rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, aRROW,
+    dOTNET, rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, aRROW, cONTROL_APPLICATIVE,
     gHC_DESUGAR, rANDOM, gHC_EXTS, cONTROL_EXCEPTION_BASE :: Module
 gHC_PRIM       = mkPrimModule (fsLit "GHC.Prim")   -- Primitive types and values
 gHC_TYPES       = mkPrimModule (fsLit "GHC.Types")
@@ -261,6 +262,8 @@ gHC_TUPLE   = mkPrimModule (fsLit "GHC.Tuple")
 dATA_TUPLE     = mkBaseModule (fsLit "Data.Tuple")
 dATA_EITHER    = mkBaseModule (fsLit "Data.Either")
 dATA_STRING    = mkBaseModule (fsLit "Data.String")
+dATA_FOLDABLE  = mkBaseModule (fsLit "Data.Foldable")
+dATA_TRAVERSABLE= mkBaseModule (fsLit "Data.Traversable")
 gHC_PACK       = mkBaseModule (fsLit "GHC.Pack")
 gHC_CONC       = mkBaseModule (fsLit "GHC.Conc")
 gHC_IO_BASE    = mkBaseModule (fsLit "GHC.IOBase")
@@ -285,6 +288,7 @@ gHC_WORD    = mkBaseModule (fsLit "GHC.Word")
 mONAD          = mkBaseModule (fsLit "Control.Monad")
 mONAD_FIX      = mkBaseModule (fsLit "Control.Monad.Fix")
 aRROW          = mkBaseModule (fsLit "Control.Arrow")
+cONTROL_APPLICATIVE = mkBaseModule (fsLit "Control.Applicative")
 gHC_DESUGAR = mkBaseModule (fsLit "GHC.Desugar")
 rANDOM         = mkBaseModule (fsLit "System.Random")
 gHC_EXTS       = mkBaseModule (fsLit "GHC.Exts")
@@ -389,9 +393,6 @@ returnM_RDR                 = nameRdrName returnMName
 bindM_RDR              = nameRdrName bindMName
 failM_RDR              = nameRdrName failMName
 
-and_RDR :: RdrName
-and_RDR                        = nameRdrName andName
-
 left_RDR, right_RDR :: RdrName
 left_RDR               = nameRdrName leftDataConName
 right_RDR              = nameRdrName rightDataConName
@@ -443,8 +444,9 @@ compose_RDR :: RdrName
 compose_RDR            = varQual_RDR gHC_BASE (fsLit ".")
 
 not_RDR, getTag_RDR, succ_RDR, pred_RDR, minBound_RDR, maxBound_RDR,
-    range_RDR, inRange_RDR, index_RDR,
+    and_RDR, range_RDR, inRange_RDR, index_RDR,
     unsafeIndex_RDR, unsafeRangeSize_RDR :: RdrName
+and_RDR                        = varQual_RDR gHC_CLASSES (fsLit "&&")
 not_RDR                = varQual_RDR gHC_CLASSES (fsLit "not")
 getTag_RDR             = varQual_RDR gHC_BASE (fsLit "getTag")
 succ_RDR               = varQual_RDR gHC_ENUM (fsLit "succ")
@@ -502,6 +504,13 @@ inlDataCon_RDR     = dataQual_RDR gHC_GENERICS (fsLit "Inl")
 inrDataCon_RDR     = dataQual_RDR gHC_GENERICS (fsLit "Inr")
 genUnitDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Unit")
 
+fmap_RDR, pure_RDR, ap_RDR, foldable_foldr_RDR, traverse_RDR :: RdrName
+fmap_RDR               = varQual_RDR gHC_BASE (fsLit "fmap")
+pure_RDR               = varQual_RDR cONTROL_APPLICATIVE (fsLit "pure")
+ap_RDR                         = varQual_RDR cONTROL_APPLICATIVE (fsLit "<*>")
+foldable_foldr_RDR     = varQual_RDR dATA_FOLDABLE       (fsLit "foldr")
+traverse_RDR           = varQual_RDR dATA_TRAVERSABLE    (fsLit "traverse")
+
 ----------------------
 varQual_RDR, tcQual_RDR, clsQual_RDR, dataQual_RDR
     :: Module -> FastString -> RdrName
@@ -573,13 +582,19 @@ bindMName    = methName gHC_BASE (fsLit ">>=")    bindMClassOpKey
 returnMName       = methName gHC_BASE (fsLit "return") returnMClassOpKey
 failMName         = methName gHC_BASE (fsLit "fail")   failMClassOpKey
 
+-- Classes (Applicative, Foldable, Traversable)
+applicativeClassName, foldableClassName, traversableClassName :: Name
+applicativeClassName  = clsQual  cONTROL_APPLICATIVE (fsLit "Applicative") applicativeClassKey
+foldableClassName     = clsQual  dATA_FOLDABLE       (fsLit "Foldable")    foldableClassKey
+traversableClassName  = clsQual  dATA_TRAVERSABLE    (fsLit "Traversable") traversableClassKey
+
 -- Functions for GHC extensions
 groupWithName :: Name
 groupWithName = varQual gHC_EXTS (fsLit "groupWith") groupWithIdKey
 
 -- Random PrelBase functions
 fromStringName, otherwiseIdName, foldrName, buildName, augmentName,
-    mapName, appendName, andName, orName, assertName,
+    mapName, appendName, assertName,
     breakpointName, breakpointCondName, breakpointAutoName,
     opaqueTyConName :: Name
 fromStringName = methName dATA_STRING (fsLit "fromString") fromStringClassOpKey
@@ -589,8 +604,6 @@ buildName     = varQual gHC_BASE (fsLit "build")      buildIdKey
 augmentName      = varQual gHC_BASE (fsLit "augment")    augmentIdKey
 mapName       = varQual gHC_BASE (fsLit "map")        mapIdKey
 appendName       = varQual gHC_BASE (fsLit "++")         appendIdKey
-andName                  = varQual gHC_CLASSES (fsLit "&&")     andIdKey
-orName           = varQual gHC_CLASSES (fsLit "||")     orIdKey
 assertName        = varQual gHC_BASE (fsLit "assert")     assertIdKey
 breakpointName    = varQual gHC_BASE (fsLit "breakpoint") breakpointIdKey
 breakpointCondName= varQual gHC_BASE (fsLit "breakpointCond") breakpointCondIdKey
@@ -889,6 +902,11 @@ randomGenClassKey  = mkPreludeClassUnique 32
 
 isStringClassKey :: Unique
 isStringClassKey       = mkPreludeClassUnique 33
+
+applicativeClassKey, foldableClassKey, traversableClassKey :: Unique
+applicativeClassKey    = mkPreludeClassUnique 34
+foldableClassKey       = mkPreludeClassUnique 35
+traversableClassKey    = mkPreludeClassUnique 36
 \end{code}
 
 %************************************************************************
@@ -1156,9 +1174,7 @@ rootMainKey, runMainKey :: Unique
 rootMainKey                  = mkPreludeMiscIdUnique 55
 runMainKey                   = mkPreludeMiscIdUnique 56
 
-andIdKey, orIdKey, thenIOIdKey, lazyIdKey, assertErrorIdKey :: Unique
-andIdKey                     = mkPreludeMiscIdUnique 57
-orIdKey                              = mkPreludeMiscIdUnique 58
+thenIOIdKey, lazyIdKey, assertErrorIdKey :: Unique
 thenIOIdKey                  = mkPreludeMiscIdUnique 59
 lazyIdKey                    = mkPreludeMiscIdUnique 60
 assertErrorIdKey             = mkPreludeMiscIdUnique 61
@@ -1260,6 +1276,7 @@ fromStringClassOpKey            = mkPreludeMiscIdUnique 125
 toAnnotationWrapperIdKey :: Unique
 toAnnotationWrapperIdKey      = mkPreludeMiscIdUnique 126
 
+
 ---------------- Template Haskell -------------------
 --     USES IdUniques 200-399
 -----------------------------------------------------
@@ -1325,7 +1342,8 @@ standardClassKeys = derivableClassKeys ++ numericClassKeys
                  ++ [randomClassKey, randomGenClassKey,
                      functorClassKey, 
                      monadClassKey, monadPlusClassKey,
-                     isStringClassKey
+                     isStringClassKey,
+                     applicativeClassKey, foldableClassKey, traversableClassKey
                     ]
 \end{code}