Skip to content

Commit

Permalink
Implement bundled toolchain feature
Browse files Browse the repository at this point in the history
  • Loading branch information
melted committed Apr 2, 2015
1 parent 4359edd commit b9b19e5
Show file tree
Hide file tree
Showing 6 changed files with 62 additions and 9 deletions.
29 changes: 23 additions & 6 deletions Setup.hs
Original file line number Diff line number Diff line change
Expand Up @@ -137,17 +137,33 @@ generateTargetModule verbosity dir targetDir = do
++ " dir <- getDataDir\n"
++ " return (dir ++ \"/\" ++ name)"

-- a module that has info about existence and location of a bundled toolchain
generateToolchainModule verbosity srcDir toolDir = do
let commonContent = "module Tools_idris where\n\n"
let toolContent = case toolDir of
Just dir -> "hasBundledToolchain = True\n" ++
"getToolchainDir = \"" ++ dir ++ "\"\n"
Nothing -> "hasBundledToolchain = False\n" ++
"getToolchainDir = \"\""
let toolPath = srcDir </> "Tools_idris" Px.<.> "hs"
createDirectoryIfMissingVerbose verbosity True srcDir
rewriteFile toolPath (commonContent ++ toolContent)

idrisConfigure _ flags _ local = do
configureRTS
generateVersionModule verbosity (autogenModulesDir local) (isRelease (configFlags local))
when (isFreestanding $ configFlags local) (do
targetDir <- lookupEnv "IDRIS_INSTALL_DIR"
configureRTS
generateVersionModule verbosity (autogenModulesDir local) (isRelease (configFlags local))
if (isFreestanding $ configFlags local)
then (do
toolDir <- lookupEnv "IDRIS_TOOLCHAIN_DIR"
generateToolchainModule verbosity (autogenModulesDir local) toolDir
targetDir <- lookupEnv "IDRIS_LIB_DIR"
case targetDir of
Just d -> generateTargetModule verbosity (autogenModulesDir local) d
Nothing -> error $ "Trying to build freestanding without a target directory."
++ " Set it by defining IDRIS_INSTALL_DIR.")
where
++ " Set it by defining IDRIS_LIB_DIR.")
else
generateToolchainModule verbosity (autogenModulesDir local) Nothing
where
verbosity = S.fromFlag $ S.configVerbosity flags
version = pkgVersion . package $ localPkgDescr local

Expand All @@ -162,6 +178,7 @@ idrisPreSDist args flags = do
let verb = S.fromFlag (S.sDistVerbosity flags)
generateVersionModule verb ("src") True
generateTargetModule verb "src" "./libs"
generateToolchainModule verb "src" Nothing
preSDist simpleUserHooks args flags

idrisPostSDist args flags desc lbi = do
Expand Down
5 changes: 4 additions & 1 deletion codegen/idris-c/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,8 @@ import Control.Monad

import Paths_idris

import Util.System

data Opts = Opts { inputs :: [FilePath],
interface :: Bool,
output :: FilePath }
Expand All @@ -31,7 +33,8 @@ getOpts = do xs <- getArgs
process opts [] = opts

c_main :: Opts -> Idris ()
c_main opts = do elabPrims
c_main opts = do runIO setupBundledCC
elabPrims
loadInputs (inputs opts) Nothing
mainProg <- if interface opts
then liftM Just elabMain
Expand Down
1 change: 1 addition & 0 deletions idris.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -806,6 +806,7 @@ Library
-- Auto Generated
, Paths_idris
, Version_idris
, Tools_idris

Build-depends: base >=4 && <5
, annotated-wl-pprint >= 0.5.3 && < 0.6
Expand Down
2 changes: 2 additions & 0 deletions main/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,7 @@ import Idris.CmdOptions
import IRTS.System ( getLibFlags, getIdrisLibDir, getIncFlags )

import Util.DynamicLinker
import Util.System

import Pkg.Package

Expand All @@ -43,6 +44,7 @@ main = do opts <- runArgParser

runIdris :: [Opt] -> Idris ()
runIdris opts = do
runIO setupBundledCC
when (ShowIncs `elem` opts) $ runIO showIncs
when (ShowLibs `elem` opts) $ runIO showLibs
when (ShowLibdir `elem` opts) $ runIO showLibdir
Expand Down
32 changes: 30 additions & 2 deletions src/Util/System.hs
Original file line number Diff line number Diff line change
@@ -1,19 +1,26 @@
{-# LANGUAGE CPP #-}
module Util.System(tempfile,withTempdir,rmFile,catchIO, isWindows,
readSource, writeSource) where
writeSource, readSource, setupBundledCC) where

-- System helper functions.
import Control.Monad (when)
import System.Directory (getTemporaryDirectory
, removeFile
, removeDirectoryRecursive
, createDirectoryIfMissing
, doesDirectoryExist
)
import System.FilePath ((</>), normalise)
import System.FilePath ((</>), normalise, isAbsolute, dropFileName)
import System.IO
import System.Info
import System.IO.Error
import Control.Exception as CE

#ifdef FREESTANDING
import Tools_idris
import System.Environment (getEnv, setEnv, getExecutablePath)
#endif

catchIO :: IO a -> (IOError -> IO a) -> IO a
catchIO = CE.catch

Expand Down Expand Up @@ -54,3 +61,24 @@ rmFile f = do putStrLn $ "Removing " ++ f
catchIO (removeFile f)
(\ioerr -> putStrLn $ "WARNING: Cannot remove file "
++ f ++ ", Error msg:" ++ show ioerr)

setupBundledCC :: IO()
#ifdef FREESTANDING
setupBundledCC = when hasBundledToolchain
$ do
exePath <- getExecutablePath
path <- getEnv "PATH"
tcDir <- return getToolchainDir
absolute <- return $ isAbsolute tcDir
target <- return $
if absolute
then tcDir
else dropFileName exePath ++ tcDir
let pathSep = if isWindows then ";" else ":"
present <- doesDirectoryExist target
when present
$ do newPath <- return $ target ++ pathSep ++ path
setEnv "PATH" newPath
#else
setupBundledCC = return ()
#endif
2 changes: 2 additions & 0 deletions win-release.sh
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@

IDRIS_LIB_DIR="./libs" IDRIS_TOOLCHAIN_DIR="./mingw/bin" CABALFLAGS="-fffi -ffreestanding -frelease" make

0 comments on commit b9b19e5

Please sign in to comment.