From 75a02fc2df03a21df044d35115ac72149524ca7a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 6 Dec 2016 21:39:26 -0400 Subject: - 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. --- luxc/src/lux/analyser/host.clj | 4 +- luxc/src/lux/analyser/parser.clj | 3 + luxc/src/lux/compiler/host.clj | 22 +++++- stdlib/source/lux/host.lux | 39 +++++----- stdlib/test/test/lux/host.lux | 151 ++++++++++++++++++++++++++++----------- stdlib/test/tests.lux | 2 +- 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 [ ] + (defn [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 )) + (.visitInsn Opcodes/DUP))] + _ (compile ?value) + :let [_ (doto *writer* + (.visitTypeInsn Opcodes/CHECKCAST (&host-generics/->bytecode-class-name )) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host-generics/->bytecode-class-name ) ) + (.visitInsn Opcodes/L2I) + (.visitInsn ) + (.visitMethodInsn Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name ) init-method ))]] + (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 [ ] (defn [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]) (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% [ (do-template [ ] - [(match (|> ))] - - [123 l2d d2l] - [123 l2f f2l] - [123 l2i i2l] - [123.0 d2l l2d] - [123.0 d2f f2d] - [123.0 d2i i2d] - ) - (do-template [ ] - [(match 123 (|> 123 l2i 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)))) - - - ))) +(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% [ (do-template [ ] + [(assert + (or (|> sample (i.= sample)) + (let [capped-sample (|> sample )] + (|> capped-sample (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 + + ))) + +(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] -- cgit v1.2.3