From fd94f66371dfd4a2c6694d933374a3a5aa7bd7b4 Mon Sep 17 00:00:00 2001 From: simonpj Date: Wed, 17 Oct 2001 11:26:04 +0000 Subject: [PATCH] [project @ 2001-10-17 11:26:04 by simonpj] ------------------------------------------- nullAddr# fix for the HEAD ------------------------------------------- *** DO NOT MERGE *** nullAddr# is simply a name for (Lit nullAddrLit). Up to now it has been a PrimOp with the rather stange type nullAddr# :: Int# -> Addr# which discards its argument. (I think the problem with nullary primops is to do with the top-level bindings in PrelPrimOpWrappers.) And there was a RULE in PrelRules to rewrite nullAddr _ ==> nullAddrLit It's excessive to make it a PrimOp. We can just treat it like unsafeCoerce#, which is made in MkId.lhs. So I've done that, and given it the more sensible type nullAddr# :: Addr# I fixed all the occurrences I could find. --- ghc/compiler/basicTypes/MkId.lhs | 19 +++++++++++++++---- ghc/compiler/prelude/PrelNames.lhs | 1 + ghc/compiler/prelude/PrelRules.lhs | 7 +------ ghc/compiler/prelude/primops.txt.pp | 19 +++++++++++++------ ghc/lib/std/PrelGHC.hi-boot.pp | 6 +++--- ghc/lib/std/PrelPtr.lhs | 6 +++--- 6 files changed, 36 insertions(+), 22 deletions(-) diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs index 0e45b8f..7fc7804 100644 --- a/ghc/compiler/basicTypes/MkId.lhs +++ b/ghc/compiler/basicTypes/MkId.lhs @@ -22,7 +22,7 @@ module MkId ( -- And some particular Ids; see below for why they are wired in wiredInIds, - unsafeCoerceId, realWorldPrimId, + unsafeCoerceId, realWorldPrimId, nullAddrId, eRROR_ID, eRROR_CSTRING_ID, rEC_SEL_ERROR_ID, pAT_ERROR_ID, rEC_CON_ERROR_ID, rEC_UPD_ERROR_ID, iRREFUT_PAT_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, aBSENT_ERROR_ID, pAR_ERROR_ID @@ -47,7 +47,7 @@ import TcType ( Type, ThetaType, mkDictTy, mkPredTys, mkTyConApp, import Module ( Module ) import CoreUtils ( mkInlineMe ) import CoreUnfold ( mkTopUnfolding, mkCompulsoryUnfolding, mkOtherCon ) -import Literal ( Literal(..) ) +import Literal ( Literal(..), nullAddrLit ) import TyCon ( TyCon, isNewTyCon, tyConTyVars, tyConDataCons, tyConTheta, isProductTyCon, isDataTyCon, isRecursiveTyCon ) import Class ( Class, classTyCon, classTyVars, classSelIds ) @@ -121,9 +121,11 @@ wiredInIds , rEC_CON_ERROR_ID , rEC_UPD_ERROR_ID - -- These three can't be defined in Haskell + -- These can't be defined in Haskell, but they have + -- perfectly reasonable unfoldings in Core , realWorldPrimId , unsafeCoerceId + , nullAddrId , getTagId , seqId ] @@ -756,7 +758,7 @@ mkDictFunId dfun_name clas inst_tyvars inst_tys dfun_theta These Ids can't be defined in Haskell. They could be defined in unfoldings in PrelGHC.hi-boot, but we'd have to ensure that they were definitely, definitely inlined, because there is no curried -identifier for them. Thats what mkCompulsoryUnfolding does. +identifier for them. That's what mkCompulsoryUnfolding does. If we had a way to get a compulsory unfolding from an interface file, we could do that, but we don't right now. @@ -782,6 +784,15 @@ unsafeCoerceId rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $ Note (Coerce openBetaTy openAlphaTy) (Var x) +-- nullAddr# :: Addr# +-- The reason is is here is because we don't provide +-- a way to write this literal in Haskell. +nullAddrId + = pcMiscPrelId nullAddrIdKey pREL_GHC SLIT("nullAddr#") addrPrimTy info + where + info = noCafNoTyGenIdInfo `setUnfoldingInfo` + mkCompulsoryUnfolding (Lit nullAddrLit) + seqId = pcMiscPrelId seqIdKey pREL_GHC SLIT("seq") ty info where diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs index 20384c2..ed4d031 100644 --- a/ghc/compiler/prelude/PrelNames.lhs +++ b/ghc/compiler/prelude/PrelNames.lhs @@ -846,6 +846,7 @@ timesIntegerIdKey = mkPreludeMiscIdUnique 42 printIdKey = mkPreludeMiscIdUnique 43 failIOIdKey = mkPreludeMiscIdUnique 44 unpackCStringListIdKey = mkPreludeMiscIdUnique 45 +nullAddrIdKey = mkPreludeMiscIdUnique 46 \end{code} Certain class operations from Prelude classes. They get their own diff --git a/ghc/compiler/prelude/PrelRules.lhs b/ghc/compiler/prelude/PrelRules.lhs index 9a1c493..c916e63 100644 --- a/ghc/compiler/prelude/PrelRules.lhs +++ b/ghc/compiler/prelude/PrelRules.lhs @@ -28,7 +28,7 @@ import Literal ( Literal(..), isLitLitLit, mkMachInt, mkMachWord , narrow8WordLit, narrow16WordLit, narrow32WordLit , char2IntLit, int2CharLit , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit - , nullAddrLit, float2DoubleLit, double2FloatLit + , float2DoubleLit, double2FloatLit ) import PrimOp ( PrimOp(..), primOpOcc ) import TysWiredIn ( trueDataConId, falseDataConId ) @@ -64,7 +64,6 @@ primOpRules op = primop_rule op -- ToDo: something for integer-shift ops? -- NotOp - primop_rule AddrNullOp = one_rule nullAddrRule primop_rule SeqOp = one_rule seqRule primop_rule TagToEnumOp = one_rule tagToEnumRule primop_rule DataToTagOp = one_rule dataToTagRule @@ -349,10 +348,6 @@ mkFloatVal f = Lit (convFloating (MachFloat f)) mkDoubleVal d = Lit (convFloating (MachDouble d)) \end{code} -\begin{code} -nullAddrRule _ = Just(Lit nullAddrLit) -\end{code} - %************************************************************************ %* * diff --git a/ghc/compiler/prelude/primops.txt.pp b/ghc/compiler/prelude/primops.txt.pp index 3e78e47..7d6b000 100644 --- a/ghc/compiler/prelude/primops.txt.pp +++ b/ghc/compiler/prelude/primops.txt.pp @@ -1,5 +1,5 @@ ----------------------------------------------------------------------- --- $Id: primops.txt.pp,v 1.7 2001/10/16 13:31:56 simonmar Exp $ +-- $Id: primops.txt.pp,v 1.8 2001/10/17 11:26:04 simonpj Exp $ -- -- Primitive Operations -- @@ -13,7 +13,7 @@ -- -- To add a new primop, you currently need to update the following files: -- --- - this file (ghc/compiler/prelude/primops.txt), which includes +-- - this file (ghc/compiler/prelude/primops.txt.pp), which includes -- the type of the primop, and various other properties (its -- strictness attributes, whether it is defined as a macro -- or as out-of-line code, etc.) @@ -934,12 +934,12 @@ primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp ------------------------------------------------------------------------ section "Addr#" {Addr\# is an arbitrary machine address assumed to point outside - the garbage-collected heap.} + the garbage-collected heap. + + NB: {\tt nullAddr\#::Addr\#} is not a primop, but is defined in MkId.lhs. + It is the null address.} ------------------------------------------------------------------------ -primop AddrNullOp "nullAddr#" GenPrimOp Int# -> Addr# - {Returns null address. Argument is ignored (nullary primops - don't quite work!)} primop AddrAddOp "plusAddr#" GenPrimOp Addr# -> Int# -> Addr# primop AddrSubOp "minusAddr#" GenPrimOp Addr# -> Addr# -> Int# {Result is meaningless if two Addr\#s are so far apart that their @@ -1606,6 +1606,13 @@ primop NewBCOOp "newBCO#" GenPrimOp out_of_line = True ------------------------------------------------------------------------ +section "Coercion" + {{\tt unsafeCoerce# :: a -> b} is not a primop, but is defined in MkId.lhs.} + +------------------------------------------------------------------------ + + +------------------------------------------------------------------------ --- --- ------------------------------------------------------------------------ diff --git a/ghc/lib/std/PrelGHC.hi-boot.pp b/ghc/lib/std/PrelGHC.hi-boot.pp index 51850e0..5fc5008 100644 --- a/ghc/lib/std/PrelGHC.hi-boot.pp +++ b/ghc/lib/std/PrelGHC.hi-boot.pp @@ -52,7 +52,7 @@ __export PrelGHC isEmptyMVarzh -- Seq - seq + seq -- Defined in MkId -- Parallel seqzh @@ -136,7 +136,7 @@ __export PrelGHC #endif Addrzh - nullAddrzh + nullAddrzh -- Defined in MkId plusAddrzh minusAddrzh remAddrzh @@ -424,7 +424,7 @@ __export PrelGHC BCOzh mkApUpd0zh - unsafeCoercezh + unsafeCoercezh -- Defined in MkId addrToHValuezh ; diff --git a/ghc/lib/std/PrelPtr.lhs b/ghc/lib/std/PrelPtr.lhs index cbf076c..ddff34e 100644 --- a/ghc/lib/std/PrelPtr.lhs +++ b/ghc/lib/std/PrelPtr.lhs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: PrelPtr.lhs,v 1.3 2001/08/17 17:18:54 apt Exp $ +-- $Id: PrelPtr.lhs,v 1.4 2001/10/17 11:26:04 simonpj Exp $ -- -- (c) 2000 -- @@ -17,7 +17,7 @@ import PrelBase data Ptr a = Ptr Addr# deriving (Eq, Ord) nullPtr :: Ptr a -nullPtr = Ptr (nullAddr# 0#) +nullPtr = Ptr nullAddr# castPtr :: Ptr a -> Ptr b castPtr (Ptr addr) = Ptr addr @@ -43,7 +43,7 @@ instance CReturnable (Ptr a) data FunPtr a = FunPtr Addr# deriving (Eq, Ord) nullFunPtr :: FunPtr a -nullFunPtr = FunPtr (nullAddr# 0#) +nullFunPtr = FunPtr nullAddr# castFunPtr :: FunPtr a -> FunPtr b castFunPtr (FunPtr addr) = FunPtr addr -- 1.7.10.4