git.iko.soy/Idris-dev
on master help sign in
Java FFI: imports included and dependencies downloaded via maven
dc91b01Jan Bessai
java/executable_pom_template.xml+1
compare with master
unifiedsplit
@@ -17,6 +17,7 @@
17 <artifactId>idris</artifactId>
17 <artifactId>idris</artifactId>
18 <version>$RTS-VERSION$</version>
18 <version>$RTS-VERSION$</version>
19 </dependency>
19 </dependency>
20+$DEPENDENCIES$
20 </dependencies>
21 </dependencies>
21
22
22
23
samples/javaffi.idrnew file+12
@@ -0,0 +1,12 @@
1+module Main
2+
3+%include "com.google.common.math.IntMath"
4+%lib "com.google.guava:guava:14.0"
5+
6+binom : Int -> Int -> IO Int
7+binom n k = mkForeign (FFun "IntMath.binomial" [FInt, FInt] FInt) n k
8+
9+main : IO ()
10+main = do print "The number of possibilities in lotto is 49 choose 6:"
11+ res <- binom 49 6
12+ print res
src/IRTS/CodegenJava.hs+50−19
@@ -15,7 +15,7 @@ import qualified Control.Monad.Trans as T
15import Control.Monad.Trans.State
15import Control.Monad.Trans.State
16import Data.Char
16import Data.Char
17import Data.Maybe (fromJust)
17import Data.Maybe (fromJust)
18−import Data.List (isPrefixOf, intercalate)
18+import Data.List (isPrefixOf, isSuffixOf, intercalate)
19import qualified Data.Text as T
19import qualified Data.Text as T
20import qualified Data.Text.IO as TIO
20import qualified Data.Text.IO as TIO
21import Language.Java.Parser
21import Language.Java.Parser
@@ -35,9 +35,11 @@ type CodeGeneration = StateT (CodeGenerationEnv) (Either String)
35codegenJava :: [(Name, SExp)] -> -- initialization of globals
35codegenJava :: [(Name, SExp)] -> -- initialization of globals
36 [(Name, SDecl)] ->
36 [(Name, SDecl)] ->
37 FilePath -> -- output file name
37 FilePath -> -- output file name
38+ [String] -> -- headers
39+ [String] -> -- libs
38 OutputType ->
40 OutputType ->
39 IO ()
41 IO ()
40−codegenJava globalInit defs out exec = do
42+codegenJava globalInit defs out hdrs libs exec = do
41 withTempdir (takeBaseName out) $ \ tmpDir -> do
43 withTempdir (takeBaseName out) $ \ tmpDir -> do
42 let srcdir = tmpDir </> "src" </> "main" </> "java"
44 let srcdir = tmpDir </> "src" </> "main" </> "java"
43 createDirectoryIfMissing True srcdir
45 createDirectoryIfMissing True srcdir
@@ -46,7 +48,7 @@ codegenJava globalInit defs out exec = do
46 let outjava = srcdir </> clsName <.> "java"
48 let outjava = srcdir </> clsName <.> "java"
47 let jout = either error
49 let jout = either error
48 (flatIndent . prettyPrint)
50 (flatIndent . prettyPrint)
49− (evalStateT (mkCompilationUnit globalInit defs out) (mkCodeGenEnv globalInit))
51+ (evalStateT (mkCompilationUnit globalInit defs hdrs out) (mkCodeGenEnv globalInit))
50 writeFile outjava jout
52 writeFile outjava jout
51 if (exec == Raw)
53 if (exec == Raw)
52 then copyFile outjava (takeDirectory out </> clsName <.> "java")
54 then copyFile outjava (takeDirectory out </> clsName <.> "java")
@@ -57,12 +59,16 @@ codegenJava globalInit defs out exec = do
57 (T.pack clsName)
59 (T.pack clsName)
58 (T.replace (T.pack "$ARTIFACT-NAME$")
60 (T.replace (T.pack "$ARTIFACT-NAME$")
59 (T.pack $ takeBaseName out)
61 (T.pack $ takeBaseName out)
62+ (T.replace (T.pack "$DEPENDENCIES$")
63+ (mkPomDependencies libs)
60− execPomTemplate)
64+ execPomTemplate
65+ )
66+ )
61 TIO.writeFile (tmpDir </> "pom.xml") execPom
67 TIO.writeFile (tmpDir </> "pom.xml") execPom
62 mvnCmd <- getMvn
68 mvnCmd <- getMvn
63 let args = ["-f", (tmpDir </> "pom.xml")]
69 let args = ["-f", (tmpDir </> "pom.xml")]
64− (exit, _, err) <- readProcessWithExitCode mvnCmd (args ++ ["compile"]) ""
70+ (exit, mvout, err) <- readProcessWithExitCode mvnCmd (args ++ ["compile"]) ""
65− when (exit /= ExitSuccess) $ error ("FAILURE: " ++ mvnCmd ++ " compile\n" ++ err)
71+ when (exit /= ExitSuccess) $ error ("FAILURE: " ++ mvnCmd ++ " compile\n" ++ err ++ mvout)
66 if (exec == Object)
72 if (exec == Object)
67 then do
73 then do
68 classFiles <-
74 classFiles <-
@@ -72,8 +78,8 @@ codegenJava globalInit defs out exec = do
72 mapM_ (\ clsFile -> copyFile clsFile (takeDirectory out </> takeFileName clsFile))
78 mapM_ (\ clsFile -> copyFile clsFile (takeDirectory out </> takeFileName clsFile))
73 classFiles
79 classFiles
74 else do
80 else do
75− (exit, _, err) <- readProcessWithExitCode mvnCmd (args ++ ["package"]) ""
81+ (exit, mvout, err) <- readProcessWithExitCode mvnCmd (args ++ ["package"]) ""
76− when (exit /= ExitSuccess) (error ("FAILURE: " ++ mvnCmd ++ " package\n" ++ err))
82+ when (exit /= ExitSuccess) (error ("FAILURE: " ++ mvnCmd ++ " package\n" ++ err ++ mvout))
77 copyFile (tmpDir </> "target" </> (takeBaseName out) <.> "jar") out
83 copyFile (tmpDir </> "target" </> (takeBaseName out) <.> "jar") out
78 handle <- openBinaryFile out ReadMode
84 handle <- openBinaryFile out ReadMode
79 contents <- TIO.hGetContents handle
85 contents <- TIO.hGetContents handle
@@ -99,21 +105,40 @@ jarHeader =
99 ++ "exec \"$java\" $java_args -jar $MYSELF \"$@\""
105 ++ "exec \"$java\" $java_args -jar $MYSELF \"$@\""
100 ++ "exit 1\n"
106 ++ "exit 1\n"
101
107
108+mkPomDependencies :: [String] -> T.Text
109+mkPomDependencies deps =
110+ T.concat $ map (T.concat . map (T.append (T.pack " ")) . mkDependency . T.pack) deps
111+ where
112+ mkDependency s =
113+ case T.splitOn (T.pack ":") s of
114+ [g, a, v] ->
115+ [ T.pack $ "<dependency>\n"
116+ , T.append (T.pack " ") $ mkGroupId g
117+ , T.append (T.pack " ") $ mkArtifactId a
118+ , T.append (T.pack " ") $ mkVersion v
119+ , T.pack $ "</dependency>\n"
120+ ]
121+ _ -> []
122+ mkGroupId g = T.append (T.pack $ "<groupId>") (T.append g $ T.pack "</groupId>\n")
123+ mkArtifactId a = T.append (T.pack $ "<artifactId>") (T.append a $ T.pack "</artifactId>\n")
124+ mkVersion v = T.append (T.pack $ "<version>") (T.append v $ T.pack "</version>\n")
125+
102mkCodeGenEnv :: [(Name, SExp)] -> CodeGenerationEnv
126mkCodeGenEnv :: [(Name, SExp)] -> CodeGenerationEnv
103mkCodeGenEnv globalInit =
127mkCodeGenEnv globalInit =
104 CodeGenerationEnv $ zipWith (\ (name, _) pos -> (name, pos)) globalInit [0..]
128 CodeGenerationEnv $ zipWith (\ (name, _) pos -> (name, pos)) globalInit [0..]
105
129
106−mkCompilationUnit :: [(Name, SExp)] -> [(Name, SDecl)] -> FilePath -> CodeGeneration CompilationUnit
130+mkCompilationUnit :: [(Name, SExp)] -> [(Name, SDecl)] -> [String] -> FilePath -> CodeGeneration CompilationUnit
107−mkCompilationUnit globalInit defs out =
131+mkCompilationUnit globalInit defs hdrs out =
108− CompilationUnit Nothing [ ImportDecl False idrisRts True
132+ CompilationUnit Nothing ( [ ImportDecl False idrisRts True
109− , ImportDecl True idrisForeign True
133+ , ImportDecl True idrisForeign True
110− , ImportDecl False bigInteger False
134+ , ImportDecl False bigInteger False
111− , ImportDecl False stringBuffer False
135+ , ImportDecl False stringBuffer False
112− , ImportDecl False runtimeException False
136+ , ImportDecl False runtimeException False
113− , ImportDecl False scanner False
137+ , ImportDecl False scanner False
114− , ImportDecl False arrays False
138+ , ImportDecl False arrays False
115− ] <$>
139+ ] ++ otherHdrs
140+ )
116− mkTypeDecl globalInit defs out
141+ <$> mkTypeDecl globalInit defs out
117 where
142 where
118 idrisRts = J.Name $ map Ident ["org", "idris", "rts"]
143 idrisRts = J.Name $ map Ident ["org", "idris", "rts"]
119 idrisForeign = J.Name $ map Ident ["org", "idris", "rts", "ForeignPrimitives"]
144 idrisForeign = J.Name $ map Ident ["org", "idris", "rts", "ForeignPrimitives"]
@@ -122,6 +147,12 @@ mkCompilationUnit globalInit defs out =
122 runtimeException = J.Name $ map Ident ["java", "lang", "RuntimeException"]
147 runtimeException = J.Name $ map Ident ["java", "lang", "RuntimeException"]
123 scanner = J.Name $ map Ident ["java", "util", "Scanner"]
148 scanner = J.Name $ map Ident ["java", "util", "Scanner"]
124 arrays = J.Name $ map Ident ["java", "util", "Arrays"]
149 arrays = J.Name $ map Ident ["java", "util", "Arrays"]
150+ otherHdrs = map ( (\ name -> ImportDecl False name False)
151+ . J.Name
152+ . map (Ident . T.unpack)
153+ . T.splitOn (T.pack ".")
154+ . T.pack)
155+ $ filter (not . isSuffixOf ".h") hdrs
125
156
126flatIndent :: String -> String
157flatIndent :: String -> String
127flatIndent (' ' : ' ' : xs) = flatIndent xs
158flatIndent (' ' : ' ' : xs) = flatIndent xs
src/IRTS/Compiler.hs+1−1
@@ -71,7 +71,7 @@ compile target f tm
71 (concatMap mkObj objs)
71 (concatMap mkObj objs)
72 (concatMap mkLib libs) NONE
72 (concatMap mkLib libs) NONE
73 ViaJava ->
73 ViaJava ->
74− codegenJava [] c f outty
74+ codegenJava [] c f hdrs libs outty
75 ViaJavaScript ->
75 ViaJavaScript ->
76 codegenJavaScript JavaScript c f outty
76 codegenJavaScript JavaScript c f outty
77 ViaNode ->
77 ViaNode ->
src/IRTS/LParser.hs+1−1
@@ -61,7 +61,7 @@ fovm tgt outty f
61 case checked of
61 case checked of
62 OK c -> case tgt of
62 OK c -> case tgt of
63 ViaC -> codegenC c "a.out" outty ["math.h"] "" "" TRACE
63 ViaC -> codegenC c "a.out" outty ["math.h"] "" "" TRACE
64− ViaJava -> codegenJava [] c "a.out" outty
64+ ViaJava -> codegenJava [] c "a.out" [] [] outty
65 Error e -> fail $ show e
65 Error e -> fail $ show e
66
66
67parseFOVM :: FilePath -> IO [(Name, LDecl)]
67parseFOVM :: FilePath -> IO [(Name, LDecl)]