From 2443774403902ed72d21296bd9fed010843ecc4e Mon Sep 17 00:00:00 2001
From: Galen Huntington <galen@alumni.reed.edu>
Date: Fri, 15 Mar 2019 21:10:40 -0700
Subject: [PATCH 1/2] Get this to compile.
---
src/System/Plugins/Consts.hs | 2 +-
src/System/Plugins/Env.hs | 7 ++++---
src/System/Plugins/Load.hs | 7 ++++---
src/System/Plugins/Parser.hs | 2 +-
src/System/Plugins/Utils.hs | 7 ++-----
5 files changed, 12 insertions(+), 13 deletions(-)
diff --git a/src/System/Plugins/Consts.hs b/src/System/Plugins/Consts.hs
index 5142fae..2fea08c 100644
--- a/src/System/Plugins/Consts.hs
+++ b/src/System/Plugins/Consts.hs
@@ -20,7 +20,7 @@
module System.Plugins.Consts where
-#include "../../../config.h"
+#include "config.h"
#if __GLASGOW_HASKELL__ >= 604
diff --git a/src/System/Plugins/Env.hs b/src/System/Plugins/Env.hs
index 1826f7f..0a24c64 100644
--- a/src/System/Plugins/Env.hs
+++ b/src/System/Plugins/Env.hs
@@ -50,7 +50,7 @@ module System.Plugins.Env (
) where
-#include "../../../config.h"
+#include "config.h"
import System.Plugins.LoadTypes (Module)
import System.Plugins.Consts ( sysPkgSuffix )
@@ -76,7 +76,7 @@ import DynFlags (
Way(WayDyn), dynamicGhc, ways,
#endif
defaultDynFlags, initDynFlags)
-import SysTools (initSysTools)
+import SysTools (initSysTools, initLlvmConfig)
import Distribution.Package hiding (
#if MIN_VERSION_ghc(7,6,0)
@@ -466,7 +466,8 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p
-- If we're loading dynamic libs we need the cbits to appear before the
-- real packages.
settings <- initSysTools (Just libdir)
- dflags <- initDynFlags $ defaultDynFlags settings
+ llvmConfig <- initLlvmConfig (Just libdir)
+ dflags <- initDynFlags $ defaultDynFlags settings llvmConfig
libs <- mapM (findHSlib
#if MIN_VERSION_ghc(7,8,0)
(WayDyn `elem` ways dflags || dynamicGhc)
diff --git a/src/System/Plugins/Load.hs b/src/System/Plugins/Load.hs
index bff1b21..32a5a08 100644
--- a/src/System/Plugins/Load.hs
+++ b/src/System/Plugins/Load.hs
@@ -61,7 +61,7 @@ module System.Plugins.Load (
) where
-#include "../../../config.h"
+#include "config.h"
import System.Plugins.Make ( build )
import System.Plugins.Env
@@ -104,7 +104,7 @@ import GHC ( defaultCallbacks )
#else
import DynFlags (defaultDynFlags, initDynFlags)
import GHC.Paths (libdir)
-import SysTools (initSysTools)
+import SysTools (initSysTools, initLlvmConfig)
#endif
import GHC.Ptr ( Ptr(..), nullPtr )
#if !MIN_VERSION_ghc(7,4,1)
@@ -127,7 +127,8 @@ readBinIface' hi_path = do
-- kludgy as hell
#if MIN_VERSION_ghc(7,2,0)
mySettings <- initSysTools (Just libdir) -- how should we really set the top dir?
- dflags <- initDynFlags (defaultDynFlags mySettings)
+ llvmConfig <- initLlvmConfig (Just libdir)
+ dflags <- initDynFlags (defaultDynFlags mySettings llvmConfig)
e <- newHscEnv dflags
#else
e <- newHscEnv defaultCallbacks undefined
diff --git a/src/System/Plugins/Parser.hs b/src/System/Plugins/Parser.hs
index 9970359..739249a 100644
--- a/src/System/Plugins/Parser.hs
+++ b/src/System/Plugins/Parser.hs
@@ -25,7 +25,7 @@ module System.Plugins.Parser (
replaceModName
) where
-#include "../../../config.h"
+#include "config.h"
import Data.List
import Data.Char
diff --git a/src/System/Plugins/Utils.hs b/src/System/Plugins/Utils.hs
index bec328e..5c7bb4b 100644
--- a/src/System/Plugins/Utils.hs
+++ b/src/System/Plugins/Utils.hs
@@ -58,7 +58,7 @@ module System.Plugins.Utils (
) where
-#include "../../../config.h"
+#include "config.h"
import System.Plugins.Env ( isLoaded )
import System.Plugins.Consts ( objSuf, hiSuf, tmpDir )
@@ -289,7 +289,7 @@ findFile (ext:exts) file
infixr 6 </>
infixr 6 <.>
-(</>), (<.>), (<+>), (<>) :: FilePath -> FilePath -> FilePath
+(</>), (<.>), (<+>) :: FilePath -> FilePath -> FilePath
[] </> b = b
a </> b = a ++ "/" ++ b
@@ -299,9 +299,6 @@ a <.> b = a ++ "." ++ b
[] <+> b = b
a <+> b = a ++ " " ++ b
-[] <> b = b
-a <> b = a ++ b
-
--
-- | dirname : return the directory portion of a file path
-- if null, return "."
From 57aa1e606a195c0fe7975b8c7817aa5b4afa9ea6 Mon Sep 17 00:00:00 2001
From: Galen Huntington <galen@alumni.reed.edu>
Date: Fri, 15 Mar 2019 21:43:48 -0700
Subject: [PATCH 2/2] Try to integrate @abarbu patches.
---
plugins.cabal | 1 +
src/System/Plugins/Env.hs | 46 ++++++++++++++++++++++++++++++++------
src/System/Plugins/Load.hs | 21 +++++++++++++----
3 files changed, 57 insertions(+), 11 deletions(-)
diff --git a/plugins.cabal b/plugins.cabal
index 5a657d1..9f7f8b5 100644
--- a/plugins.cabal
+++ b/plugins.cabal
@@ -59,6 +59,7 @@ library
filepath,
random,
process,
+ split,
ghc >= 6.10,
ghc-prim
diff --git a/src/System/Plugins/Env.hs b/src/System/Plugins/Env.hs
index 0a24c64..4285a1a 100644
--- a/src/System/Plugins/Env.hs
+++ b/src/System/Plugins/Env.hs
@@ -40,13 +40,15 @@ module System.Plugins.Env (
lookupMerged,
addMerge,
addPkgConf,
+ defaultPkgConf,
union,
addStaticPkg,
isStaticPkg,
rmStaticPkg,
grabDefaultPkgConf,
readPackageConf,
- lookupPkg
+ lookupPkg,
+ pkgManglingPrefix
) where
@@ -59,7 +61,7 @@ import Control.Monad ( liftM )
import Data.IORef ( writeIORef, readIORef, newIORef, IORef() )
import Data.Maybe ( isJust, isNothing, fromMaybe )
-import Data.List ( (\\), nub, )
+import Data.List ( (\\), nub )
import System.IO.Unsafe ( unsafePerformIO )
import System.Directory ( doesFileExist )
@@ -83,6 +85,7 @@ import Distribution.Package hiding (
Module,
#endif
depends, packageName, PackageName(..)
+ , installedUnitId
#if MIN_VERSION_ghc(7,10,0)
, installedPackageId
#endif
@@ -96,6 +99,9 @@ import Distribution.Simple.PackageIndex
import Distribution.Simple.Program
import Distribution.Verbosity
+import System.Environment
+import Data.List.Split
+
import qualified Data.Map as M
import qualified Data.Set as S
--
@@ -305,6 +311,15 @@ addPkgConf f = do
ps <- readPackageConf f
modifyPkgEnv env $ \ls -> return $ union ls ps
+-- | This function is required when running with stack.
+defaultPkgConf :: IO ()
+defaultPkgConf = do
+ paths <- lookupEnv "GHC_PACKAGE_PATH"
+ unsetEnv "GHC_PACKAGE_PATH"
+ case paths of
+ Nothing -> return ()
+ Just s -> mapM_ addPkgConf $ splitOn ":" s
+
--
-- | add a new FM for the package.conf to the list of existing ones; if a package occurs multiple
-- times, pick the one with the higher version number as the default (e.g., important for base in
@@ -407,6 +422,17 @@ lookupPkg pn = go [] pn
(f', g') <- liftM unzip $ mapM (go (nub $ seen ++ ps)) (ps \\ seen)
return $ (nub $ (concat f') ++ f, if static then [] else nub $ (concat g') ++ g)
+-- This is the prefix of mangled symbols that come from this package.
+pkgManglingPrefix :: PackageName -> IO (Maybe String)
+-- base seems to be mangled differently!
+pkgManglingPrefix "base" = return $ Just "base"
+pkgManglingPrefix p = withPkgEnvs env $ \fms -> return (go fms p)
+ where
+ go [] _ = Nothing
+ go (fm:fms) q = case lookupFM fm q of
+ Nothing -> go fms q -- look in other pkgs
+ Just pkg -> Just $ drop 2 $ getHSLibraryName $ installedUnitId pkg
+
data LibrarySpec
= DLL String -- -lLib
| DLLPath FilePath -- -Lpath
@@ -459,9 +485,9 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p
ldOptsPaths = [ path | Just (DLLPath path) <- ldInput ]
dlls = map mkSOName (extras ++ ldOptsLibs)
#if defined(CYGWIN) || defined(__MINGW32__)
- libdirs = fix_topdir (libraryDirs pkg) ++ ldOptsPaths
+ libdirs = fix_topdir (libraryDirs pkg) ++ ldOptsPaths ++ fix_topdir (libraryDynDirs pkg)
#else
- libdirs = libraryDirs pkg ++ ldOptsPaths
+ libdirs = libraryDirs pkg ++ ldOptsPaths ++ libraryDynDirs pkg
#endif
-- If we're loading dynamic libs we need the cbits to appear before the
-- real packages.
@@ -531,9 +557,15 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p
-- Solution: look for dynamic libraries only if using -dynamic; otherwise, use static
-- and add any other dynamic libraries found.
dl <- findHSdlib dirs lib
- let rdl = case dl of
- Just file -> Right $ Dynamic file
- Nothing -> Left lib
+ rdl <- case dl of
+ Just file -> return $ Right $ Dynamic file
+ Nothing -> do
+ -- TODO Generate this suffix automatically. It's absurd we have to use the preprocessor.
+ dynamicSuffix <- findHSdlib dirs (lib ++ "-ghc" ++ (reverse $ takeWhile (/= '-') $ reverse GHC_LIB_PATH))
+ case dynamicSuffix of
+ Just file -> return $ Right $ Dynamic file
+ Nothing -> return $ Left lib
+
if dynonly then return rdl else do
rsl <- findHSslib dirs lib
return $ case rsl of
diff --git a/src/System/Plugins/Load.hs b/src/System/Plugins/Load.hs
index 32a5a08..a824efc 100644
--- a/src/System/Plugins/Load.hs
+++ b/src/System/Plugins/Load.hs
@@ -474,10 +474,17 @@ loadFunction__ :: Maybe String
-> String
-> IO (Maybe a)
loadFunction__ pkg m valsym
- = do let symbol = prefixUnderscore++(maybe "" (\p -> zEncodeString p++"_") pkg)
- ++zEncodeString m++"_"++(zEncodeString valsym)++"_closure"
+ = do let encode = zEncodeString
+ p <- case pkg of
+ Just p -> do
+ prefix <- pkgManglingPrefix p
+ return $ encode (maybe p id prefix)++"_"
+ Nothing -> return ""
+ let symbol = prefixUnderscore++p++encode m++"_"++(encode valsym)++"_closure"
+
#if DEBUG
putStrLn $ "Looking for <<"++symbol++">>"
+ initLinker
#endif
ptr@(Ptr addr) <- withCString symbol c_lookupSymbol
if (ptr == nullPtr)
@@ -596,10 +603,15 @@ unloadObj (Module { path = p, kind = k, key = ky }) = case k of
-- Load a .so type object file.
--
loadShared :: FilePath -> IO Module
-loadShared str = do
+loadShared str' = do
#if DEBUG
- putStrLn $ " shared: " ++ str
+ putStrLn $ " shared: " ++ str'
#endif
+ let str = case str' of
+ -- TODO My GHC segfaults because libm.so is a linker script
+ "libm.so" -> "/lib/x86_64-linux-gnu/libm.so.6"
+ "libpthread.so" -> "/lib/x86_64-linux-gnu/libpthread.so.0"
+ x -> x
maybe_errmsg <- withCString str $ \dll -> c_addDLL dll
if maybe_errmsg == nullPtr
then return (Module str (mkModid str) Shared undefined (Package (mkModid str)))
@@ -618,6 +630,7 @@ loadShared str = do
--
loadPackage :: String -> IO ()
loadPackage p = do
+ initLinker
#if DEBUG
putStr (' ':p) >> hFlush stdout
#endif