Finished generics support #49

typelead · Oct 13, 2016 · 9e0700b · 9e0700b
1 parent b329015
commit 9e0700b
Show file tree

Hide file tree

Showing 6 changed files with 93 additions and 91 deletions.
diff --git a/README.md b/README.md
@@ -58,6 +58,9 @@ Now, go through the following tutorials for understanding how GHCVM works and ho
 
 ### Examples
 
+For examples of using GHCVM, check out:
+
+- [ghcvm-examples](https://github.com/rahulmutt/ghcvm-examples) repository
 - [JavaFX Example](https://github.com/rahulmutt/ghcvm-javafx)
 
 ### Libraries

diff --git a/compiler/GHCVM/CodeGen/Foreign.hs b/compiler/GHCVM/CodeGen/Foreign.hs
@@ -48,26 +48,17 @@ cgForeignCall (CCall (CCallSpec target cconv safety)) args resType
         emitReturn resLocs
   where resultReps = getUnboxedResultReps resType
 
-labelToTarget :: Bool -> String -> [FieldType] -> [PrimRep] -> (Bool, Code -> Code)
-labelToTarget hasObj label argFts reps = case words label of
-  ("@static":label1) ->
-    let isStatic = True
-    in ( isStatic,
-         case label1 of
-           ["@new"] -> genNewTarget isStatic (getObjectClass resRep)
-           ["@field",label] -> genFieldTarget isStatic label getstatic putstatic
-           [label] -> genMethodTarget isStatic label invokestatic
-           _ -> pprPanic "labelToTarget: static label: " (ppr label1))
-  label2 ->
-    let notStatic = False
-    in ( notStatic
-       , case label2 of
-           ["@field",label] -> genFieldTarget notStatic label getfield putfield
-           ["@interface",label] -> genMethodTarget notStatic label invokeinterface
-           ["@new"] -> genNewTarget notStatic (getObjectClass resRep)
-           [label] -> genMethodTarget notStatic label invokevirtual
-           _ -> pprPanic "labelToTarget: instance label: " (ppr label2) )
-  where (thisRep, resRep) =
+labelToTarget :: Bool -> String -> [FieldType] -> [PrimRep] -> (Bool, [Code] -> Code)
+labelToTarget hasObj label' argFts reps = (isStatic, result)
+  where (label, isStatic) = maybe (label', False) (, True) $ stripPrefix "@static" label'
+        result = case words label of
+          ["@new"]              -> genNewTarget
+          ["@field",label1]     -> genFieldTarget label1
+          ["@interface",label1] -> genMethodTarget True label1
+          [label1]              -> genMethodTarget False label1
+          _                     -> pprPanic "labelToTarget: bad label: " (ppr label')
+        -- Remove the passed 'this'
+        (thisRep, resRep) =
           if hasObj then
             case reps of
               [a]     -> (a, VoidRep)
@@ -77,31 +68,50 @@ labelToTarget hasObj label argFts reps = case words label of
             case reps of
               [] -> (VoidRep, VoidRep)
               (a:_) -> (VoidRep, a)
-        -- Remove the passed 'this'
-        argFts' isStatic = if isStatic && not hasObj then argFts else drop 1 argFts
-        genNewTarget isStatic clsName =
-          let clsFt = obj clsName
-          in \c -> new clsFt
-                <> dup clsFt
-                <> c
-                <> invokespecial (mkMethodRef clsName "<init>" (argFts' (not hasObj)) void)
-        genFieldTarget isStatic label getInstr putInstr =
-          let (clsName, fieldName) = labelToMethod label
+        argFts' dropArg = if dropArg then drop 1 argFts else argFts
+        genNewTarget =
+          let clsName = getObjectClass resRep
+              clsFt = obj clsName
+          in \args -> new clsFt
+                   <> dup clsFt
+                   <> fold (if hasObj then drop 1 args else args)
+                   <> invokespecial (mkMethodRef clsName "<init>" (argFts' hasObj) void)
+        genFieldTarget label =
+          let (getInstr, putInstr) = if isStatic
+                                     then (getstatic, putstatic)
+                                     else (getfield, putfield)
+              (clsName, fieldName) =
+                if isStatic
+                then labelToMethod label
+                else (getFtClass (let args = argFts' False
+                                  in if length args > 0
+                                     then head args
+                                     else primRepFieldType resRep), T.pack label)
               (instr, fieldFt) =
                 if isVoidRep resRep then
-                  (putInstr, head (argFts' isStatic))
+                  (putInstr,
+                   if isStatic
+                   then head (argFts' hasObj)
+                   else head (argFts' True))
                 else
                   (getInstr, primRepFieldType resRep)
-          in \c -> c <> instr (mkFieldRef clsName fieldName fieldFt)
-        genMethodTarget isStatic label instr =
-          let (clsName, methodName) =
-                if hasObj && not isStatic
-                then (getObjectClass thisRep, T.pack label)
-                else labelToMethod label
+          in \args -> fold args
+                   <> instr (mkFieldRef clsName fieldName fieldFt)
+        genMethodTarget isInterface label =
+          let instr = if isInterface
+                      then invokeinterface
+                      else if isStatic
+                           then invokestatic
+                           else invokevirtual
+              (clsName, methodName) =
+                if isStatic
+                then labelToMethod label
+                else (getFtClass (head (argFts' False)), T.pack label)
               resFt = primRepFieldType_maybe resRep
-          in \c -> c <> instr (mkMethodRef clsName methodName (argFts' isStatic) resFt)
+          in \args -> fold args
+                   <> instr (mkMethodRef clsName methodName (argFts' (not isStatic)) resFt)
 
-emitForeignCall :: Safety -> Maybe Code -> [CgLoc] -> (Code -> Code) -> [Code] -> CodeGen ()
+emitForeignCall :: Safety -> Maybe Code -> [CgLoc] -> ([Code] -> Code) -> [Code] -> CodeGen ()
 emitForeignCall safety mbObj results target args =
   wrapSafety $ do
     maybe (emit callCode) (flip emitAssign callCode) resLoc
@@ -111,7 +121,7 @@ emitForeignCall safety mbObj results target args =
           code
           whenSafe $ emit resumeThreadMethod
           where whenSafe = when (playSafe safety)
-        callCode = target $ fold args
+        callCode = target args
         (resLoc, objLoc) =
           if isJust mbObj then
             case results of

diff --git a/compiler/GHCVM/DeSugar/DsForeign.hs b/compiler/GHCVM/DeSugar/DsForeign.hs
@@ -144,18 +144,7 @@ dsFCall funId co fcall mDeclHeader = do
                                                   (mkFastString ("@java " ++
                                                                  (f $ unpackFS label)))
                                                   mPkgKey isFun) JavaCallConv safety)
-            in case getTyVar_maybe javaTagType of
-              Just var ->
-                case lookupVarEnv extendsInfo var of
-                 Just (ident, ty, _) ->
-                   morphTarget id
-                   -- (\label ->
-                   --    let parts = words label
-                   --        start = init parts
-                   --        change = last parts
-                   --    in unwords $ start ++ [T.unpack (tagTypeToText ty) ++ "." ++ change])
-                 Nothing -> morphTarget ("@static " ++)
-              _ -> morphTarget id
+            in morphTarget id
           | otherwise = fcall
 
 extendsMap :: ThetaType -> DsM ([Id], ExtendsInfo)

diff --git a/libraries/base/GHCVM/IO.hs b/libraries/base/GHCVM/IO.hs
@@ -30,4 +30,4 @@ data {-# CLASS "java.io.PrintStream" #-} PrintStream = PrintStream (Object# Prin
 
 foreign import java unsafe "@static @field java.lang.System.out" stdout :: PrintStream
 
-foreign import java unsafe "java.io.PrintStream.println" printStr :: PrintStream -> JString -> IO ()
+foreign import java unsafe "println" printStr :: PrintStream -> JString -> IO ()
diff --git a/libraries/ghc-prim/GHC/CString.hs b/libraries/ghc-prim/GHC/CString.hs
@@ -27,9 +27,9 @@ import GHC.Prim
 
 type JString# = Object# JString -- convenience
 
-foreign import java unsafe "java.lang.String.getBytes" getBytes :: JString# -> JString# -> JByteArray#
+foreign import java unsafe "getBytes" getBytes :: JString# -> JString# -> JByteArray#
 
-foreign import java unsafe "java.lang.String.length" strLength :: JString# -> Int#
+foreign import java unsafe "length" strLength :: JString# -> Int#
 
 getBytesUtf8# :: JString# -> JByteArray#
 getBytesUtf8# this = getBytes this "UTF-8"#

diff --git a/libraries/integer/GHC/Integer/BigInteger/Prim.hs b/libraries/integer/GHC/Integer/BigInteger/Prim.hs
@@ -107,81 +107,81 @@ instance Class BigInteger where
 -- NOTE: We need to do this in order to bypass the back that you can't have top level
 -- unboxed value bindings.
 foreign import java unsafe "@static @field java.math.BigInteger.ZERO" zeroInteger# :: Void# -> Integer#
-foreign import java unsafe "java.math.BigInteger.equals" equalsInteger# :: Integer# -> Integer# -> JBool#
-foreign import java unsafe "java.math.BigInteger.abs" absInteger# :: Integer# -> Integer#
-foreign import java unsafe "java.math.BigInteger.bitLength" bitsInteger# :: Integer# -> Int#
-foreign import java unsafe "java.math.BigInteger.signum" signumInteger# :: Integer# -> Int#
-foreign import java unsafe "java.math.BigInteger.negate" negateInteger# :: Integer# -> Integer#
+foreign import java unsafe "equals" equalsInteger# :: Integer# -> Integer# -> JBool#
+foreign import java unsafe "abs" absInteger# :: Integer# -> Integer#
+foreign import java unsafe "bitLength" bitsInteger# :: Integer# -> Int#
+foreign import java unsafe "signum" signumInteger# :: Integer# -> Int#
+foreign import java unsafe "negate" negateInteger# :: Integer# -> Integer#
 
-foreign import java unsafe "java.math.BigInteger.compareTo" cmpInteger#
+foreign import java unsafe "compareTo" cmpInteger#
   :: Integer# -> Integer# -> Int#
 
 cmpIntegerInt# :: Integer# -> Int# -> Int#
 cmpIntegerInt# bigInt int = cmpInteger# bigInt (int2Integer# int)
 
-foreign import java unsafe "java.math.BigInteger.add" plusInteger#
+foreign import java unsafe "add" plusInteger#
   :: Integer# -> Integer# -> Integer#
 
 plusIntegerInt# :: Integer# -> Int# -> Integer#
 plusIntegerInt# bigInt int = plusInteger# bigInt (int2Integer# int)
 
-foreign import java unsafe "java.math.BigInteger.subtract" minusInteger#
+foreign import java unsafe "subtract" minusInteger#
   :: Integer# -> Integer# -> Integer#
 
 minusIntegerInt# :: Integer# -> Int# -> Integer#
 minusIntegerInt# bigInt int = minusInteger# bigInt (int2Integer# int)
 
-foreign import java unsafe "java.math.BigInteger.multiply" timesInteger#
+foreign import java unsafe "multiply" timesInteger#
   :: Integer# -> Integer# -> Integer#
 
 timesIntegerInt# :: Integer# -> Int# -> Integer#
 timesIntegerInt# bigInt int = timesInteger# bigInt (int2Integer# int)
 
-foreign import java unsafe "java.math.BigInteger.divideAndRemainder" quotRemInteger#
+foreign import java unsafe "divideAndRemainder" quotRemInteger#
   :: Integer# -> Integer# -> IntegerPair#
 
 quotRemIntegerWord# :: Integer# -> Word# -> IntegerPair#
 quotRemIntegerWord# bigInt word = quotRemInteger# bigInt (word2Integer# word)
 
-foreign import java unsafe "java.math.BigInteger.divide" quotInteger#
+foreign import java unsafe "divide" quotInteger#
   :: Integer# -> Integer# -> Integer#
 
 quotIntegerWord# :: Integer# -> Word# -> Integer#
 quotIntegerWord# bigInt word = quotInteger# bigInt (word2Integer# word)
 
-foreign import java unsafe "java.math.BigInteger.remainder" remInteger#
+foreign import java unsafe "remainder" remInteger#
   :: Integer# -> Integer# -> Integer#
 
 -- TODO: Reconcile differences between divMod/quotRem
 remIntegerWord# :: Integer# -> Word# -> Integer#
 remIntegerWord# bigInt word = remInteger# bigInt (word2Integer# word)
 
-foreign import java unsafe "java.math.BigInteger.divideAndRemainder" divModInteger#
+foreign import java unsafe "divideAndRemainder" divModInteger#
   :: Integer# -> Integer# -> IntegerPair#
 
 divModIntegerWord# :: Integer# -> Word# -> IntegerPair#
 divModIntegerWord# bigInt word = divModInteger# bigInt (word2Integer# word)
 
-foreign import java unsafe "java.math.BigInteger.divide" divInteger#
+foreign import java unsafe "divide" divInteger#
   :: Integer# -> Integer# -> Integer#
 
 divIntegerWord# :: Integer# -> Word# -> Integer#
 divIntegerWord# bigInt word = divInteger# bigInt (word2Integer# word)
 
-foreign import java unsafe "java.math.BigInteger.remainder" modInteger#
+foreign import java unsafe "remainder" modInteger#
   :: Integer# -> Integer# -> Integer#
 
 modIntegerWord# :: Integer# -> Word# -> Integer#
 modIntegerWord# bigInt word = modInteger# bigInt (word2Integer# word)
 
 -- TODO: Optimize divExactInteger#
-foreign import java unsafe "java.math.BigInteger.divide" divExactInteger#
+foreign import java unsafe "divide" divExactInteger#
   :: Integer# -> Integer# -> Integer#
 
 divExactIntegerWord# :: Integer# -> Word# -> Integer#
 divExactIntegerWord# bigInt word = divExactInteger# bigInt (word2Integer# word)
 
-foreign import java unsafe "java.math.BigInteger.gcd" gcdInteger#
+foreign import java unsafe "gcd" gcdInteger#
   :: Integer# -> Integer# -> Integer#
 
 foreign import java unsafe "@static ghcvm.integer.Utils.extendedEuclid" gcdExtInteger#
@@ -202,46 +202,46 @@ int2Integer# i# = int64ToInteger# (intToInt64# i#)
 foreign import java unsafe "@static ghcvm.integer.Utils.toUnsignedBigInteger" word2Integer#
   :: Word# -> Integer#
 
-foreign import java unsafe "java.math.BigInteger.and" andInteger#
+foreign import java unsafe "and" andInteger#
   :: Integer# -> Integer# -> Integer#
 
-foreign import java unsafe "java.math.BigInteger.or" orInteger#
+foreign import java unsafe "or" orInteger#
   :: Integer# -> Integer# -> Integer#
 
-foreign import java unsafe "java.math.BigInteger.xor" xorInteger#
+foreign import java unsafe "xor" xorInteger#
   :: Integer# -> Integer# -> Integer#
 
-foreign import java unsafe "java.math.BigInteger.testBit" testBitInteger#
+foreign import java unsafe "testBit" testBitInteger#
   :: Integer# -> Int# -> Int#
 
-foreign import java unsafe "java.math.BigInteger.shiftLeft" mul2ExpInteger#
+foreign import java unsafe "shiftLeft" mul2ExpInteger#
   :: Integer# -> Int# -> Integer#
 
-foreign import java unsafe "java.math.BigInteger.shiftRight" fdivQ2ExpInteger#
+foreign import java unsafe "shiftRight" fdivQ2ExpInteger#
   :: Integer# -> Int# -> Integer#
 
-foreign import java unsafe "java.math.BigInteger.pow" powInteger#
+foreign import java unsafe "pow" powInteger#
   :: Integer# -> Word# -> Integer#
 
-foreign import java unsafe "java.math.BigInteger.modPow" powModInteger#
+foreign import java unsafe "modPow" powModInteger#
   :: Integer# -> Integer# -> Integer# -> Integer#
 
 -- TODO: Use the secure version of the algorithm
-foreign import java unsafe "java.math.BigInteger.modPow" powModSecInteger#
+foreign import java unsafe "modPow" powModSecInteger#
   :: Integer# -> Integer# -> Integer# -> Integer#
 
-foreign import java unsafe "java.math.BigInteger.modInverse" recipModInteger#
+foreign import java unsafe "modInverse" recipModInteger#
   :: Integer# -> Integer# -> Integer#
 
-foreign import java unsafe "java.math.BigInteger.nextProbablePrime" nextPrimeInteger#
+foreign import java unsafe "nextProbablePrime" nextPrimeInteger#
   :: Integer# -> Integer#
 
 -- NOTE: This is different from GHC's integer-gmp in that the 2nd argument is
 --       certainty instead of number of rounds.
-foreign import java unsafe "java.math.BigInteger.isProbablePrime" testPrimeInteger#
+foreign import java unsafe "isProbablePrime" testPrimeInteger#
   :: Integer# -> Int# -> JBool#
 
-foreign import java unsafe "java.math.BigInteger.not" complementInteger#
+foreign import java unsafe "not" complementInteger#
   :: Integer# -> Integer#
 
 foreign import java unsafe "@static java.math.BigInteger.valueOf" int64ToInteger#
@@ -251,24 +251,24 @@ foreign import java unsafe "@static java.math.BigInteger.valueOf" int64ToInteger
 foreign import java unsafe "@static java.math.BigInteger.valueOf" word64ToInteger#
   :: Word64# -> Integer#
 
-foreign import java unsafe "java.math.BigInteger.longValue" integerToInt64#
+foreign import java unsafe "longValue" integerToInt64#
   :: Integer# -> Int64#
 
 -- TODO: Is this correct?
-foreign import java unsafe "java.math.BigInteger.longValue" integerToWord64#
+foreign import java unsafe "longValue" integerToWord64#
   :: Integer# -> Word64#
 
-foreign import java unsafe "java.math.BigInteger.intValue" integer2Int#
+foreign import java unsafe "intValue" integer2Int#
   :: Integer# -> Int#
 
 -- TODO: Is this correct?
-foreign import java unsafe "java.math.BigInteger.intValue" integer2Word#
+foreign import java unsafe "intValue" integer2Word#
   :: Integer# -> Word#
 
-foreign import java unsafe "java.math.BigInteger.floatValue"  integer2Float#
+foreign import java unsafe "floatValue"  integer2Float#
   :: Integer# -> Float#
 
-foreign import java unsafe "java.math.BigInteger.doubleValue" integer2Double#
+foreign import java unsafe "doubleValue" integer2Double#
   :: Integer# -> Double#
 
 foreign import java unsafe "@static ghcvm.integer.Utils.encodeFloat"