aclocal.m4

   1 # Copyright 2005,2008 David Roundy
   2
   3 # Redistribution and use in source and binary forms of this file, with or
   4 # without modification, are permitted provided that redistributions of
   5 # source code must retain the above copyright notice.
   6
   7 # TRY_COMPILE_GHC(PROGRAM, [ACTION-IF-TRUE], [ACTION-IF-FALSE])
   8 # -----------
   9 # Compile and link using ghc.
  10 AC_DEFUN([TRY_COMPILE_GHC],[
  11 cat << \EOF > conftest.hs
  12 [$1]
  13 -- this file generated by TRY-COMPILE-GHC
  14 EOF
  15 rm -f Main.hi Main.o
  16 # Convert LDFLAGS and LIBS to the format GHC wants them in
  17 GHCLDFLAGS=""
  18 for f in $LDFLAGS ; do
  19   GHCLDFLAGS="$GHCLDFLAGS -optl$f"
  20 done
  21 GHCLIBS=""
  22 for l in $LIBS ; do
  23   GHCLIBS="$GHCLIBS -optl$l"
  24 done
  25 if AC_TRY_COMMAND($GHC $GHCFLAGS $GHCLDFLAGS -o conftest conftest.hs $GHCLIBS) && test -s conftest
  26 then
  27 dnl Don't remove the temporary files here, so they can be examined.
  28   ifelse([$2], , :, [$2])
  29 else
  30   echo "configure: failed program was:" >&AS_MESSAGE_LOG_FD
  31   cat conftest.hs >&AS_MESSAGE_LOG_FD
  32   echo "end of failed program." >&AS_MESSAGE_LOG_FD
  33 ifelse([$3], , , [ rm -f Main.hi Main.o
  34   $3
  35 ])dnl
  36 fi])
  37
  38 # TRY_RUN_GHC(PROGRAM, [ACTION-IF-TRUE], [ACTION-IF-FALSE])
  39 # -----------
  40 # Compile, link and run using ghc.
  41 AC_DEFUN([TRY_RUN_GHC],[
  42   TRY_COMPILE_GHC([$1],
  43     AS_IF([AC_TRY_COMMAND(./conftest)],[$2],[$3]),
  44     [$3])
  45 ])
  46
  47 # GHC_CHECK_ONE_MODULE(MODULE, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND])
  48 # -----------
  49 # Compile and link using ghc.
  50 AC_DEFUN([GHC_CHECK_ONE_MODULE],[
  51 TRY_COMPILE_GHC([import $1
  52 main = seq ($2) (putStr "Hello world.\n")
  53                 ],[$3],[$4])
  54
  55 ])
  56
  57 # GHC_CHECK_MODULE(MODULE, PACKAGE, CODE, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND])
  58 # -----------
  59 # Compile and link using ghc.
  60 AC_DEFUN([GHC_CHECK_MODULE],[
  61 AC_MSG_CHECKING([for module $1])
  62 GHC_CHECK_ONE_MODULE([$1], [$3], [AC_MSG_RESULT([yes])
  63 $4], [
  64   check_module_save_GHCFLAGS=$GHCFLAGS
  65   GHCFLAGS="$GHCFLAGS -package $2"
  66   GHC_CHECK_ONE_MODULE([$1], [$3], [AC_MSG_RESULT([in package $2])
  67 $4],[
  68     GHCFLAGS=$check_module_save_GHCFLAGS
  69     AC_MSG_RESULT(no; and neither in package $2)
  70     $5])
  71   ])
  72 ])
  73
  74 # GHC_COMPILE_FFI(IMPORT, TYPE, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND])
  75 # -----------
  76 # Compile and link ffi code using ghc.
  77 AC_DEFUN([GHC_COMPILE_FFI],[
  78 TRY_COMPILE_GHC([{-# OPTIONS -fffi -Werror #-}
  79 module Main where
  80
  81 foreign import ccall unsafe "$1" fun :: $2
  82
  83 main = fun `seq` putStrLn "hello world"
  84 ],[$3],[$4])])
  85
  86 # GHC_CHECK_LIBRARY(LIBRARY, IMPORT, TYPE, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND])
  87 # -----------
  88 # Compile and link with C library using ghc.
  89 AC_DEFUN([GHC_CHECK_LIBRARY],[
  90 AC_MSG_CHECKING([for library $1])
  91 GHC_COMPILE_FFI([$2], [$3], [AC_MSG_RESULT([yes])
  92 $4], [
  93   check_library_save_GHCFLAGS=$GHCFLAGS
  94   GHCFLAGS="$GHCFLAGS -l$1"
  95   GHC_COMPILE_FFI([$2], [$3], [AC_MSG_RESULT([in -l$1])
  96 LIBS="$LIBS -l$1"
  97 $4],[
  98     GHCFLAGS=$check_module_save_GHCFLAGS
  99     AC_MSG_RESULT(no; and not with -l$1 either)
 100     $5])
 101   ])
 102 ])
 103
 104 # INIT_WORKAROUND
 105 # ---------------
 106 # Initialize src/Workaround.hs module.
 107 AC_DEFUN([INIT_WORKAROUND],[
 108 rm -f src/Workaround.hs.beginning src/Workaround.hs.ending
 109 touch src/Workaround.hs.ending
 110 cat << \EOF > src/Workaround.hs.prefix
 111 {-# OPTIONS -w #-}
 112 {- Workaround.hs
 113
 114 This file was created automatically by configure.  We disable warnings to
 115 avoid issues with duplicate imports.
 116
 117 -}
 118
 119 module Workaround(
 120 EOF
 121 cat << \EOF > src/Workaround.hs.beginning
 122  ) where
 123
 124 EOF
 125 ])
 126
 127 # OUTPUT_WORKAROUND
 128 # -----------------
 129 # Create the src/Workaround.hs module.
 130 AC_DEFUN([OUTPUT_WORKAROUND],[
 131 cat src/Workaround.hs.prefix src/Workaround.hs.beginning src/Workaround.hs.ending > src/Workaround.hs
 132 rm -f src/Workaround.hs.beginning src/Workaround.hs.ending src/Workaround.hs.prefix
 133 ])
 134
 135 # IMPORT_WORKAROUND(CODE)
 136 # -----------------------
 137 # Import a module into src/Workaround.hs
 138 AC_DEFUN([IMPORT_WORKAROUND],[
 139 cat << \EOF >> src/Workaround.hs.beginning
 140 $1
 141 EOF
 142 ])
 143
 144 # EXPORT_WORKAROUND(CODE)
 145 # -----------------------
 146 # Export from src/Workaround.hs
 147 AC_DEFUN([EXPORT_WORKAROUND],[
 148 cat << \EOF >> src/Workaround.hs.prefix
 149 $1
 150 EOF
 151 ])
 152
 153 # CODE_WORKAROUND(CODE)
 154 # ---------------------
 155 # Import a module into src/Workaround.hs
 156 AC_DEFUN([CODE_WORKAROUND],[
 157 cat << \EOF >> src/Workaround.hs.ending
 158 $1
 159 EOF
 160 ])
 161
 162 # WORKAROUND_POSIXSIGNALS(IMPORTS)
 163 # -----------------------
 164 # Work around missing POSIX signals code.
 165 AC_DEFUN([WORKAROUND_POSIXSIGNALS],[
 166   EXPORT_WORKAROUND([$1])
 167   GHC_CHECK_MODULE(System.Posix.Signals($1), unix, undefined,
 168     [IMPORT_WORKAROUND([import System.Posix.Signals($1)])],
 169     GHC_CHECK_MODULE(Posix($1), util, undefined,
 170       [IMPORT_WORKAROUND([import Posix($1)])],
 171       [CODE_WORKAROUND([[
 172
 173 -- Dummy implementation of POSIX signals
 174
 175 data Handler = Default | Ignore | Catch (IO ())
 176 type Signal = Int
 177
 178 installHandler :: Signal -> Handler -> Maybe () -> IO ()
 179 installHandler _ _ _ = return ()
 180
 181 raiseSignal :: Signal -> IO ()
 182 raiseSignal _ = return ()
 183
 184 sigINT, {- sigKILL, -} sigHUP, {- sigQUIT, -} sigABRT, sigALRM, sigTERM, sigPIPE :: Signal
 185 sigINT = 0
 186 -- not used: sigKILL = 0
 187 sigHUP = 0
 188 -- not used: sigQUIT = 0
 189 sigABRT = 0
 190 sigTERM = 0
 191 sigPIPE = 0
 192 sigALRM = 0
 193
 194 -- not used: raiseSignal :: Signal -> IO ()
 195 -- not used: raiseSignal _ = return ()
 196
 197 ]])]
 198     )
 199   )
 200 ])
 201
 202 # WORKAROUND_bracketOnError
 203 # -----------------------
 204 # Work around missing bracketOnError
 205 AC_DEFUN([WORKAROUND_bracketOnError],[
 206   EXPORT_WORKAROUND([           bracketOnError, ])
 207   GHC_CHECK_MODULE(Control.Exception( bracketOnError ), base ,
 208     bracketOnError (return ()) (const $ return ()) (const $ return ()),
 209     [IMPORT_WORKAROUND([import Control.Exception( bracketOnError )])],
 210     [IMPORT_WORKAROUND([import qualified Control.Exception( catch, throw, block, unblock )])
 211      CODE_WORKAROUND([[
 212
 213 -- | Like bracket, but only performs the final action if there was an
 214 -- exception raised by the in-between computation.
 215 -- From GHC 6.6 (with twiddling for qualified block, catch, etc)
 216 bracketOnError
 217         :: IO a         -- ^ computation to run first (\"acquire resource\")
 218         -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
 219         -> (a -> IO c)  -- ^ computation to run in-between
 220         -> IO c         -- returns the value from the in-between computation
 221 bracketOnError before after thing =
 222   Control.Exception.block (do
 223     a <- before
 224     Control.Exception.catch
 225         (Control.Exception.unblock (thing a))
 226         (\e -> do { after a; Control.Exception.throw e })
 227   )
 228 ]])
 229 ])
 230 ])
 231
 232 # WORKAROUND_createLink
 233 # -----------------------
 234 # Work around missing POSIX createLink code.
 235 AC_DEFUN([WORKAROUND_createLink],[
 236   EXPORT_WORKAROUND([           createLink, ])
 237   GHC_CHECK_MODULE(System.Posix.Files( createLink ), unix, createLink "a" "b",
 238     [IMPORT_WORKAROUND([import System.Posix.Files( createLink )])],
 239     GHC_CHECK_MODULE(Posix( createLink ), util, createLink "a" "b",
 240       [IMPORT_WORKAROUND([import Posix( createLink )])],
 241       [CODE_WORKAROUND([[
 242
 243 -- Dummy implementation of createLink.
 244
 245 createLink :: FilePath -> FilePath -> IO ()
 246 createLink _ _ = fail "Dummy create link error should be caught."
 247 ]])]
 248     )
 249   )
 250 ])
 251
 252 # WORKAROUND_createDirectoryIfMissing
 253 # ------------------------------
 254 # Work around missing createDirectoryIfMissing.
 255 AC_DEFUN([WORKAROUND_createDirectoryIfMissing],[
 256   EXPORT_WORKAROUND([           createDirectoryIfMissing, ])
 257   AC_MSG_CHECKING([createDirectoryIfMissing])
 258   TRY_COMPILE_GHC([
 259 import System.Directory(createDirectoryIfMissing)
 260 main = createDirectoryIfMissing True ""
 261     ],
 262     [AC_MSG_RESULT([has createDirectoryIfMissing])
 263      IMPORT_WORKAROUND([import System.Directory(createDirectoryIfMissing)])],
 264     [AC_MSG_RESULT([doesn't have createDirectoryIfMissing])
 265       IMPORT_WORKAROUND([import System.Directory ( doesDirectoryExist, createDirectory )])
 266       CODE_WORKAROUND([[
 267 createDirectoryIfMissing
 268   :: Bool     -- ^ Create its parents too?
 269   -> FilePath -- ^ The path to the directory you want to make
 270   -> IO ()
 271 createDirectoryIfMissing parents file = do
 272   b <- doesDirectoryExist file
 273   case (b,parents, file) of
 274     (_,     _, "") -> return ()
 275     (True,  _,  _) -> return ()
 276     (_,  True,  _) -> mapM_ (createDirectoryIfMissing False) (tail (pathParents file))
 277     (_, False,  _) -> createDirectory file
 278  where    pathParents :: FilePath -> [FilePath]
 279           pathParents p =
 280               root'' : map ((++) root') (dropEmptyPath $ inits path')
 281               where
 282 #ifdef WIN32
 283                  (root,path) = case break (== ':') p of
 284                     (rel,    "") -> ("",rel)
 285                     (drv,_:rel) -> (drv++":",rel)
 286 #else
 287                  (root,path) = ("",p)
 288 #endif
 289                  (root',root'',path') = case path of
 290                    (c:path'') | isPathSeparator c -> (root++[pathSeparator],root++[pathSeparator],path'')
 291                    _                              -> (root                 ,root++"."            ,path)
 292
 293                  dropEmptyPath ("":paths) = paths
 294                  dropEmptyPath paths      = paths
 295
 296                  inits :: String -> [String]
 297                  inits [] =  [""]
 298                  inits cs =
 299                    case pre of
 300                      "."  -> inits suf
 301                      ".." -> map (joinFileName pre) (dropEmptyPath $ inits suf)
 302                      _    -> "" : map (joinFileName pre) (inits suf)
 303                    where
 304                      (pre,suf) = case break isPathSeparator cs of
 305                         (pre',"")     -> (pre', "")
 306                         (pre',_:suf') -> (pre',suf')
 307                  isPathSeparator :: Char -> Bool
 308                  isPathSeparator ch = ch == pathSeparator || ch == '/'
 309                  pathSeparator :: Char
 310 #ifdef WIN32
 311                  pathSeparator = '\\'
 312 #else
 313                  pathSeparator = '/'
 314 #endif
 315                  joinFileName :: String -> String -> FilePath
 316                  joinFileName ""  fname = fname
 317                  joinFileName "." fname = fname
 318                  joinFileName dir ""    = dir
 319                  joinFileName dir fname
 320                    | isPathSeparator (last dir) = dir++fname
 321                    | otherwise                  = dir++pathSeparator:fname
 322       ]])
 323     ]
 324   )
 325 ])
 326
 327 # WORKAROUND_getCurrentDirectory
 328 # ------------------------------
 329 # Work around getCurrentDirectory that uses '\\' rather than '/'.
 330 AC_DEFUN([WORKAROUND_getCurrentDirectory],[
 331   EXPORT_WORKAROUND([           getCurrentDirectory, ])
 332   AC_MSG_CHECKING([getCurrentDirectory])
 333   TRY_RUN_GHC([
 334 import System.Directory(getCurrentDirectory, setCurrentDirectory)
 335 main = do setCurrentDirectory "src"
 336           d <- getCurrentDirectory
 337           case reverse $ take 4 $ reverse d of
 338               "/src" -> return ()
 339     ],
 340     [AC_MSG_RESULT([uses /])
 341      IMPORT_WORKAROUND([import System.Directory(getCurrentDirectory)])]
 342      GHC_SEPARATOR='/',
 343     [AC_MSG_RESULT([uses \\])
 344       IMPORT_WORKAROUND([import qualified System.Directory(getCurrentDirectory)])
 345       GHC_SEPARATOR='\\'
 346       CODE_WORKAROUND([[
 347 {-
 348 System.Directory.getCurrentDirectory returns a path with backslashes in it
 349 under windows, and some of the code gets confused by that, so we override
 350 getCurrentDirectory and translates '\\' to '/'
 351 -}
 352
 353 getCurrentDirectory :: IO FilePath
 354 getCurrentDirectory = do d <- System.Directory.getCurrentDirectory
 355                          return $ map rb d
 356     where rb '\\' = '/'
 357           rb c = c
 358       ]])
 359     ]
 360   )
 361 ])
 362
 363 # WORKAROUND_renameFile
 364 # -----------------------
 365 # Work around buggy renameFile.
 366 AC_DEFUN([WORKAROUND_renameFile],[
 367   EXPORT_WORKAROUND([           renameFile, ])
 368   AC_MSG_CHECKING([renameFile])
 369   TRY_RUN_GHC([
 370 import System.Directory ( renameFile )
 371
 372 main = do writeFile "conftest.data" "orig_data"
 373           writeFile "conftest.newdata" "new_data"
 374           renameFile "conftest.newdata" "conftest.data"
 375     ],
 376     [AC_MSG_RESULT([okay])
 377      IMPORT_WORKAROUND([import System.Directory ( renameFile )])],
 378     AC_MSG_RESULT([buggy!])
 379     IMPORT_WORKAROUND([import qualified System.Directory( renameFile, removeFile )])
 380     IMPORT_WORKAROUND([import qualified System.IO.Error])
 381     IMPORT_WORKAROUND([import qualified Control.Exception ( block )])
 382     CODE_WORKAROUND([
 383 {-
 384 System.Directory.renameFile incorrectly fails when the new file already
 385 exists.  This code works around that bug at the cost of losing atomic
 386 writes.
 387 -}
 388
 389 renameFile :: FilePath -> FilePath -> IO ()
 390 renameFile old new = Control.Exception.block $
 391    do System.Directory.removeFile new
 392         `System.IO.Error.catch`
 393          (\e -> if System.IO.Error.isDoesNotExistError e
 394                    then return ()
 395                    else System.IO.Error.ioError e)
 396       System.Directory.renameFile old new
 397      ])
 398   )
 399 ])
 400
 401 # WORKAROUND_fileModes
 402 # --------------------
 403 # Figure out how to set unix permissions on a file (or creates a dummy
 404 # function for this).
 405
 406 AC_DEFUN([WORKAROUND_fileModes],[
 407   EXPORT_WORKAROUND([           fileMode, getFileStatus, setFileMode, ])
 408   GHC_CHECK_MODULE(System.Posix.Files( fileMode, getFileStatus, setFileMode ), unix, getFileStatus "",
 409     IMPORT_WORKAROUND([import System.Posix.Files(fileMode,getFileStatus,setFileMode)]),
 410     CODE_WORKAROUND([
 411 fileMode :: () -> ()
 412 fileMode _ = ()
 413 getFileStatus :: FilePath -> IO ()
 414 getFileStatus _ = return ()
 415 setFileMode :: FilePath -> () -> IO ()
 416 setFileMode _ _ = return ()
 417 ])
 418   )
 419 ])
 420
 421 # WORKAROUND_executable
 422 # --------------------
 423 # Figure out how to make a file executable (or test if it is).
 424
 425 AC_DEFUN([WORKAROUND_executable],[
 426   EXPORT_WORKAROUND([           setExecutable, ])
 427   GHC_CHECK_MODULE(System.Posix.Files( fileMode, getFileStatus, setFileMode, setFileCreationMask ),
 428                    unix, getFileStatus "",
 429     IMPORT_WORKAROUND([
 430 import System.Posix.Files (fileMode,getFileStatus, setFileMode, nullFileMode,
 431                            setFileCreationMask,
 432                            ownerReadMode, ownerWriteMode, ownerExecuteMode,
 433                            groupReadMode, groupWriteMode, groupExecuteMode,
 434                            otherReadMode, otherWriteMode, otherExecuteMode)
 435 import Data.Bits ( (.&.), (.|.), complement )
 436
 437 setExecutable :: FilePath -> Bool -> IO ()
 438 setExecutable f ex =
 439   do st <- getFileStatus f
 440      umask <- setFileCreationMask 0
 441      setFileCreationMask umask
 442      let rw = fileMode st .&.
 443               (ownerReadMode .|. ownerWriteMode .|.
 444                groupReadMode .|. groupWriteMode .|.
 445                otherReadMode .|. otherWriteMode)
 446          total = if ex then rw .|.
 447                            ((ownerExecuteMode .|. groupExecuteMode .|. otherExecuteMode)
 448                             .&. complement umask)
 449                        else rw
 450      setFileMode f total
 451 ]),
 452     CODE_WORKAROUND([
 453 setExecutable :: FilePath -> Bool -> IO ()
 454 setExecutable _ _ = return ()
 455 ])
 456   )
 457 ])
 458
 459 # WORKAROUND_openFd
 460 # -----------------------
 461 # Work around changing openFd function
 462 AC_DEFUN([WORKAROUND_openFd],[
 463   EXPORT_WORKAROUND([           openFd, ])
 464   AC_MSG_CHECKING([GHC.Handle.openFd])
 465   TRY_RUN_GHC([
 466 import GHC.Handle ( openFd )
 467 import IO ( IOMode(..))
 468
 469 main = openFd 1 Nothing "stdout" WriteMode True False
 470     ],
 471      AC_MSG_RESULT([okay])
 472      IMPORT_WORKAROUND([import GHC.Handle( openFd )]),
 473      AC_MSG_RESULT([NOT old API])
 474      AC_MSG_CHECKING([GHC.Handle.openFd new API])
 475      TRY_RUN_GHC([
 476 import GHC.Handle ( openFd )
 477 import IO ( IOMode(..))
 478
 479 main = openFd 1 Nothing False "stdout" WriteMode True
 480       ],
 481       AC_MSG_RESULT([okay])
 482       IMPORT_WORKAROUND([import qualified GHC.Handle ( openFd )
 483 import System.IO ( Handle, IOMode )
 484 import System.Posix.Internals ( FDType )
 485 ])
 486       CODE_WORKAROUND([[
 487 {-
 488 Work around change in the GHC.Handle.openFd API.
 489 -}
 490 openFd :: Int -> Maybe FDType -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
 491 openFd fd x y z a b = GHC.Handle.openFd fd x b y z a
 492         ]]),
 493        AC_MSG_RESULT([NOT 'new' API])
 494        AC_MSG_CHECKING([GHC.Handle.fdToHandle' API])
 495        TRY_RUN_GHC([
 496 import GHC.Handle ( fdToHandle' )
 497 import IO ( IOMode(..) )
 498
 499 main = fdToHandle' 1 Nothing False "stdout" WriteMode True
 500        ],
 501        AC_MSG_RESULT([okay])
 502        IMPORT_WORKAROUND([import qualified GHC.Handle ( fdToHandle' )
 503 import System.IO ( Handle, IOMode )
 504 import System.Posix.Internals ( FDType )
 505 ])
 506        CODE_WORKAROUND([[
 507 {-
 508 Work around renaming of GHC.Handle.openFd and change in its API.
 509 -}
 510 openFd :: Int -> Maybe FDType -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
 511 openFd fd x y z a b = GHC.Handle.fdToHandle' (fromIntegral fd) x b y z a
 512         ]]),
 513        AC_MSG_RESULT([failed])
 514        AC_MSG_ERROR([Couldnt figure out how to call GHC.Handle.openFd!])
 515     )
 516   )
 517 )])
 518
 519