diff options
author | Eduardo Julian | 2019-05-29 00:24:04 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-05-29 00:24:04 -0400 |
commit | 36d22e31ab696b2cf3382d77b0896dcb357dfb8c (patch) | |
tree | b8278f0e700843b52d859ea8478dccc8b7b4c48f | |
parent | 8cd61c00de00728759d0362a60dbca8d23e4d8dc (diff) |
More massaging of the stdlib for the sake of the new compiler.
-rw-r--r-- | stdlib/source/lux/host.jvm.lux | 5 | ||||
-rw-r--r-- | stdlib/source/lux/target/jvm/loader.lux | 31 | ||||
-rw-r--r-- | stdlib/source/lux/world/net/tcp.lux | 50 | ||||
-rw-r--r-- | stdlib/source/lux/world/net/udp.lux | 53 | ||||
-rw-r--r-- | stdlib/source/test/lux/host.jvm.lux | 134 | ||||
-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 |