[nhc-users] hmake 3.09
Ian Lynagh
igloo at earth.li
Thu Nov 18 16:12:13 EST 2004
Hi Malcolm,
I happened to notice a new release of hmake was out - thanks for doing
this!
However, unfortunately it seems that the patch I sent here:
http://www.haskell.org//pipermail/nhc-users/2003-September/000099.html
didn't make it into CVS :-( I've attached the patch for 3.09 (it has
a few other small tweaks I made too).
In src/hmake/Imports.hs does "stringgap (c:cs) = stringgap cs"
deliberately not check isSpace c? Hmm, there's no [] case either.
There is a docs/hmake/.#index.html.1.30 in the tarball - it looks like
you have lost the change of hi copyright from 2000 to 2000-2003.
Thanks
Ian
-------------- next part --------------
--- 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
+<igloo at debian.org>, for the Debian GNU/Linux system
+(but may be used by others).
+
+.\" Local variables:
+.\" mode: nroff
+.\" End:
More information about the Nhc-users
mailing list