Comment out deeply suspicious (and unused) function insertStableSymbol

The function insertStableSymbol looks utterly wrong, because it
coerces a value of type 'a' to an Addr#!  That was in turn making the
code generator get confused (now improved), but since insertStableSymbol
isn't used at all, I'm just commenting it out.

Meanwhile, this patch also enhances CoreToStg to report the most egregious
cases where an unsafe coerce is going to confuse the code generator.

diff --git a/compiler/ghci/ObjLink.lhs b/compiler/ghci/ObjLink.lhs
index d5e0f7b..48deb46 100644 (file)
--- a/compiler/ghci/ObjLink.lhs
+++ b/compiler/ghci/ObjLink.lhs
@@ -17,7 +17,8 @@ module ObjLink (
    loadObj,             -- :: String -> IO ()
    unloadObj,           -- :: String -> IO ()
    insertSymbol,         -- :: String -> String -> Ptr a -> IO ()
    loadObj,             -- :: String -> IO ()
    unloadObj,           -- :: String -> IO ()
    insertSymbol,         -- :: String -> String -> Ptr a -> IO ()

-   insertStableSymbol,   -- :: String -> String -> a -> IO ()
+-- Suspicious; see defn
+--    insertStableSymbol,   -- :: String -> String -> a -> IO ()

    lookupSymbol,        -- :: String -> IO (Maybe (Ptr a))
    resolveObjs          -- :: IO SuccessFlag
   )  where
    lookupSymbol,        -- :: String -> IO (Maybe (Ptr a))
    resolveObjs          -- :: IO SuccessFlag
   )  where

@@ -43,12 +44,14 @@ insertSymbol obj_name key symbol
          withCString str $ \c_str ->
           c_insertSymbol c_obj_name c_str symbol
 
          withCString str $ \c_str ->
           c_insertSymbol c_obj_name c_str symbol
 

+{- Deeply suspicious use of unsafeCoerce#; should use makeStablePtr#

 insertStableSymbol :: String -> String -> a -> IO ()
 insertStableSymbol obj_name key symbol
     = let str = prefixUnderscore key
       in withCString obj_name $ \c_obj_name ->
          withCString str $ \c_str ->
           c_insertStableSymbol c_obj_name c_str (Ptr (unsafeCoerce# symbol))
 insertStableSymbol :: String -> String -> a -> IO ()
 insertStableSymbol obj_name key symbol
     = let str = prefixUnderscore key
       in withCString obj_name $ \c_obj_name ->
          withCString str $ \c_str ->
           c_insertStableSymbol c_obj_name c_str (Ptr (unsafeCoerce# symbol))

+-}

 
 lookupSymbol :: String -> IO (Maybe (Ptr a))
 lookupSymbol str_in = do
 
 lookupSymbol :: String -> IO (Maybe (Ptr a))
 lookupSymbol str_in = do

@@ -98,8 +101,9 @@ resolveObjs = do
 foreign import ccall unsafe "addDLL"      c_addDLL :: CString -> IO CString
 foreign import ccall unsafe "initLinker"   initObjLinker :: IO ()
 foreign import ccall unsafe "insertSymbol" c_insertSymbol :: CString -> CString -> Ptr a -> IO ()
 foreign import ccall unsafe "addDLL"      c_addDLL :: CString -> IO CString
 foreign import ccall unsafe "initLinker"   initObjLinker :: IO ()
 foreign import ccall unsafe "insertSymbol" c_insertSymbol :: CString -> CString -> Ptr a -> IO ()

-foreign import ccall unsafe "insertStableSymbol" c_insertStableSymbol
-    :: CString -> CString -> Ptr a -> IO ()
+-- Suspicious: should take a stable pointer
+-- foreign import ccall unsafe "insertStableSymbol" c_insertStableSymbol
+--     :: CString -> CString -> Ptr a -> IO ()

 foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
 foreign import ccall unsafe "loadObj"      c_loadObj :: CString -> IO Int
 foreign import ccall unsafe "unloadObj"    c_unloadObj :: CString -> IO Int
 foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
 foreign import ccall unsafe "loadObj"      c_loadObj :: CString -> IO Int
 foreign import ccall unsafe "unloadObj"    c_unloadObj :: CString -> IO Int

diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs
index 66e2d61..64f9fe3 100644 (file)
--- a/compiler/stgSyn/CoreToStg.lhs
+++ b/compiler/stgSyn/CoreToStg.lhs
@@ -548,6 +548,21 @@ coreToStgArgs (arg : args) -- Non-type argument
                       StgLit lit       -> StgLitArg lit
                       _                -> pprPanic "coreToStgArgs" (ppr arg)
     in
                       StgLit lit       -> StgLitArg lit
                       _                -> pprPanic "coreToStgArgs" (ppr arg)
     in

+       -- WARNING: what if we have an argument like (v `cast` co)
+       --          where 'co' changes the representation type?
+       --          (This really only happens if co is unsafe.)
+       -- Then all the getArgAmode stuff in CgBindery will set the
+       -- cg_rep of the CgIdInfo based on the type of v, rather
+       -- than the type of 'co'.
+       -- This matters particularly when the function is a primop
+       -- or foreign call.
+       -- Wanted: a better solution than this hacky warning
+    let
+       arg_ty = exprType arg
+       stg_arg_ty = stgArgType stg_arg
+    in
+    WARN( isUnLiftedType arg_ty /= isUnLiftedType stg_arg_ty, 
+         ptext SLIT("Dangerous-looking argument. Probable cause: bad unsafeCoerce#") $$ ppr arg)

     returnLne (stg_arg : stg_args, fvs)
 
 
     returnLne (stg_arg : stg_args, fvs)