diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/prelude/ForeignCall.hs (renamed from compiler/prelude/ForeignCall.lhs) | 74 | ||||
| -rw-r--r-- | compiler/prelude/PrelInfo.hs (renamed from compiler/prelude/PrelInfo.lhs) | 74 | ||||
| -rw-r--r-- | compiler/prelude/PrelNames.hs (renamed from compiler/prelude/PrelNames.lhs) | 182 | ||||
| -rw-r--r-- | compiler/prelude/PrelNames.hs-boot (renamed from compiler/prelude/PrelNames.lhs-boot) | 3 | ||||
| -rw-r--r-- | compiler/prelude/PrelRules.hs (renamed from compiler/prelude/PrelRules.lhs) | 90 | ||||
| -rw-r--r-- | compiler/prelude/PrimOp.hs (renamed from compiler/prelude/PrimOp.lhs) | 173 | ||||
| -rw-r--r-- | compiler/prelude/PrimOp.hs-boot (renamed from compiler/prelude/PrimOp.lhs-boot) | 4 | ||||
| -rw-r--r-- | compiler/prelude/TysPrim.hs (renamed from compiler/prelude/TysPrim.lhs) | 225 | ||||
| -rw-r--r-- | compiler/prelude/TysWiredIn.hs (renamed from compiler/prelude/TysWiredIn.lhs) | 150 | ||||
| -rw-r--r-- | compiler/prelude/TysWiredIn.hs-boot (renamed from compiler/prelude/TysWiredIn.lhs-boot) | 2 |
10 files changed, 435 insertions, 542 deletions
diff --git a/compiler/prelude/ForeignCall.lhs b/compiler/prelude/ForeignCall.hs index 010434300b..0a7a8384dc 100644 --- a/compiler/prelude/ForeignCall.lhs +++ b/compiler/prelude/ForeignCall.hs @@ -1,9 +1,9 @@ -% -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -% +{- +(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 + \section[Foreign]{Foreign calls} +-} -\begin{code} {-# LANGUAGE DeriveDataTypeable #-} module ForeignCall ( @@ -25,16 +25,15 @@ import Module import Data.Char import Data.Data -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsubsection{Data types} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} newtype ForeignCall = CCall CCallSpec deriving Eq {-! derive: Binary !-} @@ -46,10 +45,7 @@ isSafeForeignCall (CCall (CCallSpec _ _ safe)) = playSafe safe -- but this simple printer will do for now instance Outputable ForeignCall where ppr (CCall cc) = ppr cc -\end{code} - -\begin{code} data Safety = PlaySafe -- Might invoke Haskell GC, or do a call back, or -- switch threads, etc. So make sure things are @@ -82,16 +78,15 @@ playSafe PlayRisky = False playInterruptible :: Safety -> Bool playInterruptible PlayInterruptible = True playInterruptible _ = False -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsubsection{Calling C} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} data CExportSpec = CExportStatic -- foreign export ccall foo :: ty CLabelString -- C Name of exported function @@ -105,11 +100,8 @@ data CCallSpec Safety deriving( Eq ) {-! derive: Binary !-} -\end{code} -The call target: - -\begin{code} +-- The call target: -- | How to call a particular function in C-land. data CCallTarget @@ -138,9 +130,8 @@ data CCallTarget isDynamicTarget :: CCallTarget -> Bool isDynamicTarget DynamicTarget = True isDynamicTarget _ = False -\end{code} - +{- Stuff to do with calling convention: ccall: Caller allocates parameters, *and* deallocates them. @@ -154,8 +145,8 @@ so perhaps we should emit a warning if it's being used on other platforms. See: http://www.programmersheaven.com/2/Calling-conventions +-} -\begin{code} -- any changes here should be replicated in the CallConv type in template haskell data CCallConv = CCallConv | CApiConv | StdCallConv | PrimCallConv | JavaScriptCallConv deriving (Eq, Data, Typeable) @@ -177,21 +168,19 @@ ccallConvToInt CCallConv = 1 ccallConvToInt CApiConv = panic "ccallConvToInt CApiConv" ccallConvToInt (PrimCallConv {}) = panic "ccallConvToInt PrimCallConv" ccallConvToInt JavaScriptCallConv = panic "ccallConvToInt JavaScriptCallConv" -\end{code} +{- Generate the gcc attribute corresponding to the given calling convention (used by PprAbsC): +-} -\begin{code} ccallConvAttribute :: CCallConv -> SDoc ccallConvAttribute StdCallConv = text "__attribute__((__stdcall__))" ccallConvAttribute CCallConv = empty ccallConvAttribute CApiConv = empty ccallConvAttribute (PrimCallConv {}) = panic "ccallConvAttribute PrimCallConv" ccallConvAttribute JavaScriptCallConv = panic "ccallConvAttribute JavaScriptCallConv" -\end{code} -\begin{code} type CLabelString = FastString -- A C label, completely unencoded pprCLabelString :: CLabelString -> SDoc @@ -204,12 +193,9 @@ isCLabelString lbl ok c = isAlphaNum c || c == '_' || c == '.' -- The '.' appears in e.g. "foo.so" in the -- module part of a ExtName. Maybe it should be separate -\end{code} +-- Printing into C files: -Printing into C files: - -\begin{code} instance Outputable CExportSpec where ppr (CExportStatic str _) = pprCLabelString str @@ -233,9 +219,7 @@ instance Outputable CCallSpec where ppr_fun DynamicTarget = text "__dyn_ccall" <> gc_suf <+> text "\"\"" -\end{code} -\begin{code} -- The filename for a C header file newtype Header = Header FastString deriving (Eq, Data, Typeable) @@ -253,16 +237,15 @@ instance Outputable CType where where hDoc = case mh of Nothing -> empty Just h -> ppr h -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsubsection{Misc} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} {-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-} instance Binary ForeignCall where put_ bh (CCall aa) = put_ bh aa @@ -350,4 +333,3 @@ instance Binary Header where put_ bh (Header h) = put_ bh h get bh = do h <- get bh return (Header h) -\end{code} diff --git a/compiler/prelude/PrelInfo.lhs b/compiler/prelude/PrelInfo.hs index eaefff2364..2303a8edd3 100644 --- a/compiler/prelude/PrelInfo.lhs +++ b/compiler/prelude/PrelInfo.hs @@ -1,9 +1,9 @@ -% -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -% +{- +(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 + \section[PrelInfo]{The @PrelInfo@ interface to the compiler's prelude knowledge} +-} -\begin{code} {-# LANGUAGE CPP #-} module PrelInfo ( wiredInIds, ghcPrimIds, @@ -39,13 +39,13 @@ import Util import {-# SOURCE #-} TcTypeNats ( typeNatTyCons ) import Data.Array -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[builtinNameInfo]{Lookup built-in names} -%* * -%************************************************************************ +* * +************************************************************************ Notes about wired in things ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -64,9 +64,8 @@ Notes about wired in things * MkIface prunes out wired-in things before putting them in an interface file. So interface files never contain wired-in things. +-} - -\begin{code} wiredInThings :: [TyThing] -- This list is used only to initialise HscMain.knownKeyNames -- to ensure that when you say "Prelude.map" in your source code, you @@ -86,19 +85,19 @@ wiredInThings where tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons ++ typeNatTyCons) -\end{code} +{- We let a lot of "non-standard" values be visible, so that we can make sense of them in interface pragmas. It's cool, though they all have "non-standard" names, so they won't get past the parser in user code. -%************************************************************************ -%* * +************************************************************************ +* * PrimOpIds -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} primOpIds :: Array Int Id -- A cache of the PrimOp Ids, indexed by PrimOp tag primOpIds = array (1,maxPrimOpTag) [ (primOpTag op, mkPrimOpId op) @@ -106,51 +105,47 @@ primOpIds = array (1,maxPrimOpTag) [ (primOpTag op, mkPrimOpId op) primOpId :: PrimOp -> Id primOpId op = primOpIds ! primOpTag op -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{Export lists for pseudo-modules (GHC.Prim)} -%* * -%************************************************************************ +* * +************************************************************************ GHC.Prim "exports" all the primops and primitive types, some wired-in Ids. +-} -\begin{code} ghcPrimExports :: [IfaceExport] ghcPrimExports = map (Avail . idName) ghcPrimIds ++ map (Avail . idName . primOpId) allThePrimOps ++ [ AvailTC n [n] | tc <- funTyCon : primTyCons, let n = tyConName tc ] -\end{code} - - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{Built-in keys} -%* * -%************************************************************************ +* * +************************************************************************ ToDo: make it do the ``like'' part properly (as in 0.26 and before). +-} -\begin{code} maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool maybeCharLikeCon con = con `hasKey` charDataConKey maybeIntLikeCon con = con `hasKey` intDataConKey -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{Class predicates} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} isNumericClass, isStandardClass :: Class -> Bool isNumericClass clas = classKey clas `is_elem` numericClassKeys @@ -158,4 +153,3 @@ isStandardClass clas = classKey clas `is_elem` standardClassKeys is_elem :: Eq a => a -> [a] -> Bool is_elem = isIn "is_X_Class" -\end{code} diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.hs index e0a5890619..65eaebb2db 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.hs @@ -1,6 +1,6 @@ -% -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -% +{- +(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 + \section[PrelNames]{Definitions of prelude modules and names} @@ -100,8 +100,8 @@ This is accomplished through a combination of mechanisms: than trying to find it in the original-name cache. See also Note [Built-in syntax and the OrigNameCache] +-} -\begin{code} {-# LANGUAGE CPP #-} module PrelNames ( @@ -127,36 +127,32 @@ import SrcLoc import FastString import Config ( cIntegerLibraryType, IntegerLibrary(..) ) import Panic ( panic ) -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * allNameStrings -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} allNameStrings :: [String] -- Infinite list of a,b,c...z, aa, ab, ac, ... etc allNameStrings = [ c:cs | cs <- "" : allNameStrings, c <- ['a'..'z'] ] -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{Local Names} -%* * -%************************************************************************ +* * +************************************************************************ This *local* name is used by the interactive stuff +-} -\begin{code} itName :: Unique -> SrcSpan -> Name itName uniq loc = mkInternalName uniq (mkOccNameFS varName (fsLit "it")) loc -\end{code} -\begin{code} -- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly -- during compiler debugging. mkUnboundName :: RdrName -> Name @@ -164,14 +160,13 @@ mkUnboundName rdr_name = mkInternalName unboundKey (rdrNameOcc rdr_name) noSrcSp isUnboundName :: Name -> Bool isUnboundName name = name `hasKey` unboundKey -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{Known key Names} -%* * -%************************************************************************ +* * +************************************************************************ This section tells what the compiler knows about the association of names with uniques. These ones are the *non* wired-in ones. The @@ -182,8 +177,8 @@ The names for DPH can come from one of multiple backend packages. At the point w the names for multiple backends. That works out fine, although they use the same uniques, as we are guaranteed to only load one backend; hence, only one of the different names sharing a unique will be used. +-} -\begin{code} basicKnownKeyNames :: [Name] basicKnownKeyNames = genericTyConNames @@ -368,18 +363,18 @@ genericTyConNames = [ d1TyConName, c1TyConName, s1TyConName, noSelTyConName, repTyConName, rep1TyConName ] -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{Module names} -%* * -%************************************************************************ +* * +************************************************************************ --MetaHaskell Extension Add a new module here -\begin{code} +-} + pRELUDE :: Module pRELUDE = mkBaseModule_ pRELUDE_NAME @@ -491,29 +486,28 @@ mkMainModule m = mkModule mainPackageKey (mkModuleNameFS m) mkMainModule_ :: ModuleName -> Module mkMainModule_ m = mkModule mainPackageKey m -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{Constructing the names of tuples -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} mkTupleModule :: TupleSort -> Module mkTupleModule BoxedTuple = gHC_TUPLE mkTupleModule ConstraintTuple = gHC_TUPLE mkTupleModule UnboxedTuple = gHC_PRIM -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * RdrNames -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} main_RDR_Unqual :: RdrName main_RDR_Unqual = mkUnqual varName (fsLit "main") -- We definitely don't want an Orig RdrName, because @@ -738,13 +732,13 @@ varQual_RDR mod str = mkOrig mod (mkOccNameFS varName str) tcQual_RDR mod str = mkOrig mod (mkOccNameFS tcName str) clsQual_RDR mod str = mkOrig mod (mkOccNameFS clsName str) dataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str) -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{Known-key names} -%* * -%************************************************************************ +* * +************************************************************************ Many of these Names are not really "built in", but some parts of the compiler (notably the deriving mechanism) need to mention their names, @@ -752,9 +746,8 @@ and it's convenient to write them all down in one place. --MetaHaskell Extension add the constrs and the lower case case -- guys as well (perhaps) e.g. see trueDataConName below +-} - -\begin{code} wildCardName :: Name wildCardName = mkSystemVarName wildCardKey (fsLit "wild") @@ -1165,17 +1158,17 @@ pLUGINS :: Module pLUGINS = mkThisGhcModule (fsLit "Plugins") pluginTyConName :: Name pluginTyConName = tcQual pLUGINS (fsLit "Plugin") pluginTyConKey -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{Local helpers} -%* * -%************************************************************************ +* * +************************************************************************ All these are original names; hence mkOrig +-} -\begin{code} varQual, tcQual, clsQual :: Module -> FastString -> Unique -> Name varQual = mk_known_key_name varName tcQual = mk_known_key_name tcName @@ -1188,16 +1181,16 @@ mk_known_key_name space modu str unique conName :: Module -> FastString -> Unique -> Name conName modu occ unique = mkExternalName unique modu (mkOccNameFS dataName occ) noSrcSpan -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@} -%* * -%************************************************************************ +* * +************************************************************************ --MetaHaskell extension hand allocate keys here +-} -\begin{code} boundedClassKey, enumClassKey, eqClassKey, floatingClassKey, fractionalClassKey, integralClassKey, monadClassKey, dataClassKey, functorClassKey, numClassKey, ordClassKey, readClassKey, realClassKey, @@ -1270,15 +1263,15 @@ ghciIoClassKey = mkPreludeClassUnique 44 ipClassNameKey :: Unique ipClassNameKey = mkPreludeClassUnique 45 -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} addrPrimTyConKey, arrayPrimTyConKey, arrayArrayPrimTyConKey, boolTyConKey, byteArrayPrimTyConKey, charPrimTyConKey, charTyConKey, doublePrimTyConKey, doubleTyConKey, floatPrimTyConKey, floatTyConKey, funTyConKey, intPrimTyConKey, @@ -1495,15 +1488,15 @@ smallMutableArrayPrimTyConKey = mkPreludeTyConUnique 179 unitTyConKey :: Unique unitTyConKey = mkTupleTyConUnique BoxedTuple 0 -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} charDataConKey, consDataConKey, doubleDataConKey, falseDataConKey, floatDataConKey, intDataConKey, integerSDataConKey, nilDataConKey, ratioDataConKey, stableNameDataConKey, trueDataConKey, wordDataConKey, @@ -1545,15 +1538,15 @@ eqDataConKey = mkPreludeDataConUnique 28 gtDataConKey = mkPreludeDataConUnique 29 coercibleDataConKey = mkPreludeDataConUnique 32 -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} wildCardKey, absentErrorIdKey, augmentIdKey, appendIdKey, buildIdKey, errorIdKey, foldrIdKey, recSelErrorIdKey, seqIdKey, irrefutPatErrorIdKey, eqStringIdKey, @@ -1716,13 +1709,13 @@ magicDictKey = mkPreludeMiscIdUnique 156 coerceKey :: Unique coerceKey = mkPreludeMiscIdUnique 157 -\end{code} +{- Certain class operations from Prelude classes. They get their own uniques so we can look them up easily when we want to conjure them up during type checking. +-} -\begin{code} -- Just a place holder for unbound variables produced by the renamer: unboundKey :: Unique unboundKey = mkPreludeMiscIdUnique 160 @@ -1800,19 +1793,19 @@ proxyHashKey = mkPreludeMiscIdUnique 502 ---------------- Template Haskell ------------------- -- USES IdUniques 200-499 ----------------------------------------------------- -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[Class-std-groups]{Standard groups of Prelude classes} -%* * -%************************************************************************ +* * +************************************************************************ NOTE: @Eq@ and @Text@ do need to appear in @standardClasses@ even though every numeric class has these two as a superclass, because the list of ambiguous dictionaries hasn't been simplified. +-} -\begin{code} numericClassKeys :: [Unique] numericClassKeys = [ numClassKey @@ -1840,14 +1833,13 @@ standardClassKeys = derivableClassKeys ++ numericClassKeys applicativeClassKey, foldableClassKey, traversableClassKey, alternativeClassKey ] -\end{code} +{- @derivableClassKeys@ is also used in checking \tr{deriving} constructs (@TcDeriv@). +-} -\begin{code} derivableClassKeys :: [Unique] derivableClassKeys = [ eqClassKey, ordClassKey, enumClassKey, ixClassKey, boundedClassKey, showClassKey, readClassKey ] -\end{code} diff --git a/compiler/prelude/PrelNames.lhs-boot b/compiler/prelude/PrelNames.hs-boot index 7b5365e621..0bd74d5577 100644 --- a/compiler/prelude/PrelNames.lhs-boot +++ b/compiler/prelude/PrelNames.hs-boot @@ -1,4 +1,3 @@ -\begin{code} module PrelNames where import Module @@ -6,5 +5,3 @@ import Unique mAIN :: Module liftedTypeKindTyConKey :: Unique -\end{code} - diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.hs index 054137178b..6807b1c79f 100644 --- a/compiler/prelude/PrelRules.lhs +++ b/compiler/prelude/PrelRules.hs @@ -1,6 +1,6 @@ -% -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -% +{- +(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 + \section[ConFold]{Constant Folder} Conceptually, constant folding should be parameterized with the kind @@ -10,8 +10,8 @@ and runtime. We cheat a little bit here... ToDo: check boundaries before folding, e.g. we can fold the Float addition (i1 + i2) only if it results in a valid Float. +-} -\begin{code} {-# LANGUAGE CPP, RankNTypes #-} {-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-} @@ -60,9 +60,8 @@ import qualified Data.ByteString as BS import Data.Int import Data.Ratio import Data.Word -\end{code} - +{- Note [Constant folding] ~~~~~~~~~~~~~~~~~~~~~~~ primOpRules generates a rewrite rule for each primop @@ -77,9 +76,8 @@ more like where the (+#) on the rhs is done at compile time That is why these rules are built in here. +-} - -\begin{code} primOpRules :: Name -> PrimOp -> Maybe CoreRule -- ToDo: something for integer-shift ops? -- NotOp @@ -271,15 +269,13 @@ primOpRules nm SparkOp = mkPrimOpRule nm 4 [ sparkRule ] primOpRules _ _ = Nothing -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{Doing the business} -%* * -%************************************************************************ - -\begin{code} +* * +************************************************************************ +-} -- useful shorthands mkPrimOpRule :: Name -> Int -> [RuleM CoreExpr] -> Maybe CoreRule @@ -401,10 +397,10 @@ wordShiftRule shift_op = do { dflags <- getDynFlags ; [e1, Lit (MachInt shift_len)] <- getArgs ; case e1 of - _ | shift_len == 0 + _ | shift_len == 0 -> return e1 | shift_len < 0 || wordSizeInBits dflags < shift_len - -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy + -> return (mkRuntimeErrorApp rUNTIME_ERROR_ID wordPrimTy ("Bad shift length" ++ show shift_len)) Lit (MachWord x) -> let op = shift_op dflags @@ -553,8 +549,8 @@ idempotent :: RuleM CoreExpr idempotent = do [e1, e2] <- getArgs guard $ cheapEqExpr e1 e2 return e1 -\end{code} +{- Note [Guarding against silly shifts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this code: @@ -593,7 +589,7 @@ Shift.$wgo = \ (w_sCS :: GHC.Prim.Int#) (w1_sCT :: [GHC.Types.Bool]) -> 9223372036854775807 -> __word 0 } } } } -Note the massive shift on line "!!!!". It can't happen, because we've checked +Note the massive shift on line "!!!!". It can't happen, because we've checked that w < 64, but the optimiser didn't spot that. We DO NO want to constant-fold this! Moreover, if the programmer writes (n `uncheckedShiftL` 9223372036854775807), we can't constant fold it, but if it gets to the assember we get @@ -602,13 +598,13 @@ can't constant fold it, but if it gets to the assember we get So the best thing to do is to rewrite the shift with a call to error, when the second arg is stupid. -%************************************************************************ -%* * +************************************************************************ +* * \subsection{Vaguely generic functions} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} mkBasicRule :: Name -> Int -> RuleM CoreExpr -> CoreRule -- Gives the Rule the same name as the primop itself mkBasicRule op_name n_args rm @@ -829,13 +825,12 @@ matchPrimOpId op id = do op' <- liftMaybe $ isPrimOpId_maybe id guard $ op == op' -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{Special rules for seq, tagToEnum, dataToTag} -%* * -%************************************************************************ +* * +************************************************************************ Note [tagToEnum#] ~~~~~~~~~~~~~~~~~ @@ -857,8 +852,8 @@ because we don't expect the user to call tagToEnum# at all; we merely generate calls in derived instances of Enum. So we compromise: a rewrite rule rewrites a bad instance of tagToEnum# to an error call, and emits a warning. +-} -\begin{code} tagToEnumRule :: RuleM CoreExpr -- If data T a = A | B | C -- then tag2Enum# (T ty) 2# --> B ty @@ -875,15 +870,14 @@ tagToEnumRule = do -- See Note [tagToEnum#] _ -> WARN( True, ptext (sLit "tagToEnum# on non-enumeration type") <+> ppr ty ) return $ mkRuntimeErrorApp rUNTIME_ERROR_ID ty "tagToEnum# on non-enumeration type" -\end{code} - +{- For dataToTag#, we can reduce if either (a) the argument is a constructor (b) the argument is a variable whose unfolding is a known constructor +-} -\begin{code} dataToTagRule :: RuleM CoreExpr dataToTagRule = a `mplus` b where @@ -899,15 +893,15 @@ dataToTagRule = a `mplus` b (dc,_,_) <- liftMaybe $ exprIsConApp_maybe in_scope val_arg ASSERT( not (isNewTyCon (dataConTyCon dc)) ) return () return $ mkIntVal dflags (toInteger (dataConTag dc - fIRST_TAG)) -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{Rules for seq# and spark#} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} -- seq# :: forall a s . a -> State# s -> (# State# s, a #) seqRule :: RuleM CoreExpr seqRule = do @@ -921,13 +915,13 @@ sparkRule :: RuleM CoreExpr sparkRule = seqRule -- reduce on HNF, just the same -- XXX perhaps we shouldn't do this, because a spark eliminated by -- this rule won't be counted as a dud at runtime? -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{Built in rules} -%* * -%************************************************************************ +* * +************************************************************************ Note [Scoping for Builtin rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -954,9 +948,8 @@ rewriting so again we are fine. (This whole thing doesn't show up for non-built-in rules because their dependencies are explicit.) +-} - -\begin{code} builtinRules :: [CoreRule] -- Rules for non-primops that can't be expressed using a RULE pragma builtinRules @@ -1327,4 +1320,3 @@ match_smallIntegerTo primOp _ _ _ [App (Var x) y] | idName x == smallIntegerName = Just $ App (Var (mkPrimOpId primOp)) y match_smallIntegerTo _ _ _ _ _ = Nothing -\end{code} diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.hs index 198078bc9f..1b7e314fc7 100644 --- a/compiler/prelude/PrimOp.lhs +++ b/compiler/prelude/PrimOp.hs @@ -1,9 +1,9 @@ -% -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 -% +{- +(c) The GRASP/AQUA Project, Glasgow University, 1992-1998 + \section[PrimOp]{Primitive operations (machine-level)} +-} -\begin{code} {-# LANGUAGE CPP #-} module PrimOp ( @@ -41,26 +41,23 @@ import Outputable import FastTypes import FastString import Module ( PackageKey ) -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)} -%* * -%************************************************************************ +* * +************************************************************************ These are in \tr{state-interface.verb} order. - -\begin{code} +-} -- supplies: -- data PrimOp = ... #include "primop-data-decl.hs-incl" -\end{code} -Used for the Ord instance +-- Used for the Ord instance -\begin{code} primOpTag :: PrimOp -> Int primOpTag op = iBox (tagOf_PrimOp op) @@ -84,34 +81,26 @@ instance Ord PrimOp where instance Outputable PrimOp where ppr op = pprPrimOp op -\end{code} -\begin{code} data PrimOpVecCat = IntVec | WordVec | FloatVec -\end{code} -An @Enum@-derived list would be better; meanwhile... (ToDo) +-- An @Enum@-derived list would be better; meanwhile... (ToDo) -\begin{code} allThePrimOps :: [PrimOp] allThePrimOps = #include "primop-list.hs-incl" -\end{code} -\begin{code} tagToEnumKey :: Unique tagToEnumKey = mkPrimOpIdUnique (primOpTag TagToEnumOp) -\end{code} - - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[PrimOp-info]{The essential info about each @PrimOp@} -%* * -%************************************************************************ +* * +************************************************************************ The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may refer to the primitive operation. The conventional \tr{#}-for- @@ -122,7 +111,8 @@ interfere with the programmer's Haskell name spaces. We use @PrimKinds@ for the ``type'' information, because they're (slightly) more convenient to use than @TyCons@. -\begin{code} +-} + data PrimOpInfo = Dyadic OccName -- string :: T -> T -> T Type @@ -142,50 +132,50 @@ mkCompare str ty = Compare (mkVarOccFS str) ty mkGenPrimOp :: FastString -> [TyVar] -> [Type] -> Type -> PrimOpInfo mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOccFS str) tvs tys ty -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsubsection{Strictness} -%* * -%************************************************************************ +* * +************************************************************************ Not all primops are strict! +-} -\begin{code} primOpStrictness :: PrimOp -> Arity -> StrictSig -- See Demand.StrictnessInfo for discussion of what the results -- The arity should be the arity of the primop; that's why -- this function isn't exported. #include "primop-strictness.hs-incl" -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsubsection{Fixity} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} primOpFixity :: PrimOp -> Maybe Fixity #include "primop-fixity.hs-incl" -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops} -%* * -%************************************************************************ +* * +************************************************************************ @primOpInfo@ gives all essential information (from which everything else, notably a type, can be constructed) for each @PrimOp@. +-} -\begin{code} primOpInfo :: PrimOp -> PrimOpInfo #include "primop-primop-info.hs-incl" primOpInfo _ = error "primOpInfo: unknown primop" -\end{code} +{- Here are a load of comments from the old primOp info: A @Word#@ is an unsigned @Int#@. @@ -302,27 +292,25 @@ These primops are pretty weird. The constraints aren't currently checked by the front end, but the code generator will fall over if they aren't satisfied. -%************************************************************************ -%* * +************************************************************************ +* * Which PrimOps are out-of-line -%* * -%************************************************************************ +* * +************************************************************************ Some PrimOps need to be called out-of-line because they either need to perform a heap check or they block. +-} - -\begin{code} primOpOutOfLine :: PrimOp -> Bool #include "primop-out-of-line.hs-incl" -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * Failure and side effects -%* * -%************************************************************************ +* * +************************************************************************ Note [PrimOp can_fail and has_side_effects] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -470,9 +458,8 @@ Two main predicates on primpops test these flags: * The no-duplicate thing is done via primOpIsCheap, by making has_side_effects things (very very very) not-cheap! +-} - -\begin{code} primOpHasSideEffects :: PrimOp -> Bool #include "primop-has-side-effects.hs-incl" @@ -492,9 +479,8 @@ primOpOkForSpeculation op primOpOkForSideEffects :: PrimOp -> Bool primOpOkForSideEffects op = not (primOpHasSideEffects op) -\end{code} - +{- Note [primOpIsCheap] ~~~~~~~~~~~~~~~~~~~~ @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK @@ -502,8 +488,8 @@ WARNING), we just borrow some other predicates for a what-should-be-good-enough test. "Cheap" means willing to call it more than once, and/or push it inside a lambda. The latter could change the behaviour of 'seq' for primops that can fail, so we don't treat them as cheap. +-} -\begin{code} primOpIsCheap :: PrimOp -> Bool -- See Note [PrimOp can_fail and has_side_effects] primOpIsCheap op = primOpOkForSpeculation op @@ -523,21 +509,20 @@ primOpIsCheap op = primOpOkForSpeculation op -- were we don't want to inline x. But primopIsCheap doesn't control -- that (it's exprIsDupable that does) so the problem doesn't occur -- even if primOpIsCheap sometimes says 'True'. -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * PrimOp code size -%* * -%************************************************************************ +* * +************************************************************************ primOpCodeSize ~~~~~~~~~~~~~~ Gives an indication of the code size of a primop, for the purposes of calculating unfolding sizes; see CoreUnfold.sizeExpr. +-} -\begin{code} primOpCodeSize :: PrimOp -> Int #include "primop-code-size.hs-incl" @@ -548,16 +533,15 @@ primOpCodeSizeDefault = 1 primOpCodeSizeForeignCall :: Int primOpCodeSizeForeignCall = 4 -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * PrimOp types -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} primOpType :: PrimOp -> Type -- you may want to use primOpSig instead primOpType op = case primOpInfo op of @@ -590,9 +574,7 @@ primOpSig op Dyadic _occ ty -> ([], [ty,ty], ty ) Compare _occ ty -> ([], [ty,ty], intPrimTy) GenPrimOp _occ tyvars arg_tys res_ty -> (tyvars, arg_tys, res_ty ) -\end{code} -\begin{code} data PrimOpResultInfo = ReturnsPrim PrimRep | ReturnsAlg TyCon @@ -614,46 +596,41 @@ getPrimOpResultInfo op -- All primops return a tycon-app result -- The tycon can be an unboxed tuple, though, which -- gives rise to a ReturnAlg -\end{code} +{- We do not currently make use of whether primops are commutable. We used to try to move constants to the right hand side for strength reduction. +-} -\begin{code} {- commutableOp :: PrimOp -> Bool #include "primop-commutable.hs-incl" -} -\end{code} -Utils: -\begin{code} +-- Utils: + dyadic_fun_ty, monadic_fun_ty, compare_fun_ty :: Type -> Type dyadic_fun_ty ty = mkFunTys [ty, ty] ty monadic_fun_ty ty = mkFunTy ty ty compare_fun_ty ty = mkFunTys [ty, ty] intPrimTy -\end{code} -Output stuff: -\begin{code} +-- Output stuff: + pprPrimOp :: PrimOp -> SDoc pprPrimOp other_op = pprOccName (primOpOcc other_op) -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsubsection[PrimCall]{User-imported primitive calls} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} data PrimCall = PrimCall CLabelString PackageKey instance Outputable PrimCall where ppr (PrimCall lbl pkgId) = text "__primcall" <+> ppr pkgId <+> ppr lbl - -\end{code} diff --git a/compiler/prelude/PrimOp.lhs-boot b/compiler/prelude/PrimOp.hs-boot index 5d003f2b51..6b92ef3d49 100644 --- a/compiler/prelude/PrimOp.lhs-boot +++ b/compiler/prelude/PrimOp.hs-boot @@ -1,7 +1,3 @@ - -\begin{code} module PrimOp where data PrimOp -\end{code} - diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.hs index e130fe57b7..e8542eb670 100644 --- a/compiler/prelude/TysPrim.lhs +++ b/compiler/prelude/TysPrim.hs @@ -1,10 +1,10 @@ -% -% (c) The AQUA Project, Glasgow University, 1994-1998 -% +{- +(c) The AQUA Project, Glasgow University, 1994-1998 + \section[TysPrim]{Wired-in knowledge about primitive types} +-} -\begin{code} {-# LANGUAGE CPP #-} -- | This module defines TyCons that can't be expressed in Haskell. @@ -92,15 +92,15 @@ import PrelNames import FastString import Data.Char -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{Primitive type constructors} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} primTyCons :: [TyCon] primTyCons = [ addrPrimTyCon @@ -195,18 +195,18 @@ stableNamePrimTyConName = mkPrimTc (fsLit "StableName#") stableNamePrimTyC bcoPrimTyConName = mkPrimTc (fsLit "BCO#") bcoPrimTyConKey bcoPrimTyCon weakPrimTyConName = mkPrimTc (fsLit "Weak#") weakPrimTyConKey weakPrimTyCon threadIdPrimTyConName = mkPrimTc (fsLit "ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{Support code} -%* * -%************************************************************************ +* * +************************************************************************ alphaTyVars is a list of type variables for use in templates: ["a", "b", ..., "z", "t1", "t2", ... ] +-} -\begin{code} tyVarList :: Kind -> [TyVar] tyVarList kind = [ mkTyVar (mkInternalName (mkAlphaTyVarUnique u) (mkTyVarOccFS (mkFastString name)) @@ -245,16 +245,14 @@ openBetaTy = mkTyVarTy openBetaTyVar kKiVar :: KindVar kKiVar = (tyVarList superKind) !! 10 -\end{code} - - -%************************************************************************ -%* * +{- +************************************************************************ +* * FunTyCon -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} funTyConName :: Name funTyConName = mkPrimTyConName (fsLit "(->)") funTyConKey funTyCon @@ -283,14 +281,13 @@ funTyCon = mkFunTyCon funTyConName $ -- -------------------------- -- Gamma |- tau -> sigma :: * -- In the end we don't want subkinding at all. -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * Kinds -%* * -%************************************************************************ +* * +************************************************************************ Note [SuperKind (BOX)] ~~~~~~~~~~~~~~~~~~~~~~ @@ -308,9 +305,8 @@ So the full defn of keq is keq :: (~) BOX * * = Eq# BOX * * <refl *> So you can see it's convenient to have BOX:BOX +-} - -\begin{code} -- | See "Type#kind_subtyping" for details of the distinction between the 'Kind' 'TyCon's superKindTyCon, anyKindTyCon, liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon, @@ -349,10 +345,7 @@ mkPrimTyConName occ key tycon = mkWiredInName gHC_PRIM (mkTcOccFS occ) BuiltInSyntax -- All of the super kinds and kinds are defined in Prim and use BuiltInSyntax, -- because they are never in scope in the source -\end{code} - -\begin{code} kindTyConType :: TyCon -> Type kindTyConType kind = TyConApp kind [] -- mkTyConApp isn't defined yet @@ -373,15 +366,15 @@ mkArrowKind k1 k2 = FunTy k1 k2 -- | Iterated application of 'mkArrowKind' mkArrowKinds :: [Kind] -> Kind -> Kind mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind arg_kinds -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[TysPrim-basic]{Basic primitive types (@Char#@, @Int#@, etc.)} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} -- only used herein pcPrimTyCon :: Name -> [Role] -> PrimRep -> TyCon pcPrimTyCon name roles rep @@ -445,14 +438,13 @@ doublePrimTy :: Type doublePrimTy = mkTyConTy doublePrimTyCon doublePrimTyCon :: TyCon doublePrimTyCon = pcPrimTyCon0 doublePrimTyConName DoubleRep -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[TysPrim-state]{The @State#@ type (and @_RealWorld@ types)} -%* * -%************************************************************************ +* * +************************************************************************ Note [The ~# TyCon) ~~~~~~~~~~~~~~~~~~~~ @@ -480,8 +472,8 @@ keep different state threads separate. It is represented by nothing at all. The type parameter to State# is intended to keep separate threads separate. Even though this parameter is not used in the definition of State#, it is given role Nominal to enforce its intended use. +-} -\begin{code} mkStatePrimTy :: Type -> Type mkStatePrimTy ty = TyConApp statePrimTyCon [ty] @@ -520,31 +512,31 @@ eqReprPrimTyCon = mkPrimTyCon eqReprPrimTyConName kind where kind = ForAllTy kv $ mkArrowKinds [k, k] unliftedTypeKind kv = kKiVar k = mkTyVarTy kv -\end{code} +{- RealWorld is deeply magical. It is *primitive*, but it is not *unlifted* (hence ptrArg). We never manipulate values of type RealWorld; it's only used in the type system, to parameterise State#. +-} -\begin{code} realWorldTyCon :: TyCon realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind [] PtrRep realWorldTy :: Type realWorldTy = mkTyConTy realWorldTyCon realWorldStatePrimTy :: Type realWorldStatePrimTy = mkStatePrimTy realWorldTy -- State# RealWorld -\end{code} +{- Note: the ``state-pairing'' types are not truly primitive, so they are defined in \tr{TysWiredIn.lhs}, not here. -%************************************************************************ -%* * +************************************************************************ +* * \subsection[TysPrim-arrays]{The primitive array types} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} arrayPrimTyCon, mutableArrayPrimTyCon, mutableByteArrayPrimTyCon, byteArrayPrimTyCon, arrayArrayPrimTyCon, mutableArrayArrayPrimTyCon, smallArrayPrimTyCon, smallMutableArrayPrimTyCon :: TyCon @@ -573,110 +565,110 @@ mkMutableArrayArrayPrimTy :: Type -> Type mkMutableArrayArrayPrimTy s = TyConApp mutableArrayArrayPrimTyCon [s] mkSmallMutableArrayPrimTy :: Type -> Type -> Type mkSmallMutableArrayPrimTy s elt = TyConApp smallMutableArrayPrimTyCon [s, elt] -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[TysPrim-mut-var]{The mutable variable type} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} mutVarPrimTyCon :: TyCon mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName [Nominal, Representational] PtrRep mkMutVarPrimTy :: Type -> Type -> Type mkMutVarPrimTy s elt = TyConApp mutVarPrimTyCon [s, elt] -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[TysPrim-synch-var]{The synchronizing variable type} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} mVarPrimTyCon :: TyCon mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName [Nominal, Representational] PtrRep mkMVarPrimTy :: Type -> Type -> Type mkMVarPrimTy s elt = TyConApp mVarPrimTyCon [s, elt] -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[TysPrim-stm-var]{The transactional variable type} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} tVarPrimTyCon :: TyCon tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName [Nominal, Representational] PtrRep mkTVarPrimTy :: Type -> Type -> Type mkTVarPrimTy s elt = TyConApp tVarPrimTyCon [s, elt] -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[TysPrim-stable-ptrs]{The stable-pointer type} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} stablePtrPrimTyCon :: TyCon stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName [Representational] AddrRep mkStablePtrPrimTy :: Type -> Type mkStablePtrPrimTy ty = TyConApp stablePtrPrimTyCon [ty] -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[TysPrim-stable-names]{The stable-name type} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} stableNamePrimTyCon :: TyCon stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName [Representational] PtrRep mkStableNamePrimTy :: Type -> Type mkStableNamePrimTy ty = TyConApp stableNamePrimTyCon [ty] -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[TysPrim-BCOs]{The ``bytecode object'' type} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} bcoPrimTy :: Type bcoPrimTy = mkTyConTy bcoPrimTyCon bcoPrimTyCon :: TyCon bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName PtrRep -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[TysPrim-Weak]{The ``weak pointer'' type} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} weakPrimTyCon :: TyCon weakPrimTyCon = pcPrimTyCon weakPrimTyConName [Representational] PtrRep mkWeakPrimTy :: Type -> Type mkWeakPrimTy v = TyConApp weakPrimTyCon [v] -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[TysPrim-thread-ids]{The ``thread id'' type} -%* * -%************************************************************************ +* * +************************************************************************ A thread id is represented by a pointer to the TSO itself, to ensure that they are always unique and we can always find the TSO for a given @@ -686,19 +678,19 @@ collector and can keep TSOs around for too long. Hence the programmer API for thread manipulation uses a weak pointer to the thread id internally. +-} -\begin{code} threadIdPrimTy :: Type threadIdPrimTy = mkTyConTy threadIdPrimTyCon threadIdPrimTyCon :: TyCon threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName PtrRep -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * Any -%* * -%************************************************************************ +* * +************************************************************************ Note [Any types] ~~~~~~~~~~~~~~~~ @@ -763,8 +755,8 @@ This commit uses Any for kind * Any(*->*) for kind *->* etc +-} -\begin{code} anyTyConName :: Name anyTyConName = mkPrimTc (fsLit "Any") anyTyConKey anyTyCon @@ -780,14 +772,13 @@ anyTyCon = mkFamilyTyCon anyTyConName kind [kKiVar] anyTypeOfKind :: Kind -> Type anyTypeOfKind kind = TyConApp anyTyCon [kind] -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{SIMD vector types} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} #include "primop-vector-tys.hs-incl" -\end{code} diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.hs index f4dca9a0de..ccebe539d2 100644 --- a/compiler/prelude/TysWiredIn.lhs +++ b/compiler/prelude/TysWiredIn.hs @@ -1,9 +1,9 @@ -% -% (c) The GRASP Project, Glasgow University, 1994-1998 -% +{- +(c) The GRASP Project, Glasgow University, 1994-1998 + \section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types} +-} -\begin{code} {-# LANGUAGE CPP #-} -- | This module is about types that can be defined in Haskell, but which @@ -111,19 +111,18 @@ alpha_tyvar = [alphaTyVar] alpha_ty :: [Type] alpha_ty = [alphaTy] -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{Wired in type constructors} -%* * -%************************************************************************ +* * +************************************************************************ If you change which things are wired in, make sure you change their names in PrelNames, so they use wTcQual, wDataQual, etc +-} -\begin{code} -- This list is used only to define PrelInfo.wiredInThings. That in turn -- is used to initialise the name environment carried around by the renamer. -- This means that if we look up the name of a TyCon (or its implicit binders) @@ -156,9 +155,7 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because , typeNatKindCon , typeSymbolKindCon ] -\end{code} -\begin{code} mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name mkWiredInTyConName built_in modu fs unique tycon = mkWiredInName modu (mkTcOccFS fs) unique @@ -228,15 +225,15 @@ listTyCon_RDR = nameRdrName listTyConName consDataCon_RDR = nameRdrName consDataConName parrTyCon_RDR = nameRdrName parrTyConName eqTyCon_RDR = nameRdrName eqTyConName -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection{mkWiredInTyCon} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} pcNonRecDataTyCon :: Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon -- Not an enumeration, not promotable pcNonRecDataTyCon = pcTyCon False NonRecursive False @@ -293,16 +290,15 @@ pcDataConWithFixity' declared_infix dc_name wrk_key tyvars arg_tys tycon wrk_occ = mkDataConWorkerOcc (nameOccName dc_name) wrk_name = mkWiredInName modu wrk_occ wrk_key (AnId (dataConWorkId data_con)) UserSyntax -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * Kinds -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} typeNatKindCon, typeSymbolKindCon :: TyCon -- data Nat -- data Symbol @@ -312,14 +308,13 @@ typeSymbolKindCon = pcTyCon False NonRecursive True typeSymbolKindConName Nothin typeNatKind, typeSymbolKind :: Kind typeNatKind = TyConApp (promoteTyCon typeNatKindCon) [] typeSymbolKind = TyConApp (promoteTyCon typeSymbolKindCon) [] -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * Stuff for dealing with tuples -%* * -%************************************************************************ +* * +************************************************************************ Note [How tuples work] See also Note [Known-key names] in PrelNames ~~~~~~~~~~~~~~~~~~~~~~ @@ -338,10 +333,10 @@ Note [How tuples work] See also Note [Known-key names] in PrelNames we get the right wired-in name. This guy can't tell the difference betweeen BoxedTuple and ConstraintTuple (same OccName!), so tuples are not serialised into interface files using OccNames at all. +-} -\begin{code} isBuiltInOcc_maybe :: OccName -> Maybe Name --- Built in syntax isn't "in scope" so these OccNames +-- Built in syntax isn't "in scope" so these OccNames -- map to wired-in Names with BuiltInSyntax isBuiltInOcc_maybe occ = case occNameString occ of @@ -365,7 +360,7 @@ isBuiltInOcc_maybe occ tail_matches BoxedTuple ")" = True tail_matches UnboxedTuple "#)" = True tail_matches _ _ = False - + choose_ns tc dc | isTcClsNameSpace ns = Just (getName tc) | isDataConNameSpace ns = Just (getName dc) @@ -479,16 +474,15 @@ unboxedPairTyCon :: TyCon unboxedPairTyCon = tupleTyCon UnboxedTuple 2 unboxedPairDataCon :: DataCon unboxedPairDataCon = tupleCon UnboxedTuple 2 -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)} -%* * -%************************************************************************ +* * +************************************************************************ +-} -\begin{code} eqTyCon :: TyCon eqTyCon = mkAlgTyCon eqTyConName (ForAllTy kv $ mkArrowKinds [k, k] constraintKind) @@ -537,9 +531,6 @@ coercibleDataCon = pcDataCon coercibleDataConName args [TyConApp eqReprPrimTyCon coercibleClass :: Class coercibleClass = mkClass (tyConTyVars coercibleTyCon) [] [] [] [] [] (mkAnd []) coercibleTyCon -\end{code} - -\begin{code} charTy :: Type charTy = mkTyConTy charTyCon @@ -552,9 +543,7 @@ charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon stringTy :: Type stringTy = mkListTy charTy -- convenience only -\end{code} -\begin{code} intTy :: Type intTy = mkTyConTy intTyCon @@ -562,9 +551,7 @@ intTyCon :: TyCon intTyCon = pcNonRecDataTyCon intTyConName (Just (CType Nothing (fsLit "HsInt"))) [] [intDataCon] intDataCon :: DataCon intDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon -\end{code} -\begin{code} wordTy :: Type wordTy = mkTyConTy wordTyCon @@ -572,9 +559,7 @@ wordTyCon :: TyCon wordTyCon = pcNonRecDataTyCon wordTyConName (Just (CType Nothing (fsLit "HsWord"))) [] [wordDataCon] wordDataCon :: DataCon wordDataCon = pcDataCon wordDataConName [] [wordPrimTy] wordTyCon -\end{code} -\begin{code} floatTy :: Type floatTy = mkTyConTy floatTyCon @@ -582,9 +567,7 @@ floatTyCon :: TyCon floatTyCon = pcNonRecDataTyCon floatTyConName (Just (CType Nothing (fsLit "HsFloat"))) [] [floatDataCon] floatDataCon :: DataCon floatDataCon = pcDataCon floatDataConName [] [floatPrimTy] floatTyCon -\end{code} -\begin{code} doubleTy :: Type doubleTy = mkTyConTy doubleTyCon @@ -593,14 +576,13 @@ doubleTyCon = pcNonRecDataTyCon doubleTyConName (Just (CType Nothing (fsLit "HsD doubleDataCon :: DataCon doubleDataCon = pcDataCon doubleDataConName [] [doublePrimTy] doubleTyCon -\end{code} - -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[TysWiredIn-Bool]{The @Bool@ type} -%* * -%************************************************************************ +* * +************************************************************************ An ordinary enumeration type, but deeply wired in. There are no magical operations on @Bool@ (just the regular Prelude code). @@ -643,8 +625,8 @@ necessarily need to be a straightforwardly boxed version of its primitive counterpart. {\em END IDLE SPECULATION BY SIMON} +-} -\begin{code} boolTy :: Type boolTy = mkTyConTy boolTyCon @@ -674,13 +656,13 @@ ltDataConId, eqDataConId, gtDataConId :: Id ltDataConId = dataConWorkId ltDataCon eqDataConId = dataConWorkId eqDataCon gtDataConId = dataConWorkId gtDataCon -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[TysWiredIn-List]{The @List@ type (incl ``build'' magic)} -%* * -%************************************************************************ +* * +************************************************************************ Special syntax, deeply wired in, but otherwise an ordinary algebraic data types: @@ -690,8 +672,8 @@ data () = () data (,) a b = (,,) a b ... \end{verbatim} +-} -\begin{code} mkListTy :: Type -> Type mkListTy ty = mkTyConApp listTyCon [ty] @@ -715,13 +697,13 @@ consDataCon = pcDataConWithFixity True {- Declared infix -} -- Interesting: polymorphic recursion would help here. -- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy -- gets the over-specific type (Type -> Type) -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[TysWiredIn-Tuples]{The @Tuple@ types} -%* * -%************************************************************************ +* * +************************************************************************ The tuple types are definitely magic, because they form an infinite family. @@ -762,8 +744,8 @@ There should also be a way to generate the appropriate code for each of these instances, but (like the info tables and entry code) it is done by enumeration\srcloc{lib/prelude/InTup?.hs}. \end{itemize} +-} -\begin{code} mkTupleTy :: TupleSort -> [Type] -> Type -- Special case for *boxed* 1-tuples, which are represented by the type itself mkTupleTy sort [ty] | Boxed <- tupleSortBoxity sort = ty @@ -775,17 +757,17 @@ mkBoxedTupleTy tys = mkTupleTy BoxedTuple tys unitTy :: Type unitTy = mkTupleTy BoxedTuple [] -\end{code} -%************************************************************************ -%* * +{- +************************************************************************ +* * \subsection[TysWiredIn-PArr]{The @[::]@ type} -%* * -%************************************************************************ +* * +************************************************************************ Special syntax for parallel arrays needs some wired in definitions. +-} -\begin{code} -- | Construct a type representing the application of the parallel array constructor mkPArrTy :: Type -> Type mkPArrTy ty = mkTyConApp parrTyCon [ty] @@ -848,20 +830,16 @@ mkPArrFakeCon arity = data_con -- | Checks whether a data constructor is a fake constructor for parallel arrays isPArrFakeCon :: DataCon -> Bool isPArrFakeCon dcon = dcon == parrFakeCon (dataConSourceArity dcon) -\end{code} -Promoted Booleans +-- Promoted Booleans -\begin{code} promotedBoolTyCon, promotedFalseDataCon, promotedTrueDataCon :: TyCon promotedBoolTyCon = promoteTyCon boolTyCon promotedTrueDataCon = promoteDataCon trueDataCon promotedFalseDataCon = promoteDataCon falseDataCon -\end{code} -Promoted Ordering +-- Promoted Ordering -\begin{code} promotedOrderingTyCon , promotedLTDataCon , promotedEQDataCon @@ -871,7 +849,3 @@ promotedOrderingTyCon = promoteTyCon orderingTyCon promotedLTDataCon = promoteDataCon ltDataCon promotedEQDataCon = promoteDataCon eqDataCon promotedGTDataCon = promoteDataCon gtDataCon -\end{code} - - - diff --git a/compiler/prelude/TysWiredIn.lhs-boot b/compiler/prelude/TysWiredIn.hs-boot index 305d82e2b5..309dfa22e1 100644 --- a/compiler/prelude/TysWiredIn.lhs-boot +++ b/compiler/prelude/TysWiredIn.hs-boot @@ -1,4 +1,3 @@ -\begin{code} module TysWiredIn where import {-# SOURCE #-} TyCon (TyCon) @@ -8,4 +7,3 @@ import {-# SOURCE #-} TypeRep (Type) eqTyCon, coercibleTyCon :: TyCon typeNatKind, typeSymbolKind :: Type mkBoxedTupleTy :: [Type] -> Type -\end{code} |