Permalink
Fetching contributors…
Cannot retrieve contributors at this time
517 lines (401 sloc) 21.2 KB
{- «•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»
Copyright © 2011 - 2015, Ingo Wechsung
All rights reserved.
Redistribution and use in source and binary forms, with or
without modification, are permitted provided that the following
conditions are met:
Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution. Neither the name of the copyright holder
nor the names of its contributors may be used to endorse or
promote products derived from this software without specific
prior written permission.
THIS SOFTWARE IS PROVIDED BY THE
COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER
OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
THE POSSIBILITY OF SUCH DAMAGE.
«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•»«•» -}
{--
* Here live all classes and interfaces from @java.lang@ except those already
* introduced in the Prelude.
-}
protected package frege.java.Lang
inline (Byte.unsigned)
where
import frege.prelude.PreludeArrays (ArrayElement, JArray, PrimitiveArrayElement)
import frege.prelude.PreludeBase
import frege.prelude.PreludeBase public(Throwable, Object,
ClassNotFoundException,
NumberFormatException,
InterruptedException)
import frege.prelude.PreludeIO (Exceptional, Mutable, MutableIO, Serializable, STMutable)
import frege.prelude.PreludeIO public(Exception)
-- import frege.prelude.PreludeText
import frege.prelude.PreludeMonad
-- -------------------------------------------------------------------------
-- ---------------------- several exceptions -------------------------------
-- -------------------------------------------------------------------------
instance Exceptional Throwable where
pure native javaClass "java.lang.Throwable.class" :: Class Throwable
instance Exceptional ClassNotFoundException where
pure native javaClass "java.lang.ClassNotFoundException.class" :: Class ClassNotFoundException
protected data IOException = pure native java.io.IOException
derive Exceptional IOException
derive Exceptional InterruptedException
data IllegalStateException = pure native java.lang.IllegalStateException
derive Exceptional IllegalStateException
data IllegalThreadStateException = pure native java.lang.IllegalThreadStateException
derive Exceptional IllegalThreadStateException
data InstantiationException = pure native java.lang.InstantiationException
derive Exceptional InstantiationException
data NoSuchFieldException = pure native java.lang.NoSuchFieldException
derive Exceptional NoSuchFieldException
data IllegalAccessException = pure native java.lang.IllegalAccessException
derive Exceptional IllegalAccessException
data IllegalArgumentException = pure native java.lang.IllegalArgumentException where
--- temporary 'new' name until name lookup bug fixed
pure native new :: String -> IllegalArgumentException
| String -> Throwable -> IllegalArgumentException
derive Exceptional IllegalArgumentException
data SecurityException = pure native java.lang.SecurityException
derive Exceptional SecurityException
data NullPointerException = pure native java.lang.NullPointerException
derive Exceptional NullPointerException
data Error = pure native java.lang.Error
derive Exceptional Error
data NoSuchMethodError = pure native java.lang.NoSuchMethodError
derive Exceptional NoSuchMethodError
data ExceptionInInitializerError = pure native java.lang.ExceptionInInitializerError
derive Exceptional ExceptionInInitializerError
data IndexOutOfBoundsException = pure native java.lang.IndexOutOfBoundsException
derive Exceptional IndexOutOfBoundsException
data StringIndexOutOfBoundsException = pure native java.lang.StringIndexOutOfBoundsException
derive Exceptional StringIndexOutOfBoundsException
-- -------------------------------------------------------------------------
-- ---------------------- Runnable ----------------------------------------
-- -------------------------------------------------------------------------
native module where {
public static<S> java.lang.Runnable runnable(final Func.U<S,Short> arg1) {
return new java.lang.Runnable() {
public void run() {
final short done = PreludeBase.TST.run(
RunTM.<Func.U<Object,Short>>cast(arg1)).call();
}
};
}
}
--- A @java.lang.Runnable@, can be created from 'IO' or 'ST' actions
data Runnable = native java.lang.Runnable where
--- nowarn: argument of type 'ST' s ()
--- Create a java Runnable from a 'ST' @s@ '()'.
--- When the @run@ method is called from java code, the ST action will be performed.
native new Lang.runnable :: ST s () -> ST s (Mutable s Runnable)
--- perform the ST action that is associated with this runnable.
native run :: Mutable s Runnable -> ST s ()
-- -------------------------------------------------------------------------
-- ---------------------- Class Loading & Resources ------------------------
-- -------------------------------------------------------------------------
protected data MetaFP = pure native "frege.runtime.Meta.FregePackage"
private pure native md "frege.runtime.Meta.FregePackage.class" :: Class MetaFP
data ClassLoader = mutable native java.lang.ClassLoader where
native getClassLoader :: Class a -> IO ClassLoader
current = getClassLoader md
protected data PrintStream = mutable native java.io.PrintStream
data Appendable = native java.lang.Appendable where
native append :: Mutable s Appendable -> Char -> ST s (Mutable s Appendable)
throws IOException
| Mutable s Appendable -> String -> ST s (Mutable s Appendable)
throws IOException
data System = pure native java.lang.System where
pure native getenv java.lang.System.getenv :: String -> Maybe String
pure native getProperty java.lang.System.getProperty :: String -> Maybe String
pure native lineSeparator java.lang.System.lineSeparator :: () -> String
native exit java.lang.System.exit :: Int -> IO ()
native currentTimeMillis java.lang.System.currentTimeMillis
:: () -> IO Long
native nanoTime java.lang.System.nanoTime :: () -> IO Long
--- nowarn: System.err is not supposed to change
native err "java.lang.System.err" :: PrintStream
--- nowarn: System.out is not supposed to change
native out "java.lang.System.out" :: PrintStream
--- expose memory / cpu related functions here for convenience
native availableProcessors "java.lang.Runtime.getRuntime().availableProcessors"
:: () -> IO Int
native freeMemory "java.lang.Runtime.getRuntime().freeMemory"
:: () -> IO Long
native maxMemory "java.lang.Runtime.getRuntime().maxMemory" :: () -> IO Long
native totalMemory "java.lang.Runtime.getRuntime().totalMemory"
:: () -> IO Long
data CharSequence = pure native java.lang.CharSequence where
pure native charAt :: CharSequence -> Int -> Char
pure native length :: CharSequence -> Int
pure native subSeq subSequence :: CharSequence -> Int -> Int -> CharSequence
pure native toString :: CharSequence -> String
pure native fromString "(java.lang.CharSequence)" :: String -> CharSequence
{--
Returns the code point at the given index of the 'CharSequence'.
If the char value at the given index in the CharSequence is
in the high-surrogate range,
the following index is less than the length of the CharSequence,
and the char value at the following index is in the low-surrogate range,
then the supplementary code point corresponding to this surrogate pair is returned.
Otherwise, the char value at the given index is returned.
Note that the corresponding java method is from @java.lang.Character@,
but logically fits in here better.
See also: 'Char.isSupplementaryCodePoint'
-}
pure native codePointAt
"java.lang.Character.codePointAt" :: CharSequence -> Int -> Int
--- Resembles @java.lang.StringBuilder@
data StringBuilder = native java.lang.StringBuilder where
native new :: String -> ST s (Mutable s StringBuilder)
native toString :: Mutable s StringBuilder -> ST s String
-- -------------------------------------------------------------------------
-- ---------------------- Threads -----------------------------------------
-- -------------------------------------------------------------------------
--- An OS thread
data Thread = mutable native java.lang.Thread where
native new :: MutableIO Runnable -> IO Thread
native start :: Thread -> IO ()
native setName :: Thread -> String -> IO ()
native getName :: Thread -> IO String
--- Obtain the current 'Thread'
native current java.lang.Thread.currentThread
:: () -> IO Thread
--- Sleep for a number of milliseconds.
native sleep java.lang.Thread.sleep
:: Long -> IO () throws InterruptedException
data Boolean = pure native java.lang.Boolean
data Character = pure native java.lang.Character
data Readable = native "java.lang.Readable"
data StringBuffer = native java.lang.StringBuffer where
native new :: CharSequence -> STMutable s StringBuffer
| String -> STMutable s StringBuffer
| Int -> STMutable s StringBuffer
| () -> STMutable s StringBuffer
native append :: Mutable s StringBuffer -> Float -> STMutable s StringBuffer
| Mutable s StringBuffer -> Double -> STMutable s StringBuffer
| Mutable s StringBuffer -> Bool -> STMutable s StringBuffer
| Mutable s StringBuffer -> Char -> STMutable s StringBuffer
| Mutable s StringBuffer -> Int -> STMutable s StringBuffer
| Mutable s StringBuffer -> Long -> STMutable s StringBuffer
| Mutable s StringBuffer -> Object -> STMutable s StringBuffer
| Mutable s StringBuffer -> CharSequence -> STMutable s StringBuffer
| Mutable s StringBuffer -> CharSequence -> Int -> Int -> STMutable s StringBuffer
| Mutable s StringBuffer -> Mutable s (JArray Char) -> STMutable s StringBuffer
| Mutable s StringBuffer -> Mutable s (JArray Char) -> Int -> Int -> STMutable s StringBuffer
| Mutable s StringBuffer -> String -> STMutable s StringBuffer
| Mutable s StringBuffer -> Mutable s StringBuffer -> STMutable s StringBuffer
native appendCodePoint :: Mutable s StringBuffer -> Int -> STMutable s StringBuffer
native capacity :: Mutable s StringBuffer -> ST s Int
native charAt :: Mutable s StringBuffer -> Int -> ST s Char
native codePointAt :: Mutable s StringBuffer -> Int -> ST s Int
native codePointBefore :: Mutable s StringBuffer -> Int -> ST s Int
native codePointCount :: Mutable s StringBuffer -> Int -> Int -> ST s Int
native delete :: Mutable s StringBuffer -> Int -> Int -> STMutable s StringBuffer
native deleteCharAt :: Mutable s StringBuffer -> Int -> STMutable s StringBuffer
native ensureCapacity :: Mutable s StringBuffer -> Int -> ST s ()
native getChars :: Mutable s StringBuffer -> Int -> Int -> Mutable s (JArray Char) -> Int -> ST s ()
native indexOf :: Mutable s StringBuffer -> String -> ST s Int
| Mutable s StringBuffer -> String -> Int -> ST s Int
native insert :: Mutable s StringBuffer -> Int -> Mutable s (JArray Char) -> STMutable s StringBuffer
| Mutable s StringBuffer -> Int -> CharSequence -> STMutable s StringBuffer
| Mutable s StringBuffer -> Int -> CharSequence -> Int -> Int -> STMutable s StringBuffer
| Mutable s StringBuffer -> Int -> Bool -> STMutable s StringBuffer
| Mutable s StringBuffer -> Int -> Char -> STMutable s StringBuffer
| Mutable s StringBuffer -> Int -> Double -> STMutable s StringBuffer
| Mutable s StringBuffer -> Int -> Mutable s (JArray Char) -> Int -> Int -> STMutable s StringBuffer
| Mutable s StringBuffer -> Int -> Object -> STMutable s StringBuffer
| Mutable s StringBuffer -> Int -> String -> STMutable s StringBuffer
| Mutable s StringBuffer -> Int -> Float -> STMutable s StringBuffer
| Mutable s StringBuffer -> Int -> Long -> STMutable s StringBuffer
| Mutable s StringBuffer -> Int -> Int -> STMutable s StringBuffer
native lastIndexOf :: Mutable s StringBuffer -> String -> ST s Int
| Mutable s StringBuffer -> String -> Int -> ST s Int
native length :: Mutable s StringBuffer -> ST s Int
native offsetByCodePoints :: Mutable s StringBuffer -> Int -> Int -> ST s Int
native replace :: Mutable s StringBuffer -> Int -> Int -> String -> STMutable s StringBuffer
native reverse :: Mutable s StringBuffer -> STMutable s StringBuffer
native setCharAt :: Mutable s StringBuffer -> Int -> Char -> ST s ()
native setLength :: Mutable s StringBuffer -> Int -> ST s ()
native subSequence :: Mutable s StringBuffer -> Int -> Int -> ST s CharSequence
native substring :: Mutable s StringBuffer -> Int -> ST s String
| Mutable s StringBuffer -> Int -> Int -> ST s String
native toString :: Mutable s StringBuffer -> ST s String
native trimToSize :: Mutable s StringBuffer -> ST s ()
instance Serializable StringBuffer
data Comparable t = pure native java.lang.Comparable where
pure native compareTo :: Comparable t -> t -> Int
-- forward declaration
protected data Iterator e = native java.util.Iterator
data Iterable t = pure native java.lang.Iterable where
native iterator :: Iterable t -> STMutable s (Iterator t)
--- 'Byte' is the Frege type for the primitive JVM @byte@
--- However, it is given _unsigend_ semantics in Frege.
--- Use 'Byte' only in 'JArray's or tightly packed records!
--- Otherwise you'll waste time while not saving space.
data Byte = pure native "byte" where
--- this gives the 'Int' corresponding to the *signed* interpretation of the 'Byte'
pure native signed "(int)" :: Byte -> Int
--- this gives the 'Int' corresponding to the *unsigned* interpretation of the 'Byte'
unsigned b = signed b Int..&. 0xFF
--- convert an 'Int' to a 'Byte' by chopping off the leading 24 bits.
pure native byte "(byte)" :: Int -> Byte
instance Eq Byte where
hashCode = Byte.unsigned
pure native == :: Byte -> Byte -> Bool
pure native != :: Byte -> Byte -> Bool
--- The 'Ord' instance for 'Byte's assumes that bytes are unsigned.
--- Hence
--- > byte (-1) > byte 1
instance Ord Byte where
a <=> b = a.unsigned Int.<=> b.unsigned
a < b = a.unsigned Int.< b.unsigned
a > b = a.unsigned Int.> b.unsigned
a <= b = a.unsigned Int.<= b.unsigned
a >= b = a.unsigned Int.>= b.unsigned
instance Num Byte where
fromInt = byte
one = byte 1
zero = byte 0
fromInteger n = fromInt (fromInteger n)
--- A no-op, since 'Byte's are unsigned
abs b = b
--- Never -1, since 'Byte's are unsigned
sign b = if b > zero then 1 else 0
b1 + b2 = byte (b1.unsigned + b2.unsigned)
b1 - b2 = byte (b1.unsigned - b2.unsigned)
b1 * b2 = byte (b1.unsigned * b2.unsigned)
instance Integral Byte where
odd b = odd b.unsigned
even b = even b.unsigned
big b = big b.unsigned
a `quot` b = byte (a.unsigned `quot` b.unsigned)
a `rem` b = byte (a.unsigned `rem` b.unsigned)
instance Bounded Byte where
minBound = zero
maxBound = byte 255
instance Enum Byte where
from = fromInt
ord = Byte.unsigned
succ b
| b < maxBound = byte (b.unsigned + 1)
| otherwise = error "Byte.succ 255"
pred b
| b > minBound = byte (b.unsigned - 1)
| otherwise = error "Byte.pred 0"
enumFromThenTo a b l
| a < b, a <= l = stepUp a (b-a) l
| a > b, a >= l = stepDown a (a-b) l
| otherwise = []
where
stepUp !a !s !l
| a <= l = a : if a+s > a then stepUp (a+s) s l else []
| otherwise = []
stepDown !a !s !l
| a >= l = a : if a-s < a then stepDown (a-s) s l else []
| otherwise = []
enumFromThen a b
| a < b = enumFromThenTo a b maxBound
| a > b = enumFromThenTo a b minBound
| otherwise = []
enumFromTo a b
| a < b = a:enumFromTo (succ a) b
| a == b = [a]
| otherwise = []
enumFrom a = enumFromTo a maxBound
instance PrimitiveArrayElement Byte where
native javaClass "byte.class" :: Class Byte
--- 'Short' is the Frege type for the primitive JVM @short@
--- However, it is given _unsigend_ semantics in Frege.
--- Use 'Short' only in 'JArray's or tightly packed records!
--- Otherwise you'll waste time while not saving space.
data Short = pure native "short" where
--- this gives the 'Int' corresponding to the *signed* interpretation of 'Short'
pure native signed "(int)" :: Short -> Int
--- this gives the 'Int' corresponding to the *unsigned* interpretation of 'Short'
unsigned b = signed b Int..&. 0xFFFF
--- convert an 'Int' to a 'Short' by chopping off the leading 16 bits.
pure native short "(short)" :: Int -> Short
instance Eq Short where
hashCode = Short.unsigned
pure native == :: Short -> Short -> Bool
pure native != :: Short -> Short -> Bool
--- The 'Ord' instance for 'Byte's assumes that bytes are unsigned.
--- Hence
--- > byte (-1) > byte 1
instance Ord Short where
a <=> b = a.unsigned Int.<=> b.unsigned
a < b = a.unsigned Int.< b.unsigned
a > b = a.unsigned Int.> b.unsigned
a <= b = a.unsigned Int.<= b.unsigned
a >= b = a.unsigned Int.>= b.unsigned
instance Num Short where
fromInt = short
one = short 1
zero = short 0
fromInteger n = fromInt (fromInteger n)
--- A no-op, since 'Short's are unsigned
abs b = b
--- Never -1, since 'Short's are unsigned
sign b = if b > zero then 1 else 0
b1 + b2 = short (b1.unsigned + b2.unsigned)
b1 - b2 = short (b1.unsigned - b2.unsigned)
b1 * b2 = short (b1.unsigned * b2.unsigned)
instance Integral Short where
odd b = odd b.unsigned
even b = even b.unsigned
big b = big b.unsigned
a `quot` b = short (a.unsigned `quot` b.unsigned)
a `rem` b = short (a.unsigned `rem` b.unsigned)
instance Bounded Short where
minBound = zero
maxBound = short 0xffff
instance Enum Short where
from = fromInt
ord = Short.unsigned
succ b
| b < maxBound = short (b.unsigned + 1)
| otherwise = error "Short.succ 0xffff"
pred b
| b > minBound = short (b.unsigned - 1)
| otherwise = error "Short.pred 0"
enumFromThenTo a b l
| a < b, a <= l = stepUp a (b-a) l
| a > b, a >= l = stepDown a (a-b) l
| otherwise = []
where
stepUp !a !s !l
| a <= l = a : if a+s > a then stepUp (a+s) s l else []
| otherwise = []
stepDown !a !s !l
| a >= l = a : if a-s < a then stepDown (a-s) s l else []
| otherwise = []
enumFromThen a b
| a < b = enumFromThenTo a b maxBound
| a > b = enumFromThenTo a b minBound
| otherwise = []
enumFromTo a b
| a < b = a:enumFromTo (succ a) b
| a == b = [a]
| otherwise = []
enumFrom a = enumFromTo a maxBound
instance PrimitiveArrayElement Short where
native javaClass "short.class" :: Class Short
data JEnum e = pure native "java.lang.Enum" {}
instance ArrayElement (JEnum e) where
native javaClass "java.lang.Enum.class" :: Class (JEnum e)
instance ArrayElement Object where
native javaClass "java.lang.Object.class" :: Class Object