Merge pull request #9 from galenhuntington/master

Try to get this package working again.

plugins.cabal

@@ -59,6 +59,7 @@ library
                           filepath,
                           random,
                           process,
+                          split,
                           ghc >= 6.10,
                           ghc-prim
 

src/System/Plugins/Consts.hs

@@ -20,7 +20,7 @@
 
 module System.Plugins.Consts where
 
-#include "../../../config.h"
+#include "config.h"
 
 
 #if __GLASGOW_HASKELL__ >= 604

src/System/Plugins/Env.hs

@@ -40,17 +40,19 @@ module System.Plugins.Env (
         lookupMerged,
         addMerge,
         addPkgConf,
+        defaultPkgConf,
         union,
         addStaticPkg,
         isStaticPkg,
         rmStaticPkg,
         grabDefaultPkgConf,
         readPackageConf,
-        lookupPkg
+        lookupPkg,
+        pkgManglingPrefix
 
    ) where
 
-#include "../../../config.h"
+#include "config.h"
 
 import System.Plugins.LoadTypes (Module)
 import System.Plugins.Consts           ( sysPkgSuffix )
@@ -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 )
@@ -76,13 +78,14 @@ 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)
                                      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,14 +485,15 @@ 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.
                 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)
@@ -530,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
+            rdl <- case dl of
-                  Just file -> Right $ Dynamic file
+                  Just file -> return $ Right $ Dynamic file
-                  Nothing   -> Left lib
+                  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

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
@@ -473,10 +474,17 @@ loadFunction__ :: Maybe String
               -> String
               -> IO (Maybe a)
 loadFunction__ pkg m valsym
-   = do let symbol = prefixUnderscore++(maybe "" (\p -> zEncodeString p++"_") pkg)
+   = do let encode = zEncodeString
-                     ++zEncodeString m++"_"++(zEncodeString valsym)++"_closure"
+        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)
@@ -595,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)))
@@ -617,6 +630,7 @@ loadShared str = do
 --
 loadPackage :: String -> IO ()
 loadPackage p = do
+        initLinker
 #if DEBUG
         putStr (' ':p) >> hFlush stdout
 #endif

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

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 "."