- Updated lux/host tests.

- Fixed a bug in the way the [jvm l2b] and [jvm l2s] procedures worked.
- Fixed a bug in interface definition.
- Relaxed the syntacting requirements of class/interface/anonymous-class definition macros.

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]