Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Handle HValues slightly nicer

We now have addrToAny# rather than addrToHValue#, and both addrToAny#
and mkApUpd0# return "Any" rather than "a". This makes it a little
easier to see what's going on, and fixes a warning in ByteCodeLink.
  • Loading branch information...
commit aff9d6908525567cdeca09c7ef40bee34459cd31 1 parent 25f8f25
@igfoo igfoo authored
View
2  compiler/codeGen/CgPrimOp.hs
@@ -203,7 +203,7 @@ emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2] _
= stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [arg1,arg2]))
-- #define addrToHValuezh(r,a) r=(P_)a
-emitPrimOp [res] AddrToHValueOp [arg] _
+emitPrimOp [res] AddrToAnyOp [arg] _
= stmtC (CmmAssign (CmmLocal res) arg)
-- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
View
2  compiler/codeGen/StgCmmPrim.hs
@@ -269,7 +269,7 @@ emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2]
= emit (mkAssign (CmmLocal res) (CmmMachOp mo_wordEq [arg1,arg2]))
-- #define addrToHValuezh(r,a) r=(P_)a
-emitPrimOp [res] AddrToHValueOp [arg]
+emitPrimOp [res] AddrToAnyOp [arg]
= emit (mkAssign (CmmLocal res) arg)
-- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
View
19 compiler/ghci/ByteCodeLink.lhs
@@ -8,8 +8,7 @@ ByteCodeLink: Bytecode assembler and linker
{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
module ByteCodeLink (
- HValue(..), -- We don't want to export the constructor, but
- -- we get a warning that it's unsed if we don't
+ HValue,
ClosureEnv, emptyClosureEnv, extendClosureEnv,
linkBCO, lookupStaticPtr, lookupName
,lookupIE
@@ -95,8 +94,8 @@ linkBCO ie ce ul_bco
-- non-zero arity BCOs in an AP thunk.
--
if (unlinkedBCOArity ul_bco > 0)
- then return (unsafeCoerce# bco#)
- else case mkApUpd0# bco# of { (# final_bco #) -> return final_bco }
+ then return (HValue (unsafeCoerce# bco#))
+ else case mkApUpd0# bco# of { (# final_bco #) -> return (HValue final_bco) }
linkBCO' :: ItblEnv -> ClosureEnv -> UnlinkedBCO -> IO BCO
@@ -146,9 +145,9 @@ mkPtrsArray ie ce n_ptrs ptrs = do
BCO bco# <- linkBCO' ie ce ul_bco
writeArrayBCO marr i bco#
fill (BCOPtrBreakInfo brkInfo) i =
- unsafeWrite marr i (unsafeCoerce# brkInfo)
+ unsafeWrite marr i (HValue (unsafeCoerce# brkInfo))
fill (BCOPtrArray brkArray) i =
- unsafeWrite marr i (unsafeCoerce# brkArray)
+ unsafeWrite marr i (HValue (unsafeCoerce# brkArray))
zipWithM_ fill ptrs [0..]
unsafeFreeze marr
@@ -206,8 +205,8 @@ lookupPrimOp primop
= do let sym_to_find = primopToCLabel primop "closure"
m <- lookupSymbol sym_to_find
case m of
- Just (Ptr addr) -> case addrToHValue# addr of
- (# hval #) -> return hval
+ Just (Ptr addr) -> case addrToAny# addr of
+ (# a #) -> return (HValue a)
Nothing -> linkFail "ByteCodeLink.lookupCE(primop)" sym_to_find
lookupName :: ClosureEnv -> Name -> IO HValue
@@ -219,8 +218,8 @@ lookupName ce nm
do let sym_to_find = nameToCLabel nm "closure"
m <- lookupSymbol sym_to_find
case m of
- Just (Ptr addr) -> case addrToHValue# addr of
- (# hval #) -> return hval
+ Just (Ptr addr) -> case addrToAny# addr of
+ (# a #) -> return (HValue a)
Nothing -> linkFail "ByteCodeLink.lookupCE" sym_to_find
lookupIE :: ItblEnv -> Name -> IO (Ptr a)
View
5 compiler/prelude/TysPrim.lhs
@@ -67,7 +67,7 @@ module TysPrim(
eqPrimTyCon, -- ty1 ~# ty2
-- * Any
- anyTyCon, anyTyConOfKind, anyTypeOfKind
+ anyTy, anyTyCon, anyTyConOfKind, anyTypeOfKind
) where
#include "HsVersions.h"
@@ -671,6 +671,9 @@ This commit uses
anyTyConName :: Name
anyTyConName = mkPrimTc (fsLit "Any") anyTyConKey anyTyCon
+anyTy :: Type
+anyTy = mkTyConTy anyTyCon
+
anyTyCon :: TyCon
anyTyCon = mkLiftedPrimTyCon anyTyConName liftedTypeKind 0 PtrRep
View
8 compiler/prelude/primops.txt.pp
@@ -1761,14 +1761,14 @@
primtype BCO#
{Primitive bytecode type.}
-primop AddrToHValueOp "addrToHValue#" GenPrimOp
- Addr# -> (# a #)
- {Convert an {\tt Addr\#} to a followable type.}
+primop AddrToAnyOp "addrToAny#" GenPrimOp
+ Addr# -> (# Any #)
+ {Convert an {\tt Addr\#} to a followable Any type.}
with
code_size = 0
primop MkApUpd0_Op "mkApUpd0#" GenPrimOp
- BCO# -> (# a #)
+ BCO# -> (# Any #)
with
out_of_line = True
View
1  utils/genprimopcode/Main.hs
@@ -621,6 +621,7 @@ ppTyVar "o" = "openAlphaTyVar"
ppTyVar _ = error "Unknown type var"
ppType :: Ty -> String
+ppType (TyApp "Any" []) = "anyTy"
ppType (TyApp "Bool" []) = "boolTy"
ppType (TyApp "Int#" []) = "intPrimTy"
Please sign in to comment.
Something went wrong with that request. Please try again.