#104 Enhancements, bug fixes to support Idris 2

Author: mmhelloworld

.gitignore

@@ -1,5 +1,6 @@
 # Java
 *.class
+*.jar
 
 # Idris
 *.ibc
@@ -28,3 +29,4 @@ buildNumber.properties
 .mvn/timing.properties
 
 .DS_Store
+*.log

.travis.yml

@@ -12,7 +12,7 @@ env:
 before_install:
 - docker pull mmhelloworld/idris:1.3.2
 - mkdir -p $HOME/bin/idris-packages $IDRIS_JVM_HOME
-- wget https://github.com/mmhelloworld/idris-jvm/releases/download/v1.0-SNAPSHOT-20190525/idris-jvm.zip
+- wget https://github.com/mmhelloworld/idris-jvm/releases/download/v1.0-SNAPSHOT-20190914/idris-jvm.zip
 - unzip -o idris-jvm.zip -d $HOME/bin
 - export PATH=`pwd`/bin/travis:$IDRIS_JVM_HOME/codegen/bin:$HOME/.local/bin:$PATH
 - export PROJECT_ROOT=`pwd`
@@ -21,7 +21,8 @@ before_install:
 script:
 - lsof -ti ":$(cat $IDRIS_JVM_HOME/.idrisjvmport)" | xargs --no-run-if-empty kill
 - unzip -o idris-jvm-codegen-launcher/target/idris-jvm.zip -d $HOME/bin
-- mvn -pl :idris-jvm-integration-test test -B
+- export IDRIS_JVM_HOME=${HOME}/bin/idris-jvm
+- bin/travis/travis_long mvn -pl :idris-jvm-integration-test test -B
 before_deploy:
 - git config --local user.name mmhelloworld
 - git config --local user.email $USER_EMAIL

idris-jvm-codegen-launcher/src/main/java/io/github/mmhelloworld/idrisjvm/codegen/launcher/IdrisJvmCodegenLauncher.java

@@ -23,6 +23,7 @@
 
 import static java.lang.Integer.parseInt;
 import static java.lang.String.format;
