aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--stdlib/source/lux/host.jvm.lux5
-rw-r--r--stdlib/source/lux/target/jvm/loader.lux31
-rw-r--r--stdlib/source/lux/world/net/tcp.lux50
-rw-r--r--stdlib/source/lux/world/net/udp.lux53
-rw-r--r--stdlib/source/test/lux/host.jvm.lux134
-rw-r--r--stdlib/source/test/lux/target/jvm.lux (renamed from stdlib/source/test/lux/target/jvm.old.lux)0
6 files changed, 205 insertions, 68 deletions
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index d4bc8f3d1..eb81a408e 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -408,7 +408,7 @@
(def: (qualify imports name)
(-> Class-Imports Text Text)
- (maybe.default name (get-import name imports)))
+ (|> imports (get-import name) (maybe.default name)))
(def: (make-get-const-parser class-name field-name)
(-> Text Text (Parser Code))
@@ -1844,7 +1844,8 @@
[#jvm.Char "jvm array new char"])
_
- (wrap (list (` ("jvm array new object" (~ (type$ type)) (~ g!size))))))))
+ (wrap (list (` (: (~ (jvm-type #ManualPrM (jvm.array 1 type)))
+ ("jvm array new object" (~ g!size)))))))))
(def: (type->class-name type)
(-> .Type (Meta Text))
diff --git a/stdlib/source/lux/target/jvm/loader.lux b/stdlib/source/lux/target/jvm/loader.lux
index ae4d0373c..882a5c7dd 100644
--- a/stdlib/source/lux/target/jvm/loader.lux
+++ b/stdlib/source/lux/target/jvm/loader.lux
@@ -57,21 +57,22 @@
(loadClass [java/lang/String]
#io #try (java/lang/Class java/lang/Object)))
-(def: java/lang/ClassLoader::defineClass
- java/lang/reflect/Method
- (let [signature (|> (host.array (java/lang/Class java/lang/Object) 4)
- (host.array-write 0 (:coerce (java/lang/Class java/lang/Object)
- (host.class-for java/lang/String)))
- (host.array-write 1 (java/lang/Object::getClass (host.array byte 0)))
- (host.array-write 2 (:coerce (java/lang/Class java/lang/Object)
- (java/lang/Integer::TYPE)))
- (host.array-write 3 (:coerce (java/lang/Class java/lang/Object)
- (java/lang/Integer::TYPE))))]
- (do-to (error.assume
- (java/lang/Class::getDeclaredMethod "defineClass"
- signature
- (host.class-for java/lang/ClassLoader)))
- (java/lang/reflect/AccessibleObject::setAccessible true))))
+(with-expansions [<elemT> (as-is (java/lang/Class java/lang/Object))]
+ (def: java/lang/ClassLoader::defineClass
+ java/lang/reflect/Method
+ (let [signature (|> (host.array <elemT> 4)
+ (host.array-write 0 (:coerce <elemT>
+ (host.class-for java/lang/String)))
+ (host.array-write 1 (java/lang/Object::getClass (host.array byte 0)))
+ (host.array-write 2 (:coerce <elemT>
+ (java/lang/Integer::TYPE)))
+ (host.array-write 3 (:coerce <elemT>
+ (java/lang/Integer::TYPE))))]
+ (do-to (error.assume
+ (java/lang/Class::getDeclaredMethod "defineClass"
+ signature
+ (host.class-for java/lang/ClassLoader)))
+ (java/lang/reflect/AccessibleObject::setAccessible true)))))
(def: #export (define class-name bytecode loader)
(-> Text Binary java/lang/ClassLoader (Error java/lang/Object))
diff --git a/stdlib/source/lux/world/net/tcp.lux b/stdlib/source/lux/world/net/tcp.lux
index a0fa13c8a..d9011a5cb 100644
--- a/stdlib/source/lux/world/net/tcp.lux
+++ b/stdlib/source/lux/world/net/tcp.lux
@@ -36,39 +36,41 @@
[write //.can-write]
[close //.can-close])))))
-(with-expansions [<for-jvm> (as-is (import: java/lang/AutoCloseable
+(with-expansions [<for-jvm> (as-is (import: #long java/lang/String)
+
+ (import: #long java/lang/AutoCloseable
(close [] #io #try void))
- (import: java/io/Flushable
+ (import: #long java/io/Flushable
(flush [] #io #try void))
- (import: java/io/InputStream
+ (import: #long java/io/InputStream
(read [[byte] int int] #io #try int))
- (import: java/io/OutputStream
+ (import: #long java/io/OutputStream
(write [[byte] int int] #io #try void))
- (import: java/net/Socket
- (new [String int] #io #try)
- (getInputStream [] #try InputStream)
- (getOutputStream [] #try OutputStream))
+ (import: #long java/net/Socket
+ (new [java/lang/String int] #io #try)
+ (getInputStream [] #try java/io/InputStream)
+ (getOutputStream [] #try java/io/OutputStream))
- (import: java/net/ServerSocket
+ (import: #long java/net/ServerSocket
(new [int] #io #try)
- (accept [] #io #try Socket))
+ (accept [] #io #try java/net/Socket))
(def: (tcp socket)
- (-> Socket (Error (TCP IO)))
+ (-> java/net/Socket (Error (TCP IO)))
(do error.monad
- [input (Socket::getInputStream socket)
- output (Socket::getOutputStream socket)]
+ [input (java/net/Socket::getInputStream socket)
+ output (java/net/Socket::getOutputStream socket)]
(wrap (: (TCP IO)
(structure (def: read
(//.can-read
(function (read size)
(do (error.with io.monad)
[#let [data (binary.create size)]
- bytes-read (InputStream::read data +0 (.int size) input)]
+ bytes-read (java/io/InputStream::read data +0 (.int size) input)]
(wrap [(.nat bytes-read)
data])))))
@@ -76,33 +78,33 @@
(//.can-write
(function (write data)
(do (error.with io.monad)
- [_ (OutputStream::write data +0 (.int (binary.size data))
- output)]
- (Flushable::flush output)))))
+ [_ (java/io/OutputStream::write data +0 (.int (binary.size data))
+ output)]
+ (java/io/Flushable::flush output)))))
(def: close
(//.can-close
(function (close _)
(do (error.with io.monad)
- [_ (AutoCloseable::close input)
- _ (AutoCloseable::close output)]
- (AutoCloseable::close socket))))))))))
+ [_ (java/lang/AutoCloseable::close input)
+ _ (java/lang/AutoCloseable::close output)]
+ (java/lang/AutoCloseable::close socket))))))))))
(def: #export (client address port)
(-> //.Address //.Port (IO (Error (TCP IO))))
(do (error.with io.monad)
- [socket (Socket::new address (.int port))]
+ [socket (java/net/Socket::new address (.int port))]
(io.io (tcp socket))))
(def: #export (server port)
(-> //.Port (IO (Error [(Resolver Any)
(Channel (TCP IO))])))
(do (error.with io.monad)
- [server (ServerSocket::new (.int port))
+ [server (java/net/ServerSocket::new (.int port))
#let [[close-signal close-resolver] (: [(Promise Any) (Resolver Any)]
(promise.promise []))
_ (promise.await (function (_ _)
- (AutoCloseable::close server))
+ (java/lang/AutoCloseable::close server))
close-signal)
[output sink] (: [(Channel (TCP IO)) (Sink (TCP IO))]
(frp.channel []))
@@ -111,7 +113,7 @@
(loop [_ []]
(do io.monad
[?client (do (error.with io.monad)
- [socket (ServerSocket::accept server)]
+ [socket (java/net/ServerSocket::accept server)]
(io.io (tcp socket)))]
(case ?client
(#error.Failure error)
diff --git a/stdlib/source/lux/world/net/udp.lux b/stdlib/source/lux/world/net/udp.lux
index df9244186..44a1354cc 100644
--- a/stdlib/source/lux/world/net/udp.lux
+++ b/stdlib/source/lux/world/net/udp.lux
@@ -45,52 +45,51 @@
[write //.can-write]
[close //.can-close])))))
-(with-expansions [<for-jvm> (as-is (import: java/lang/AutoCloseable
- (close [] #io #try void))
+(with-expansions [<for-jvm> (as-is (import: #long java/lang/String)
- (import: java/io/Flushable
- (flush [] #io #try void))
+ (import: #long java/lang/AutoCloseable
+ (close [] #io #try void))
- (import: java/net/InetAddress
- (#static getAllByName [String] #io #try [InetAddress])
- (getHostAddress [] String))
+ (import: #long java/net/InetAddress
+ (#static getAllByName [java/lang/String] #io #try [java/net/InetAddress])
+ (getHostAddress [] java/lang/String))
- (import: java/net/DatagramPacket
- (new #as new|send [[byte] int int InetAddress int])
+ (import: #long java/net/DatagramPacket
+ (new #as new|send [[byte] int int java/net/InetAddress int])
(new #as new|receive [[byte] int int])
- (getAddress [] InetAddress)
+ (getAddress [] java/net/InetAddress)
(getPort [] int)
(getLength [] int))
- (import: java/net/DatagramSocket
+ (import: #long java/net/DatagramSocket
(new #as new|client [] #io #try)
(new #as new|server [int] #io #try)
- (receive [DatagramPacket] #io #try void)
- (send [DatagramPacket] #io #try void))
+ (receive [java/net/DatagramPacket] #io #try void)
+ (send [java/net/DatagramPacket] #io #try void))
(def: (resolve address)
- (-> //.Address (IO (Error InetAddress)))
+ (-> //.Address (IO (Error java/net/InetAddress)))
(do (error.with io.monad)
- [addresses (InetAddress::getAllByName address)]
- (: (IO (Error InetAddress))
+ [addresses (java/net/InetAddress::getAllByName address)]
+ (: (IO (Error java/net/InetAddress))
(case (array.size addresses)
0 (io.io (ex.throw cannot-resolve-address address))
1 (wrap (maybe.assume (array.read 0 addresses)))
_ (io.io (ex.throw multiple-candidate-addresses address))))))
(def: (udp socket)
- (-> DatagramSocket (UDP IO))
+ (-> java/net/DatagramSocket (UDP IO))
(structure (def: read
(//.can-read
(function (read size)
(let [data (binary.create size)
- packet (DatagramPacket::new|receive data +0 (.int size))]
+ packet (java/net/DatagramPacket::new|receive data +0 (.int size))]
(do (error.with io.monad)
- [_ (DatagramSocket::receive packet socket)
- #let [bytes-read (.nat (DatagramPacket::getLength packet))]]
+ [_ (java/net/DatagramSocket::receive packet socket)
+ #let [bytes-read (.nat (java/net/DatagramPacket::getLength packet))]]
(wrap [bytes-read
- {#//.address (|> packet DatagramPacket::getAddress InetAddress::getHostAddress)
- #//.port (.nat (DatagramPacket::getPort packet))}
+ {#//.address (|> packet java/net/DatagramPacket::getAddress java/net/InetAddress::getHostAddress)
+ #//.port (.nat (java/net/DatagramPacket::getPort packet))}
data]))))))
(def: write
@@ -98,23 +97,23 @@
(function (write [location data])
(do (error.with io.monad)
[address (resolve (get@ #//.address location))]
- (DatagramSocket::send (DatagramPacket::new|send data +0 (.int (binary.size data)) address (.int (get@ #//.port location)))
- socket)))))
+ (java/net/DatagramSocket::send (java/net/DatagramPacket::new|send data +0 (.int (binary.size data)) address (.int (get@ #//.port location)))
+ socket)))))
(def: close
(//.can-close
(function (close _)
- (AutoCloseable::close socket))))))
+ (java/lang/AutoCloseable::close socket))))))
(def: #export client
(IO (Error (UDP IO)))
- (|> (DatagramSocket::new|client)
+ (|> (java/net/DatagramSocket::new|client)
(:: (error.with io.monad) map ..udp)))
(def: #export server
(-> //.Port (IO (Error (UDP IO))))
(|>> .int
- DatagramSocket::new|server
+ java/net/DatagramSocket::new|server
(:: (error.with io.monad) map ..udp)))
)]
(`` (for {(~~ (static @.old))
diff --git a/stdlib/source/test/lux/host.jvm.lux b/stdlib/source/test/lux/host.jvm.lux
new file mode 100644
index 000000000..c9446b857
--- /dev/null
+++ b/stdlib/source/test/lux/host.jvm.lux
@@ -0,0 +1,134 @@
+(.module:
+ [lux #*
+ [abstract/monad (#+ Monad do)]
+ [control
+ pipe]
+ [data
+ ["." text ("#;." equivalence)]]
+ [math
+ ["r" random]]
+ ["_" test (#+ Test)]]
+ {1
+ ["." / (#+ import: class: interface: object)]})
+
+(import: (java/util/concurrent/Callable a))
+
+(import: java/lang/Exception
+ (new [String]))
+
+(import: java/lang/Object)
+
+(import: (java/lang/Class a)
+ (getName [] String))
+
+(import: java/lang/System
+ (#static out java/io/PrintStream)
+ (#static currentTimeMillis [] #io long)
+ (#static getenv [String] #io #? String))
+
+(class: #final (TestClass A) [Runnable]
+ ## Fields
+ (#private foo boolean)
+ (#private bar A)
+ (#private baz java/lang/Object)
+ ## Methods
+ (#public [] (new {value A}) []
+ (exec (:= ::foo #1)
+ (:= ::bar value)
+ (:= ::baz "")
+ []))
+ (#public (virtual self) java/lang/Object
+ "")
+ (#public #static (static) java/lang/Object
+ "")
+ (Runnable [] (run self) void
+ []))
+
+(def: test-runnable
+ (object [] [Runnable]
+ []
+ (Runnable [] (run self) void
+ [])))
+
+(def: test-callable
+ (object [a] [(Callable a)]
+ []
+ (Callable [] (call self) a
+ (undefined))))
+
+(interface: TestInterface
+ ([] foo [boolean String] void #throws [Exception]))
+
+(def: conversions
+ Test
+ (do r.monad
+ [sample r.int]
+ (`` ($_ _.and
+ (~~ (template [<to> <from> <message>]
+ [(_.test <message>
+ (or (|> sample <to> <from> (i/= sample))
+ (let [capped-sample (|> sample <to> <from>)]
+ (|> capped-sample <to> <from> (i/= capped-sample)))))]
+
+ [/.long-to-byte /.byte-to-long "Can succesfully convert to/from byte."]
+ [/.long-to-short /.short-to-long "Can succesfully convert to/from short."]
+ [/.long-to-int /.int-to-long "Can succesfully convert to/from int."]
+ [/.long-to-float /.float-to-long "Can succesfully convert to/from float."]
+ [/.long-to-double /.double-to-long "Can succesfully convert to/from double."]
+ [(<| /.int-to-char /.long-to-int) (<| /.int-to-long /.char-to-int) "Can succesfully convert to/from char."]
+ ))
+ ))))
+
+(def: miscellaneous
+ Test
+ (do r.monad
+ [sample (r.ascii 1)]
+ ($_ _.and
+ (_.test "Can check if an object is of a certain class."
+ (and (case (/.check String sample) (#.Some _) true #.None false)
+ (case (/.check Long sample) (#.Some _) false #.None true)
+ (case (/.check Object sample) (#.Some _) true #.None false)
+ (case (/.check Object (/.null)) (#.Some _) false #.None true)))
+
+ (_.test "Can run code in a 'synchronized' block."
+ (/.synchronized sample #1))
+
+ (_.test "Can access Class instances."
+ (text;= "java.lang.Class" (Class::getName (/.class-for java/lang/Class))))
+
+ (_.test "Can check if a value is null."
+ (and (/.null? (/.null))
+ (not (/.null? sample))))
+
+ (_.test "Can safely convert nullable references into Maybe values."
+ (and (|> (: (Maybe Object) (/.??? (/.null)))
+ (case> #.None #1
+ _ #0))
+ (|> (: (Maybe Object) (/.??? sample))
+ (case> (#.Some _) #1
+ _ #0))))
+ )))
+
+(def: arrays
+ Test
+ (do r.monad
+ [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1))))
+ idx (|> r.nat (:: @ map (n/% size)))
+ value r.int]
+ ($_ _.and
+ (_.test "Can create arrays of some length."
+ (n/= size (/.array-length (/.array Long size))))
+
+ (_.test "Can set and get array values."
+ (let [arr (/.array Long size)]
+ (exec (/.array-write idx value arr)
+ (i/= value (/.array-read idx arr))))))))
+
+(def: #export test
+ ($_ _.and
+ (<| (_.context "Conversions.")
+ ..conversions)
+ (<| (_.context "Miscellaneous.")
+ ..miscellaneous)
+ (<| (_.context "Arrays.")
+ ..arrays)))
diff --git a/stdlib/source/test/lux/target/jvm.old.lux b/stdlib/source/test/lux/target/jvm.lux
index 47c6f35d9..47c6f35d9 100644
--- a/stdlib/source/test/lux/target/jvm.old.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 18:23:33 +0000