--- hmake-3.09.orig/src/hmake/Makefile +++ hmake-3.09/src/hmake/Makefile @@ -9,11 +9,11 @@ SRCS = QSort.hs Unlit.hs Utils.hs Tsort.hs FileName.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 CPPHSSRCS = CppIfdef.hs ParseLib.hs Position.hs ReadFirst.hs Tokenise.hs \ SymTab.hs HashDefine.hs CPPSRCS = Argv.hs Graph.hs GetDep.hs Compat.hs Imports.hs \ - Platform.hs + Platform.hs Config.hs CFGSRCS = RunAndReadStdout.hs Config.hs Compiler.hs Platform.hs @@ -29,12 +29,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 ifeq "hbc" "$(findstring hbc, ${HC})" @@ -133,7 +134,8 @@ ${OBJDIR}/PackageConfig.$O: ${OBJDIR}/Config.$O ${OBJDIR}/Compiler.$O \ ${OBJDIR}/Platform.$O ${OBJDIR}/RunAndReadStdout.$O ${OBJDIR}/Platform.$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 \ @@ -142,11 +144,10 @@ ${OBJDIR}/MkProg.$O: ${OBJDIR}/Argv.$O ${OBJDIR}/GetDep.$O \ ${OBJDIR}/Getmodtime.$O ${OBJDIR}/ListUtil.$O \ ${OBJDIR}/Order.$O ${OBJDIR}/Output.$O -${OBJDIR}/MkConfig.$O: ${OBJDIR}/Compiler.$O ${OBJDIR}/Config.$O \ - ${OBJDIR}/Platform.$O +${OBJDIR}/MkConfig.$O: ${OBJDIR}/RunAndReadStdout.$O ${OBJDIR}/Config.$O ${OBJDIR}/Older.$O: -ifeq "hbc" "$(HC)" +ifeq "hbc" "${BUILDCOMP}" ${OBJDIR}/Argv.$O: ${OBJDIR}/IsPrefixOf.$O endif --- hmake-3.09.orig/src/hmake/Argv.hs +++ hmake-3.09/src/hmake/Argv.hs @@ -73,21 +73,13 @@ } -- | Given the list of program arguments, decode them. -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 []) + , pathSrc = error "pathSrc not known yet" + , pathPrel = error "pathPrel not known yet" + , zdefs = error "zdefs not known yet" , defs = (map tail . filter (\v -> head v == 'D')) flags , ignoreHi = (map tail . filter (\v -> head v == 'N')) flags , dflag = False -- isopt "od" @@ -116,12 +108,27 @@ { globalConfig = readConfig (tail x) , localConfig = Nothing } _ -> error "hmake: only one -fconfigfile option allowed\n" - , compiler = case filter (\v-> "hc=" `isPrefixOf` v) flags of + , 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.09.orig/src/hmake/Config.hs +++ hmake-3.09/src/hmake/Config.hs @@ -14,11 +14,21 @@ module Config where import Compiler -import System (getEnv) -import Directory (doesFileExist,doesDirectoryExist,createDirectory) +import System (ExitCode(..),exitWith,getEnv) +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 @@ -56,12 +66,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) @@ -139,7 +156,7 @@ -> (FilePath, Maybe FilePath) defaultConfigLocation create = unsafePerformIO $ do machine <- getEnv "MACHINE" - global <- getEnv "HMAKEDIR" + global <- getEnv "HMAKECONFDIR" let g = global++"/"++machine++"/hmakerc" catch (do home <- getEnv "HOME" let dir = home ++ "/.hmakerc" @@ -196,3 +213,180 @@ 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 = let v = (read (take 3 (filter isDigit ghcversion ++ "0"))) :: Int + in if v <= 600 then v + else let hundreds = (v`div`100)*100 in + hundreds + ((v-hundreds)`div`10) + 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 only static for ghc < 500; for later versions found dynamically + 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 = case toCompiler (basename path) of + Unknown hc -> do x <- runAndReadStdout + $ path ++ " 2>&1 | head -1 | cut -c1-3" + return $ case toCompiler x of + Unknown _ -> Unknown hc + y -> y + 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 <- testFile Nothing (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.09.orig/src/hmake/MkConfig.hs +++ hmake-3.09/src/hmake/MkConfig.hs @@ -12,17 +12,12 @@ module Main where -import Compiler (HC(..)) import Config -import Platform (unsafePerformIO,escape,windows,exe) -import RunAndReadStdout (runAndReadStdout, basename, 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 Monad (foldM,when) -import Maybe (isJust,fromJust) +import RunAndReadStdout (dirname) +import Directory (createDirectory) +import System (exitWith,ExitCode(..),getArgs) +import List (nub,sort) +import Maybe (fromJust) import IO (stderr,isDoesNotExistError) #ifdef __HBC__ import IOMisc (hPutStrLn) @@ -44,30 +39,31 @@ (case lfile of Just f -> putStrLn ("Personal config file is:\n "++f) Nothing -> return ()) + known <- mapM unDyn $ knownComps config putStrLn "Known compilers:" 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 writeBack gfile lfile config' ["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" - ++" -- hc is name/path of a Haskell compiler") + _ -> do hPutStrLn stderr usage exitWith (ExitFailure 1) ---- exitWith ExitSuccess @@ -77,10 +73,8 @@ findConfigFile args = case args of [] -> do let (g,_) = defaultConfigLocation False - hPutStrLn stderr ("Usage: hmake-config [configfile] list\n" - ++" hmake-config [configfile] [add|delete|default] hc\n" - ++" -- hc is name/path of a Haskell compiler\n" - ++" default configfile is:\n "++g) + hPutStrLn stderr (usage + ++ "\n default configfile is:\n "++g) exitWith (ExitFailure 1) (file:"new":_) -> return (file, Nothing, tail args) (file:"list":_) -> return (file, Nothing, tail args) @@ -88,6 +82,9 @@ ("list":_) -> let (g,l) = defaultConfigLocation False in return (g, l, args) _ -> let (g,l) = defaultConfigLocation True in return (g, l, args) + usage = "Usage: hmake-config [configfile] list\n" + ++ " hmake-config [configfile] [add-dyn|delete|default] hc\n" + ++ " -- hc is name/path of a Haskell compiler" {- parseConfigFile :: String -> FilePath -> IO HmakeConfig @@ -98,7 +95,7 @@ hPutStrLn stderr ("hmake-config: Warning: " ++"Config file not found:\n '" ++path++"'") - globalDir <- getEnv "HMAKEDIR" + globalDir <- getEnv "HMAKECONFDIR" let global = globalDir++"/"++machine++"/hmakerc" if path == global then newConfigFile path @@ -207,169 +204,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 = let v = (read (take 3 (filter isDigit ghcversion ++ "0"))) :: Int - in if v <= 600 then v - else let hundreds = (v`div`100)*100 in - hundreds + ((v-hundreds)`div`10) - 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 only static for ghc < 500; for later versions found dynamically - 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 <- testFile Nothing (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.09.orig/src/hmake/MkProg.hs +++ hmake-3.09/src/hmake/MkProg.hs @@ -22,9 +22,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.09.orig/src/hmake/PackageConfig.hs +++ hmake-3.09/src/hmake/PackageConfig.hs @@ -50,7 +50,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" -- pkgs <- runAndReadStdout (ghcpkg++" --list-packages") pkgs <- runAndReadStdout (ghcpkg++" -l") let (ok,bad) = partition (`elem` deComma pkgs) packages --- hmake-3.09.orig/src/interpreter/Makefile +++ hmake-3.09/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.09.orig/src/interpreter/HInteractive.hs +++ hmake-3.09/src/interpreter/HInteractive.hs @@ -36,8 +36,8 @@ return (cfg, Just file, opts) _ -> do cfg <- readPersonalConfig (defaultConfigLocation False) return (cfg,Nothing,options) - let defaultComp = usualCompiler cfg - opts = options ++ extraHiOptions defaultComp + defaultComp <- unDyn $ usualCompiler cfg + let opts = options ++ extraHiOptions defaultComp putStrLn banner putStrLn (replicate 43 ' '++ "... Using compiler "++compilerPath defaultComp++" ...\n") @@ -229,13 +229,14 @@ putStrLn ("Current compiler: "++compilerPath (compiler state) ++" ("++compilerVersion (compiler state)++")") putStr "Compilers available:\n " + kcs <- (mapM unDyn . knownComps . config) state putStrLn ((concat . intersperse ("\n ") . reverse . sort . map (\cc->compilerPath cc++"\t("++compilerVersion cc++")") - . knownComps . config) state) + ) kcs) else if compilerKnown (head target) (config state) then do - let newcomp = matchCompiler (head target) (config state) - newopts = ((options state) + newcomp <- unDyn $ matchCompiler (head target) (config state) + let newopts = ((options state) \\ extraHiOptions (compiler state)) ++ extraHiOptions newcomp makeclean ".o" (modules state) --- hmake-3.09.orig/script/hmake.inst +++ hmake-3.09/script/hmake.inst @@ -8,8 +8,9 @@ SCRIPTDIR=${SCRIPTDIR-ScriptDir} MACHINE=${MACHINE-"`$SCRIPTDIR/harch`"} HMAKEDIR=${HMAKEDIR-ExecutableDir} +HMAKECONFDIR=${HMAKECONFDIR-ConfDir} TMP=${TMP-/tmp} -export HMAKEDIR # to find location of global hmakerc file. +export HMAKEDIR HMAKECONFDIR # to find location of global hmakerc file. MKPROG=${MKPROG-$HMAKEDIR/$MACHINE/MkProg} # the real `hmake' program OLDER=${OLDER-$HMAKEDIR/$MACHINE/Older} # a helper program @@ -233,8 +234,8 @@ if [ -f $HOME/.hmakerc/$MACHINE ] then COMP=`grep defaultCompiler $HOME/.hmakerc/$MACHINE |cut -d'"' -f2` else - if [ -f $HMAKEDIR/$MACHINE/hmakerc ] - then COMP=`grep defaultCompiler $HMAKEDIR/$MACHINE/hmakerc |cut -d'"' -f2` + if [ -f $HMAKECONFDIR/$MACHINE/hmakerc ] + then COMP=`grep defaultCompiler $HMAKECONFDIR/$MACHINE/hmakerc |cut -d'"' -f2` else COMP=$BUILTBY # a desparate fallback position fi fi @@ -245,22 +246,32 @@ OD= # Define the characteristics of each known compiler. compilerstyle () { - case `basename $1` in - hbc) RTSOPTIONSTYLE=minus - CTSOPTIONSTYLE=none - IMPORTOPTIONSTYLE=minusi - export LMLDIR HBCDIR - ;; - nhc98*)RTSOPTIONSTYLE=rts - CTSOPTIONSTYLE=cts - IMPORTOPTIONSTYLE=minusP - OD="-od" - ;; - ghc*) RTSOPTIONSTYLE=none - CTSOPTIONSTYLE=none - IMPORTOPTIONSTYLE=minusi - ;; - *) ;; + 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 + ;; + nhc) RTSOPTIONSTYLE=rts + CTSOPTIONSTYLE=cts + IMPORTOPTIONSTYLE=minusP + OD="-od" + ;; + ghc) RTSOPTIONSTYLE=none + CTSOPTIONSTYLE=none + IMPORTOPTIONSTYLE=minusi + ;; + *) echo "No compiler style found" >&2 + exit 1 + ;; esac } --- hmake-3.09.orig/script/hmake-config.inst +++ hmake-3.09/script/hmake-config.inst @@ -6,8 +6,9 @@ SCRIPTDIR=${SCRIPTDIR-ScriptDir} MACHINE=${MACHINE-"`$SCRIPTDIR/harch`"} HMAKEDIR=${HMAKEDIR-ExecutableDir} +HMAKECONFDIR=${HMAKECONFDIR-ConfDir} TMP=${TMP-/tmp} -export MACHINE HMAKEDIR +export MACHINE HMAKEDIR HMAKECONFDIR if [ ! -d $HMAKEDIR/$MACHINE ] then --- hmake-3.09.orig/script/hi.inst +++ hmake-3.09/script/hi.inst @@ -4,9 +4,10 @@ # (also ensures that hi's config is identical to hmake) SCRIPTDIR=${SCRIPTDIR-ScriptDir} HMAKEDIR=${HMAKEDIR-ExecutableDir} +HMAKECONFDIR=${HMAKECONFDIR-ConfDir} MACHINE=${MACHINE-"`$SCRIPTDIR/harch`"} INSTALLVER="InstallVer" -export MACHINE INSTALLVER HMAKEDIR SCRIPTDIR +export MACHINE INSTALLVER HMAKEDIR HMAKECONFDIR SCRIPTDIR if [ ! -d $HMAKEDIR/$MACHINE ] then --- hmake-3.09.orig/script/confhc +++ hmake-3.09/script/confhc @@ -171,6 +171,8 @@ echo " Now I'm creating targets/$MACHINE/hmake3.config for your installation." INVOKE="$PWD/script/hmake-config $CONFIGPATH" { echo "$INVOKE new" + if false # Don't care about what happens to be installed for the deb + then if [ "$HBCKNOWN" != "" ] then echo "$INVOKE add hbc" echo "$INVOKE add ${HBCKNOWN}" @@ -193,6 +195,9 @@ then echo "$INVOKE add nhc98" echo "$INVOKE add ${NHCKNOWN}" fi; + fi; + echo "$INVOKE add-dyn /usr/bin/haskell-compiler"; + echo "$INVOKE default /usr/bin/haskell-compiler"; } >targets/$MACHINE/hmake3.config echo $BUILDHMAKE >targets/$MACHINE/buildwith --- hmake-3.09.orig/man/harch.1 +++ hmake-3.09/man/harch.1 @@ -0,0 +1,21 @@ +.TH HARCH 1 local +.SH NAME +harch \- determine machine architecture for nhc98 and hmake +.SH SYNOPSIS +.B harch +.SH DESCRIPTION +.I harch +is a simple script to determine a canonical name for +your machine architecture in a format that the +.I nhc98 +compiler and +.I hmake +compilation manager will recognise. + +.SH FILES +.TP 25 +.B /usr/local/bin/harch + +.SH "SEE ALSO" +hmake(1), nhc98(1) + --- hmake-3.09.orig/Makefile +++ hmake-3.09/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* \ @@ -40,31 +43,31 @@ $(TARGDIR)/$(MACHINE)/hmake-nhc: $(HMAKE) - cd src/hmake; $(MAKE) HC=$(BUILDWITH) all config + cd src/hmake; $(MAKE) HC=$(BUILDWITH) BUILDCOMP=$(BUILDCOMP) all config touch $(TARGDIR)/$(MACHINE)/hmake-nhc $(TARGDIR)/$(MACHINE)/hmake-hbc: $(HMAKE) - cd src/hmake; $(MAKE) HC=$(BUILDWITH) all config + cd src/hmake; $(MAKE) HC=$(BUILDWITH) BUILDCOMP=$(BUILDCOMP) all config touch $(TARGDIR)/$(MACHINE)/hmake-hbc $(TARGDIR)/$(MACHINE)/hmake-ghc: $(HMAKE) - cd src/hmake; $(MAKE) HC=$(BUILDWITH) all config + cd src/hmake; $(MAKE) HC=$(BUILDWITH) BUILDCOMP=$(BUILDCOMP) all 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) all + cd src/interpreter; $(MAKE) HC=$(BUILDWITH) BUILDCOMP=$(BUILDCOMP) all touch $(TARGDIR)/$(MACHINE)/hi-nhc98 $(TARGDIR)/$(MACHINE)/hi-hbc: $(HMAKE) hmake-hbc - cd src/interpreter; $(MAKE) HC=$(BUILDWITH) all + cd src/interpreter; $(MAKE) HC=$(BUILDWITH) BUILDCOMP=$(BUILDCOMP) all touch $(TARGDIR)/$(MACHINE)/hi-hbc $(TARGDIR)/$(MACHINE)/hi-ghc: $(HMAKE) hmake-ghc - cd src/interpreter; $(MAKE) HC=$(BUILDWITH) all + cd src/interpreter; $(MAKE) HC=$(BUILDWITH) BUILDCOMP=$(BUILDCOMP) all 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 --- hmake-3.09.orig/configure +++ hmake-3.09/configure @@ -88,6 +88,7 @@ --installdir=*) INSTALLDIR=`echo "$1" | cut -c14-` ;; --bindir=*) BINDIR=`echo "$1" | cut -c10-` ;; --libdir=*) LIBDIR=`echo "$1" | cut -c10-` ;; + --confdir=*) CONFDIR=`echo "$1" | cut -c11-` ;; --mandir=*) MANDIR=`echo "$1" | cut -c10-` ;; --hbcdir=*) HBCDIR=`echo "$1" | cut -c10-` ;; --ghcdir=*) GHCDIR=`echo "$1" | cut -c10-` ;; @@ -111,6 +112,7 @@ echo " --installdir=rootdir | Use rootdir as base for installation [/usr/local]" echo " --bindir=dir Install scripts in dir [rootdir/bin]" echo " --libdir=dir Install libraries in dir [rootdir/lib/hmake]" + echo " --confdir=dir Install libraries in dir [libdir]" echo " --mandir=dir Install man pages in dir [rootdir/man/man1]" echo echo " [+/-]bin Do/don't (re-)install scripts [+bin]" @@ -138,6 +140,7 @@ INSTALLINFO="config: $MACHINE/$BUILDWITH by $USER@`uname -n` on `date`" LIBDIR=${LIBDIR-$INSTALLDIR/lib/hmake} +CONFDIR=${CONFDIR-$LIBDIR} BINDIR=${BINDIR-$INSTALLDIR/bin} MANDIR=${MANDIR-$INSTALLDIR/man/man1} #HBCDIR=${HBCDIR} @@ -147,6 +150,7 @@ CYGWIN*) INSTALLDIR=`cygpath -w "$INSTALLDIR" | tr '\\\\' '/'` BUILDDIR=`cygpath -w "$BUILDDIR" | tr '\\\\' '/'` LIBDIR=`cygpath -w "$LIBDIR" | tr '\\\\' '/'` + CONFDIR=`cygpath -w "$CONFDIR" | tr '\\\\' '/'` BINDIR=`cygpath -w "$BINDIR" | tr '\\\\' '/'` ;; *) ;; @@ -178,6 +182,7 @@ if [ "$LIB" = "yes" ] then echo "hmake binaries: $LIBDIR/$MACHINE" + echo "hmakerc: $CONFDIR/$MACHINE" else echo "Executables and libs: (none)" fi @@ -359,13 +364,16 @@ echo "Adding build scripts for hmake, hmake-config, and hi to" echo " $BUILDBINDIR..." sed -e "s|ExecutableDir|$BUILDLIBDIR|" script/hmake.inst |\ + sed -e "s|ConfDir|$BUILDLIBDIR|" |\ sed -e "s|InstallVer|$HMAKEVERSION|" |\ sed -e "s|^BUILTBY=$|BUILTBY=${BUILDWITH}|" |\ sed -e "s|ScriptDir|$BUILDBINDIR|" >$BUILDBINDIR/hmake sed -e "s|ExecutableDir|$BUILDLIBDIR|" script/hmake-config.inst |\ + sed -e "s|ConfDir|$BUILDLIBDIR|" |\ sed -e "s|ScriptDir|$BUILDBINDIR|" >$BUILDBINDIR/hmake-config sed -e "s|ExecutableDir|$BUILDLIBDIR|" script/hi.inst |\ + sed -e "s|ConfDir|$BUILDLIBDIR|" |\ sed -e "s|InstallVer|$HMAKEVERSION|" |\ sed -e "s|ScriptDir|$BUILDBINDIR|" >$BUILDBINDIR/hi chmod +x $BUILDBINDIR/hmake $BUILDBINDIR/hmake-config $BUILDBINDIR/hi @@ -392,14 +400,17 @@ cp script/harch $DESTDIR$BINDIR echo -n "hmake " sed -e "s|ExecutableDir|$LIBDIR|" script/hmake.inst |\ + sed -e "s|ConfDir|$CONFDIR|" |\ sed -e "s|InstallVer|$HMAKEVERSION|" |\ sed -e "s|^BUILTBY=$|BUILTBY=${BUILDWITH}|" |\ sed -e "s|ScriptDir|$BINDIR|" >$DESTDIR$BINDIR/hmake echo -n "hmake-config " sed -e "s|ExecutableDir|$LIBDIR|" script/hmake-config.inst |\ + sed -e "s|ConfDir|$CONFDIR|" |\ sed -e "s|ScriptDir|$BINDIR|" >$DESTDIR$BINDIR/hmake-config echo -n "hi " sed -e "s|ExecutableDir|$LIBDIR|" script/hi.inst |\ + sed -e "s|ConfDir|$CONFDIR|" |\ sed -e "s|InstallVer|$HMAKEVERSION|" |\ sed -e "s|ScriptDir|$BINDIR|" >$DESTDIR$BINDIR/hi echo @@ -417,11 +428,26 @@ then mkdir -p $DESTDIR$LIBDIR/$MACHINE; echo ' (created)' else echo ' (exists)' fi + echo "Conf files go into:" + echo -n " $DESTDIR$CONFDIR/$MACHINE" + if [ ! -d $DESTDIR$CONFDIR/$MACHINE ] + then mkdir -p $DESTDIR$CONFDIR/$MACHINE; echo ' (created)' + else echo ' (exists)' + fi echo -n " " for file in $BUILDLIBDIR/$MACHINE/* do - echo -n "`basename $file` " - if [ -f $file ]; then cp -p $file $DESTDIR$LIBDIR/$MACHINE; fi + FILE="`basename $file`" + echo -n "$FILE " + if [ -f "$file" ]; + then + if [ "$FILE" = "hmakerc" ] + then + cp -p $file $DESTDIR$CONFDIR/$MACHINE + else + cp -p $file $DESTDIR$LIBDIR/$MACHINE + fi + fi done echo else @@ -451,6 +477,7 @@ echo "Saving current configuration in targets/$MACHINE/config.cache" ( echo "INSTALLDIR=$INSTALLDIR" ; if [ "$LIBDIR" != "$INSTALLDIR/lib/hmake" ]; then echo "LIBDIR=$LIBDIR" ; fi; + if [ "$CONFDIR" != "$LIBDIR" ]; then echo "CONFDIR=$CONFDIR" ; fi; if [ "$MANDIR" != "$INSTALLDIR/man/man1" ]; then echo "MANDIR=$MANDIR" ; fi; if [ "$BINDIR" != "$INSTALLDIR/bin" ]; then echo "BINDIR=$BINDIR" ; fi; if [ "$HBCDIR" != "" ]; then echo "HBCDIR=$HBCDIR" ; fi; --- hmake-3.09.orig/debian/hi.1.in +++ hmake-3.09/debian/hi.1.in @@ -0,0 +1,55 @@ +.TH HI 1 "2003-10-16" "nhc98 Suite" "hmake interactive" +.SH NAME +hmake interactive (hi) \- an interactive Haskell environment + +.SH SYNOPSIS +.B hi +[-f FILE] [\fIARG\fR]... + +.SH DESCRIPTION +This manual page documents briefly the +.BR hi +command. + +.PP +This manual page was written for the Debian GNU/Linux distribution +because the original program does not have a manual page. Instead, it +has documentation in HTML format; see below. + +.PP +.B hi +is an interactive Haskell environment which uses one of the Haskell +compilers (ghc, nhc98 or hbc) to do the work. Expressions to be +evaluated are given at a prompt in a similar way to hugs and ghci. + +.SH OPTIONS + +.TP +.BR \-f " " FILE +Use FILE, a personal config file, rather than the global config file. +.PP +All other argument are passed on to the underlying compiler. + +.SH FILES +.I @LIBDIR@ + +.SH "SEE ALSO" +.BR @DOCDIR@ , +the nhc98 homepage +.UR http://haskell.org/nhc98/ +(http://haskell.org/nhc98/) +.UE + +.SH COPYRIGHT +Happy Version @VERSION@ + +Copyright (c) 2000 Malcolm Wallace. + +.SH AUTHOR +This manual page was written by Ian Lynagh +, for the Debian GNU/Linux system +(but may be used by others). + +.\" Local variables: +.\" mode: nroff +.\" End: