+
+recoverDataCon :: a -> TcM Name
+recoverDataCon a = recoverDCInRTS a `recoverM` ioToTcRn (do
+ mb_name <- recoverDCInDynEnv a
+ maybe (fail "Linker.recoverDatacon: Name not found in Dyn Env")
+ return
+ mb_name)
+
+-- | If a is a Constr closure, lookupDC returns either the Name of the DataCon or the
+-- symbol if it is a nullary constructor
+-- For instance, for a closure containing 'Just x' it would return the Name for Data.Maybe.Just
+-- For a closure containing 'Nothing' it would return the String "DataziMaybe_Nothing_static_info"
+recoverDCInDynEnv :: a -> IO (Maybe Name)
+recoverDCInDynEnv a = do
+ pls <- readIORef v_PersistentLinkerState
+ let de = dtacons_env pls
+ ctype <- getClosureType a
+ if not (isConstr ctype)
+ then putStrLn ("Not a Constr (" ++ show ctype ++ ")") >>
+ return Nothing
+ else do let infot = getInfoTablePtr a
+ name = lookupAddressEnv de (castPtr$ infot `plusPtr` (wORD_SIZE*2))
+ return name
+
+
+recoverDCInRTS :: a -> TcM Name
+recoverDCInRTS a = do
+ ctype <- ioToTcRn$ getClosureType a
+ if (not$ isConstr ctype)
+ then fail "not Constr"
+ else do
+ Just symbol <- ioToTcRn$ lookupDataCon (getInfoTablePtr a)
+ let (occ,mod) = (parse . lex) symbol
+ lookupOrig mod occ
+ where lex x = map zDecodeString . init . init . split '_' . removeLeadingUnderscore $ x
+ parse [pkg, modName, occ] = (mkOccName OccName.dataName occ,
+ mkModule (stringToPackageId pkg) (mkModuleName modName))
+ parse [modName, occ] = (mkOccName OccName.dataName occ,
+ mkModule mainPackageId (mkModuleName modName))
+ split delim = let
+ helper [] = Nothing
+ helper x = Just . second (drop 1) . break (==delim) $ x
+ in unfoldr helper
+ removeLeadingUnderscore = if cLeadingUnderscore=="YES"
+ then tail
+ else id
+
+getHValue :: Name -> IO (Maybe HValue)
+getHValue name = do
+ pls <- readIORef v_PersistentLinkerState
+ case lookupNameEnv (closure_env pls) name of
+ Just (_,x) -> return$ Just x
+ _ -> return Nothing
+