diff --git a/Data/Presburger/Omega/Expr.hs b/Data/Presburger/Omega/Expr.hs --- a/Data/Presburger/Omega/Expr.hs +++ b/Data/Presburger/Omega/Expr.hs @@ -517,7 +517,7 @@ addPrec = 6 cmpPrec = 4 -- Less-than, equal andPrec = 3 -lamPrec = 0 +lamPrec = 0 -- Body of lambda -- An environment for showing expressions. -- @@ -560,6 +560,12 @@ -- Showing a variable produces "varE varName" showVar nm n = showParen (n >= appPrec) $ showString "varE " . nm +bindVariables :: Int -> ShowsEnv -> ([ShowS], ShowsEnv) +bindVariables 0 env = ([], env) +bindVariables n env = let (v, env') = bindVariable env + (vs, env'') = bindVariables (n-1) env + in (v:vs, env'') + showsVarPrec :: ShowsEnv -> Int -> Var -> ShowS showsVarPrec env prec (Bound i) = if i < numBound env @@ -752,6 +758,29 @@ in quantifier . varName . showString " -> " . showExpr env' lamPrec e +-- Show a term with a lambda-bound parameter +showLambdaBound :: (ShowsEnv -> Int -> ShowS) + -> ShowsEnv -> Int -> ShowS +showLambdaBound showBody env prec = + let -- Take a new variable name + (varName, env') = bindVariable env + + in showParen (prec >= appPrec) $ + showChar '\\' . varName . showString " -> " . + showBody env' lamPrec + +-- Show a term with a lambda-bound list parameter +showLambdaList :: Int + -> (ShowsEnv -> Int -> ShowS) + -> ShowsEnv -> Int -> ShowS +showLambdaList n_params showBody env prec = + let -- Take a new variable name + (varNames, env') = bindVariables n_params env + + in showParen (prec >= appPrec) $ + showChar '\\' . showsList varNames . showString " -> " . + showBody env' lamPrec + ------------------------------------------------------------------------------- -- Syntactic equality on expressions @@ -909,12 +938,10 @@ zus :: Expr t -> Expr t zus exp@(CAUE op l es) = case es - of [] -> LitE l - [e] | l `isZeroOf` op -> LitE l -- zero * x = zero - | l `isUnitOf` op -> e -- unit * x = x - | otherwise -> exp -- no simplificaiton - _ | l `isZeroOf` op -> LitE l -- zero * x = zero - | otherwise -> exp -- no simplification + of [] -> LitE l + _ | l `isZeroOf` op -> LitE l -- zero * x = zero + [e] | l `isUnitOf` op -> e -- unit * x = x + _ -> exp -- no simplification zus e = e diff --git a/Data/Presburger/Omega/Set.hs b/Data/Presburger/Omega/Set.hs --- a/Data/Presburger/Omega/Set.hs +++ b/Data/Presburger/Omega/Set.hs @@ -69,16 +69,16 @@ -- -- For example, the set of all points on the plane is -- --- > set 2 trueE +-- > set 2 (\[_, _] -> trueE) -- -- The set of all points (x, y, z) where x > y + z is -- --- > set 3 (case takeFreeVariables' 3 of [x,y,z] -> x |>| y |+| z) +-- > set 3 (\[x,y,z] -> x |>| y |+| z) -- set :: Int -- ^ Number of dimensions - -> BoolExp -- ^ Predicate defining the set + -> ([Var] -> BoolExp) -- ^ Predicate defining the set -> Set -set dim expr +set dim mk_expr | variablesWithinRange dim expr = Set { setDim = dim @@ -86,6 +86,8 @@ , setOmegaSet = unsafePerformIO $ mkOmegaSet dim expr } | otherwise = error "set: Variables out of range" + where + expr = mk_expr (takeFreeVariables dim) mkOmegaSet :: Int -> BoolExp -> IO OmegaSet mkOmegaSet dim expr = L.newOmegaSet dim (\vars -> expToFormula vars expr) diff --git a/DoSetup.hs b/DoSetup.hs new file mode 100644 --- /dev/null +++ b/DoSetup.hs @@ -0,0 +1,384 @@ + +-- Choose feature sets based on Cabal version +#if CABAL_MAJOR == 1 +# if CABAL_MINOR <= 14 +# define OLD_GHC_OPTIONS +# define OLD_LBI_COMPONENTS +# elif CABAL_MINOR <= 16 +# define NEW_GHC_OPTIONS +# define OLD_LBI_COMPONENTS +# else +# if CABAL_MINOR > 18 +# warning "Building with an unrecognized version of Cabal" +# endif +# define NEW_GHC_OPTIONS +# define NEW_LBI_COMPONENTS +# error "Unsupported Cabal version" +# endif +#else +# error "Unsupported Cabal version" +#endif + + +import Control.Applicative +import Control.Exception(IOException, catch, bracket) +import Control.Monad +import Data.Char +import Data.Maybe +import Distribution.PackageDescription +import Distribution.Simple +import Distribution.Simple.Build +import Distribution.Simple.BuildPaths +import Distribution.Simple.GHC +import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.PreProcess +import Distribution.Simple.Program +#ifdef NEW_GHC_OPTIONS +import Distribution.Simple.Program.GHC +#endif +import Distribution.Simple.Setup +import Distribution.Simple.Utils +import qualified Distribution.Verbosity as Verbosity +import System.Cmd +import System.Directory +import System.Exit(ExitCode(..)) +import System.IO +import System.FilePath((), (<.>), takeExtension, takeDirectory) +import System.Process + +-- Recover from IO exceptions +recover :: IO a -> IO a -> IO a +f `recover` h = f `Control.Exception.catch` handler + where + handler e = let _ = e :: IOException + in h + +------------------------------------------------------------------------------- +-- Filenames and constants + +-- Record whether we're building the Omega library here +useInstalledOmegaFlagPath = "build" "UseInstalledOmega" + +-- We will call 'autoconf' and 'make' +autoconfProgram = simpleProgram "autoconf" +makeProgram = simpleProgram "make" + +-- Our single C++ source file and corresponding object file are here +cppSourceName = "src" "C_omega.cc" +cppObjectName = "build" "C_omega.o" + +-- If we're building the Omega library, it's here +omegaLibPath = "src" "the-omega-project" "omega_lib" "obj" "libomega.a" + +-- Unpack the Omega library into this directory +omegaUnpackPath = "build" "unpack_omega" + +-- Path where Cabal builds files +cabalBuildPath = "dist" "build" + +-- Main test file +testSourceName = "test" "runtests.hs" + +-- Extra files produced by configuration +configFiles = ["configure", "config.log", "config.status", "Makefile", + useInstalledOmegaFlagPath] + +------------------------------------------------------------------------------- +-- Helpful IO procedures + +noGHCiLib = + die $ "Sorry, this package does not support GHCi.\n" ++ + "Please configure with --disable-library-for-ghci to disable." + +noSharedLib = + die $ "Sorry, this package does not support shared library output.\n" ++ + "Please configure with --disable-shared to disable." + +writeUseInstalledOmegaFlag :: Bool -> IO () +writeUseInstalledOmegaFlag b = do + createDirectoryIfMissing False "build" + writeFile useInstalledOmegaFlagPath (show b) + +readUseInstalledOmegaFlag :: IO Bool +readUseInstalledOmegaFlag = do + text <- readFile useInstalledOmegaFlagPath `recover` + die "Configuration file missing; try reconfiguring" + return $! read text + +-- Attempt to remove a file, ignoring errors +lenientRemoveFile f = removeFile f `recover` return () + +lenientRemoveFiles = mapM_ lenientRemoveFile + +-- Attempt to remove a directory and its contents +-- (one level of recursion only), ignoring errors +lenientRemoveDirectory f = do + b <- doesDirectoryExist f + when b $ do lenientRemoveFiles . map (f ) =<< getDirectoryContents f + removeDirectory f `recover` return () + +------------------------------------------------------------------------------- +-- Configuration + +configureOmega pkgDesc originalFlags = do + -- Disable unsupported configuratoins + when (flagToMaybe (configGHCiLib originalFlags) == Just True) $ + notice verbosity $ "** Sorry, this package does not support GHCi.\n" ++ + "** Disabling GHCi library output." + + when (flagToMaybe (configSharedLib originalFlags) == Just True) $ + notice verbosity $ "** Sorry, this package does not support " ++ + "shared library output.\n" ++ + "** Disabling shared library output." + + -- Run Cabal configuration + lbi <- confHook simpleUserHooks pkgDesc flags + + -- Run autoconf configuration + runAutoconf lbi + runConfigure lbi + + -- Save this flag for later use + writeUseInstalledOmegaFlag useInstalledOmega + + return lbi + where + verbosity = fromFlagOrDefault Verbosity.normal $ configVerbosity flags + flags = originalFlags { configSharedLib = toFlag False + , configGHCiLib = toFlag False + } + + -- Will build the Omega library? + useInstalledOmega = fromMaybe False $ + lookup (FlagName "useinstalledomega") $ + configConfigurationsFlags flags + + -- Configure programs + runAutoconf lbi = do + runDbProgram verbosity autoconfProgram (withPrograms lbi) [] + + -- Run 'configure' with the extra arguments that were passed to + -- Setup.hs + runConfigure lbi = do + currentDir <- getCurrentDirectory + + let opts = autoConfigureOptions lbi useInstalledOmega + configProgramName = currentDir "configure" + + rawSystemExit verbosity configProgramName opts + +-- Configuration: extract options to pass to 'configure' +autoConfigureOptions :: LocalBuildInfo -> Bool -> [String] +autoConfigureOptions localBuildInfo useInstalledOmega = + withOmega ++ [libdirs, includedirs] + where + withOmega = if useInstalledOmega + then ["--with-omega"] + else [] + + libraryDescr = case library $ localPkgDescr localBuildInfo + of Nothing -> error "Library description is missing" + Just l -> l + + buildinfo = libBuildInfo libraryDescr + + -- Create a string "-L/usr/foo -L/usr/bar" + ldflagsString = + intercalate " " ["-L" ++ dir | dir <- extraLibDirs buildinfo] + + libdirs = "LDFLAGS=" ++ ldflagsString + + -- Create a string "-I/usr/foo -I/usr/bar" + cppflagsString = + intercalate " " ["-I" ++ dir | dir <- includeDirs buildinfo] + + includedirs = "CPPFLAGS=" ++ cppflagsString + +------------------------------------------------------------------------------- +-- Building + +buildOmega pkgDesc lbi userhooks flags = do + + let verb = fromFlagOrDefault Verbosity.normal $ buildVerbosity flags + useInstalledOmega <- readUseInstalledOmegaFlag + + -- Build the C++ source file (and Omega library, if configured) + -- Makefile's behavior is controlled by output of 'configure' + runDbProgram verb makeProgram (withPrograms lbi) ["all"] + + -- Custom build procedure for test suite + buildTestSuites useInstalledOmega pkgDesc lbi flags + + -- Default build procedure for hs files in library + -- Tests are already built, so they won't be built again + buildHook simpleUserHooks pkgDesc (hideTestComponents lbi) userhooks flags + + -- Get 'ar' and 'ld' programs + let runAr = runDbProgram verb arProgram (withPrograms lbi) + + -- Add other object files to libraries + let pkgId = package $ localPkgDescr lbi + + let -- Add extra files into an archive file + addStaticObjectFiles libName = do + -- Add the C++ interface file + addStaticObjectFile cppObjectName libName + + -- Add contents of libomega.a + unless useInstalledOmega $ + transferArFiles verb runAr omegaLibPath libName + + where + addStaticObjectFile objName libName = + runAr ["r", libName, objName] + + when (withVanillaLib lbi) $ + let libName = buildDir lbi mkLibName pkgId + in addStaticObjectFiles libName + + when (withProfLib lbi) $ + let libName = buildDir lbi mkProfLibName pkgId + in addStaticObjectFiles libName + + when (withGHCiLib lbi) noGHCiLib + when (withSharedLib lbi) noSharedLib + + return () + +-- | Hide the test suite so Cabal doesn't try to use its default build +-- procedure with it. +hideTestComponents :: LocalBuildInfo -> LocalBuildInfo + +hideTestComponents lbi = +#if defined(OLD_LBI_COMPONENTS) + lbi {compBuildOrder = filter (not . isTestComponent) $ compBuildOrder lbi + , testSuiteConfigs = []} +#elif defined(NEW_LBI_COMPONENTS) + lbi {componentsConfigs = mapMaybe removeTests $ componentsConfigs lbi} + where + removeTests (cname, clbi, deps) + | isTestComponent cname = Nothing + | otherwise = Just (cname, clbi, filter (not . isTestComponent) deps) +#else +#error +#endif + +isTestComponent :: ComponentName -> Bool +isTestComponent (CTestName {}) = True +isTestComponent _ = False + +-- | Get command line options for invoking GHC +genericGhcOptions :: Version -> Verbosity.Verbosity -> LocalBuildInfo + -> BuildInfo -> ComponentLocalBuildInfo -> FilePath + -> [String] + +genericGhcOptions ver verb lbi bi clbi build_path = +#if defined(OLD_GHC_OPTIONS) + ghcOptions lbi bi clbi cabalBuildPath +#elif defined(NEW_GHC_OPTIONS) + renderGhcOptions ver $ componentGhcOptions verb lbi bi clbi cabalBuildPath +#else +#error +#endif + +buildTestSuites useInstalledOmega pkgDesc lbi flags = + withTestLBI pkgDesc lbi $ \test clbi -> do + let verb = fromFlagOrDefault Verbosity.normal $ buildVerbosity flags + + -- Run preprocessors + writeAutogenFiles verb pkgDesc lbi + preprocessComponent pkgDesc (CTest test) lbi False verb knownSuffixHandlers + + -- Run compiler + (ghcProg, ghcVersion) <- configureGHC verb lbi + + let bi = testBuildInfo test + opts = genericGhcOptions ghcVersion verb lbi bi clbi cabalBuildPath + + build_opts = ["--make", "-o", + cabalBuildPath testName test testName test] + + -- If building Omega library locally, link to the local archive + local_link_opt = if useInstalledOmega + then [] + else ["-L" ++ takeDirectory omegaLibPath] + + input_opts = [testSourceName, -- Source file + cppObjectName, -- Compiled C++ file + "-lomega", -- Omega library + "-lstdc++" -- C++ libarry + ] + all_opts = build_opts ++ opts ++ local_link_opt ++ input_opts + + createDirectoryIfMissing True (cabalBuildPath testName test) + runProgram verb ghcProg all_opts + +configureGHC verb lbi = do + (ghcProg, _) <- requireProgram verb ghcProgram (withPrograms lbi) + ghcVersion <- case programVersion ghcProg + of Just x -> return x + Nothing -> die "Can't determine GHC vesion" + return (ghcProg, ghcVersion) + +-- Transfer the contents of one archive to another +transferArFiles verb runAr src dst = do + srcCan <- canonicalizePath src + dstCan <- canonicalizePath dst + + -- Create/remove a temporary directory + bracket createUnpackDirectory (\_ -> removeUnpackDirectory) $ \_ -> + + -- Save/restore the current working directory + bracket getCurrentDirectory setCurrentDirectory $ \_ -> do + + -- Go to temporary directory + setCurrentDirectory omegaUnpackPath + + -- Unpack source archive + runAr ["x", srcCan] + + -- Find object files + objs <- liftM (filter isObjectFile) $ getDirectoryContents "." + when (null objs) $ warn verb "No object files found in Omega library; build may be incomplete" + + -- Insert into destination archive + runAr (["r", dstCan] ++ objs) + where + isObjectFile f = takeExtension f == ".o" + + createUnpackDirectory = createDirectoryIfMissing True omegaUnpackPath + removeUnpackDirectory = removeDirectoryRecursive omegaUnpackPath + +------------------------------------------------------------------------------- +-- Cleaning + +cleanOmega pkgDesc mlbi userhooks flags = do + let verb = fromFlagOrDefault Verbosity.normal $ cleanVerbosity flags + + -- run 'make clean', which will clean the Omega library if appropriate + pgmConf <- configureProgram verb makeProgram defaultProgramConfiguration + makeExists <- doesFileExist "Makefile" + when makeExists $ + runDbProgram verb makeProgram pgmConf ["clean"] + + -- Clean extra files if we don't need to save configuration + -- (Other temp files are automatically cleaned) + unless (fromFlag $ cleanSaveConf flags) $ do + lenientRemoveFiles configFiles + lenientRemoveDirectory "autom4te.cache" + + -- Do default clean procedure + cleanHook simpleUserHooks pkgDesc mlbi userhooks flags + +------------------------------------------------------------------------------- +-- Hooks + +hooks = + simpleUserHooks + { hookedPrograms = [arProgram, autoconfProgram, makeProgram] + , confHook = configureOmega + , buildHook = buildOmega + , cleanHook = cleanOmega + } + +main = defaultMainWithHooks hooks diff --git a/Omega.cabal b/Omega.cabal --- a/Omega.cabal +++ b/Omega.cabal @@ -1,18 +1,19 @@ -Cabal-Version: >= 1.2.3 +Cabal-Version: >= 1.9.2 Name: Omega -Version: 1.0 +Version: 1.0.1 Build-Type: Custom License: BSD3 License-File: LICENSE Author: Christopher Rodrigues Maintainer: cirodrig@illinois.edu Stability: Alpha -Synopsis: Operations on Presburger arithmetic formulae +Synopsis: Integer sets and relations using Presburger arithmetic Description: - This package provides tools for manipulating sets and relations - whose members can be represented compactly as a Presburger - arithmetic formula. Formulae are simplified and solved by the - Omega Library. The primary interface can be found in + Sets of integer tuples and relations on integer tuples. + Sets and relations are represented compactly by storing their + characteristic function as a Presburger arithmetic formula. + Formulae are simplified and solved by the Omega Library. + The primary interface can be found in "Data.Presburger.Omega.Set" and "Data.Presburger.Omega.Rel". Category: Data Extra-Source-Files: @@ -20,10 +21,12 @@ aclocal.m4 configure.ac Makefile.in + DoSetup.hs src/C_omega.cc src/C_omega.h src/the-omega-project.tar.gz Extra-Tmp-Files: build/C_omega.o +Tested-With: GHC ==7.4.1, GHC ==7.6.3 Flag UseInstalledOmega Description: Link to a preinstalled version of the Omega library @@ -42,6 +45,26 @@ Build-Tools: hsc2hs Include-Dirs: src + if flag(UseInstalledOmega) + Extra-Libraries: omega stdc++ + else + Extra-Libraries: stdc++ + +Test-Suite test-Omega + Type: exitcode-stdio-1.0 + main-is: runtests.hs + Build-Depends: base >= 4 && < 5, containers, HUnit + Other-Modules: + Data.Presburger.Omega.Expr + Data.Presburger.Omega.LowLevel + Data.Presburger.Omega.Set + Data.Presburger.Omega.Rel + Data.Presburger.Omega.SetRel + TestExpr + Extensions: GADTs ScopedTypeVariables + Build-Tools: hsc2hs + Hs-Source-Dirs: . test + Include-Dirs: src if flag(UseInstalledOmega) Extra-Libraries: omega stdc++ else diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,270 +1,36 @@ +{-| This is a small harness to check the version of the Cabal library and + build and run the real setup script, @DoSetup.hs@. +-} -import Control.Applicative -import Control.Exception(bracket) import Control.Monad import Data.Char -import Data.Maybe -import Distribution.PackageDescription -import Distribution.Simple -import Distribution.Simple.BuildPaths -import Distribution.Simple.LocalBuildInfo -import Distribution.Simple.Program -import Distribution.Simple.Setup -import Distribution.Simple.Utils -import qualified Distribution.Verbosity as Verbosity -import System.Cmd -import System.Directory -import System.Exit(ExitCode(..)) -import System.IO -import System.FilePath((), (<.>), takeExtension) +import Distribution.Simple.Utils(cabalVersion) +import Distribution.Version(Version(..)) +import System.Environment +import System.Exit import System.Process --- Mimic the && command of 'sh' -(>&&>) :: IO ExitCode -> IO ExitCode -> IO ExitCode -cmd1 >&&> cmd2 = cmd1 >>= continue - where - continue ExitSuccess = cmd2 - continue returnCode = return returnCode - --- Record whether we're building the Omega library here -useInstalledOmegaFlagPath = "build" "UseInstalledOmega" - -writeUseInstalledOmegaFlag :: Bool -> IO () -writeUseInstalledOmegaFlag b = do - createDirectoryIfMissing False "build" - writeFile useInstalledOmegaFlagPath (show b) - -readUseInstalledOmegaFlag :: IO Bool -readUseInstalledOmegaFlag = do - text <- readFile useInstalledOmegaFlagPath `catch` - \_ -> die "Configuration file missing; try reconfiguring" - return $! read text - --- We will call 'autoconf' and 'make' -autoconfProgram = simpleProgram "autoconf" -makeProgram = simpleProgram "make" - --- Our single C++ source file and corresponding object file are here -cppSourceName = "src" "C_omega.cc" -cppObjectName = "build" "C_omega.o" - --- If we're building the Omega library, it's here -omegaLibPath = "src" "the-omega-project" "omega_lib" "obj" "libomega.a" - --- Unpack the Omega library into this directory -omegaUnpackPath = "build" "unpack_omega" - -noGHCiLib = - die "Sorry, this package does not support GHCi.\n\ - \Please configure with --disable-library-for-ghci to disable." - -noSharedLib = - die "Sorry, this package does not support shared library output.\n\ - \Please configure with --disable-shared to disable." - -------------------------------------------------------------------------------- --- Configuration - -configureOmega pkgDesc originalFlags = do - -- Disable unsupported configuratoins - when (flagToMaybe (configGHCiLib originalFlags) == Just True) $ - notice verbosity "** Sorry, this package does not support GHCi.\n\ - \** Disabling GHCi library output." - - when (flagToMaybe (configSharedLib originalFlags) == Just True) $ - notice verbosity "** Sorry, this package does not support \ - \shared library output.\n\ - \** Disabling shared library output." - - -- Run Cabal configure - lbi <- confHook simpleUserHooks pkgDesc flags - - -- Configure programs - let verb = fromFlagOrDefault Verbosity.normal $ configVerbosity flags - cfg = withPrograms lbi - runAutoconf = do rawSystemProgramConf verb autoconfProgram cfg [] - return ExitSuccess - - -- Run autoconf configure - runAutoconf >&&> runConfigure lbi - - -- Save this flag for later use - writeUseInstalledOmegaFlag useInstalledOmega - - return lbi - - where - verbosity = fromFlag $ configVerbosity originalFlags - flags = originalFlags { configSharedLib = toFlag False - , configGHCiLib = toFlag False - } - - -- Will build the Omega library? - useInstalledOmega = fromMaybe False $ - lookup (FlagName "useinstalledomega") $ - configConfigurationsFlags flags - - -- Run 'configure' with the extra arguments that were passed to - -- Setup.hs - runConfigure lbi = do - currentDir <- getCurrentDirectory - - let opts = autoConfigureOptions lbi useInstalledOmega - configProgramName = currentDir "configure" - - rawSystem configProgramName opts - --- Configuration: extract options to pass to 'configure' -autoConfigureOptions :: LocalBuildInfo -> Bool -> [String] -autoConfigureOptions localBuildInfo useInstalledOmega = - withOmega ++ [libdirs, includedirs] - where - withOmega = if useInstalledOmega - then ["--with-omega"] - else [] - - libraryDescr = case library $ localPkgDescr localBuildInfo - of Nothing -> error "Library description is missing" - Just l -> l - - buildinfo = libBuildInfo libraryDescr - - -- Create a string "-L/usr/foo -L/usr/bar" - ldflagsString = - intercalate " " ["-L" ++ dir | dir <- extraLibDirs buildinfo] - - libdirs = "LDFLAGS=" ++ ldflagsString - - -- Create a string "-I/usr/foo -I/usr/bar" - cppflagsString = - intercalate " " ["-I" ++ dir | dir <- includeDirs buildinfo] - - includedirs = "CPPFLAGS=" ++ cppflagsString - -------------------------------------------------------------------------------- --- Building - -buildOmega pkgDesc lbi userhooks flags = do - - useInstalledOmega <- readUseInstalledOmegaFlag - - -- Do default build procedure for hs files - buildHook simpleUserHooks pkgDesc lbi userhooks flags - - -- Get 'ar' and 'ld' programs - let verb = fromFlagOrDefault Verbosity.normal $ buildVerbosity flags - let runAr = rawSystemProgramConf verb arProgram (withPrograms lbi) - - -- Build the C++ source file (and Omega library, if configured) - -- Makefile's behavior is controlled by output of 'configure' - rawSystemProgramConf verb makeProgram (withPrograms lbi) ["all"] - - -- Add other object files to libraries - let pkgId = package $ localPkgDescr lbi - - let -- Add extra files into an archive file - addStaticObjectFiles libName = do - -- Add the C++ interface file - addStaticObjectFile cppObjectName libName - - -- Add contents of libomega.a - unless useInstalledOmega $ - transferArFiles verb runAr omegaLibPath libName - - where - addStaticObjectFile objName libName = - runAr ["r", libName, objName] - - when (withVanillaLib lbi) $ - let libName = buildDir lbi mkLibName pkgId - in addStaticObjectFiles libName - - when (withProfLib lbi) $ - let libName = buildDir lbi mkProfLibName pkgId - in addStaticObjectFiles libName - - when (withGHCiLib lbi) noGHCiLib - when (withSharedLib lbi) noSharedLib - - return () - --- Transfer the contents of one archive to another -transferArFiles verb runAr src dst = do - srcCan <- canonicalizePath src - dstCan <- canonicalizePath dst - - -- Create/remove a temporary directory - bracket createUnpackDirectory (\_ -> removeUnpackDirectory) $ \_ -> - - -- Save/restore the current working directory - bracket getCurrentDirectory setCurrentDirectory $ \_ -> do - - -- Go to temporary directory - setCurrentDirectory omegaUnpackPath - - -- Unpack source archive - runAr ["x", srcCan] - - -- Find object files - objs <- liftM (filter isObjectFile) $ getDirectoryContents "." - when (null objs) $ warn verb "No object files found in Omega library; build may be incomplete" - - -- Insert into destination archive - runAr (["r", dstCan] ++ objs) - where - isObjectFile f = takeExtension f == ".o" - - createUnpackDirectory = createDirectoryIfMissing True omegaUnpackPath - removeUnpackDirectory = removeDirectoryRecursive omegaUnpackPath - -------------------------------------------------------------------------------- --- Cleaning - -cleanOmega pkgDesc mlbi userhooks flags = do - let verb = fromFlagOrDefault Verbosity.normal $ cleanVerbosity flags - - -- run 'make clean', which will clean the Omega library if appropriate - pgmConf <- configureProgram verb makeProgram defaultProgramConfiguration - makeExists <- doesFileExist "Makefile" - when makeExists $ - rawSystemProgramConf verb makeProgram pgmConf ["clean"] - - -- Clean extra files if we don't need to save configuration - -- (Other temp files are automatically cleaned) - unless (fromFlag $ cleanSaveConf flags) $ do - lenientRemoveFiles configFiles - lenientRemoveDirectory "autom4te.cache" - - -- Do default clean procedure - cleanHook simpleUserHooks pkgDesc mlbi userhooks flags - - where - -- Attempt to remove a file, ignoring errors - lenientRemoveFile f = - removeFile f `catch` \_ -> return () - - lenientRemoveFiles = mapM_ lenientRemoveFile - - -- Attempt to remove a directory and its contents - -- (one level of recursion only), ignoring errors - lenientRemoveDirectory f = do - b <- doesDirectoryExist f - when b $ do lenientRemoveFiles . map (f ) =<< getDirectoryContents f - removeDirectory f `catch` \_ -> return () +-- | Pick a CPP flag based on the Cabal library version +cabalVersionCPPFlags :: [String] +cabalVersionCPPFlags = [major_flag, minor_flag] + where + major:minor:_ = versionBranch cabalVersion - -- Extra files produced by configuration - configFiles = ["configure", "config.log", "config.status", "Makefile", - useInstalledOmegaFlagPath] + major_flag = "-DCABAL_MAJOR=" ++ show major + minor_flag = "-DCABAL_MINOR=" ++ show minor -------------------------------------------------------------------------------- --- Hooks +outputDir = "dist/setup" +setupPath = "dist/setup/do-setup" -hooks = - simpleUserHooks - { hookedPrograms = [arProgram, autoconfProgram, makeProgram] - , confHook = configureOmega - , buildHook = buildOmega - , cleanHook = cleanOmega - } +buildSetup = do + let flags = ["--make", "-XCPP"] ++ cabalVersionCPPFlags ++ + ["DoSetup.hs", "-outputdir", outputDir, "-o", setupPath] + ec <- rawSystem "ghc" flags + unless (ec == ExitSuccess) $ + fail "Error occured when building the setup script" -main = defaultMainWithHooks hooks +main = do + buildSetup + args <- getArgs + ec <- rawSystem setupPath args + exitWith ec diff --git a/configure.ac b/configure.ac --- a/configure.ac +++ b/configure.ac diff --git a/test/TestExpr.hs b/test/TestExpr.hs new file mode 100644 --- /dev/null +++ b/test/TestExpr.hs @@ -0,0 +1,27 @@ + +module TestExpr(exprTests) where + +import Test.HUnit + +import Data.Presburger.Omega.Expr +import Debug.Trace + +-- | Test whether two expressions are equal by subtracting them. +-- Equal expressions simplify to 0. +assertEqualExps :: IntExp -> IntExp -> Assertion +assertEqualExps e1 e2 = + if show (e1 |-| e2) == "intE 0" + then return () + else assertFailure message + where + message = + "Expressions not equal:\n\t" ++ show e1 ++ "\n\t" ++ show e2 + +sumOfProducts = assertEqualExps sop pos + where + [x, y] = takeFreeVariables' 2 + sop = x |*| x |-| x |*| y |-| 2 *| y |*| y + pos = (x |+| y) |*| (x |-| 2 *| y) + +exprTests = TestLabel "Expression manipulation" $ TestList + [test sumOfProducts] diff --git a/test/runtests.hs b/test/runtests.hs new file mode 100644 --- /dev/null +++ b/test/runtests.hs @@ -0,0 +1,13 @@ + +import Test.HUnit +import System.Exit + +import TestExpr + +allTests = TestList [exprTests] + +main = do + counts <- runTestTT allTests + if errors counts > 0 || failures counts > 0 + then exitFailure + else exitSuccess