--- hmake-3.08.orig/src/hmake/Makefile +++ hmake-3.08/src/hmake/Makefile @@ -9,9 +9,9 @@ SRCS = QSort.hs Unlit.hs Utils.hs Tsort.hs FileName.hs SymTab.hs \ Output.hs Order.hs ListUtil.hs Getmodtime.hs \ MkProg.hs IsPrefixOf.hs Compiler.hs PreProcessor.hs \ - PackageConfig.hs Config.hs RunAndReadStdout.hs + PackageConfig.hs RunAndReadStdout.hs CPPSRCS = Argv.hs Graph.hs GetDep.hs ParseLib.hs Compat.hs Imports.hs \ - Platform.hs + Platform.hs Config.hs CFGSRCS = RunAndReadStdout.hs Config.hs Compiler.hs Platform.hs OBJS = $(patsubst %.hs, $(OBJDIR)/%.$O, $(SRCS)) @@ -25,12 +25,13 @@ hmake hmake.1 HC = $(LOCAL)nhc98 # can be overridden by caller HC=... +BUILDCOMP = nhc # Override if you override the above. Should be ghc|nhc|hbc|gcc HFLAGS = $(shell echo $(BUILDOPTS)) #-$(CFG) -ifeq "nhc98" "$(findstring nhc98, ${HC})" +ifeq "nhc" "${BUILDCOMP}" HEAP = -H4M endif -ifeq "ghc" "$(findstring ghc, ${HC})" +ifeq "ghc" "${BUILDCOMP}" HFLAGS += $(shell ${LOCAL}fixghc ${GHCSYM} -package lang) endif @@ -102,7 +103,8 @@ ${OBJDIR}/FileName.$O ${OBJDIR}/Unlit.$O \ ${OBJDIR}/Argv.$O ${OBJDIR}/PreProcessor.$O \ ${OBJDIR}/Config.$O -${OBJDIR}/Config.$O: ${OBJDIR}/Compiler.$O ${OBJDIR}/Platform.$O +${OBJDIR}/Config.$O: ${OBJDIR}/Compiler.$O ${OBJDIR}/Platform.$O \ + ${OBJDIR}/RunAndReadStdout.$O ${OBJDIR}/Compiler.$O: ${OBJDIR}/ListUtil.$O: ${OBJDIR}/Argv.$O: ${OBJDIR}/ListUtil.$O ${OBJDIR}/Compiler.$O \ @@ -117,7 +119,7 @@ ${OBJDIR}/Platform.$O ${OBJDIR}/Older.$O: -ifeq "hbc" "$(HC)" +ifeq "hbc" "${BUILDCOMP}" ${OBJDIR}/Argv.$O: ${OBJDIR}/IsPrefixOf.$O endif --- hmake-3.08.orig/src/hmake/Argv.hs +++ hmake-3.08/src/hmake/Argv.hs @@ -53,21 +53,10 @@ , compiler :: CompilerConfig -- chosen compiler } -decode :: [String] -> DecodedArgs -decode progArgs = +decode :: [String] -> IO DecodedArgs +decode progArgs = do let d = Decoded { modules = (map wrapGoal . filter (not . isflag)) progArgs - , pathSrc = (map tail . filter (\v -> head v == 'I')) flags ++ - (map tail . filter (\v -> head v == 'i')) flags ++ - if isopt "keepPrelude" then pathPrel d else [] - , pathPrel = (map tail . filter (\v -> head v == 'P')) flags ++ - includePaths (compiler d) ++ - packageDirs (compiler d) - (map (drop 8) $ - filter ("package="`isPrefixOf`) flags) - , zdefs = (map tail . filter (\v -> head v == 'Z')) flags ++ - cppSymbols (compiler d) ++ - (if isHaskell98 (compiler d) then haskell98SymsForCpp else []) , defs = (map tail . filter (\v -> head v == 'D')) flags , ignoreHi = (map tail . filter (\v -> head v == 'N')) flags , dflag = False -- isopt "od" @@ -94,12 +83,27 @@ { globalConfig = readConfig (tail x) , localConfig = Nothing } _ -> error "hmake: only one -fconfigfile option allowed\n" - , compiler = case filter (\v-> "hc=" `isPrefixOf` v) flags of - [] -> usualCompiler (config d) - [x] -> matchCompiler (drop 3 x) (config d) - _ -> error "hmake: only one -hc=compiler option allowed\n" + , compiler = error "compiler not yet known" + } + cc <- unDyn $ case filter (\v-> "hc=" `isPrefixOf` v) flags of + [] -> usualCompiler (config d) + [x] -> matchCompiler (drop 3 x) (config d) + _ -> error "hmake: only one -hc=compiler option allowed\n" + let d' = d { + pathSrc = (map tail . filter (\v -> head v == 'I')) flags ++ + (map tail . filter (\v -> head v == 'i')) flags ++ + if isopt "keepPrelude" then pathPrel d' else [] + , pathPrel = (map tail . filter (\v -> head v == 'P')) flags ++ + includePaths (compiler d') ++ + packageDirs (compiler d') + (map (drop 8) $ + filter ("package="`isPrefixOf`) flags) + , zdefs = (map tail . filter (\v -> head v == 'Z')) flags ++ + cppSymbols (compiler d') ++ + (if isHaskell98 (compiler d') then haskell98SymsForCpp else []) + , compiler = cc } - in d + return d' where flags = (map tail . filter isflag) progArgs --- hmake-3.08.orig/src/hmake/Config.hs +++ hmake-3.08/src/hmake/Config.hs @@ -1,11 +1,21 @@ module Config where import Compiler -import System (getEnv) -import Directory (doesFileExist,doesDirectoryExist,createDirectory) +import System (ExitCode(..),getEnv,system,exitWith) +import Directory (doesFileExist,doesDirectoryExist,createDirectory + ,getPermissions,Permissions(..)) import Monad (when) -import List (nub) -import Platform (unsafePerformIO) +import List (nub,isPrefixOf) +import Platform (unsafePerformIO,exe,escape,windows) +import RunAndReadStdout (runAndReadStdout, basename, dirname) +import Char (isDigit) +import Monad (foldM) +import IO (stderr) +#ifdef __HBC__ +import IOMisc (hPutStrLn) +#else +import IO (hPutStrLn) +#endif ---- data PersonalConfig = PersonalConfig @@ -43,12 +53,19 @@ , extraCompilerFlags :: [String] , isHaskell98 :: Bool } + | DynCompiler { compilerPath :: FilePath } deriving (Read) +unDyn :: CompilerConfig -> IO CompilerConfig +unDyn (DynCompiler path) = configure path +unDyn cc = return cc + instance Eq CompilerConfig where -- equality on filename only cc1 == cc2 = compilerPath cc1 == compilerPath cc2 instance Show CompilerConfig where + showsPrec p (DynCompiler hc) = + showString "DynCompiler { compilerPath = " . shows hc . showString " }\n" showsPrec p cc = showString "CompilerConfig" . showString "\n { compilerStyle = " . shows (compilerStyle cc) @@ -176,3 +193,186 @@ usualCompiler :: HmakeConfig -> CompilerConfig usualCompiler config = matchCompiler (defaultCompiler config) config -} + +configure :: String -> IO CompilerConfig +configure comp_path = do comp_type <- hcStyle comp_path + configure' comp_type comp_path + +-- configure for each style of compiler +configure' :: HC -> String -> IO CompilerConfig +configure' Ghc ghcpath = do + ghcversion <- runAndReadStdout (escape ghcpath ++ " --version 2>&1 | " + ++"sed 's/^.*version[ ]*\\([0-9.]*\\).*/\\1/'" + ) + let ghcsym = (read (take 3 (filter isDigit ghcversion ++ "0"))) :: Int + config = CompilerConfig + { compilerStyle = Ghc + , compilerPath = ghcpath + , compilerVersion = ghcversion + , includePaths = undefined + , cppSymbols = ["__GLASGOW_HASKELL__="++show ghcsym] + , extraCompilerFlags = [] + , isHaskell98 = ghcsym>=400 } + if windows && ghcsym<500 + then do + fullpath <- which exe ghcpath + let incdir1 = dirname (dirname fullpath)++"/imports" + ok <- doesDirectoryExist incdir1 + if ok + then return config{ includePaths = ghcDirs ghcsym incdir1 } + else do ioError (userError ("Can't find ghc includes at\n "++incdir1)) + else if ghcsym<500 + then do + fullpath <- which exe ghcpath + dir <- runAndReadStdout ("grep '^\\$libdir=' "++fullpath++" | head -1 | " + ++ "sed 's/^\\$libdir=[^/]*\\(.*\\).;/\\1/'") + let incdir1 = dir++"/imports" + ok <- doesDirectoryExist incdir1 + if ok + then return config{ includePaths = ghcDirs ghcsym incdir1 } + else do + let incdir2 = dir++"/lib/imports" + ok <- doesDirectoryExist incdir2 + if ok + then return config{ includePaths = ghcDirs ghcsym incdir2 } + else do ioError (userError ("Can't find ghc includes at\n " + ++incdir1++"\n "++incdir2)) + else do -- 5.00 and above + pkgcfg <- runAndReadStdout (escape ghcpath++" -v 2>&1 | head -2 " + ++"| tail -1 | cut -c28- | head -1") + let libdir = dirname (escape pkgcfg) + incdir1 = libdir++"/imports" + ok <- doesDirectoryExist incdir1 + if ok + then do + fullpath <- fmap escape (which exe ghcpath) + ghcpkg0 <- runAndReadStdout $ "echo `" ++ ghcpath ++ " --print-libdir`/bin/ghc-pkg" + let ghcpkg1 = dirname fullpath++"/ghc-pkg-"++ghcversion + ghcpkg2 = dirname fullpath++"/ghc-pkg" + ok0 <- doesFileExist ghcpkg0 + ok1 <- doesFileExist ghcpkg1 + ok2 <- doesFileExist ghcpkg2 + let ghcpkg = if ok0 then ghcpkg0 + else if ok1 then ghcpkg1 + else if ok2 then ghcpkg2 + else error $ "Can't find ghc-pkg for " ++ ghcpath + -- pkgs <- runAndReadStdout (ghcpkg++" --list-packages") + pkgs <- runAndReadStdout (ghcpkg++" -l") + let pkgsOK = filter (`elem`["std","base","haskell98"]) (deComma pkgs) + idirs <- mapM (\p-> runAndReadStdout + (ghcpkg++" --show-package="++p + ++" --field=import_dirs")) + pkgsOK + return config{ includePaths = pkgDirs libdir (nub idirs) } + else do ioError (userError ("Can't find ghc includes at "++incdir1)) + where + ghcDirs n root | n < 400 = [root] + | n < 406 = map ((root++"/")++) ["std","exts","misc" + ,"posix"] + | otherwise = map ((root++"/")++) ["std","lang","data","net" + ,"posix","num","text" + ,"util","hssource" + ,"win32","concurrent"] + pkgDirs libdir dirs = + map (\dir-> if "$libdir" `isPrefixOf` dir + then libdir++drop 7 dir + else dir) + (concatMap words dirs) + deComma pkgs = map (\p-> if last p==',' then init p else p) (words pkgs) + +configure' Nhc98 nhcpath = do + fullpath <- which id nhcpath + nhcversion <- runAndReadStdout (escape nhcpath + ++" --version 2>&1 | cut -d' ' -f2 | head -1") + dir <- runAndReadStdout ("grep '^NHC98INCDIR' "++escape fullpath + ++ "| cut -c27- | cut -d'}' -f1 | head -1") + return CompilerConfig { compilerStyle = Nhc98 + , compilerPath = nhcpath + , compilerVersion = nhcversion + , includePaths = [dir] + , cppSymbols = ["__NHC__="++ + take 3 (filter isDigit nhcversion)] + , extraCompilerFlags = [] + , isHaskell98 = True + } +configure' Hbc hbcpath = do + let field n = "| cut -d' ' -f"++show n++" | head -1" + wibble <- runAndReadStdout (hbcpath ++ " -v 2>&1 " ++ field 2) + hbcversion <- + case wibble of + "version" -> runAndReadStdout (hbcpath ++ " -v 2>&1 " ++ field 3) + _ -> runAndReadStdout (hbcpath ++ " -v 2>&1 " ++ field 4) + dir <- catch (getEnv "HBCDIR") + (\e-> catch (getEnv "LMLDIR") + (\e-> return "/usr/local/lib/lmlc")) + return CompilerConfig { compilerStyle = Hbc + , compilerPath = hbcpath + , compilerVersion = hbcversion + , includePaths = map ((dir++"/")++) + ["hlib1.3","hbc_library1.3"] + , cppSymbols = ["__HBC__"] + , extraCompilerFlags = [] + , isHaskell98 = ((hbcversion!!7) >= '5') + } +configure' (Unknown hc) hcpath = do + hPutStrLn stderr ("hmake-config: the compiler\n '"++hcpath + ++"'\n does not look like a Haskell compiler.") + exitWith (ExitFailure 4) + return undefined -- never reached + +-- Work out which basic compiler. +hcStyle :: String -> IO HC +hcStyle path = do case toCompiler (basename path) of + -- Ugly hack as we can't read stdout + Unknown hc -> do rc <- system $ "case `" ++ path ++ " 2>&1 | head -1 | cut -c1-3` in ghc) exit 3;; nhc) exit 4;; hbc) exit 5;; gcc) exit 6;; *) exit 7;; esac" + return $ case rc of + ExitFailure 3 -> Ghc + ExitFailure 4 -> Nhc98 + ExitFailure 5 -> Hbc + ExitFailure 6 -> Nhc98 + _ -> Unknown hc + s -> return s + where + toCompiler :: String -> HC + toCompiler hc | "gcc" `isPrefixOf` hc = Nhc98 + | "nhc" `isPrefixOf` hc = Nhc98 + | "ghc" `isPrefixOf` hc = Ghc + | "hbc" `isPrefixOf` hc = Hbc + | otherwise = Unknown hc + +-- Emulate the shell `which` command. +which :: (String->String) -> String -> IO String +which exe cmd = + let dir = dirname cmd + in case dir of + "" -> do -- search the shell environment PATH variable for candidates + val <- getEnv "PATH" + let psep = pathSep val + dirs = splitPath psep "" val + search <- foldM (\a dir-> testFile a (dir++'/': exe cmd)) + Nothing dirs + case search of + Just x -> return x + Nothing -> ioError (userError (cmd++" not found")) + _ -> do f <- perms (exe cmd) + case f of + Just x -> return x + Nothing -> ioError (userError (cmd++" is not executable")) + where + splitPath :: Char -> String -> String -> [String] + splitPath sep acc [] = [reverse acc] + splitPath sep acc (c:path) | c==sep = reverse acc : splitPath sep "" path + splitPath sep acc (c:path) = splitPath sep (c:acc) path + + pathSep s = if length (filter (==';') s) >0 then ';' else ':' + + testFile :: Maybe String -> String -> IO (Maybe String) + testFile gotit@(Just _) path = return gotit + testFile Nothing path = do + ok <- doesFileExist path + if ok then perms path else return Nothing + + perms file = do + p <- getPermissions file + return (if executable p then Just file else Nothing) + --- hmake-3.08.orig/src/hmake/MkConfig.hs +++ hmake-3.08/src/hmake/MkConfig.hs @@ -3,13 +3,12 @@ import Compiler (HC(..)) import Config -import Platform (unsafePerformIO,escape,windows,exe) -import RunAndReadStdout (runAndReadStdout, basename, dirname) +import Platform (unsafePerformIO) +import RunAndReadStdout (dirname) import Directory (doesDirectoryExist,doesFileExist,removeFile,getPermissions ,Permissions(..),renameFile,createDirectory) import System (exitWith,ExitCode(..),getArgs,getEnv,getProgName) -import List (intersperse,nub,isPrefixOf,sort) -import Char (isDigit) +import List (intersperse,nub,sort) import Monad (foldM,when) import Maybe (isJust,fromJust) import IO (stderr,isDoesNotExistError) @@ -34,20 +33,23 @@ Just f -> putStrLn ("Personal config file is:\n "++f) Nothing -> return ()) putStrLn "Known compilers:" + known <- mapM unDyn $ knownComps config mapM_ putStrLn ((reverse . sort . map (\c-> " "++compilerPath c ++"\t("++compilerVersion c++")")) - (knownComps config)) + known) putStrLn "Default compiler:" putStrLn (" "++defaultComp config) [hc] -> do -- no command, assume 'add' - cc <- configure (hcStyle hc) hc + cc <- configure hc config' <- add cc config writeBack gfile lfile config' - ["add",hc] -> do cc <- configure (hcStyle hc) hc + ["add",hc] -> do cc <- configure hc config' <- add cc config writeBack gfile lfile config' + ["add-dyn",hc] -> do config' <- add (DynCompiler hc) config + writeBack gfile lfile config' ["delete",hc] -> do config' <- delete config gfile hc writeBack gfile lfile config' ["default",hc] -> do config' <- mkDefault config hc @@ -55,7 +57,7 @@ ["list",hc] -> do let cc = matchCompiler hc config putStrLn (show cc) _ -> do hPutStrLn stderr ("Usage: hmake-config [configfile] list\n" - ++" hmake-config [configfile] [add|delete|default] hc\n" + ++" hmake-config [configfile] [add|add-dyn|delete|default] hc\n" ++" -- hc is name/path of a Haskell compiler") exitWith (ExitFailure 1) ---- @@ -67,7 +69,7 @@ case args of [] -> do let (g,_) = defaultConfigLocation False hPutStrLn stderr ("Usage: hmake-config [configfile] list\n" - ++" hmake-config [configfile] [add|delete|default] hc\n" + ++" hmake-config [configfile] [add-dyn|delete|default] hc\n" ++" -- hc is name/path of a Haskell compiler\n" ++" default configfile is:\n "++g) exitWith (ExitFailure 1) @@ -196,165 +198,3 @@ global { knownCompilers = nub (hc: knownCompilers global)}} --- configure for each style of compiler -configure :: HC -> String -> IO CompilerConfig -configure Ghc ghcpath = do - ghcversion <- runAndReadStdout (escape ghcpath ++ " --version 2>&1 | " - ++"sed 's/^.*version[ ]*\\([0-9.]*\\).*/\\1/'" - ) - let ghcsym = (read (take 3 (filter isDigit ghcversion ++ "0"))) :: Int - config = CompilerConfig - { compilerStyle = Ghc - , compilerPath = ghcpath - , compilerVersion = ghcversion - , includePaths = undefined - , cppSymbols = ["__GLASGOW_HASKELL__="++show ghcsym] - , extraCompilerFlags = [] - , isHaskell98 = ghcsym>=400 } - if windows && ghcsym<500 - then do - fullpath <- which exe ghcpath - let incdir1 = dirname (dirname fullpath)++"/imports" - ok <- doesDirectoryExist incdir1 - if ok - then return config{ includePaths = ghcDirs ghcsym incdir1 } - else do ioError (userError ("Can't find ghc includes at\n "++incdir1)) - else if ghcsym<500 - then do - fullpath <- which exe ghcpath - dir <- runAndReadStdout ("grep '^\\$libdir=' "++fullpath++" | head -1 | " - ++ "sed 's/^\\$libdir=[^/]*\\(.*\\).;/\\1/'") - let incdir1 = dir++"/imports" - ok <- doesDirectoryExist incdir1 - if ok - then return config{ includePaths = ghcDirs ghcsym incdir1 } - else do - let incdir2 = dir++"/lib/imports" - ok <- doesDirectoryExist incdir2 - if ok - then return config{ includePaths = ghcDirs ghcsym incdir2 } - else do ioError (userError ("Can't find ghc includes at\n " - ++incdir1++"\n "++incdir2)) - else do -- 5.00 and above - pkgcfg <- runAndReadStdout (escape ghcpath++" -v 2>&1 | head -2 " - ++"| tail -1 | cut -c28- | head -1") - let libdir = dirname (escape pkgcfg) - incdir1 = libdir++"/imports" - ok <- doesDirectoryExist incdir1 - if ok - then do - fullpath <- fmap escape (which exe ghcpath) - let ghcpkg0 = dirname fullpath++"/ghc-pkg-"++ghcversion - ok <- doesFileExist ghcpkg0 - let ghcpkg = if ok then ghcpkg0 else dirname fullpath++"/ghc-pkg" - -- pkgs <- runAndReadStdout (ghcpkg++" --list-packages") - pkgs <- runAndReadStdout (ghcpkg++" -l") - let pkgsOK = filter (`elem`["std","base","haskell98"]) (deComma pkgs) - idirs <- mapM (\p-> runAndReadStdout - (ghcpkg++" --show-package="++p - ++" --field=import_dirs")) - pkgsOK - return config{ includePaths = pkgDirs libdir (nub idirs) } - else do ioError (userError ("Can't find ghc includes at "++incdir1)) - where - ghcDirs n root | n < 400 = [root] - | n < 406 = map ((root++"/")++) ["std","exts","misc" - ,"posix"] - | otherwise = map ((root++"/")++) ["std","lang","data","net" - ,"posix","num","text" - ,"util","hssource" - ,"win32","concurrent"] - pkgDirs libdir dirs = - map (\dir-> if "$libdir" `isPrefixOf` dir - then libdir++drop 7 dir - else dir) - (concatMap words dirs) - deComma pkgs = map (\p-> if last p==',' then init p else p) (words pkgs) - -configure Nhc98 nhcpath = do - fullpath <- which id nhcpath - nhcversion <- runAndReadStdout (escape nhcpath - ++" --version 2>&1 | cut -d' ' -f2 | head -1") - dir <- runAndReadStdout ("grep '^NHC98INCDIR' "++escape fullpath - ++ "| cut -c27- | cut -d'}' -f1 | head -1") - return CompilerConfig { compilerStyle = Nhc98 - , compilerPath = nhcpath - , compilerVersion = nhcversion - , includePaths = [dir] - , cppSymbols = ["__NHC__="++ - take 3 (filter isDigit nhcversion)] - , extraCompilerFlags = [] - , isHaskell98 = True - } -configure Hbc hbcpath = do - let field n = "| cut -d' ' -f"++show n++" | head -1" - wibble <- runAndReadStdout (hbcpath ++ " -v 2>&1 " ++ field 2) - hbcversion <- - case wibble of - "version" -> runAndReadStdout (hbcpath ++ " -v 2>&1 " ++ field 3) - _ -> runAndReadStdout (hbcpath ++ " -v 2>&1 " ++ field 4) - dir <- catch (getEnv "HBCDIR") - (\e-> catch (getEnv "LMLDIR") - (\e-> return "/usr/local/lib/lmlc")) - return CompilerConfig { compilerStyle = Hbc - , compilerPath = hbcpath - , compilerVersion = hbcversion - , includePaths = map ((dir++"/")++) - ["hlib1.3","hbc_library1.3"] - , cppSymbols = ["__HBC__"] - , extraCompilerFlags = [] - , isHaskell98 = ((hbcversion!!7) >= '5') - } -configure (Unknown hc) hcpath = do - hPutStrLn stderr ("hmake-config: the compiler\n '"++hcpath - ++"'\n does not look like a Haskell compiler.") - exitWith (ExitFailure 4) - return undefined -- never reached - --- Work out which basic compiler. -hcStyle :: String -> HC -hcStyle path = toCompiler (basename path) - where - toCompiler :: String -> HC - toCompiler hc | "gcc" `isPrefixOf` hc = Nhc98 - | "nhc" `isPrefixOf` hc = Nhc98 - | "ghc" `isPrefixOf` hc = Ghc - | "hbc" `isPrefixOf` hc = Hbc - | otherwise = Unknown hc - --- Emulate the shell `which` command. -which :: (String->String) -> String -> IO String -which exe cmd = - let dir = dirname cmd - in case dir of - "" -> do -- search the shell environment PATH variable for candidates - val <- getEnv "PATH" - let psep = pathSep val - dirs = splitPath psep "" val - search <- foldM (\a dir-> testFile a (dir++'/': exe cmd)) - Nothing dirs - case search of - Just x -> return x - Nothing -> ioError (userError (cmd++" not found")) - _ -> do f <- perms (exe cmd) - case f of - Just x -> return x - Nothing -> ioError (userError (cmd++" is not executable")) - where - splitPath :: Char -> String -> String -> [String] - splitPath sep acc [] = [reverse acc] - splitPath sep acc (c:path) | c==sep = reverse acc : splitPath sep "" path - splitPath sep acc (c:path) = splitPath sep (c:acc) path - - pathSep s = if length (filter (==';') s) >0 then ';' else ':' - - testFile :: Maybe String -> String -> IO (Maybe String) - testFile gotit@(Just _) path = return gotit - testFile Nothing path = do - ok <- doesFileExist path - if ok then perms path else return Nothing - - perms file = do - p <- getPermissions file - return (if executable p then Just file else Nothing) - --- hmake-3.08.orig/src/hmake/MkProg.hs +++ hmake-3.08/src/hmake/MkProg.hs @@ -10,9 +10,9 @@ main = - getArgs >>= \ args -> + getArgs >>= \ args -> + decode args >>= \ d -> let - d = decode args echo = not (quiet d) order g = (scctsort . map (\(f,(tps,i)) -> (f,i))) g --- hmake-3.08.orig/src/hmake/PackageConfig.hs +++ hmake-3.08/src/hmake/PackageConfig.hs @@ -11,6 +11,7 @@ import List (partition,intersperse,isPrefixOf) import Char (isDigit) import Monad (when,foldM) +import System (system) -- Work out the import directories for a bunch of packages. packageDirs :: CompilerConfig -> [String] -> [FilePath] @@ -31,7 +32,8 @@ ok <- doesDirectoryExist incdir1 if ok then do - let ghcpkg = matching ghc (ghcPkg ghc (compilerVersion config)) + ghcpkg <- runAndReadStdout $ "echo `" ++ ghc ++ " --print-libdir`/bin/ghc-pkg" + -- let ghcpkg = matching ghc (ghcPkg ghc (compilerVersion config)) -- pkgs <- runAndReadStdout (ghcpkg++" --list-packages") pkgs <- runAndReadStdout (ghcpkg++" -l") let (ok,bad) = partition (`elem` deComma pkgs) packages --- hmake-3.08.orig/src/interpreter/Makefile +++ hmake-3.08/src/interpreter/Makefile @@ -9,16 +9,16 @@ CHFILES = $(patsubst %.hs, ../hmake/%.$C, $(OTHERS)) -ifeq "$(findstring ghc, ${HC})" "ghc" +ifeq "${BUILDCOMP}" "ghc" HFLAGS = $(shell $(LOCAL)fixghc $(GHCSYM) \ -package lang -package util -package base $(READLINE) ) export HFLAGS endif -ifeq "$(findstring hbc, ${HC})" "hbc" +ifeq "${BUILDCOMP}" "hbc" HFLAGS = export HFLAGS endif -ifeq "$(findstring nhc98, ${HC})" "nhc98" +ifeq "${BUILDCOMP}" "nhc" HFLAGS = -package base export HFLAGS endif --- hmake-3.08.orig/script/hmake.inst +++ hmake-3.08/script/hmake.inst @@ -235,22 +235,32 @@ OD= # Define the characteristics of each known compiler. compilerstyle () { - case `basename $1` in + COMPILERSTYLE=`basename $1 | cut -c1-3` + if [ $COMPILERSTYLE != hbc ] \ + && [ $COMPILERSTYLE != ghc ] \ + && [ $COMPILERSTYLE != nhc ] + then + COMPILERSTYLE=`$1 2>&1 | head -1 | cut -c1-3` + fi + + case "$COMPILERSTYLE" in hbc) RTSOPTIONSTYLE=minus CTSOPTIONSTYLE=none IMPORTOPTIONSTYLE=minusi export LMLDIR HBCDIR ;; - nhc98) RTSOPTIONSTYLE=rts + nhc) RTSOPTIONSTYLE=rts CTSOPTIONSTYLE=cts IMPORTOPTIONSTYLE=minusP OD="-od" ;; - ghc*) RTSOPTIONSTYLE=none + ghc) RTSOPTIONSTYLE=none CTSOPTIONSTYLE=none IMPORTOPTIONSTYLE=minusi ;; - *) ;; + *) echo "No compiler style found" >&2 + exit 1 + ;; esac } --- hmake-3.08.orig/Makefile +++ hmake-3.08/Makefile @@ -3,7 +3,10 @@ # This included config is only for the BUILDWITH variable. include targets/$(MACHINE)/config.cache -BUILDCOMP = $(shell echo ${BUILDWITH} | cut -c1-3) +BUILDCOMPS := ghc nhc hbc gcc +BUILDCOMP1 := $(shell echo $(notdir ${BUILDWITH}) | cut -c1-3) +BUILDCOMP2 := $(if $(filter $(BUILDCOMP1), $(BUILDCOMPS)),$(BUILDCOMP1),$(shell ${BUILDWITH} 2>&1 | head -1 | cut -c1-3)) +BUILDCOMP := $(if $(filter $(BUILDCOMP2), $(BUILDCOMPS)),$(BUILDCOMP2),$(error Can't find compiler type)) HMAKE = src/hmake/Makefile* src/hmake/*.hs src/hmake/README* \ src/hmake/HISTORY src/hmake/Summary* \ @@ -39,31 +42,31 @@ $(TARGDIR)/$(MACHINE)/hmake-nhc: $(HMAKE) - cd src/hmake; $(MAKE) HC=$(BUILDWITH) install config + cd src/hmake; $(MAKE) HC=$(BUILDWITH) BUILDCOMP=$(BUILDCOMP) install config touch $(TARGDIR)/$(MACHINE)/hmake-nhc $(TARGDIR)/$(MACHINE)/hmake-hbc: $(HMAKE) - cd src/hmake; $(MAKE) HC=$(BUILDWITH) install config + cd src/hmake; $(MAKE) HC=$(BUILDWITH) BUILDCOMP=$(BUILDCOMP) install config touch $(TARGDIR)/$(MACHINE)/hmake-hbc $(TARGDIR)/$(MACHINE)/hmake-ghc: $(HMAKE) - cd src/hmake; $(MAKE) HC=$(BUILDWITH) install config + cd src/hmake; $(MAKE) HC=$(BUILDWITH) BUILDCOMP=$(BUILDCOMP) install config touch $(TARGDIR)/$(MACHINE)/hmake-ghc $(TARGDIR)/$(MACHINE)/chmake: $(HMAKEC) @echo "WARNING: hmake might not build correctly from C sources!" - cd src/hmake; $(MAKE) HC=nhc98 fromC config + cd src/hmake; $(MAKE) HC=nhc98 BUILDCOMP=nhc fromC config touch $(TARGDIR)/$(MACHINE)/chmake $(TARGDIR)/$(MACHINE)/hi-nhc: $(HMAKE) hmake-nhc - cd src/interpreter; $(MAKE) HC=$(BUILDWITH) install + cd src/interpreter; $(MAKE) HC=$(BUILDWITH) BUILDCOMP=$(BUILDCOMP) install touch $(TARGDIR)/$(MACHINE)/hi-nhc98 $(TARGDIR)/$(MACHINE)/hi-hbc: $(HMAKE) hmake-hbc - cd src/interpreter; $(MAKE) HC=$(BUILDWITH) install + cd src/interpreter; $(MAKE) HC=$(BUILDWITH) BUILDCOMP=$(BUILDCOMP) install touch $(TARGDIR)/$(MACHINE)/hi-hbc $(TARGDIR)/$(MACHINE)/hi-ghc: $(HMAKE) hmake-ghc - cd src/interpreter; $(MAKE) HC=$(BUILDWITH) install + cd src/interpreter; $(MAKE) HC=$(BUILDWITH) BUILDCOMP=$(BUILDCOMP) install touch $(TARGDIR)/$(MACHINE)/hi-ghc $(TARGDIR)/$(MACHINE)/chi: $(HMAKEC) chmake @echo "WARNING: hi might not build correctly from C sources!" - cd src/interpreter; $(MAKE) HC=nhc98 fromC + cd src/interpreter; $(MAKE) HC=nhc98 BUILDCOMP=nhc fromC touch $(TARGDIR)/$(MACHINE)/chi @@ -72,6 +75,7 @@ clean: cd src/hmake; $(MAKE) clean cd src/interpreter; $(MAKE) clean + rm -f script/hmake script/hi script/hmake-config realclean: clean cd $(TARGDIR)/$(MACHINE); rm -f $(TARGETS) @@ -79,4 +83,3 @@ rm -f $(LIBDIR)/$(MACHINE)/* rm -f $(TARGDIR)/$(MACHINE)/config.cache rm -f $(LIBDIR)/$(MACHINE)/hmakerc - rm -f script/hmake script/hi script/hmake-config