diff --git a/idris-jvm-runtime/src/main/java/io/github/mmhelloworld/idrisjvm/runtime/Conversion.java b/idris-jvm-runtime/src/main/java/io/github/mmhelloworld/idrisjvm/runtime/Conversion.java index 5af59cd1..d8e03402 100644 --- a/idris-jvm-runtime/src/main/java/io/github/mmhelloworld/idrisjvm/runtime/Conversion.java +++ b/idris-jvm-runtime/src/main/java/io/github/mmhelloworld/idrisjvm/runtime/Conversion.java @@ -19,39 +19,21 @@ private Conversion() { } public static int toInt(Object that) { - if (that == null) { - return 0; - } else if (that instanceof Integer) { - return (int) that; - } else if (that instanceof BigInteger) { - return ((BigInteger) that).intValue(); - } else if (that instanceof Long) { - return (int) (long) that; + if (that instanceof Number) { + return ((Number) that).intValue(); } else if (that instanceof Character) { return (char) that; } else if (that instanceof Boolean) { return boolToInt1((boolean) that); - } else if (that instanceof Byte) { - return (byte) that; - } else if (that instanceof Short) { - return (short) that; } else { - throw new IllegalArgumentException(format("Unable to convert value %s of type %s to int", + throw new NumberFormatException(format("Unable to convert value %s of type %s to int", that, that.getClass())); } } - public static int toInt1(Object that) { - return toInt(that); - } - public static char toChar(Object that) { - if (that == null) { - return 0; - } else if (that instanceof Character) { + if (that instanceof Character) { return (char) that; - } else if (that instanceof Thunk) { - return (char) ((Thunk) that).getInt(); } else if (that instanceof Integer) { return (char) (int) (Integer) that; } else { @@ -61,12 +43,8 @@ public static char toChar(Object that) { } public static boolean toBoolean(Object that) { - if (that == null) { - return false; - } else if (that instanceof Boolean) { + if (that instanceof Boolean) { return (Boolean) that; - } else if (that instanceof Thunk) { - return intToBoolean1(((Thunk) that).getInt()); } else if (that instanceof Integer) { return intToBoolean1((Integer) that); } else { @@ -80,55 +58,19 @@ public static boolean toBoolean1(Object that) { } public static long toLong(Object value) { - if (value instanceof Long) { - return (long) value; - } else if (value instanceof Integer) { - return (int) value; - } else if (value instanceof BigInteger) { - return ((BigInteger) value).longValue(); - } else if (value instanceof LongThunk) { - return ((Thunk) value).getLong(); - } else { - throw new IllegalArgumentException(format("Unable to convert value %s of type %s to long", - value, value.getClass())); - } + return ((Number) value).longValue(); } public static double toDouble(Object that) { - if (that instanceof Double) { - return (double) that; - } else if (that instanceof Integer) { - return (int) that; - } else if (that instanceof Thunk) { - return ((Thunk) that).getDouble(); - } else if (that instanceof Float) { - return (float) that; - } else { - throw new IllegalArgumentException(format("Unable to convert value %s of type %s to double", - that, that.getClass())); - } + return ((Number) that).doubleValue(); } public static byte toByte(Object that) { - if (that instanceof Integer) { - return ((Integer) that).byteValue(); - } else if (that instanceof Byte) { - return (byte) that; - } else { - throw new IllegalArgumentException(format("Unable to convert value %s of type %s to byte", - that, that.getClass())); - } + return ((Number) that).byteValue(); } public static short toShort(Object that) { - if (that instanceof Integer) { - return ((Integer) that).shortValue(); - } else if (that instanceof Short) { - return (short) that; - } else { - throw new IllegalArgumentException(format("Unable to convert value %s of type %s to short", - that, that.getClass())); - } + return ((Number) that).shortValue(); } public static float toFloat(Object that) { diff --git a/idris-jvm-runtime/src/main/java/io/github/mmhelloworld/idrisjvm/runtime/MemoizedDelayed.java b/idris-jvm-runtime/src/main/java/io/github/mmhelloworld/idrisjvm/runtime/MemoizedDelayed.java index 5a10654d..25b68583 100644 --- a/idris-jvm-runtime/src/main/java/io/github/mmhelloworld/idrisjvm/runtime/MemoizedDelayed.java +++ b/idris-jvm-runtime/src/main/java/io/github/mmhelloworld/idrisjvm/runtime/MemoizedDelayed.java @@ -1,7 +1,5 @@ package io.github.mmhelloworld.idrisjvm.runtime; -import static io.github.mmhelloworld.idrisjvm.runtime.Runtime.unwrap; - public final class MemoizedDelayed implements Delayed { private boolean initialized; private Delayed delayed; @@ -10,7 +8,7 @@ public MemoizedDelayed(Delayed delayed) { this.delayed = () -> { synchronized (this) { if (!initialized) { - Object value = unwrap(delayed.evaluate()); + Object value = delayed.evaluate(); this.delayed = () -> value; initialized = true; } diff --git a/idris-jvm-runtime/src/main/java/io/github/mmhelloworld/idrisjvm/runtime/Runtime.java b/idris-jvm-runtime/src/main/java/io/github/mmhelloworld/idrisjvm/runtime/Runtime.java index 70f1a592..7aedf784 100644 --- a/idris-jvm-runtime/src/main/java/io/github/mmhelloworld/idrisjvm/runtime/Runtime.java +++ b/idris-jvm-runtime/src/main/java/io/github/mmhelloworld/idrisjvm/runtime/Runtime.java @@ -27,7 +27,6 @@ public final class Runtime { private static IdrisList programArgsList; private static Exception exception; - private Runtime() { } @@ -135,82 +134,14 @@ public static String getStackTraceString() { public static void free(Object object) { } - public static IntThunk unboxToIntThunk(Thunk value) { - return () -> value; - } - - public static DoubleThunk unboxToDoubleThunk(Thunk value) { - return () -> value; - } - - public static IntThunk createThunk(int value) { - return new IntThunkResult(value); - } - - public static LongThunk createThunk(long value) { - return new LongThunkResult(value); - } - - public static DoubleThunk createThunk(double value) { - return new DoubleThunkResult(value); - } - - public static Thunk createThunk(Object value) { - return value instanceof Thunk ? (Thunk) value : new ObjectThunkResult(value); - } - - public static Object unwrap(Object possibleThunk) { - if (possibleThunk instanceof Thunk) { - Thunk thunk = (Thunk) possibleThunk; - while (thunk != null && thunk.isRedex()) { - thunk = thunk.evaluate(); - } - return thunk == null ? null : thunk.getObject(); - } else { - return possibleThunk; - } - } - public static Object force(Object delayed) { - return unwrap(((Delayed) unwrap(delayed)).evaluate()); - } - - public static int unwrapIntThunk(Object possibleThunk) { - if (possibleThunk instanceof Thunk) { - return ((Thunk) possibleThunk).getInt(); - } else { - return Conversion.toInt(possibleThunk); - } - } - - public static char unwrapIntThunkToChar(Object possibleThunk) { - if (possibleThunk instanceof Thunk) { - return (char) ((Thunk) possibleThunk).getInt(); - } else { - return (char) possibleThunk; - } - } - - public static long unwrapLongThunk(Object possibleThunk) { - if (possibleThunk instanceof Thunk) { - return ((Thunk) possibleThunk).getLong(); - } else { - return (long) possibleThunk; - } - } - - public static double unwrapDoubleThunk(Object possibleThunk) { - if (possibleThunk instanceof Thunk) { - return ((Thunk) possibleThunk).getDouble(); - } else { - return (double) possibleThunk; - } + return ((Delayed)delayed).evaluate(); } public static ForkJoinTask fork(Function action) { return FORK_JOIN_POOL.submit(() -> { try { - unwrap(action.apply(0)); + action.apply(0); } catch (Exception e) { e.printStackTrace(); } @@ -218,7 +149,7 @@ public static ForkJoinTask fork(Function action) { } public static ForkJoinTask fork(Delayed action) { - return FORK_JOIN_POOL.submit(() -> unwrap(action.evaluate())); + return FORK_JOIN_POOL.submit(action::evaluate); } public static void await(ForkJoinTask task) { diff --git a/src/Compiler/Jvm/Codegen.idr b/src/Compiler/Jvm/Codegen.idr index 4d03c364..72a837ac 100644 --- a/src/Compiler/Jvm/Codegen.idr +++ b/src/Compiler/Jvm/Codegen.idr @@ -243,6 +243,12 @@ isInterfaceInvocation : InferredType -> Bool isInterfaceInvocation (IRef _ Interface _) = True isInterfaceInvocation _ = False +assembleZero : {auto stateRef: Ref AsmState AsmState} -> (isTailCall: Bool) -> InferredType -> Core () +assembleZero isTailCall returnType = do + iconst 0 + asmCast IInt returnType + when isTailCall $ asmReturn returnType + assembleNil : {auto stateRef: Ref AsmState AsmState} -> (isTailCall: Bool) -> InferredType -> Core () assembleNil isTailCall returnType = do field GetStatic idrisNilClass "INSTANCE" "Lio/github/mmhelloworld/idrisjvm/runtime/IdrisList$Nil;" @@ -477,15 +483,9 @@ mutual ldc $ DoubleConst value asmCast IDouble returnType when isTailCall $ asmReturn returnType - assembleExpr isTailCall returnType (NmPrimVal fc _) = do - iconst 0 - asmCast IInt returnType - when isTailCall $ asmReturn returnType - assembleExpr isTailCall IInt (NmErased fc) = do iconst 0; when isTailCall $ asmReturn IInt - assembleExpr isTailCall IChar (NmErased fc) = do iconst 0; when isTailCall $ asmReturn IChar - assembleExpr isTailCall IDouble (NmErased fc) = do ldc $ DoubleConst 0; when isTailCall $ asmReturn IDouble - assembleExpr isTailCall returnType (NmErased fc) = do aconstnull; when isTailCall $ asmReturn returnType - assembleExpr isTailCall returnType (NmCrash fc msg) = do + assembleExpr isTailCall returnType (NmPrimVal _ _) = assembleZero isTailCall returnType + assembleExpr isTailCall returnType (NmErased _) = assembleZero isTailCall returnType + assembleExpr isTailCall returnType (NmCrash _ msg) = do ldc $ StringConst msg invokeMethod InvokeStatic runtimeClass "crash" "(Ljava/lang/String;)Ljava/lang/Object;" False asmCast inferredObjectType returnType diff --git a/src/Compiler/Jvm/Optimizer.idr b/src/Compiler/Jvm/Optimizer.idr index e56b1905..f9261b6a 100644 --- a/src/Compiler/Jvm/Optimizer.idr +++ b/src/Compiler/Jvm/Optimizer.idr @@ -725,7 +725,7 @@ mutual inferExpr (NmPrimVal fc (Ch _)) = pure IChar inferExpr (NmPrimVal fc (Db _)) = pure IDouble inferExpr (NmPrimVal fc _) = pure IInt - inferExpr (NmErased fc) = pure IUnknown + inferExpr (NmErased fc) = pure IInt inferExpr (NmCrash fc msg) = pure IUnknown inferConstructorSwitchExpr : {auto stateRef: Ref AsmState AsmState} -> NamedCExp -> Core () @@ -798,30 +798,30 @@ mutual if (endsWith (methodName rootMethodName) "$ltinit$gt") then inferExtPrim fc JvmStaticMethodCall [voidTypeExpr, NmErased fc, fargs, world] else pure IUnknown - inferExtPrim _ NewArray [_, size, val, world] = do + inferExtPrim _ NewArray [_, size, val, _] = do ignore $ inferExpr size ignore $ inferExpr val pure arrayListType - inferExtPrim _ ArrayGet [_, arr, pos, world] = do + inferExtPrim _ ArrayGet [_, arr, pos, _] = do ignore $ inferExpr arr ignore $ inferExpr pos pure IUnknown - inferExtPrim _ ArraySet [_, arr, pos, val, world] = do + inferExtPrim _ ArraySet [_, arr, pos, val, _] = do ignore $ inferExpr arr ignore $ inferExpr pos ignore $ inferExpr val pure inferredObjectType - inferExtPrim _ JvmNewArray [tyExpr, size, world] = do + inferExtPrim _ JvmNewArray [tyExpr, size, _] = do ignore $ inferExpr size elemTy <- tySpec tyExpr pure $ IArray elemTy - inferExtPrim _ JvmSetArray [tyExpr, index, val, arr, world] = do + inferExtPrim _ JvmSetArray [tyExpr, index, val, arr, _] = do elemTy <- tySpec tyExpr ignore $ inferExpr arr ignore $ inferExpr index ignore $ inferExpr val pure inferredObjectType - inferExtPrim _ JvmGetArray [tyExpr, index, arr, world] = do + inferExtPrim _ JvmGetArray [tyExpr, index, arr, _] = do elemTy <- tySpec tyExpr ignore $ inferExpr arr ignore $ inferExpr index diff --git a/src/Compiler/Jvm/Variable.idr b/src/Compiler/Jvm/Variable.idr index 952cd757..01665bf2 100644 --- a/src/Compiler/Jvm/Variable.idr +++ b/src/Compiler/Jvm/Variable.idr @@ -132,13 +132,13 @@ asmCast IShort IShort = pure () asmCast IInt IBool = pure () asmCast IInt IInt = pure () asmCast IChar IInt = pure () +asmCast IBool IInt = boolToInt +asmCast IVoid IInt = iconst 0 -- for primitive functions returning void, Idris return type will be int asmCast ILong ILong = pure () asmCast IFloat IFloat = pure () asmCast IDouble IDouble = pure () asmCast (IArray _) (IArray _) = pure () -asmCast IBool IInt = boolToInt -asmCast IVoid IInt = iconst 0 -- for primitive functions returning void, Idris return type will be int asmCast IInt IChar = i2c asmCast IInt IByte = i2b asmCast IInt IShort = i2s