+import static java.util.Arrays.asList;
 import static java.util.stream.Collectors.toList;
 
 public class IdrisJvmCodegenLauncher {
@@ -95,7 +96,7 @@ public void run() {
     }
 
     private void send(final String[] args) {
-        List<String> endpointArgs = new ArrayList<>(Arrays.asList(args));
+        List<String> endpointArgs = new ArrayList<>(asList(args));
         endpointArgs.add(System.getProperty("user.dir"));
         int port = getPort().orElseThrow(() -> new RuntimeException("Idris JVM codegen server is not running"));
         ResponseEntity<String> response = restTemplate.postForEntity("http://localhost:" + port,

idris-jvm-core/pom.xml

@@ -106,8 +106,10 @@
                                 <argument>${idris.srcdir}/IdrisJvm/Core/Function.idr</argument>
                                 <argument>${idris.srcdir}/IdrisJvm/Core/JAsm.idr</argument>
                                 <argument>${idris.srcdir}/IdrisJvm/Core/Operator.idr</argument>
+                                <argument>--cg-opt</argument>
+                                <argument>--classes-dir=classes</argument>
                                 <argument>-o</argument>
-                                <argument>${project.build.outputDirectory}</argument>
+                                <argument>${project.build.directory}/idrisjvmcore</argument>
                             </arguments>
                         </configuration>
                     </execution>

idris-jvm-core/src/main/idris/IdrisJvm/Core/Asm.idr

@@ -165,8 +165,6 @@ mutual
                                | InterfaceDesc ClassName
                                | ArrayDesc FieldTypeDescriptor
                                | IdrisExportDesc ClassName
-                               | NullableStrDesc
-                               | NullableRefDesc ClassName
 
   data FieldTypeDescriptor = FieldTyDescByte
                            | FieldTyDescChar
@@ -185,8 +183,6 @@ mutual
     (InterfaceDesc className1      ) == (InterfaceDesc className2      ) = className1 == className2
     (ArrayDesc elemDesc1           ) == (ArrayDesc elemDesc2           ) = elemDesc1 == elemDesc2
     (IdrisExportDesc className1    ) == (IdrisExportDesc className2    ) = className1 == className2
-    (NullableStrDesc               ) == (NullableStrDesc               ) = True
-    (NullableRefDesc className1    ) == (NullableRefDesc className2    ) = className1 == className2
     _                                == _                                = False
 
   Eq FieldTypeDescriptor where
@@ -272,8 +268,6 @@ mutual
     show (InterfaceDesc className) = "InterfaceDesc " ++ show className
     show (ArrayDesc tyDesc) = "ArrayDesc " ++ show tyDesc
     show (IdrisExportDesc className) = "IdrisExportDesc " ++ show className
-    show NullableStrDesc = "NullableStrDesc"
-    show (NullableRefDesc className) = "NullableRefDesc" ++ show className
 
   Show FieldTypeDescriptor where
     show FieldTyDescByte = "FieldTyDescByte"
@@ -296,16 +290,12 @@ mutual
     asmRefTyDesc (ClassDesc c)       = "L" ++ c ++ ";"
     asmRefTyDesc (IdrisExportDesc c) = "L" ++ c ++ ";"
     asmRefTyDesc (InterfaceDesc c)   = "L" ++ c ++ ";"
-    asmRefTyDesc (NullableRefDesc c) = "L" ++ c ++ ";"
-    asmRefTyDesc NullableStrDesc     = "Ljava/lang/String;"
     asmRefTyDesc (ArrayDesc ty)   = "[" ++ asmFieldTypeDesc ty
 
     refTyClassName : ReferenceTypeDescriptor -> ClassName
     refTyClassName (ClassDesc c)       = c
     refTyClassName (InterfaceDesc c)   = c
     refTyClassName (IdrisExportDesc c) = c
-    refTyClassName (NullableRefDesc c) = c
-    refTyClassName NullableStrDesc     = "java/lang/String"
     refTyClassName arr@(ArrayDesc _)   = asmRefTyDesc arr
 
     asmFieldTypeDesc : FieldTypeDescriptor -> String

idris-jvm-core/src/main/idris/IdrisJvm/Core/Common.idr

@@ -313,6 +313,34 @@ cgCast (Ref ty1) (Ref ty2) = when (ty1 /= ty2) $ checkcast ty2
 
 cgCast _ _ = pure ()
 
+loadAndBox : (Int -> Asm ()) -> Asm () -> InferredTypeStore -> LVar -> Asm ()
+loadAndBox loadOp boxOp sourceLocTys var = let op = \index => do loadOp index; boxOp
+                                           in opWithWordSize sourceLocTys op var
+
+loadAndBoxBool : InferredTypeStore -> LVar -> Asm ()
+loadAndBoxBool = loadAndBox Iload boxBool
+
+loadAndBoxByte : InferredTypeStore -> LVar -> Asm ()
+loadAndBoxByte = loadAndBox Iload boxByte
+
+loadAndBoxChar : InferredTypeStore -> LVar -> Asm ()
+loadAndBoxChar = loadAndBox Iload boxChar
+
+loadAndBoxShort : InferredTypeStore -> LVar -> Asm ()
+loadAndBoxShort = loadAndBox Iload boxShort
+
+loadAndBoxInt : InferredTypeStore -> LVar -> Asm ()
+loadAndBoxInt = loadAndBox Iload boxInt
+
+loadAndBoxLong : InferredTypeStore -> LVar -> Asm ()
+loadAndBoxLong = loadAndBox Lload boxLong
+
+loadAndBoxFloat : InferredTypeStore -> LVar -> Asm ()
+loadAndBoxFloat = loadAndBox Fload boxFloat
+
+loadAndBoxDouble : InferredTypeStore -> LVar -> Asm ()
+loadAndBoxDouble = loadAndBox Dload boxDouble
+
 loadVar : InferredTypeStore -> (srcTy: InferredType) -> (targetTy: InferredType) -> LVar -> Asm ()
 loadVar sourceLocTys IBool IBool var = opWithWordSize sourceLocTys Iload var
 loadVar sourceLocTys IByte IByte var = opWithWordSize sourceLocTys Iload var
@@ -330,63 +358,29 @@ loadVar sourceLocTys IFloat IDouble var = opWithWordSize sourceLocTys (\var => d
 loadVar sourceLocTys IDouble IDouble var = opWithWordSize sourceLocTys Dload var
 loadVar sourceLocTys IDouble IFloat var = opWithWordSize sourceLocTys (\var => do Dload var; D2f)  var
 
-loadVar sourceLocTys IBool IUnknown  var =
-    let loadInstr = \index => do Iload index; boxBool
-    in opWithWordSize sourceLocTys loadInstr var 
-loadVar sourceLocTys IBool (Ref _) var =
-    let loadInstr = \index => do Iload index; boxBool
-    in opWithWordSize sourceLocTys loadInstr var
+loadVar sourceLocTys IBool IUnknown  var = loadAndBoxBool sourceLocTys var
+loadVar sourceLocTys IBool (Ref _) var = loadAndBoxBool sourceLocTys var
 
-loadVar sourceLocTys IByte IUnknown  var =
-    let loadInstr = \index => do Iload index; boxByte
-    in opWithWordSize sourceLocTys loadInstr var
-loadVar sourceLocTys IByte (Ref _) var =
-    let loadInstr = \index => do Iload index; boxByte
-    in opWithWordSize sourceLocTys loadInstr var
+loadVar sourceLocTys IByte IUnknown  var = loadAndBoxByte sourceLocTys var
+loadVar sourceLocTys IByte (Ref _) var = loadAndBoxByte sourceLocTys var
 
-loadVar sourceLocTys IChar IUnknown var =
-    let loadInstr = \index => do Iload index; boxChar
-    in opWithWordSize sourceLocTys loadInstr var
-    
-loadVar sourceLocTys IChar (Ref _) var =
-    let loadInstr = \index => do Iload index; boxChar
-    in opWithWordSize sourceLocTys loadInstr var
+loadVar sourceLocTys IChar IUnknown var = loadAndBoxChar sourceLocTys var
+loadVar sourceLocTys IChar (Ref _) var = loadAndBoxChar sourceLocTys var
 
-loadVar sourceLocTys IShort IUnknown var  =
-    let loadInstr = \index => do Iload index; boxShort
-    in opWithWordSize sourceLocTys loadInstr var
-loadVar sourceLocTys IShort (Ref _) var =
-    let loadInstr = \index => do Iload index; boxShort
-    in opWithWordSize sourceLocTys loadInstr var
+loadVar sourceLocTys IShort IUnknown var  = loadAndBoxShort sourceLocTys var
+loadVar sourceLocTys IShort (Ref _) var = loadAndBoxShort sourceLocTys var
 
-loadVar sourceLocTys IInt IUnknown var  =
-    let loadInstr = \index => do Iload index; boxInt
-    in opWithWordSize sourceLocTys loadInstr var
-loadVar sourceLocTys IInt (Ref _) var =
-    let loadInstr = \index => do Iload index; boxInt
-    in opWithWordSize sourceLocTys loadInstr var
-    
-loadVar sourceLocTys ILong IUnknown var =
-    let loadInstr = \index => do Lload index; boxLong
-    in opWithWordSize sourceLocTys loadInstr var
-    
-loadVar sourceLocTys ILong (Ref _) var =
-    let loadInstr = \index => do Lload index; boxLong
-    in opWithWordSize sourceLocTys loadInstr var
+loadVar sourceLocTys IInt IUnknown var  = loadAndBoxInt sourceLocTys var
+loadVar sourceLocTys IInt (Ref _) var = loadAndBoxInt sourceLocTys var
 
-loadVar sourceLocTys IFloat IUnknown var =
-    let loadInstr = \index => do Fload index; boxFloat
-    in opWithWordSize sourceLocTys loadInstr var
-loadVar sourceLocTys IFloat (Ref _) var =
-    let loadInstr = \index => do Fload index; boxFloat
-    in opWithWordSize sourceLocTys loadInstr var
+loadVar sourceLocTys ILong IUnknown var = loadAndBoxLong sourceLocTys var
+loadVar sourceLocTys ILong (Ref _) var = loadAndBoxLong sourceLocTys var
 
-loadVar sourceLocTys IDouble IUnknown var =
-    let loadInstr = \index => do Dload index; boxDouble
-    in opWithWordSize sourceLocTys loadInstr var
-loadVar sourceLocTys IDouble (Ref _) var =
-    let loadInstr = \index => do Dload index; boxDouble
-    in opWithWordSize sourceLocTys loadInstr var
+loadVar sourceLocTys IFloat IUnknown var = loadAndBoxFloat sourceLocTys var
+loadVar sourceLocTys IFloat (Ref _) var = loadAndBoxFloat sourceLocTys var
+
+loadVar sourceLocTys IDouble IUnknown var = loadAndBoxDouble sourceLocTys var
+loadVar sourceLocTys IDouble (Ref _) var = loadAndBoxDouble sourceLocTys var
 
 loadVar sourceLocTys IUnknown IBool var =
     let loadInstr = \index => do Aload index; boolObjToBool
@@ -428,10 +422,10 @@ loadVar sourceLocTys (Ref _) IInt var =
     let loadInstr = \index => do Aload index; objToInt
     in opWithWordSize sourceLocTys loadInstr var
 
-loadVar sourceLocTys IUnknown ILong var = 
+loadVar sourceLocTys IUnknown ILong var =
     let loadInstr = \index => do Aload index; longObjToLong
     in opWithWordSize sourceLocTys loadInstr var
-loadVar sourceLocTys (Ref _) ILong var = 
+loadVar sourceLocTys (Ref _) ILong var =
     let loadInstr = \index => do Aload index; longObjToLong
     in opWithWordSize sourceLocTys loadInstr var
 
@@ -442,10 +436,10 @@ loadVar sourceLocTys (Ref _) IFloat var =
     let loadInstr = \index => do Aload index; objToFloat
     in opWithWordSize sourceLocTys loadInstr var
 
-loadVar sourceLocTys IUnknown IDouble var = 
+loadVar sourceLocTys IUnknown IDouble var =
     let loadInstr = \index => do Aload index; objToDouble
     in opWithWordSize sourceLocTys loadInstr var
-loadVar sourceLocTys (Ref _) IDouble var = 
+loadVar sourceLocTys (Ref _) IDouble var =
     let loadInstr = \index => do Aload index; objToDouble
     in opWithWordSize sourceLocTys loadInstr var
 
@@ -454,13 +448,13 @@ loadVar sourceLocTys IUnknown arr@(IArray _) var =
     in opWithWordSize sourceLocTys loadInstr var
 loadVar sourceLocTys (Ref _) arr@(IArray _) var =
     let loadInstr = \index => do Aload index; Checkcast $ getInferredTyDesc arr
-    in opWithWordSize sourceLocTys loadInstr var 
+    in opWithWordSize sourceLocTys loadInstr var
 
-loadVar sourceLocTys IUnknown (Ref ty2) var = 
+loadVar sourceLocTys IUnknown (Ref ty2) var =
     let loadInstr = \index => do Aload index; checkcast ty2
     in opWithWordSize sourceLocTys loadInstr var
 
-loadVar sourceLocTys (Ref ty1) (Ref ty2) var = 
+loadVar sourceLocTys (Ref ty1) (Ref ty2) var =
     let loadInstr = \index => do Aload index; when (ty1 /= ty2) $ checkcast ty2
     in opWithWordSize sourceLocTys loadInstr var
 

idris-jvm-core/src/main/idris/IdrisJvm/Core/Foreign.idr

@@ -24,18 +24,6 @@ data JForeign = JStatic String String
               | JLambda String String
               | JInstanceOf String
 
-javaToIdris : TypeDescriptor -> Asm ()
-javaToIdris (FieldDescriptor FieldTyDescBoolean) = pure ()
-javaToIdris (FieldDescriptor FieldTyDescByte) = pure ()
-javaToIdris (FieldDescriptor FieldTyDescShort) = pure ()
-javaToIdris (FieldDescriptor FieldTyDescInt)     = pure ()
-javaToIdris (FieldDescriptor FieldTyDescChar)    = pure ()
-javaToIdris (FieldDescriptor FieldTyDescLong)    = pure ()
-javaToIdris (FieldDescriptor FieldTyDescFloat)   = pure ()
-javaToIdris (FieldDescriptor FieldTyDescDouble)  = pure ()
-javaToIdris VoidDescriptor                       = Aconstnull
-javaToIdris _                                    = pure ()
-
 javaReturn : TypeDescriptor -> Asm ()
 javaReturn VoidDescriptor                       = Return
 javaReturn (FieldDescriptor FieldTyDescBoolean) = Ireturn
@@ -70,13 +58,9 @@ mutual
 
   fdescRefDescriptor desc@(FApp "JVM_ArrayT" [_, elemDesc]) = ArrayDesc $ fdescFieldDescriptor elemDesc
 
-  fdescRefDescriptor desc@(FApp "JVM_Nullable" [FApp "Class" [FStr typeName]]) = NullableRefDesc typeName
-  fdescRefDescriptor desc@(FApp "JVM_Nullable" [FApp "Interface" [FStr typeName]]) = NullableRefDesc typeName
-
   fdescRefDescriptor (FCon "JVM_Str") = ClassDesc "java/lang/String"
   fdescRefDescriptor (FCon "JVM_BigInteger") = ClassDesc "java/math/BigInteger"
   fdescRefDescriptor (FStr exportedType) = IdrisExportDesc exportedType
-  fdescRefDescriptor (FCon "JVM_NullableStr") = NullableStrDesc
   fdescRefDescriptor desc = jerror $ "Invalid reference type descriptor: " ++ show desc
 
 
@@ -192,10 +176,6 @@ parseDescriptor returns ffi argsDesc = tryParseStaticMethodDescriptor returns ff
             (FieldDescriptor (FieldTyDescReference (ArrayDesc _)))        => jerror "No constructors for array types"
             (FieldDescriptor (FieldTyDescReference (IdrisExportDesc _)))  =>
                 jerror "Cannot invoke constructor of Idris exported type"
-            (FieldDescriptor (FieldTyDescReference (NullableStrDesc)))    =>
-                jerror "A constructor cannot return a nullable string"
-            (FieldDescriptor (FieldTyDescReference (NullableRefDesc _)))  =>
-                jerror "A constructor cannot return a nullable reference"
         else
             tryParseNewArrayDescriptor returns ffiDesc argsDesc
   tryParseConstructorDescriptor returns ffi argsDesc = tryParseNewArrayDescriptor returns ffi argsDesc
@@ -224,8 +204,6 @@ parseDescriptor returns ffi argsDesc = tryParseStaticMethodDescriptor returns ff
         then case fdescRefDescriptor declClass of
                 ClassDesc cname     => JVirtual cname fn
                 InterfaceDesc cname => JInterface cname fn
-                NullableStrDesc     => jerror "Instance method cannot have the first argument as nullable string"
-                NullableRefDesc _   => jerror "Instance method cannot have the first argument as nullable reference"
                 ArrayDesc _         => jerror "No instance methods on an array"
                 IdrisExportDesc _   => jerror "No instance methods on an Idris exported type"
         else tryParseGetInstanceFieldDescriptor returns ffiDesc argsDesc

idris-jvm-core/src/main/idris/IdrisJvm/Core/Function.idr

@@ -247,13 +247,6 @@ mutual
     Iconst 1
     ret IBool
 
-  cgBody ret (SCon _ 0 "Prelude.Maybe.Nothing" []) = do Aconstnull; ret inferredObjectType
-  cgBody ret (SCon _ 1 "Prelude.Maybe.Just" [var]) = do
-    locTypes <- GetFunctionLocTypes
-    let varTy = getLocTy locTypes var
-    loadVar locTypes varTy inferredObjectType var
-    ret inferredObjectType
-
   cgBody ret (SCon _ t _ args) = do createIdrisObject t args; ret inferredIdrisObjectType
 
   cgBody ret (SCase _ e ((SConCase _ 0 "Prelude.Bool.False" [] falseAlt) ::
@@ -271,23 +264,6 @@ mutual
                         _))
     = cgIfTrueElse ret cgBody e trueAlt falseAlt
 
-  cgBody ret (SCase _ e ((SConCase justValueStore 1 "Prelude.Maybe.Just" [_] justExpr) ::
-                         (SConCase _ 0 "Prelude.Maybe.Nothing" [] nothingExpr) ::
-                         _))
-    = cgIfNonNull ret cgBody e justValueStore justExpr nothingExpr
-
-  cgBody ret (SCase _ e ((SConCase justValueStore 1 "Prelude.Maybe.Just" [_] justExpr) ::
-                         (SDefaultCase defaultExpr) ::
-                         _))
-    = cgIfNonNull ret cgBody e justValueStore justExpr defaultExpr
-
-  cgBody ret (SCase _ e ((SConCase _ 0 "Prelude.Maybe.Nothing" [] nothingExpr) ::
-                         (SDefaultCase defaultExpr) ::
-                         _))
-    = cgIfNull ret cgBody e nothingExpr defaultExpr
-
-  cgBody ret (SCase _ e [SConCase lv _ _ args expr]) = cgConCase ret cgBody (locIndex e) lv args expr
-
   cgBody ret (SCase _ e [SDefaultCase defaultCaseExpr]) = cgBody ret defaultCaseExpr
 
   cgBody ret (SCase _ e alts) =