93522bc · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Object and executable outputs

commit93522bc8e89b8a5d3178e29e3e5d6404b4345ef3 authorBenjamin Saunders <besaunde@sfu.ca> dateTue 25 Jun 2013, 17:36 (13 years ago) parent6b69f14

3 files changed+44−1

compare with master

unifiedsplit

Setup.hs+9 llvm/defs.c+5 src/IRTS/CodegenLLVM.hs+30−1

Setup.hs+9

@@ -53,6 +53,8 @@ cleanJavaLib verbosity

5353 execPomExists <- doesFileExist ("java" </> "executable_pom.xml")

5454 when pomExists $ removeFile ("java" </> "executable_pom.xml")

5555

56+cleanLLVMLib verbosity = make verbosity ["-C", "llvm", "clean"]

57+

5658installStdLib pkg local withoutEffects verbosity copy

5759 = do let dirs = L.absoluteInstallDirs pkg local copy

5860 let idir = datadir dirs

@@ -82,6 +84,10 @@ installStdLib pkg local withoutEffects verbosity copy

8284 , "IDRIS=" ++ icmd

8385 ]

8486

87+installLLVMLib verbosity pkg local copy =

88+ let idir = datadir $ L.absoluteInstallDirs pkg local copy in

89+ make verbosity ["-C", "llvm", "install", "TARGET=" ++ idir </> "llvm"]

90+

8591installJavaLib pkg local verbosity copy version = do

8692 let rtsFile = "idris-" ++ display version ++ ".jar"

8793 putStrLn $ "Installing java libraries"

@@ -161,11 +167,13 @@ main = do

161167 let withoutEffects = noEffectsFlag $ configFlags lbi

162168 installStdLib pkg lbi withoutEffects verb

163169 (S.fromFlag $ S.copyDest flags)

170+ installLLVMLib verb pkg lbi (S.fromFlag $ S.copyDest flags)

164171 , postInst = \ _ flags pkg lbi -> do

165172 let verb = (S.fromFlag $ S.installVerbosity flags)

166173 let withoutEffects = noEffectsFlag $ configFlags lbi

167174 installStdLib pkg lbi withoutEffects verb

168175 NoCopyDest

176+ installLLVMLib verb pkg lbi NoCopyDest

169177 when (javaFlag $ configFlags lbi)

170178 (installJavaLib pkg

171179 lbi

@@ -180,6 +188,7 @@ main = do

180188 , postClean = \ _ flags _ _ -> do

181189 let verb = S.fromFlag $ S.cleanVerbosity flags

182190 cleanStdLib verb

191+ cleanLLVMLib verb

183192 cleanJavaLib verb

184193 , postBuild = \ _ flags _ lbi -> do

185194 let verb = S.fromFlag $ S.buildVerbosity flags

llvm/defs.cnew file+5

@@ -0,0 +1,5 @@

1+#include <stdio.h>

3+void putStr(const char *str) {

4+ fputs(str, stdout);

5+}

src/IRTS/CodegenLLVM.hs+30−1

@@ -6,6 +6,9 @@ import IRTS.Lang

66import IRTS.Simplified

77import qualified Core.TT as TT

9+import Util.System

10+import Paths_idris

11+

912import LLVM.General.Context

1013import LLVM.General.Diagnostic

1114import LLVM.General.AST

@@ -31,6 +34,11 @@ import Control.Monad.Writer

3134import Control.Monad.State

3235

3336import System.Info (arch)

37+import System.IO

38+import System.Directory (removeFile)

39+import System.FilePath ((</>))

40+import System.Process (rawSystem)

41+import System.Exit (ExitCode(..))

3442import Debug.Trace

3543

3644codegenLLVM :: [(TT.Name, SDecl)] ->

@@ -39,11 +47,32 @@ codegenLLVM :: [(TT.Name, SDecl)] ->

3947 IO ()

4048codegenLLVM defs file outty = withContext $ \context -> do

4149 let ast = codegen arch (map snd defs)

42− result <- M.withModuleFromAST context ast (M.writeBitcodeToFile file)

50+ result <- M.withModuleFromAST context ast (outputModule file outty)

4351 case result of

4452 Right _ -> return ()

4553 Left msg -> ierror msg

4654

55+outputModule :: FilePath -> OutputType -> M.Module -> IO ()

56+outputModule file Raw m = M.writeBitcodeToFile file m

57+outputModule file Object m = withTmpFile $ \bc -> do

58+ outputModule bc Raw m

59+ exit <- rawSystem "llc" ["-filetype=obj", "--disable-fp-elim", "-o", file, bc]

60+ when (exit /= ExitSuccess) $ ierror "FAILURE: Object generation"

61+outputModule file Executable m = withTmpFile $ \obj -> do

62+ outputModule obj Object m

63+ cc <- getCC

64+ defs <- (</> "llvm" </> "libidris_rts.a") <$> getDataDir

65+ exit <- rawSystem cc [obj, defs, "-lm", "-lgmp", "-lgc", "-o", file]

66+ when (exit /= ExitSuccess) $ ierror "FAILURE: Linking"

67+

68+withTmpFile :: (FilePath -> IO a) -> IO a

69+withTmpFile f = do

70+ (path, handle) <- tempfile

71+ hClose handle

72+ result <- f path

73+ removeFile path

74+ return result

75+

4776ierror :: String -> a

4877ierror msg = error $ "INTERNAL ERROR: IRTS.CodegenLLVM: " ++ msg

4978