aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--luxc/src/lux/analyser/host.clj4
-rw-r--r--luxc/src/lux/analyser/parser.clj3
-rw-r--r--luxc/src/lux/compiler/host.clj22
-rw-r--r--stdlib/source/lux/host.lux39
-rw-r--r--stdlib/test/test/lux/host.lux151
-rw-r--r--stdlib/test/tests.lux2
6 files changed, 158 insertions, 63 deletions
diff --git a/luxc/src/lux/analyser/host.clj b/luxc/src/lux/analyser/host.clj
index 6aea46cab..6dd7f3da8 100644
--- a/luxc/src/lux/analyser/host.clj
+++ b/luxc/src/lux/analyser/host.clj
@@ -466,8 +466,8 @@
^:private analyse-jvm-l2d "l2d" "java.lang.Long" "java.lang.Double"
^:private analyse-jvm-l2f "l2f" "java.lang.Long" "java.lang.Float"
^:private analyse-jvm-l2i "l2i" "java.lang.Long" "java.lang.Integer"
- ^:private analyse-jvm-l2s "l2i" "java.lang.Long" "java.lang.Short"
- ^:private analyse-jvm-l2b "l2i" "java.lang.Long" "java.lang.Byte"
+ ^:private analyse-jvm-l2s "l2s" "java.lang.Long" "java.lang.Short"
+ ^:private analyse-jvm-l2b "l2b" "java.lang.Long" "java.lang.Byte"
^:private analyse-jvm-c2b "c2b" "java.lang.Character" "java.lang.Byte"
^:private analyse-jvm-c2s "c2s" "java.lang.Character" "java.lang.Short"
diff --git a/luxc/src/lux/analyser/parser.clj b/luxc/src/lux/analyser/parser.clj
index e60f28a02..586806942 100644
--- a/luxc/src/lux/analyser/parser.clj
+++ b/luxc/src/lux/analyser/parser.clj
@@ -428,10 +428,13 @@
(def parse-interface-def
(|do [=gclass-decl parse-gclass-decl
+ _ _space_
=supers (with-brackets
(spaced parse-gclass-super))
+ _ _space_
=anns (with-brackets
(spaced parse-ann))
+ _ _space_
=methods (spaced parse-method-decl)]
(return (&/T [=gclass-decl =supers =anns =methods]))))
diff --git a/luxc/src/lux/compiler/host.clj b/luxc/src/lux/compiler/host.clj
index eccfef089..3d4172110 100644
--- a/luxc/src/lux/compiler/host.clj
+++ b/luxc/src/lux/compiler/host.clj
@@ -1523,8 +1523,6 @@
^:private compile-jvm-l2d Opcodes/L2D "java.lang.Long" "longValue" "()J" "java.lang.Double" "(D)V"
^:private compile-jvm-l2f Opcodes/L2F "java.lang.Long" "longValue" "()J" "java.lang.Float" "(F)V"
^:private compile-jvm-l2i Opcodes/L2I "java.lang.Long" "longValue" "()J" "java.lang.Integer" "(I)V"
- ^:private compile-jvm-l2s Opcodes/L2I "java.lang.Long" "longValue" "()J" "java.lang.Short" "(S)V"
- ^:private compile-jvm-l2b Opcodes/L2I "java.lang.Long" "longValue" "()J" "java.lang.Byte" "(B)V"
^:private compile-jvm-c2b Opcodes/I2B "java.lang.Character" "charValue" "()C" "java.lang.Byte" "(B)V"
^:private compile-jvm-c2s Opcodes/I2S "java.lang.Character" "charValue" "()C" "java.lang.Short" "(S)V"
@@ -1536,6 +1534,26 @@
^:private compile-jvm-b2l Opcodes/I2L "java.lang.Byte" "byteValue" "()B" "java.lang.Long" "(J)V"
)
+(do-template [<name> <op> <from-class> <from-method> <from-sig> <to-class> <to-sig>]
+ (defn <name> [compile _?value special-args]
+ (|do [:let [(&/$Cons ?value (&/$Nil)) _?value]
+ ^MethodVisitor *writer* &/get-writer
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/NEW (&host-generics/->bytecode-class-name <to-class>))
+ (.visitInsn Opcodes/DUP))]
+ _ (compile ?value)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST (&host-generics/->bytecode-class-name <from-class>))
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host-generics/->bytecode-class-name <from-class>) <from-method> <from-sig>)
+ (.visitInsn Opcodes/L2I)
+ (.visitInsn <op>)
+ (.visitMethodInsn Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name <to-class>) init-method <to-sig>))]]
+ (return nil)))
+
+ ^:private compile-jvm-l2s Opcodes/I2S "java.lang.Long" "longValue" "()J" "java.lang.Short" "(S)V"
+ ^:private compile-jvm-l2b Opcodes/I2B "java.lang.Long" "longValue" "()J" "java.lang.Byte" "(B)V"
+ )
+
(do-template [<name> <op> <from1-method> <from1-sig> <from1-class> <from2-method> <from2-sig> <from2-class> <to-class> <to-sig>]
(defn <name> [compile ?values special-args]
(|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
diff --git a/stdlib/source/lux/host.lux b/stdlib/source/lux/host.lux
index 7149cab94..92ff61d92 100644
--- a/stdlib/source/lux/host.lux
+++ b/stdlib/source/lux/host.lux
@@ -1327,8 +1327,10 @@
imports (add-import [(short-class-name full-class-name) full-class-name]
(class-imports *compiler*))]}
{#let [class-vars (product;right class-decl)]}
- {super (s;opt (super-class-decl^ imports class-vars))}
- {interfaces (s;tuple (s;some (super-class-decl^ imports class-vars)))}
+ {super (s;default object-super-class
+ (super-class-decl^ imports class-vars))}
+ {interfaces (s;default (list)
+ (s;tuple (s;some (super-class-decl^ imports class-vars))))}
{annotations (annotations^ imports)}
{fields (s;some (field-decl^ imports class-vars))}
{methods (s;some (method-def^ imports class-vars))})
@@ -1340,11 +1342,11 @@
(#private datum A)
(#private waitingList (java.util.List lux.Function))
## Methods
- (#public new [] [] []
+ (#public [] new [] []
(exec (:= .resolved false)
(:= .waitingList (ArrayList.new []))
[]))
- (#public resolve [] [{value A}] boolean
+ (#public [] resolve [{value A}] boolean
(let [container (.new! [])]
(synchronized _jvm_this
(if .resolved
@@ -1360,18 +1362,18 @@
(i.range 0 (i.dec (i2l sleepers-count)))))
(:= .waitingList (null))
true)))))
- (#public poll [] [] A
+ (#public [] poll [] A
.datum)
- (#public wasResolved [] [] boolean
+ (#public [] wasResolved [] boolean
(synchronized _jvm_this
.resolved))
- (#public waitOn [] [{callback lux.Function}] void
+ (#public [] waitOn [{callback lux.Function}] void
(synchronized _jvm_this
(exec (if .resolved
(lux.Function.apply [(:! Object .datum)] callback)
(:! Object (java.util.List.add [callback] .waitingList)))
[])))
- (#public #static make [A] [{value A}] (lux.concurrency.promise.JvmPromise A)
+ (#public #static [A] make [{value A}] (lux.concurrency.promise.JvmPromise A)
(let [container (.new! [])]
(exec (.resolve! (:! (host lux.concurrency.promise.JvmPromise [Unit]) container) [(:! Unit value)])
container))))
@@ -1393,15 +1395,14 @@
replacer (parser->replacer (fold s;either
(s;fail "")
(List/append field-parsers method-parsers)))
- super-class (default object-super-class super)
def-code (format "class:"
(spaced (list (class-decl$ class-decl)
- (super-class-decl$ super-class)
+ (super-class-decl$ super)
(with-brackets (spaced (map super-class-decl$ interfaces)))
(inheritance-modifier$ im)
(with-brackets (spaced (map annotation$ annotations)))
(with-brackets (spaced (map field-decl$ fields)))
- (with-brackets (spaced (map (method-def$ replacer super-class) methods))))))]]
+ (with-brackets (spaced (map (method-def$ replacer super) methods))))))]]
(wrap (list (` (;_lux_proc ["jvm" (~ (ast;text def-code))] []))))))
(syntax: #export (interface: {#let [imports (class-imports *compiler*)]}
@@ -1410,7 +1411,8 @@
imports (add-import [(short-class-name full-class-name) full-class-name]
(class-imports *compiler*))]}
{#let [class-vars (product;right class-decl)]}
- {supers (s;tuple (s;some (super-class-decl^ imports class-vars)))}
+ {supers (s;default (list)
+ (s;tuple (s;some (super-class-decl^ imports class-vars))))}
{annotations (annotations^ imports)}
{members (s;some (method-decl^ imports class-vars))})
(let [def-code (format "interface:"
@@ -1423,8 +1425,10 @@
(syntax: #export (object {#let [imports (class-imports *compiler*)]}
{#let [class-vars (list)]}
- {super (s;opt (super-class-decl^ imports class-vars))}
- {interfaces (s;tuple (s;some (super-class-decl^ imports class-vars)))}
+ {super (s;default object-super-class
+ (super-class-decl^ imports class-vars))}
+ {interfaces (s;default (list)
+ (s;tuple (s;some (super-class-decl^ imports class-vars))))}
{constructor-args (constructor-args^ imports class-vars)}
{methods (s;some (overriden-method-def^ imports))})
{#;doc (doc "Allows defining anonymous classes."
@@ -1437,12 +1441,11 @@
(exec (do-something some-input)
[])))
)}
- (let [super-class (default object-super-class super)
- def-code (format "anon-class:"
- (spaced (list (super-class-decl$ super-class)
+ (let [def-code (format "anon-class:"
+ (spaced (list (super-class-decl$ super)
(with-brackets (spaced (map super-class-decl$ interfaces)))
(with-brackets (spaced (map constructor-arg$ constructor-args)))
- (with-brackets (spaced (map (method-def$ id super-class) methods))))))]
+ (with-brackets (spaced (map (method-def$ id super) methods))))))]
(wrap (list (` (;_lux_proc ["jvm" (~ (ast;text def-code))] []))))))
(syntax: #export (null)
diff --git a/stdlib/test/test/lux/host.lux b/stdlib/test/test/lux/host.lux
index 109d8dfed..9cb9dac23 100644
--- a/stdlib/test/test/lux/host.lux
+++ b/stdlib/test/test/lux/host.lux
@@ -1,54 +1,125 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+## If a copy of the MPL was not distributed with this file,
+## You can obtain one at http://mozilla.org/MPL/2.0/.
+
(;module:
lux
(lux (control monad)
(data text/format
[number]
- [product])
+ [product]
+ [text "Text/" Eq<Text>])
(codata function
[io])
- host)
+ ["&" host #+ jvm-import class: interface: object]
+ (math ["R" random])
+ pipe)
lux/test)
-(jvm-import java.lang.Object
- (new []))
+(jvm-import java.lang.Exception
+ (new [String]))
-(jvm-import java.lang.String)
+(jvm-import java.lang.Object)
(jvm-import (java.lang.Class a)
(getName [] String))
-(test: "lux/host exports"
- (let% [<conversions-0> (do-template [<value> <forward> <backward>]
- [(match <value> (|> <value> <forward> <backward>))]
-
- [123 l2d d2l]
- [123 l2f f2l]
- [123 l2i i2l]
- [123.0 d2l l2d]
- [123.0 d2f f2d]
- [123.0 d2i i2d]
- )
- <conversions-1> (do-template [<forward> <backward>]
- [(match 123 (|> 123 l2i <forward> <backward> i2l))]
-
- [i2c c2i]
- )]
- (test-all (match "java.lang.Class" (Class.getName [] (class-for java.lang.Class)))
- (match "java.lang.Class" (Class.getName [] (class-for Class)))
- (match true (null? (: Object (null))))
- (match false (null? (Object.new [])))
- (match #;None (: (Maybe Object) (??? (null))))
- (match (#;Some _) (: (Maybe Object) (??? (Object.new []))))
- (match true (null? (!!! (: (Maybe Object) (??? (null))))))
- (match false (null? (!!! (: (Maybe Object) (??? (Object.new []))))))
- (match true (instance? Object (Object.new [])))
- (match false (instance? String (Object.new [])))
- (match 123 (synchronized (Object.new [])
- 123))
- (match +10 (array-length (array String +10)))
- (match "YOLO" (let [array (array String +10)]
- (exec (array-store +0 "YOLO" array)
- (array-load +0 array))))
- <conversions-0>
- <conversions-1>
- )))
+(jvm-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 true)
+ (:= .bar value)
+ (:= .baz "")
+ []))
+ (#public (virtual) java.lang.Object
+ "")
+ (#public #static (static) java.lang.Object
+ "")
+ (Runnable [] (run) void
+ [])
+ )
+
+(def: test-runnable
+ (object [Runnable]
+ []
+ (Runnable [] (run) void
+ [])))
+
+(interface: TestInterface
+ ([] foo [boolean String] void #throws [Exception]))
+
+(test: "Conversions"
+ [sample R;int]
+ (let% [<int-convs> (do-template [<to> <from> <message>]
+ [(assert <message>
+ (or (|> sample <to> <from> (i.= sample))
+ (let [capped-sample (|> sample <to> <from>)]
+ (|> capped-sample <to> <from> (i.= sample)))))]
+
+ [&;l2b &;b2l "Can succesfully convert to/from byte."]
+ [&;l2s &;s2l "Can succesfully convert to/from short."]
+ [&;l2i &;i2l "Can succesfully convert to/from int."]
+ [&;l2f &;f2l "Can succesfully convert to/from float."]
+ [&;l2d &;d2l "Can succesfully convert to/from double."]
+ [(<| &;i2c &;l2i) (<| &;i2l &;c2i) "Can succesfully convert to/from char."]
+ )]
+ ($_ seq
+ <int-convs>
+ )))
+
+(test: "Miscellaneous"
+ ($_ seq
+ (assert "Can check if an object is of a certain class."
+ (and (&;instance? String "")
+ (not (&;instance? Long ""))
+ (&;instance? Object (&;null))))
+
+ (assert "Can run code in a \"synchronized\" block."
+ (&;synchronized "" true))
+
+ ## (assert "Can safely try risky code."
+ ## (and (case (&;try [])
+ ## (#;Right _) true
+ ## (#;Left _) false)
+ ## (case (&;try (_lux_proc ["jvm" "throw"] [(Exception.new "Uh, oh...")]))
+ ## (#;Right _) false
+ ## (#;Left _) true)))
+
+ (assert "Can access Class instances."
+ (Text/= "java.lang.Class" (Class.getName [] (&;class-for java.lang.Class))))
+
+ (assert "Can check if a value is null."
+ (and (&;null? (&;null))
+ (not (&;null? ""))))
+
+ (assert "Can safely convert nullable references into Maybe values."
+ (and (|> (: (Maybe Object) (&;??? (&;null)))
+ (case> #;None true
+ _ false))
+ (|> (: (Maybe Object) (&;??? ""))
+ (case> (#;Some _) true
+ _ false))))
+ ))
+
+(test: "Arrays"
+ [size (|> R;nat (:: @ map (|>. (n.% +100) (n.max +1))))
+ idx (|> R;nat (:: @ map (n.% size)))
+ value R;int]
+ ($_ seq
+ (assert "Can create arrays of some length."
+ (n.= size (&;array-length (&;array Long size))))
+
+ (assert "Can set and get array values."
+ (let [arr (&;array Long size)]
+ (exec (&;array-store idx value arr)
+ (i.= value (&;array-load idx arr)))))))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index de1487b34..2a373a872 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -12,6 +12,7 @@
[test])
(test lux
(lux ["_;" cli]
+ ["_;" host]
(codata ["_;" io]
[env]
[state]
@@ -50,7 +51,6 @@
## [stm]
## [actor]
## )
- ## [host]
## [math]
## [pipe]
## [lexer]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 08:25:27 +0000