git.iko.soy/Idris-dev
on master help sign in
Merge pull request #565 from JanBessai/KeepMavenProjects
2bb4c18Edwin Brady
src/IRTS/CodegenC.hs+1
compare with master
unifiedsplit
@@ -37,6 +37,7 @@ codegenC defs out exec incs objs libs flags dbg
37 let cout = headers incs ++ debug dbg ++ h ++ cc ++
37 let cout = headers incs ++ debug dbg ++ h ++ cc ++
38 (if (exec == Executable) then mprog else "")
38 (if (exec == Executable) then mprog else "")
39 case exec of
39 case exec of
40+ MavenProject -> putStrLn ("FAILURE: output type not supported")
40 Raw -> writeFile out cout
41 Raw -> writeFile out cout
41 _ -> do
42 _ -> do
42 (tmpn, tmph) <- tempfile
43 (tmpn, tmph) <- tempfile
src/IRTS/CodegenCommon.hs+1−1
@@ -7,7 +7,7 @@ import Control.Exception
7import System.Environment
7import System.Environment
8
8
9data DbgLevel = NONE | DEBUG | TRACE deriving Eq
9data DbgLevel = NONE | DEBUG | TRACE deriving Eq
10−data OutputType = Raw | Object | Executable deriving (Eq, Show)
10+data OutputType = Raw | Object | Executable | MavenProject deriving (Eq, Show)
11
11
12environment :: String -> IO (Maybe String)
12environment :: String -> IO (Maybe String)
13environment x = Control.Exception.catch (do e <- getEnv x
13environment x = Control.Exception.catch (do e <- getEnv x
src/IRTS/CodegenJava.hs+117−51
@@ -37,66 +37,132 @@ import System.Process
37
37
38-----------------------------------------------------------------------
38-----------------------------------------------------------------------
39-- Main function
39-- Main function
40−
41codegenJava :: [(Name, SExp)] -> -- initialization of globals
40codegenJava :: [(Name, SExp)] -> -- initialization of globals
42− [(Name, SDecl)] ->
41+ [(Name, SDecl)] -> -- decls
43 FilePath -> -- output file name
42 FilePath -> -- output file name
44 [String] -> -- headers
43 [String] -> -- headers
45 [String] -> -- libs
44 [String] -> -- libs
46 OutputType ->
45 OutputType ->
47 IO ()
46 IO ()
48−codegenJava globalInit defs out hdrs libs exec = do
47+codegenJava globalInit defs out hdrs libs exec =
48+ withTgtDir exec out (codegenJava' exec)
49+ where
50+ codegenJava' :: OutputType -> FilePath -> IO ()
51+ codegenJava' Raw tgtDir = do
52+ srcDir <- prepareSrcDir exec tgtDir
53+ generateJavaFile globalInit defs hdrs srcDir out
54+ codegenJava' MavenProject tgtDir = do
55+ codegenJava' Raw tgtDir
56+ generatePom tgtDir out libs
57+ codegenJava' Object tgtDir = do
58+ codegenJava' MavenProject tgtDir
59+ invokeMvn tgtDir "compile"
60+ copyClassFiles tgtDir out
61+ cleanUpTmp tgtDir
62+ codegenJava' _ tgtDir = do
63+ codegenJava' MavenProject tgtDir
64+ invokeMvn tgtDir "package";
65+ copyJar tgtDir out
66+ makeJarExecutable out
67+ cleanUpTmp tgtDir
68+
69+-----------------------------------------------------------------------
70+-- Compiler IO
71+
72+withTgtDir :: OutputType -> FilePath -> (FilePath -> IO ()) -> IO ()
73+withTgtDir Raw out action = action (dropFileName out)
74+withTgtDir MavenProject out action = createDirectoryIfMissing False out >> action out
49− withTempdir (takeBaseName out) $ \ tmpDir -> do
75+withTgtDir _ out action = withTempdir (takeBaseName out) action
76+
77+prepareSrcDir :: OutputType -> FilePath -> IO FilePath
78+prepareSrcDir Raw tgtDir = return tgtDir
79+prepareSrcDir _ tgtDir = do
50− let srcdir = tmpDir </> "src" </> "main" </> "java"
80+ let srcDir = (tgtDir </> "src" </> "main" </> "java")
51− createDirectoryIfMissing True srcdir
81+ createDirectoryIfMissing True srcDir
52− let (Ident clsName) = either error id (mkClassName out)
82+ return srcDir
53− let outjava = srcdir </> clsName <.> "java"
83+
84+javaFileName :: FilePath -> FilePath -> FilePath
85+javaFileName srcDir out =
86+ either error (\ (Ident clsName) -> srcDir </> clsName <.> "java") (mkClassName out)
87+
88+generateJavaFile :: [(Name, SExp)] -> -- initialization of globals
89+ [(Name, SDecl)] -> -- definitions
90+ [String] -> -- headers
91+ FilePath -> -- Source dir
92+ FilePath -> -- output target
93+ IO ()
94+generateJavaFile globalInit defs hdrs srcDir out = do
54− let jout = either error
95+ let code = either error
55 (prettyPrint)-- flatIndent . prettyPrint)
96 (prettyPrint)-- flatIndent . prettyPrint)
56 (evalStateT (mkCompilationUnit globalInit defs hdrs out) mkCodeGenEnv)
97 (evalStateT (mkCompilationUnit globalInit defs hdrs out) mkCodeGenEnv)
57− writeFile outjava jout
98+ writeFile (javaFileName srcDir out) code
58− if (exec == Raw)
99+
59− then copyFile outjava (takeDirectory out </> clsName <.> "java")
100+pomFileName :: FilePath -> FilePath
60− else do
101+pomFileName tgtDir = tgtDir </> "pom.xml"
102+
103+generatePom :: FilePath -> -- tgt dir
104+ FilePath -> -- output target
105+ [String] -> -- libs
106+ IO ()
107+generatePom tgtDir out libs = do
61− execPom <- getExecutablePom
108+ execPom <- getExecutablePom
62− execPomTemplate <- TIO.readFile execPom
109+ execPomTemplate <- TIO.readFile execPom
110+ let (Ident clsName) = either error id (mkClassName out)
63− let execPom = T.replace (T.pack "$MAIN-CLASS$")
111+ let execPom = T.replace (T.pack "$MAIN-CLASS$")
64− (T.pack clsName)
112+ (T.pack clsName)
65− (T.replace (T.pack "$ARTIFACT-NAME$")
113+ (T.replace (T.pack "$ARTIFACT-NAME$")
66− (T.pack $ takeBaseName out)
114+ (T.pack $ takeBaseName out)
67− (T.replace (T.pack "$DEPENDENCIES$")
115+ (T.replace (T.pack "$DEPENDENCIES$")
68− (mkPomDependencies libs)
116+ (mkPomDependencies libs)
69− execPomTemplate
117+ execPomTemplate
70− )
118+ )
71− )
119+ )
72− TIO.writeFile (tmpDir </> "pom.xml") execPom
120+ TIO.writeFile (pomFileName tgtDir) execPom
121+
122+invokeMvn :: FilePath -> String -> IO ()
123+invokeMvn tgtDir command = do
73− mvnCmd <- getMvn
124+ mvnCmd <- getMvn
74− let args = ["-f", (tmpDir </> "pom.xml")]
125+ let args = ["-f", pomFileName tgtDir]
75− (exit, mvout, err) <- readProcessWithExitCode mvnCmd (args ++ ["compile"]) ""
126+ (exit, mvout, err) <- readProcessWithExitCode mvnCmd (args ++ [command]) ""
127+ when (exit /= ExitSuccess) $
76− when (exit /= ExitSuccess) $ error ("FAILURE: " ++ mvnCmd ++ " compile\n" ++ err ++ mvout)
128+ error ("FAILURE: " ++ mvnCmd ++ " " ++ command ++ "\n" ++ err ++ mvout)
77− if (exec == Object)
129+
78− then do
130+classFileDir :: FilePath -> FilePath
79− classFiles <-
131+classFileDir tgtDir = tgtDir </> "target" </> "classes"
132+
133+copyClassFiles :: FilePath -> FilePath -> IO ()
134+copyClassFiles tgtDir out = do
80− map (\ clsFile -> tmpDir </> "target" </> "classes" </> clsFile)
135+ classFiles <- map (\ clsFile -> classFileDir tgtDir </> clsFile)
81 . filter ((".class" ==) . takeExtension)
136 . filter ((".class" ==) . takeExtension)
82− <$> getDirectoryContents (tmpDir </> "target" </> "classes")
137+ <$> getDirectoryContents (classFileDir tgtDir)
83− mapM_ (\ clsFile -> copyFile clsFile (takeDirectory out </> takeFileName clsFile))
138+ mapM_ (\ clsFile -> copyFile clsFile (takeDirectory out </> takeFileName clsFile)) classFiles
84− classFiles
139+
85− else do
140+jarFileName :: FilePath -> FilePath -> FilePath
86− (exit, mvout, err) <- readProcessWithExitCode mvnCmd (args ++ ["package"]) ""
87− when (exit /= ExitSuccess) (error ("FAILURE: " ++ mvnCmd ++ " package\n" ++ err ++ mvout))
88− copyFile (tmpDir </> "target" </> (takeBaseName out) <.> "jar") out
141+jarFileName tgtDir out = tgtDir </> "target" </> (takeBaseName out) <.> "jar"
142+
143+copyJar :: FilePath -> FilePath -> IO ()
144+copyJar tgtDir out =
145+ copyFile (jarFileName tgtDir out) out
146+
147+makeJarExecutable :: FilePath -> IO ()
148+makeJarExecutable out = do
89− handle <- openBinaryFile out ReadMode
149+ handle <- openBinaryFile out ReadMode
90− contents <- TIO.hGetContents handle
150+ contents <- TIO.hGetContents handle
91− hClose handle
151+ hClose handle
92− handle <- openBinaryFile out WriteMode
152+ handle <- openBinaryFile out WriteMode
93− TIO.hPutStr handle (T.append (T.pack jarHeader) contents)
153+ TIO.hPutStr handle (T.append (T.pack jarHeader) contents)
94− hFlush handle
154+ hFlush handle
95− hClose handle
155+ hClose handle
96− perms <- getPermissions out
156+ perms <- getPermissions out
97− setPermissions out (setOwnerExecutable True perms)
157+ setPermissions out (setOwnerExecutable True perms)
98− readProcess mvnCmd (args ++ ["clean"]) ""
158+
99− removeFile (tmpDir </> "pom.xml")
159+removePom :: FilePath -> IO ()
160+removePom tgtDir = removeFile (pomFileName tgtDir)
161+
162+cleanUpTmp :: FilePath -> IO ()
163+cleanUpTmp tgtDir = do
164+ invokeMvn tgtDir "clean"
165+ removePom tgtDir
100
166
101-----------------------------------------------------------------------
167-----------------------------------------------------------------------
102-- Jar and Pom infrastructure
168-- Jar and Pom infrastructure
src/IRTS/CodegenLLVM.hs+1
@@ -94,6 +94,7 @@ outputModule tm file Executable m = withTmpFile $ \obj -> do
94 defs <- (</> "llvm" </> "libidris_rts.a") <$> getDataDir
94 defs <- (</> "llvm" </> "libidris_rts.a") <$> getDataDir
95 exit <- rawSystem cc [obj, defs, "-lm", "-lgmp", "-lgc", "-o", file]
95 exit <- rawSystem cc [obj, defs, "-lm", "-lgmp", "-lgc", "-o", file]
96 when (exit /= ExitSuccess) $ ierror "FAILURE: Linking"
96 when (exit /= ExitSuccess) $ ierror "FAILURE: Linking"
97+outputModule _ _ MavenProject _ = ierror "FAILURE: unsupported output type"
97
98
98withTmpFile :: (FilePath -> IO a) -> IO a
99withTmpFile :: (FilePath -> IO a) -> IO a
99withTmpFile f = do
100withTmpFile f = do
src/Idris/REPL.hs+1
@@ -870,6 +870,7 @@ parseArgs ("--bytecode":n:ns) = NoREPL : BCAsm n : (parseArgs ns)
870parseArgs ("--fovm":n:ns) = NoREPL : FOVM n : (parseArgs ns)
870parseArgs ("--fovm":n:ns) = NoREPL : FOVM n : (parseArgs ns)
871parseArgs ("-S":ns) = OutputTy Raw : (parseArgs ns)
871parseArgs ("-S":ns) = OutputTy Raw : (parseArgs ns)
872parseArgs ("-c":ns) = OutputTy Object : (parseArgs ns)
872parseArgs ("-c":ns) = OutputTy Object : (parseArgs ns)
873+parseArgs ("--mvn":ns) = OutputTy MavenProject : (parseArgs ns)
873parseArgs ("--dumpdefuns":n:ns) = DumpDefun n : (parseArgs ns)
874parseArgs ("--dumpdefuns":n:ns) = DumpDefun n : (parseArgs ns)
874parseArgs ("--dumpcases":n:ns) = DumpCases n : (parseArgs ns)
875parseArgs ("--dumpcases":n:ns) = DumpCases n : (parseArgs ns)
875parseArgs ("--codegen":n:ns) = UseCodegen (parseCodegen n) : (parseArgs ns)
876parseArgs ("--codegen":n:ns) = UseCodegen (parseCodegen n) : (parseArgs ns)
src/Main.hs+1
@@ -98,6 +98,7 @@ usagemsg = "Idris version " ++ ver ++ "\n" ++
98 "\t--log [level] Type debugging log level\n" ++
98 "\t--log [level] Type debugging log level\n" ++
99 "\t-S Do no further compilation of code generator output\n" ++
99 "\t-S Do no further compilation of code generator output\n" ++
100 "\t-c Compile to object files rather than an executable\n" ++
100 "\t-c Compile to object files rather than an executable\n" ++
101+ "\t--mvn Create a maven project (for Java codegen)\n" ++
101 "\t--exec [expr] Execute the expression expr in the interpreter,\n" ++
102 "\t--exec [expr] Execute the expression expr in the interpreter,\n" ++
102 "\t defaulting to Main.main if none provided, and exit.\n" ++
103 "\t defaulting to Main.main if none provided, and exit.\n" ++
103 "\t--ideslave Ideslave mode (for editors; in/ouput wrapped in \n" ++
104 "\t--ideslave Ideslave mode (for editors; in/ouput wrapped in \n" ++