From c9e0b6c3a0c23b34cd6ffac1b93a266ae6243c4a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 31 Jul 2015 20:33:29 -0400 Subject: - Did some refactoring of the standard library. - Introduced 2 new modules: lux/data/tuple & lux/codata/function - Now doing safe reading of files. - Took the "let", "lambda" & "def" macros to their ultimate form. - Added some macros for doing better JVM interop. - Fixed a bug when compiling comparisons for doubles. - Changed the order in which arguments are compiled for all arithmetic operations, as the order is reversed (from the conventional order) in the JVM bytecode. --- source/lux/host/jvm.lux | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index 7af043969..2c90b1ba3 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -11,7 +11,8 @@ (functor #as F) (monad #as M #refer (#only do))) (data (list #as l #refer #all #open ("" List/Functor)) - (text #as text)) + (text #as text) + (number (int #open ("i" Int/Eq)))) (meta lux macro syntax))) @@ -236,3 +237,16 @@ (emit (list (` (_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ m-classes))] [(~@ m-args)])))))) + +(defsyntax #export (->maybe expr) + (do Lux/Monad + [g!val (gensym "")] + (emit (list (` (;let [(~ g!val) (~ expr)] + (;if (null? (~ g!val)) + #;None + (#;Some (~ g!val))))))))) + +(defsyntax #export (try$ expr) + (emit (list (` (try (#;Right (~ expr)) + (~ (' (catch java.lang.Exception e + (#;Left (.! (getMessage [] []) e)))))))))) -- cgit v1.2.3 From a8ac885a008f519816d747eca0f894ec9794e938 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 4 Aug 2015 19:40:58 -0400 Subject: - Renamed the Syntax type to AST. - Created the lux/meta/ast module. --- source/lux/host/jvm.lux | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index 2c90b1ba3..f136bd73b 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -14,20 +14,20 @@ (text #as text) (number (int #open ("i" Int/Eq)))) (meta lux - macro + ast syntax))) ## [Utils] ## Parsers (def finally^ - (Parser Syntax) + (Parser AST) (form^ (do Parser/Monad [_ (symbol?^ ["" "finally"]) expr id^] (M;wrap expr)))) (def catch^ - (Parser (, Text Ident Syntax)) + (Parser (, Text Ident AST)) (form^ (do Parser/Monad [_ (symbol?^ ["" "catch"]) ex-class local-symbol^ @@ -60,7 +60,7 @@ (M;wrap [arg-name arg-class])))) (def method-def^ - (Parser (, (List Text) Text (List (, Text Text)) Text Syntax)) + (Parser (, (List Text) Text (List (, Text Text)) Text AST)) (form^ (do Parser/Monad [modifiers (*^ local-tag^) name local-symbol^ @@ -70,7 +70,7 @@ (M;wrap [modifiers name inputs output body])))) (def method-call^ - (Parser (, Text (List Text) (List Syntax))) + (Parser (, Text (List Text) (List AST))) (form^ (do Parser/Monad [method local-symbol^ arity-classes (tuple^ (*^ local-symbol^)) @@ -89,7 +89,7 @@ (defsyntax #export (try body [catches (*^ catch^)] [finally (?^ finally^)]) (emit (list (` (_jvm_try (~ body) - (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident Syntax) Syntax) + (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident AST) AST) (lambda [catch] (let [[class ex body] catch] (` (_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body)))))) @@ -102,7 +102,7 @@ (list (` (_jvm_finally (~ finally))))))))))))) (defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)]) - (let [members' (map (: (-> (, (List Text) Text (List Text) Text) Syntax) + (let [members' (map (: (-> (, (List Text) Text (List Text) Text) AST) (lambda [member] (let [[modifiers name inputs output] member] (` ((~ (text$ name)) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))]))))) @@ -115,18 +115,18 @@ [methods (*^ method-def^)]) (do Lux/Monad [current-module get-module-name - #let [fields' (map (: (-> (, (List Text) Text Text) Syntax) + #let [fields' (map (: (-> (, (List Text) Text Text) AST) (lambda [field] (let [[modifiers name class] field] (` ((~ (text$ name)) (~ (text$ class)) [(~@ (map text$ modifiers))]))))) fields) - methods' (map (: (-> (, (List Text) Text (List (, Text Text)) Text Syntax) Syntax) + methods' (map (: (-> (, (List Text) Text (List (, Text Text)) Text AST) AST) (lambda [methods] (let [[modifiers name inputs output body] methods] (` ((~ (text$ name)) - [(~@ (map (: (-> (, Text Text) Syntax) + [(~@ (map (: (-> (, Text Text) AST) (lambda [in] (let [[left right] in] (form$ (list (symbol$ ["" left]) -- cgit v1.2.3 From 24cc40e76f83188688ad43c499a44508e1aa5d60 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 5 Aug 2015 20:21:04 -0400 Subject: - Local vars can now longer have prefixed symbols. --- source/lux/host/jvm.lux | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index f136bd73b..4f3d6df8a 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -24,7 +24,7 @@ (form^ (do Parser/Monad [_ (symbol?^ ["" "finally"]) expr id^] - (M;wrap expr)))) + (wrap expr)))) (def catch^ (Parser (, Text Ident AST)) @@ -33,7 +33,7 @@ ex-class local-symbol^ ex symbol^ expr id^] - (M;wrap [ex-class ex expr])))) + (wrap [ex-class ex expr])))) (def method-decl^ (Parser (, (List Text) Text (List Text) Text)) @@ -42,7 +42,7 @@ name local-symbol^ inputs (tuple^ (*^ local-symbol^)) output local-symbol^] - (M;wrap [modifiers name inputs output])))) + (wrap [modifiers name inputs output])))) (def field-decl^ (Parser (, (List Text) Text Text)) @@ -50,14 +50,14 @@ [modifiers (*^ local-tag^) name local-symbol^ class local-symbol^] - (M;wrap [modifiers name class])))) + (wrap [modifiers name class])))) (def arg-decl^ (Parser (, Text Text)) (form^ (do Parser/Monad [arg-name local-symbol^ arg-class local-symbol^] - (M;wrap [arg-name arg-class])))) + (wrap [arg-name arg-class])))) (def method-def^ (Parser (, (List Text) Text (List (, Text Text)) Text AST)) @@ -67,7 +67,7 @@ inputs (tuple^ (*^ arg-decl^)) output local-symbol^ body id^] - (M;wrap [modifiers name inputs output body])))) + (wrap [modifiers name inputs output body])))) (def method-call^ (Parser (, Text (List Text) (List AST))) @@ -78,9 +78,9 @@ _ (: (Parser (,)) (if (i= (size arity-classes) (size arity-args)) - (M;wrap []) + (wrap []) (lambda [_] #;None)))] - (M;wrap [method arity-classes arity-args]) + (wrap [method arity-classes arity-args]) ))) ## [Syntax] -- cgit v1.2.3 From d916be54994c8266f005744f7c3a61a36a39e31d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 28 Aug 2015 07:01:33 -0400 Subject: Changed the license from EPL to MPL. --- source/lux/host/jvm.lux | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index 4f3d6df8a..9795965bd 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -1,10 +1,7 @@ -## Copyright (c) Eduardo Julian. All rights reserved. -## The use and distribution terms for this software are covered by the -## Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) -## which can be found in the file epl-v10.html at the root of this distribution. -## By using this software in any fashion, you are agreeing to be bound by -## the terms of this license. -## You must not remove this notice, or any other, from this software. +## 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/. (;import lux (lux (control (monoid #as m) -- cgit v1.2.3 From 253d5a4a3f7ef5d42c467733e394a28d18a4d9b3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 29 Aug 2015 19:39:10 -0400 Subject: - Added some compiler optimizations. - Removed the (unnecessary) lux/control/dict & lux/control/stack modules. - The "Meta" type is now a record instead of a variant. --- source/lux/host/jvm.lux | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index 9795965bd..40021d8fa 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -96,7 +96,7 @@ (list) (#;Some finally) - (list (` (_jvm_finally (~ finally))))))))))))) + (: (List AST) (list (` (_jvm_finally (~ finally)))))))))))))) (defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)]) (let [members' (map (: (-> (, (List Text) Text (List Text) Text) AST) @@ -166,7 +166,7 @@ (defsyntax #export (.? [field local-symbol^] obj) (case obj - (#;Meta [_ (#;SymbolS obj-name)]) + [_ (#;SymbolS obj-name)] (do Lux/Monad [obj-type (find-var-type obj-name)] (case obj-type @@ -184,7 +184,7 @@ (defsyntax #export (.= [field local-symbol^] value obj) (case obj - (#;Meta [_ (#;SymbolS obj-name)]) + [_ (#;SymbolS obj-name)] (do Lux/Monad [obj-type (find-var-type obj-name)] (case obj-type @@ -203,7 +203,7 @@ (defsyntax #export (.! [call method-call^] obj) (let [[m-name ?m-classes m-args] call] (case obj - (#;Meta [_ (#;SymbolS obj-name)]) + [_ (#;SymbolS obj-name)] (do Lux/Monad [obj-type (find-var-type obj-name)] (case obj-type -- cgit v1.2.3 From 0a0fab3581eedbc13df2af40e3db8bc2d2fd8178 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 30 Aug 2015 01:20:08 -0400 Subject: - Removed the (now obsolete) `' macro. - Implemented hygienic macros by adding global symbol resolution inside the ` macro. --- source/lux/host/jvm.lux | 109 ++++++++++++++++++++++++------------------------ 1 file changed, 55 insertions(+), 54 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index 40021d8fa..d7992509a 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -82,21 +82,21 @@ ## [Syntax] (defsyntax #export (throw ex) - (emit (list (` (_jvm_throw (~ ex)))))) + (emit (list (` (;_jvm_throw (~ ex)))))) (defsyntax #export (try body [catches (*^ catch^)] [finally (?^ finally^)]) - (emit (list (` (_jvm_try (~ body) - (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident AST) AST) - (lambda [catch] - (let [[class ex body] catch] - (` (_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body)))))) - catches) - (case finally - #;None - (list) - - (#;Some finally) - (: (List AST) (list (` (_jvm_finally (~ finally)))))))))))))) + (emit (list (` (;_jvm_try (~ body) + (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident AST) AST) + (lambda [catch] + (let [[class ex body] catch] + (` (;_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body)))))) + catches) + (case finally + #;None + (list) + + (#;Some finally) + (: (List AST) (list (` (;_jvm_finally (~ finally)))))))))))))) (defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)]) (let [members' (map (: (-> (, (List Text) Text (List Text) Text) AST) @@ -104,8 +104,8 @@ (let [[modifiers name inputs output] member] (` ((~ (text$ name)) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))]))))) members)] - (emit (list (` (_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))] - (~@ members'))))))) + (emit (list (` (;_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))] + (~@ members'))))))) (defsyntax #export (defclass [name local-symbol^] [super local-symbol^] [interfaces (tuple^ (*^ local-symbol^))] [fields (*^ field-decl^)] @@ -133,36 +133,37 @@ [(~@ (map text$ modifiers))] (~ body)))))) methods)]] - (emit (list (` (_jvm_class (~ (text$ name)) (~ (text$ super)) - [(~@ (map text$ interfaces))] - [(~@ fields')] - [(~@ methods')])))))) + (emit (list (` (;_jvm_class (~ (text$ name)) (~ (text$ super)) + [(~@ (map text$ interfaces))] + [(~@ fields')] + [(~@ methods')])))))) (defsyntax #export (new [class local-symbol^] [arg-classes (tuple^ (*^ local-symbol^))] [args (tuple^ (*^ id^))]) - (emit (list (` (_jvm_new (~ (text$ class)) - [(~@ (map text$ arg-classes))] - [(~@ args)]))))) + (emit (list (` (;_jvm_new (~ (text$ class)) + [(~@ (map text$ arg-classes))] + [(~@ args)]))))) (defsyntax #export (instance? [class local-symbol^] obj) - (emit (list (` (_jvm_instanceof (~ (text$ class)) (~ obj)))))) + (emit (list (` (;_jvm_instanceof (~ (text$ class)) (~ obj)))))) (defsyntax #export (locking lock body) (do Lux/Monad [g!lock (gensym "") - g!body (gensym "")] - (emit (list (` (;let [(~ g!lock) (~ lock) - _ (_jvm_monitorenter (~ g!lock)) - (~ g!body) (~ body) - _ (_jvm_monitorexit (~ g!lock))] - (~ g!body))))) + g!body (gensym "") + g!_ (gensym "")] + (emit (list (` (let [(~ g!lock) (~ lock) + (~ g!_) (;_jvm_monitorenter (~ g!lock)) + (~ g!body) (~ body) + (~ g!_) (;_jvm_monitorexit (~ g!lock))] + (~ g!body))))) )) (defsyntax #export (null? obj) - (emit (list (` (_jvm_null? (~ obj)))))) + (emit (list (` (;_jvm_null? (~ obj)))))) (defsyntax #export (program [args symbol^] body) - (emit (list (` (_jvm_program (~ (symbol$ args)) - (~ body)))))) + (emit (list (` (;_jvm_program (~ (symbol$ args)) + (~ body)))))) (defsyntax #export (.? [field local-symbol^] obj) (case obj @@ -171,7 +172,7 @@ [obj-type (find-var-type obj-name)] (case obj-type (#;DataT class) - (emit (list (` (_jvm_getfield (~ (text$ class)) (~ (text$ field)))))) + (emit (list (` (;_jvm_getfield (~ (text$ class)) (~ (text$ field)))))) _ (fail "Can only get field from object."))) @@ -179,8 +180,8 @@ _ (do Lux/Monad [g!obj (gensym "")] - (emit (list (` (;let [(~ g!obj) (~ obj)] - (.? (~ (text$ field)) (~ g!obj))))))))) + (emit (list (` (let [(~ g!obj) (~ obj)] + (;;.? (~ (text$ field)) (~ g!obj))))))))) (defsyntax #export (.= [field local-symbol^] value obj) (case obj @@ -189,7 +190,7 @@ [obj-type (find-var-type obj-name)] (case obj-type (#;DataT class) - (emit (list (` (_jvm_putfield (~ (text$ class)) (~ (text$ field)) (~ value))))) + (emit (list (` (;_jvm_putfield (~ (text$ class)) (~ (text$ field)) (~ value))))) _ (fail "Can only set field of object."))) @@ -197,8 +198,8 @@ _ (do Lux/Monad [g!obj (gensym "")] - (emit (list (` (;let [(~ g!obj) (~ obj)] - (.= (~ (text$ field)) (~ value) (~ g!obj))))))))) + (emit (list (` (let [(~ g!obj) (~ obj)] + (;;.= (~ (text$ field)) (~ value) (~ g!obj))))))))) (defsyntax #export (.! [call method-call^] obj) (let [[m-name ?m-classes m-args] call] @@ -208,8 +209,8 @@ [obj-type (find-var-type obj-name)] (case obj-type (#;DataT class) - (emit (list (` (_jvm_invokevirtual (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ ?m-classes))] - (~ obj) [(~@ m-args)])))) + (emit (list (` (;_jvm_invokevirtual (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ ?m-classes))] + (~ obj) [(~@ m-args)])))) _ (fail "Can only call method on object."))) @@ -217,31 +218,31 @@ _ (do Lux/Monad [g!obj (gensym "")] - (emit (list (` (;let [(~ g!obj) (~ obj)] - (.! ((~ (symbol$ ["" m-name])) - [(~@ (map (lambda [c] (symbol$ ["" c])) ?m-classes))] - [(~@ m-args)]) - (~ g!obj)))))))))) + (emit (list (` (let [(~ g!obj) (~ obj)] + (;;.! ((~ (symbol$ ["" m-name])) + [(~@ (map (lambda [c] (symbol$ ["" c])) ?m-classes))] + [(~@ m-args)]) + (~ g!obj)))))))))) (defsyntax #export (..? [field local-symbol^] [class local-symbol^]) - (emit (list (` (_jvm_getstatic (~ (text$ class)) (~ (text$ field))))))) + (emit (list (` (;_jvm_getstatic (~ (text$ class)) (~ (text$ field))))))) (defsyntax #export (..= [field local-symbol^] value [class local-symbol^]) - (emit (list (` (_jvm_putstatic (~ (text$ class)) (~ (text$ field)) (~ value)))))) + (emit (list (` (;_jvm_putstatic (~ (text$ class)) (~ (text$ field)) (~ value)))))) (defsyntax #export (..! [call method-call^] [class local-symbol^]) (let [[m-name m-classes m-args] call] - (emit (list (` (_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name)) - [(~@ (map text$ m-classes))] - [(~@ m-args)])))))) + (emit (list (` (;_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name)) + [(~@ (map text$ m-classes))] + [(~@ m-args)])))))) (defsyntax #export (->maybe expr) (do Lux/Monad [g!val (gensym "")] - (emit (list (` (;let [(~ g!val) (~ expr)] - (;if (null? (~ g!val)) - #;None - (#;Some (~ g!val))))))))) + (emit (list (` (let [(~ g!val) (~ expr)] + (if (null? (~ g!val)) + #;None + (#;Some (~ g!val))))))))) (defsyntax #export (try$ expr) (emit (list (` (try (#;Right (~ expr)) -- cgit v1.2.3 From 1857af8628216353c4fa0b75a921d66b266aa0b9 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 31 Aug 2015 12:35:50 -0400 Subject: - Found a compromise with the issue of certain definitions clashing with each other when saving the class files in case-insensitive file-systems (https://github.com/LuxLang/lux/issues/8). The names of certain definitions were changed slightly to avoid clashes and the compiler throws an error if the names end up clashing prior to saving the .class file. --- source/lux/host/jvm.lux | 116 ++++++++++++++++++++++++------------------------ 1 file changed, 58 insertions(+), 58 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index d7992509a..7a564826c 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -82,21 +82,21 @@ ## [Syntax] (defsyntax #export (throw ex) - (emit (list (` (;_jvm_throw (~ ex)))))) + (emit (@list (` (;_jvm_throw (~ ex)))))) (defsyntax #export (try body [catches (*^ catch^)] [finally (?^ finally^)]) - (emit (list (` (;_jvm_try (~ body) - (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident AST) AST) - (lambda [catch] - (let [[class ex body] catch] - (` (;_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body)))))) - catches) - (case finally - #;None - (list) - - (#;Some finally) - (: (List AST) (list (` (;_jvm_finally (~ finally)))))))))))))) + (emit (@list (` (;_jvm_try (~ body) + (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident AST) AST) + (lambda [catch] + (let [[class ex body] catch] + (` (;_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body)))))) + catches) + (case finally + #;None + (@list) + + (#;Some finally) + (: (List AST) (@list (` (;_jvm_finally (~ finally)))))))))))))) (defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)]) (let [members' (map (: (-> (, (List Text) Text (List Text) Text) AST) @@ -104,8 +104,8 @@ (let [[modifiers name inputs output] member] (` ((~ (text$ name)) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))]))))) members)] - (emit (list (` (;_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))] - (~@ members'))))))) + (emit (@list (` (;_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))] + (~@ members'))))))) (defsyntax #export (defclass [name local-symbol^] [super local-symbol^] [interfaces (tuple^ (*^ local-symbol^))] [fields (*^ field-decl^)] @@ -126,44 +126,44 @@ [(~@ (map (: (-> (, Text Text) AST) (lambda [in] (let [[left right] in] - (form$ (list (symbol$ ["" left]) - (text$ right)))))) + (form$ (@list (symbol$ ["" left]) + (text$ right)))))) inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))] (~ body)))))) methods)]] - (emit (list (` (;_jvm_class (~ (text$ name)) (~ (text$ super)) - [(~@ (map text$ interfaces))] - [(~@ fields')] - [(~@ methods')])))))) + (emit (@list (` (;_jvm_class (~ (text$ name)) (~ (text$ super)) + [(~@ (map text$ interfaces))] + [(~@ fields')] + [(~@ methods')])))))) (defsyntax #export (new [class local-symbol^] [arg-classes (tuple^ (*^ local-symbol^))] [args (tuple^ (*^ id^))]) - (emit (list (` (;_jvm_new (~ (text$ class)) - [(~@ (map text$ arg-classes))] - [(~@ args)]))))) + (emit (@list (` (;_jvm_new (~ (text$ class)) + [(~@ (map text$ arg-classes))] + [(~@ args)]))))) (defsyntax #export (instance? [class local-symbol^] obj) - (emit (list (` (;_jvm_instanceof (~ (text$ class)) (~ obj)))))) + (emit (@list (` (;_jvm_instanceof (~ (text$ class)) (~ obj)))))) (defsyntax #export (locking lock body) (do Lux/Monad [g!lock (gensym "") g!body (gensym "") g!_ (gensym "")] - (emit (list (` (let [(~ g!lock) (~ lock) - (~ g!_) (;_jvm_monitorenter (~ g!lock)) - (~ g!body) (~ body) - (~ g!_) (;_jvm_monitorexit (~ g!lock))] - (~ g!body))))) + (emit (@list (` (let [(~ g!lock) (~ lock) + (~ g!_) (;_jvm_monitorenter (~ g!lock)) + (~ g!body) (~ body) + (~ g!_) (;_jvm_monitorexit (~ g!lock))] + (~ g!body))))) )) (defsyntax #export (null? obj) - (emit (list (` (;_jvm_null? (~ obj)))))) + (emit (@list (` (;_jvm_null? (~ obj)))))) (defsyntax #export (program [args symbol^] body) - (emit (list (` (;_jvm_program (~ (symbol$ args)) - (~ body)))))) + (emit (@list (` (;_jvm_program (~ (symbol$ args)) + (~ body)))))) (defsyntax #export (.? [field local-symbol^] obj) (case obj @@ -172,7 +172,7 @@ [obj-type (find-var-type obj-name)] (case obj-type (#;DataT class) - (emit (list (` (;_jvm_getfield (~ (text$ class)) (~ (text$ field)))))) + (emit (@list (` (;_jvm_getfield (~ (text$ class)) (~ (text$ field)))))) _ (fail "Can only get field from object."))) @@ -180,8 +180,8 @@ _ (do Lux/Monad [g!obj (gensym "")] - (emit (list (` (let [(~ g!obj) (~ obj)] - (;;.? (~ (text$ field)) (~ g!obj))))))))) + (emit (@list (` (let [(~ g!obj) (~ obj)] + (;;.? (~ (text$ field)) (~ g!obj))))))))) (defsyntax #export (.= [field local-symbol^] value obj) (case obj @@ -190,7 +190,7 @@ [obj-type (find-var-type obj-name)] (case obj-type (#;DataT class) - (emit (list (` (;_jvm_putfield (~ (text$ class)) (~ (text$ field)) (~ value))))) + (emit (@list (` (;_jvm_putfield (~ (text$ class)) (~ (text$ field)) (~ value))))) _ (fail "Can only set field of object."))) @@ -198,8 +198,8 @@ _ (do Lux/Monad [g!obj (gensym "")] - (emit (list (` (let [(~ g!obj) (~ obj)] - (;;.= (~ (text$ field)) (~ value) (~ g!obj))))))))) + (emit (@list (` (let [(~ g!obj) (~ obj)] + (;;.= (~ (text$ field)) (~ value) (~ g!obj))))))))) (defsyntax #export (.! [call method-call^] obj) (let [[m-name ?m-classes m-args] call] @@ -209,8 +209,8 @@ [obj-type (find-var-type obj-name)] (case obj-type (#;DataT class) - (emit (list (` (;_jvm_invokevirtual (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ ?m-classes))] - (~ obj) [(~@ m-args)])))) + (emit (@list (` (;_jvm_invokevirtual (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ ?m-classes))] + (~ obj) [(~@ m-args)])))) _ (fail "Can only call method on object."))) @@ -218,33 +218,33 @@ _ (do Lux/Monad [g!obj (gensym "")] - (emit (list (` (let [(~ g!obj) (~ obj)] - (;;.! ((~ (symbol$ ["" m-name])) - [(~@ (map (lambda [c] (symbol$ ["" c])) ?m-classes))] - [(~@ m-args)]) - (~ g!obj)))))))))) + (emit (@list (` (let [(~ g!obj) (~ obj)] + (;;.! ((~ (symbol$ ["" m-name])) + [(~@ (map (lambda [c] (symbol$ ["" c])) ?m-classes))] + [(~@ m-args)]) + (~ g!obj)))))))))) (defsyntax #export (..? [field local-symbol^] [class local-symbol^]) - (emit (list (` (;_jvm_getstatic (~ (text$ class)) (~ (text$ field))))))) + (emit (@list (` (;_jvm_getstatic (~ (text$ class)) (~ (text$ field))))))) (defsyntax #export (..= [field local-symbol^] value [class local-symbol^]) - (emit (list (` (;_jvm_putstatic (~ (text$ class)) (~ (text$ field)) (~ value)))))) + (emit (@list (` (;_jvm_putstatic (~ (text$ class)) (~ (text$ field)) (~ value)))))) (defsyntax #export (..! [call method-call^] [class local-symbol^]) (let [[m-name m-classes m-args] call] - (emit (list (` (;_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name)) - [(~@ (map text$ m-classes))] - [(~@ m-args)])))))) + (emit (@list (` (;_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name)) + [(~@ (map text$ m-classes))] + [(~@ m-args)])))))) (defsyntax #export (->maybe expr) (do Lux/Monad [g!val (gensym "")] - (emit (list (` (let [(~ g!val) (~ expr)] - (if (null? (~ g!val)) - #;None - (#;Some (~ g!val))))))))) + (emit (@list (` (let [(~ g!val) (~ expr)] + (if (null? (~ g!val)) + #;None + (#;Some (~ g!val))))))))) (defsyntax #export (try$ expr) - (emit (list (` (try (#;Right (~ expr)) - (~ (' (catch java.lang.Exception e - (#;Left (.! (getMessage [] []) e)))))))))) + (emit (@list (` (try (#;Right (~ expr)) + (~ (' (catch java.lang.Exception e + (#;Left (.! (getMessage [] []) e)))))))))) -- cgit v1.2.3 From a0eb061edbbb8bca666add620e4c82c4f3bc5fdc Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 2 Sep 2015 08:11:14 -0400 Subject: - Added a new (albeit small) I/O library with host-dependent functions. --- source/lux/host/io.lux | 35 +++++++++++++++++++++++++++++++++++ source/lux/host/jvm.lux | 2 +- 2 files changed, 36 insertions(+), 1 deletion(-) create mode 100644 source/lux/host/io.lux (limited to 'source/lux/host') diff --git a/source/lux/host/io.lux b/source/lux/host/io.lux new file mode 100644 index 000000000..7611e41b7 --- /dev/null +++ b/source/lux/host/io.lux @@ -0,0 +1,35 @@ +## 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/. + +(;import lux + lux/data/io + (.. jvm)) + +## [Functions] +(do-template [ ] + [(def #export ( x) + (-> (IO (,))) + (@io (.! ( [] [x]) + (..? out java.lang.System))))] + + [write-char print Char char] + [write print Text java.lang.String] + [write-line println Text java.lang.String]) + +(do-template [ ] + [(def #export + (IO (Maybe )) + (let [in (..? in java.lang.System) + reader (new java.io.InputStreamReader [java.io.InputStream] [in]) + buff-reader (new java.io.BufferedReader [java.io.Reader] [reader])] + (@io (let [output (: (Either Text ) (try$ ))] + (exec (.! (close [] []) buff-reader) + (case output + (#;Left _) #;None + (#;Right input) (#;Some input)))))))] + + [read-char Char (_jvm_i2c (.! (read [] []) buff-reader))] + [read-line Text (.! (readLine [] []) buff-reader)] + ) diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index 7a564826c..eddedfdc5 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -247,4 +247,4 @@ (defsyntax #export (try$ expr) (emit (@list (` (try (#;Right (~ expr)) (~ (' (catch java.lang.Exception e - (#;Left (.! (getMessage [] []) e)))))))))) + (#;Left (_jvm_invokevirtual "java.lang.Throwable" "getMessage" [] e [])))))))))) -- cgit v1.2.3 From 113143d5d2e86185a8fca5214cfa57b4456bfbbb Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 11 Sep 2015 01:37:26 -0400 Subject: - Updated the standard library. --- source/lux/host/io.lux | 22 +++---- source/lux/host/jvm.lux | 151 ++---------------------------------------------- 2 files changed, 16 insertions(+), 157 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/io.lux b/source/lux/host/io.lux index 7611e41b7..7c017a62e 100644 --- a/source/lux/host/io.lux +++ b/source/lux/host/io.lux @@ -11,25 +11,25 @@ (do-template [ ] [(def #export ( x) (-> (IO (,))) - (@io (.! ( [] [x]) - (..? out java.lang.System))))] + (@io (_jvm_invokevirtual "java.io.PrintStream" [] + (_jvm_getstatic "java.lang.System" "out") [x])))] - [write-char print Char char] - [write print Text java.lang.String] - [write-line println Text java.lang.String]) + [write-char "print" Char "char"] + [write "print" Text "java.lang.String"] + [write-line "println" Text "java.lang.String"]) (do-template [ ] [(def #export (IO (Maybe )) - (let [in (..? in java.lang.System) - reader (new java.io.InputStreamReader [java.io.InputStream] [in]) - buff-reader (new java.io.BufferedReader [java.io.Reader] [reader])] + (let [in (_jvm_getstatic "java.lang.System" "in") + reader (_jvm_new "java.io.InputStreamReader" ["java.io.InputStream"] [in]) + buff-reader (_jvm_new "java.io.BufferedReader" ["java.io.Reader"] [reader])] (@io (let [output (: (Either Text ) (try$ ))] - (exec (.! (close [] []) buff-reader) + (exec (_jvm_invokeinterface "java.io.Closeable" "close" [] buff-reader []) (case output (#;Left _) #;None (#;Right input) (#;Some input)))))))] - [read-char Char (_jvm_i2c (.! (read [] []) buff-reader))] - [read-line Text (.! (readLine [] []) buff-reader)] + [read-char Char (_jvm_i2c (_jvm_invokevirtual "java.io.BufferedReader" "read" [] buff-reader []))] + [read-line Text (_jvm_invokevirtual "java.io.BufferedReader" "readLine" [] buff-reader [])] ) diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index eddedfdc5..6f121a633 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -9,29 +9,13 @@ (monad #as M #refer (#only do))) (data (list #as l #refer #all #open ("" List/Functor)) (text #as text) - (number (int #open ("i" Int/Eq)))) + number/int) (meta lux ast syntax))) ## [Utils] ## Parsers -(def finally^ - (Parser AST) - (form^ (do Parser/Monad - [_ (symbol?^ ["" "finally"]) - expr id^] - (wrap expr)))) - -(def catch^ - (Parser (, Text Ident AST)) - (form^ (do Parser/Monad - [_ (symbol?^ ["" "catch"]) - ex-class local-symbol^ - ex symbol^ - expr id^] - (wrap [ex-class ex expr])))) - (def method-decl^ (Parser (, (List Text) Text (List Text) Text)) (form^ (do Parser/Monad @@ -66,38 +50,7 @@ body id^] (wrap [modifiers name inputs output body])))) -(def method-call^ - (Parser (, Text (List Text) (List AST))) - (form^ (do Parser/Monad - [method local-symbol^ - arity-classes (tuple^ (*^ local-symbol^)) - arity-args (tuple^ (*^ id^)) - _ (: (Parser (,)) - (if (i= (size arity-classes) - (size arity-args)) - (wrap []) - (lambda [_] #;None)))] - (wrap [method arity-classes arity-args]) - ))) - ## [Syntax] -(defsyntax #export (throw ex) - (emit (@list (` (;_jvm_throw (~ ex)))))) - -(defsyntax #export (try body [catches (*^ catch^)] [finally (?^ finally^)]) - (emit (@list (` (;_jvm_try (~ body) - (~@ (:: List/Monoid (m;++ (map (: (-> (, Text Ident AST) AST) - (lambda [catch] - (let [[class ex body] catch] - (` (;_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body)))))) - catches) - (case finally - #;None - (@list) - - (#;Some finally) - (: (List AST) (@list (` (;_jvm_finally (~ finally)))))))))))))) - (defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)]) (let [members' (map (: (-> (, (List Text) Text (List Text) Text) AST) (lambda [member] @@ -138,113 +91,19 @@ [(~@ fields')] [(~@ methods')])))))) -(defsyntax #export (new [class local-symbol^] [arg-classes (tuple^ (*^ local-symbol^))] [args (tuple^ (*^ id^))]) - (emit (@list (` (;_jvm_new (~ (text$ class)) - [(~@ (map text$ arg-classes))] - [(~@ args)]))))) - -(defsyntax #export (instance? [class local-symbol^] obj) - (emit (@list (` (;_jvm_instanceof (~ (text$ class)) (~ obj)))))) - -(defsyntax #export (locking lock body) - (do Lux/Monad - [g!lock (gensym "") - g!body (gensym "") - g!_ (gensym "")] - (emit (@list (` (let [(~ g!lock) (~ lock) - (~ g!_) (;_jvm_monitorenter (~ g!lock)) - (~ g!body) (~ body) - (~ g!_) (;_jvm_monitorexit (~ g!lock))] - (~ g!body))))) - )) - -(defsyntax #export (null? obj) - (emit (@list (` (;_jvm_null? (~ obj)))))) - (defsyntax #export (program [args symbol^] body) (emit (@list (` (;_jvm_program (~ (symbol$ args)) (~ body)))))) -(defsyntax #export (.? [field local-symbol^] obj) - (case obj - [_ (#;SymbolS obj-name)] - (do Lux/Monad - [obj-type (find-var-type obj-name)] - (case obj-type - (#;DataT class) - (emit (@list (` (;_jvm_getfield (~ (text$ class)) (~ (text$ field)))))) - - _ - (fail "Can only get field from object."))) - - _ - (do Lux/Monad - [g!obj (gensym "")] - (emit (@list (` (let [(~ g!obj) (~ obj)] - (;;.? (~ (text$ field)) (~ g!obj))))))))) - -(defsyntax #export (.= [field local-symbol^] value obj) - (case obj - [_ (#;SymbolS obj-name)] - (do Lux/Monad - [obj-type (find-var-type obj-name)] - (case obj-type - (#;DataT class) - (emit (@list (` (;_jvm_putfield (~ (text$ class)) (~ (text$ field)) (~ value))))) - - _ - (fail "Can only set field of object."))) - - _ - (do Lux/Monad - [g!obj (gensym "")] - (emit (@list (` (let [(~ g!obj) (~ obj)] - (;;.= (~ (text$ field)) (~ value) (~ g!obj))))))))) - -(defsyntax #export (.! [call method-call^] obj) - (let [[m-name ?m-classes m-args] call] - (case obj - [_ (#;SymbolS obj-name)] - (do Lux/Monad - [obj-type (find-var-type obj-name)] - (case obj-type - (#;DataT class) - (emit (@list (` (;_jvm_invokevirtual (~ (text$ class)) (~ (text$ m-name)) [(~@ (map text$ ?m-classes))] - (~ obj) [(~@ m-args)])))) - - _ - (fail "Can only call method on object."))) - - _ - (do Lux/Monad - [g!obj (gensym "")] - (emit (@list (` (let [(~ g!obj) (~ obj)] - (;;.! ((~ (symbol$ ["" m-name])) - [(~@ (map (lambda [c] (symbol$ ["" c])) ?m-classes))] - [(~@ m-args)]) - (~ g!obj)))))))))) - -(defsyntax #export (..? [field local-symbol^] [class local-symbol^]) - (emit (@list (` (;_jvm_getstatic (~ (text$ class)) (~ (text$ field))))))) - -(defsyntax #export (..= [field local-symbol^] value [class local-symbol^]) - (emit (@list (` (;_jvm_putstatic (~ (text$ class)) (~ (text$ field)) (~ value)))))) - -(defsyntax #export (..! [call method-call^] [class local-symbol^]) - (let [[m-name m-classes m-args] call] - (emit (@list (` (;_jvm_invokestatic (~ (text$ class)) (~ (text$ m-name)) - [(~@ (map text$ m-classes))] - [(~@ m-args)])))))) - (defsyntax #export (->maybe expr) (do Lux/Monad [g!val (gensym "")] (emit (@list (` (let [(~ g!val) (~ expr)] - (if (null? (~ g!val)) + (if (;_jvm_null? (~ g!val)) #;None (#;Some (~ g!val))))))))) (defsyntax #export (try$ expr) - (emit (@list (` (try (#;Right (~ expr)) - (~ (' (catch java.lang.Exception e - (#;Left (_jvm_invokevirtual "java.lang.Throwable" "getMessage" [] e [])))))))))) + (emit (@list (` (;_jvm_try (#;Right (~ expr)) + (~ (' (_jvm_catch "java.lang.Exception" e + (#;Left (_jvm_invokevirtual "java.lang.Throwable" "getMessage" [] e [])))))))))) -- cgit v1.2.3 From 5a26c40dc215dfb22a77cad28455deff28ca9976 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 11 Sep 2015 19:46:30 -0400 Subject: - Implemented the with-open macro. - Cleaned-up a bit the tag-generation macro "deftags". --- source/lux/host/io.lux | 31 ++++++++++++++++++++++++++++--- source/lux/host/jvm.lux | 4 ++-- 2 files changed, 30 insertions(+), 5 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/io.lux b/source/lux/host/io.lux index 7c017a62e..4542b0519 100644 --- a/source/lux/host/io.lux +++ b/source/lux/host/io.lux @@ -4,7 +4,12 @@ ## You can obtain one at http://mozilla.org/MPL/2.0/. (;import lux - lux/data/io + (lux (data io + (list #refer #all #open ("" List/Fold))) + (meta ast + syntax + lux) + control/monad) (.. jvm)) ## [Functions] @@ -16,7 +21,8 @@ [write-char "print" Char "char"] [write "print" Text "java.lang.String"] - [write-line "println" Text "java.lang.String"]) + [write-line "println" Text "java.lang.String"] + ) (do-template [ ] [(def #export @@ -24,7 +30,7 @@ (let [in (_jvm_getstatic "java.lang.System" "in") reader (_jvm_new "java.io.InputStreamReader" ["java.io.InputStream"] [in]) buff-reader (_jvm_new "java.io.BufferedReader" ["java.io.Reader"] [reader])] - (@io (let [output (: (Either Text ) (try$ ))] + (@io (let [output (: (Either Text ) (try ))] (exec (_jvm_invokeinterface "java.io.Closeable" "close" [] buff-reader []) (case output (#;Left _) #;None @@ -33,3 +39,22 @@ [read-char Char (_jvm_i2c (_jvm_invokevirtual "java.io.BufferedReader" "read" [] buff-reader []))] [read-line Text (_jvm_invokevirtual "java.io.BufferedReader" "readLine" [] buff-reader [])] ) + +## [Syntax] +(def simple-bindings^ + (Parser (List (, Text AST))) + (tuple^ (*^ (&^ local-symbol^ id^)))) + +(defsyntax #export (with-open [bindings simple-bindings^] body) + (do Lux/Monad + [g!output (gensym "output") + #let [code (foldL (: (-> AST (, Text AST) AST) + (lambda [body [res-name res-value]] + (let [g!res-name (symbol$ ["" res-name])] + (` (let [(~ g!res-name) (~ res-value) + (~ g!output) (~ body)] + (exec (;_jvm_invokeinterface "java.io.Closeable" "close" [] (~ g!res-name) []) + (~ g!output))))))) + body + (reverse bindings))]] + (wrap (@list code)))) diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index 6f121a633..c1e122bb6 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -95,7 +95,7 @@ (emit (@list (` (;_jvm_program (~ (symbol$ args)) (~ body)))))) -(defsyntax #export (->maybe expr) +(defsyntax #export (??? expr) (do Lux/Monad [g!val (gensym "")] (emit (@list (` (let [(~ g!val) (~ expr)] @@ -103,7 +103,7 @@ #;None (#;Some (~ g!val))))))))) -(defsyntax #export (try$ expr) +(defsyntax #export (try expr) (emit (@list (` (;_jvm_try (#;Right (~ expr)) (~ (' (_jvm_catch "java.lang.Exception" e (#;Left (_jvm_invokevirtual "java.lang.Throwable" "getMessage" [] e [])))))))))) -- cgit v1.2.3 From 3c1e63b8ea119601f6ba2c9eb709877c76683a8c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 12 Sep 2015 17:28:30 -0400 Subject: - Added full support for arrays. --- source/lux/host/jvm.lux | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index c1e122bb6..ba29925a7 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -7,9 +7,9 @@ (lux (control (monoid #as m) (functor #as F) (monad #as M #refer (#only do))) - (data (list #as l #refer #all #open ("" List/Functor)) - (text #as text) - number/int) + (data (list #refer #all #open ("" List/Functor List/Fold)) + (number/int #refer #all #open ("i:" Int/Ord)) + maybe) (meta lux ast syntax))) @@ -107,3 +107,11 @@ (emit (@list (` (;_jvm_try (#;Right (~ expr)) (~ (' (_jvm_catch "java.lang.Exception" e (#;Left (_jvm_invokevirtual "java.lang.Throwable" "getMessage" [] e [])))))))))) + +(defsyntax #export (Array [dimensions (?^ int^)] type) + (let [dimensions (? 1 dimensions)] + (if (i:> dimensions 0) + (emit (@list (foldL (lambda [inner _] (` (#;DataT "Array" (@list (~ inner))))) + type + (repeat dimensions [])))) + (fail "Array must have positive dimension.")))) -- cgit v1.2.3 From c9560da3760d0d277a715a966496451020f3f2f8 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 12 Sep 2015 22:36:34 -0400 Subject: - Added exhaustiveness testing for exception-handling code. - Added some optimizations for using List & Maybe within the compiler. --- source/lux/host/io.lux | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/io.lux b/source/lux/host/io.lux index 4542b0519..99e15722d 100644 --- a/source/lux/host/io.lux +++ b/source/lux/host/io.lux @@ -30,11 +30,11 @@ (let [in (_jvm_getstatic "java.lang.System" "in") reader (_jvm_new "java.io.InputStreamReader" ["java.io.InputStream"] [in]) buff-reader (_jvm_new "java.io.BufferedReader" ["java.io.Reader"] [reader])] - (@io (let [output (: (Either Text ) (try ))] - (exec (_jvm_invokeinterface "java.io.Closeable" "close" [] buff-reader []) - (case output - (#;Left _) #;None - (#;Right input) (#;Some input)))))))] + (@io (let [output (: (Either Text ) (try )) + _close (: (Either Text (,)) (try (_jvm_invokeinterface "java.io.Closeable" "close" [] buff-reader [])))] + (case [output _close] + (\or [(#;Left _) _] [_ (#;Left _)]) #;None + [(#;Right input) (#;Right _)] (#;Some input))))))] [read-char Char (_jvm_i2c (_jvm_invokevirtual "java.io.BufferedReader" "read" [] buff-reader []))] [read-line Text (_jvm_invokevirtual "java.io.BufferedReader" "readLine" [] buff-reader [])] -- cgit v1.2.3 From 2f2a37639e7933d97bd0dd4b790e92ff7e784dcf Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 13 Sep 2015 00:11:32 -0400 Subject: - Expanded the lux/host/jvm library. --- source/lux/host/jvm.lux | 122 +++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 120 insertions(+), 2 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index ba29925a7..710bc9a20 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -6,14 +6,17 @@ (;import lux (lux (control (monoid #as m) (functor #as F) - (monad #as M #refer (#only do))) + (monad #as M #refer (#only do seq%))) (data (list #refer #all #open ("" List/Functor List/Fold)) (number/int #refer #all #open ("i:" Int/Ord)) - maybe) + maybe + tuple) (meta lux ast syntax))) +(open List/Monad "list:") + ## [Utils] ## Parsers (def method-decl^ @@ -50,6 +53,11 @@ body id^] (wrap [modifiers name inputs output body])))) +(def opt-arg^ + (Parser (, Bool Text)) + (&^ (tag?^ ["" "?"]) + local-symbol^)) + ## [Syntax] (defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)]) (let [members' (map (: (-> (, (List Text) Text (List Text) Text) AST) @@ -115,3 +123,113 @@ type (repeat dimensions [])))) (fail "Array must have positive dimension.")))) + +(defsyntax #export (instance? [class local-symbol^] obj) + (emit (@list (` (;_jvm_instanceof (~ (text$ class)) (~ obj)))))) + +(defsyntax #export (locking lock body) + (do Lux/Monad + [g!lock (gensym "") + g!body (gensym "") + g!_ (gensym "")] + (emit (@list (` (let [(~ g!lock) (~ lock) + (~ g!_) (;_jvm_monitorenter (~ g!lock)) + (~ g!body) (~ body) + (~ g!_) (;_jvm_monitorexit (~ g!lock))] + (~ g!body))))) + )) + +(defsyntax #export (null? obj) + (emit (@list (` (;_jvm_null? (~ obj)))))) + +(def (prepare-args args) + (-> (List (, Bool Text)) (Lux (, (List AST) (List AST) (List AST) (List Text)))) + (do Lux/Monad + [vars (seq% Lux/Monad (repeat (size args) (gensym ""))) + #let [pairings (map (: (-> (, (, Bool Text) AST) (, AST (List AST))) + (lambda [[[opt? arg-class] var]] + (if opt? + [(` (Maybe (^ (~ (symbol$ ["" arg-class]))))) + (@list var (` (: (^ (~ (symbol$ ["" arg-class]))) + (case (~ var) + (#;Some (~ var)) (~ var) + #;None ;_jvm_null))))] + [(` (^ (~ (symbol$ ["" arg-class])))) + (@list)]))) + (zip2 args vars)) + var-types (map first pairings) + var-rebinds (map second pairings) + arg-classes (map second args)]] + (wrap [vars var-types (list:join var-rebinds) arg-classes]))) + +(defsyntax #export (new$ [class local-symbol^] [args (tuple^ (*^ opt-arg^))]) + (do Lux/Monad + [[vars var-types var-rebinds arg-classes] (prepare-args args)] + (case vars + (\ (@list)) + (do Lux/Monad + [g!_ (gensym "")] + (wrap (@list (` (: (-> (,) (^ (~ (symbol$ ["" class])))) + (lambda [(~ g!_)] + (;_jvm_new (~ (text$ class)) [] []))))))) + + _ + (wrap (@list (` (: (-> (, (~@ var-types)) (^ (~ (symbol$ ["" class])))) + (lambda [[(~@ vars)]] + (let [(~@ var-rebinds)] + (;_jvm_new (~ (text$ class)) [(~@ (map text$ arg-classes))] [(~@ vars)]))))))) + ))) + +(do-template [ ] + [(defsyntax #export ( [class local-symbol^] [method local-symbol^] [args (tuple^ (*^ opt-arg^))] + [ex? (tag?^ ["" "!"])] [opt? (tag?^ ["" "?"])] [return local-symbol^]) + (do Lux/Monad + [[vars var-types var-rebinds arg-classes] (prepare-args args) + g!self (gensym "self") + g!temp (gensym "temp") + #let [return-type (` (^ (~ (symbol$ ["" return])))) + body (` ( (~ (text$ class)) (~ (text$ method)) [(~@ (map text$ arg-classes))] (~ g!self) [(~@ vars)])) + [body return-type] (if opt? + [(` (let [(~ g!temp) (~ body)] + (if (;_jvm_null? (~ g!temp)) + #;None + (#;Some (~ g!temp))))) + (` (Maybe (~ return-type)))] + [body return-type]) + [body return-type] (if ex? + [(` (try (~ body))) + (` (Either Text (~ return-type)))] + [body return-type])]] + (wrap (@list (` (: (-> (, (~@ var-types)) (^ (~ (symbol$ ["" class]))) (~ return-type)) + (lambda [[(~@ vars)] (~ g!self)] + (let [(~@ var-rebinds)] + (~ body))))))) + ))] + + [invoke-virtual$ ;_jvm_invokevirtual] + [invoke-interface$ ;_jvm_invokeinterface] + ) + +(defsyntax #export (invoke-static$ [class local-symbol^] [method local-symbol^] [args (tuple^ (*^ opt-arg^))] + [ex? (tag?^ ["" "!"])] [opt? (tag?^ ["" "?"])] [return local-symbol^]) + (do Lux/Monad + [[vars var-types var-rebinds arg-classes] (prepare-args args) + g!temp (gensym "temp") + #let [return-type (` (^ (~ (symbol$ ["" return])))) + body (` (;_jvm_invokestatic (~ (text$ class)) (~ (text$ method)) [(~@ (map text$ arg-classes))] [(~@ vars)])) + [body return-type] (if opt? + [(` (let [(~ g!temp) (~ body)] + (if (;_jvm_null? (~ g!temp)) + #;None + (#;Some (~ g!temp))))) + (` (Maybe (~ return-type)))] + [body return-type]) + [body return-type] (if ex? + [(` (try (~ body))) + (` (Either Text (~ return-type)))] + [body return-type])]] + (wrap (@list (` (: (-> (, (~@ var-types)) (~ return-type)) + (lambda [[(~@ vars)]] + (let [(~@ var-rebinds)] + (~ body))))))) + )) -- cgit v1.2.3 From 8a67a7e51b3875c3ebba4e8d0acbd275aaa2c356 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 14 Sep 2015 23:27:38 -0400 Subject: - Added the possibility to define anonymous classes. - Fixed some bugs. --- source/lux/host/jvm.lux | 330 +++++++++++++++++++++++++++--------------------- 1 file changed, 188 insertions(+), 142 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index 710bc9a20..1e903ad1d 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -6,98 +6,202 @@ (;import lux (lux (control (monoid #as m) (functor #as F) - (monad #as M #refer (#only do seq%))) + (monad #as M #refer (#only do seq%)) + (enum #as E)) (data (list #refer #all #open ("" List/Functor List/Fold)) - (number/int #refer #all #open ("i:" Int/Ord)) + (number/int #refer #all #open ("i:" Int/Ord Int/Number)) maybe - tuple) + tuple + (text #open ("text:" Text/Monoid))) (meta lux ast syntax))) (open List/Monad "list:") +## [Types] +(defsyntax #export (Array [dimensions (?^ nat^)] type) + (emit (@list (foldL (lambda [inner _] (` (#;DataT "#Array" (@list (~ inner))))) + type + (repeat (? 1 dimensions) []))))) + ## [Utils] +## Types +(deftype StackFrame (^ java.lang.StackTraceElement)) +(deftype StackTrace (Array StackFrame)) + +(deftype Modifier Text) +(deftype JvmType Text) + +(deftype MemberDecl + (& #member-modifiers (List Modifier) + #member-name Text)) + +(deftype FieldDecl + JvmType) + +(deftype MethodDecl + (& #method-inputs (List JvmType) + #method-output JvmType)) + +(deftype ArgDecl + (& #arg-name Text + #arg-type JvmType)) + +(deftype MethodDef + (& #method-vars (List ArgDecl) + #return-type JvmType + #return-body AST)) + +(deftype ExpectedInput + (& #opt-input? Bool + #input-type JvmType)) + +(deftype ExpectedOutput + (& #ex-output? Bool + #opt-output? Bool + #output-type JvmType)) + +## Functions +(def (prepare-args args) + (-> (List ExpectedInput) (Lux (, (List AST) (List AST) (List AST) (List Text)))) + (do Lux/Monad + [vars (seq% Lux/Monad (repeat (size args) (gensym ""))) + #let [pairings (map (: (-> (, (, Bool Text) AST) (, AST (List AST))) + (lambda [[[opt? arg-class] var]] + (if opt? + [(` (Maybe (^ (~ (symbol$ ["" arg-class]))))) + (@list var (` (: (^ (~ (symbol$ ["" arg-class]))) + (case (~ var) + (#;Some (~ var)) (~ var) + #;None ;_jvm_null))))] + [(` (^ (~ (symbol$ ["" arg-class])))) + (@list)]))) + (zip2 args vars)) + var-types (map first pairings) + var-rebinds (map second pairings) + arg-classes (map second args)]] + (wrap [vars var-types (list:join var-rebinds) arg-classes]))) + ## Parsers +(def member-decl^ + (Parser MemberDecl) + (&^ (*^ local-tag^) local-symbol^)) + (def method-decl^ - (Parser (, (List Text) Text (List Text) Text)) - (form^ (do Parser/Monad - [modifiers (*^ local-tag^) - name local-symbol^ - inputs (tuple^ (*^ local-symbol^)) - output local-symbol^] - (wrap [modifiers name inputs output])))) + (Parser (, MemberDecl MethodDecl)) + (form^ (&^ member-decl^ + (&^ (tuple^ (*^ local-symbol^)) + local-symbol^)))) (def field-decl^ - (Parser (, (List Text) Text Text)) - (form^ (do Parser/Monad - [modifiers (*^ local-tag^) - name local-symbol^ - class local-symbol^] - (wrap [modifiers name class])))) + (Parser (, MemberDecl FieldDecl)) + (form^ (&^ member-decl^ + local-symbol^))) (def arg-decl^ - (Parser (, Text Text)) - (form^ (do Parser/Monad - [arg-name local-symbol^ - arg-class local-symbol^] - (wrap [arg-name arg-class])))) + (Parser ArgDecl) + (form^ (&^ local-symbol^ local-symbol^))) (def method-def^ - (Parser (, (List Text) Text (List (, Text Text)) Text AST)) + (Parser (, MemberDecl MethodDef)) (form^ (do Parser/Monad - [modifiers (*^ local-tag^) - name local-symbol^ + [=member-decl member-decl^ inputs (tuple^ (*^ arg-decl^)) output local-symbol^ body id^] - (wrap [modifiers name inputs output body])))) + (wrap [=member-decl [inputs output body]])))) -(def opt-arg^ - (Parser (, Bool Text)) +(def exp-input^ + (Parser ExpectedInput) (&^ (tag?^ ["" "?"]) local-symbol^)) +(def exp-output^ + (Parser ExpectedOutput) + (do Parser/Monad + [ex? (tag?^ ["" "!"]) + opt? (tag?^ ["" "?"]) + return local-symbol^] + (wrap [ex? opt? return]))) + +## Generators +(def (gen-method-decl [[modifiers name] [inputs output]]) + (-> (, MemberDecl MethodDecl) AST) + (` ((~ (text$ name)) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))]))) + +(def (gen-field-decl [[modifiers name] class]) + (-> (, MemberDecl FieldDecl) AST) + (` ((~ (text$ name)) + (~ (text$ class)) + [(~@ (map text$ modifiers))]))) + +(def (gen-arg-decl [name type]) + (-> ArgDecl AST) + (form$ (@list (symbol$ ["" name]) (text$ type)))) + +(def (gen-method-def [[modifiers name] [inputs output body]]) + (-> (, MemberDecl MethodDef) AST) + (` ((~ (text$ name)) + [(~@ (map gen-arg-decl inputs))] + (~ (text$ output)) + [(~@ (map text$ modifiers))] + (~ body)))) + +(def (gen-expected-output [ex? opt? output] body) + (-> ExpectedOutput AST (, AST AST)) + (let [type (` (^ (~ (symbol$ ["" output])))) + [body type] (if opt? + [(` (;;??? (~ body))) + (` (Maybe (~ type)))] + [body type]) + [body type] (if ex? + [(` (;;try (~ body))) + (` (Either Text (~ type)))] + [body type])] + [body type])) + +## [Functions] +(def (stack-trace->text trace) + (-> StackTrace Text) + (let [size (_jvm_arraylength trace) + idxs (E;range Int/Enum 0 (i:+ -1 size))] + (|> idxs + (map (: (-> Int Text) + (lambda [idx] + (_jvm_invokevirtual "java.lang.Object" "toString" [] (_jvm_aaload "java.lang.StackTraceElement" trace idx) [])))) + (interpose "\n") + (foldL text:++ "") + ))) + +(def (get-stack-trace t) + (-> (^ java.lang.Throwable) StackTrace) + (_jvm_invokevirtual "java.lang.Throwable" "getStackTrace" [] t [])) + +(def #export (throwable->text t) + ($ text:++ + (_jvm_invokevirtual "java.lang.Object" "toString" [] t []) + "\n" + (|> t get-stack-trace stack-trace->text))) + ## [Syntax] (defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)]) - (let [members' (map (: (-> (, (List Text) Text (List Text) Text) AST) - (lambda [member] - (let [[modifiers name inputs output] member] - (` ((~ (text$ name)) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))]))))) - members)] - (emit (@list (` (;_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))] - (~@ members'))))))) + (emit (@list (` (;_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))] + (~@ (map gen-method-decl members))))))) (defsyntax #export (defclass [name local-symbol^] [super local-symbol^] [interfaces (tuple^ (*^ local-symbol^))] [fields (*^ field-decl^)] [methods (*^ method-def^)]) - (do Lux/Monad - [current-module get-module-name - #let [fields' (map (: (-> (, (List Text) Text Text) AST) - (lambda [field] - (let [[modifiers name class] field] - (` ((~ (text$ name)) - (~ (text$ class)) - [(~@ (map text$ modifiers))]))))) - fields) - methods' (map (: (-> (, (List Text) Text (List (, Text Text)) Text AST) AST) - (lambda [methods] - (let [[modifiers name inputs output body] methods] - (` ((~ (text$ name)) - [(~@ (map (: (-> (, Text Text) AST) - (lambda [in] - (let [[left right] in] - (form$ (@list (symbol$ ["" left]) - (text$ right)))))) - inputs))] - (~ (text$ output)) - [(~@ (map text$ modifiers))] - (~ body)))))) - methods)]] - (emit (@list (` (;_jvm_class (~ (text$ name)) (~ (text$ super)) - [(~@ (map text$ interfaces))] - [(~@ fields')] - [(~@ methods')])))))) + (emit (@list (` (;_jvm_class (~ (text$ name)) (~ (text$ super)) + [(~@ (map text$ interfaces))] + [(~@ (map gen-field-decl fields))] + [(~@ (map gen-method-def methods))]))))) + +(defsyntax #export (object [super local-symbol^] [interfaces (tuple^ (*^ local-symbol^))] + [methods (*^ method-def^)]) + (emit (@list (` (;_jvm_anon-class (~ (text$ super)) + [(~@ (map text$ interfaces))] + [(~@ (map gen-method-def methods))]))))) (defsyntax #export (program [args symbol^] body) (emit (@list (` (;_jvm_program (~ (symbol$ args)) @@ -105,24 +209,16 @@ (defsyntax #export (??? expr) (do Lux/Monad - [g!val (gensym "")] - (emit (@list (` (let [(~ g!val) (~ expr)] - (if (;_jvm_null? (~ g!val)) + [g!temp (gensym "")] + (wrap (@list (` (let [(~ g!temp) (~ expr)] + (if (;_jvm_null? (~ g!temp)) #;None - (#;Some (~ g!val))))))))) + (#;Some (~ g!temp))))))))) (defsyntax #export (try expr) (emit (@list (` (;_jvm_try (#;Right (~ expr)) (~ (' (_jvm_catch "java.lang.Exception" e - (#;Left (_jvm_invokevirtual "java.lang.Throwable" "getMessage" [] e [])))))))))) - -(defsyntax #export (Array [dimensions (?^ int^)] type) - (let [dimensions (? 1 dimensions)] - (if (i:> dimensions 0) - (emit (@list (foldL (lambda [inner _] (` (#;DataT "Array" (@list (~ inner))))) - type - (repeat dimensions [])))) - (fail "Array must have positive dimension.")))) + (#;Left (throwable->text e)))))))))) (defsyntax #export (instance? [class local-symbol^] obj) (emit (@list (` (;_jvm_instanceof (~ (text$ class)) (~ obj)))))) @@ -142,64 +238,26 @@ (defsyntax #export (null? obj) (emit (@list (` (;_jvm_null? (~ obj)))))) -(def (prepare-args args) - (-> (List (, Bool Text)) (Lux (, (List AST) (List AST) (List AST) (List Text)))) +(defsyntax #export (new$ [class local-symbol^] [args (tuple^ (*^ exp-input^))] [ex? (tag?^ ["" "!"])]) (do Lux/Monad - [vars (seq% Lux/Monad (repeat (size args) (gensym ""))) - #let [pairings (map (: (-> (, (, Bool Text) AST) (, AST (List AST))) - (lambda [[[opt? arg-class] var]] - (if opt? - [(` (Maybe (^ (~ (symbol$ ["" arg-class]))))) - (@list var (` (: (^ (~ (symbol$ ["" arg-class]))) - (case (~ var) - (#;Some (~ var)) (~ var) - #;None ;_jvm_null))))] - [(` (^ (~ (symbol$ ["" arg-class])))) - (@list)]))) - (zip2 args vars)) - var-types (map first pairings) - var-rebinds (map second pairings) - arg-classes (map second args)]] - (wrap [vars var-types (list:join var-rebinds) arg-classes]))) - -(defsyntax #export (new$ [class local-symbol^] [args (tuple^ (*^ opt-arg^))]) - (do Lux/Monad - [[vars var-types var-rebinds arg-classes] (prepare-args args)] - (case vars - (\ (@list)) - (do Lux/Monad - [g!_ (gensym "")] - (wrap (@list (` (: (-> (,) (^ (~ (symbol$ ["" class])))) - (lambda [(~ g!_)] - (;_jvm_new (~ (text$ class)) [] []))))))) - - _ - (wrap (@list (` (: (-> (, (~@ var-types)) (^ (~ (symbol$ ["" class])))) - (lambda [[(~@ vars)]] - (let [(~@ var-rebinds)] - (;_jvm_new (~ (text$ class)) [(~@ (map text$ arg-classes))] [(~@ vars)]))))))) - ))) + [[vars var-types var-rebinds arg-classes] (prepare-args args) + #let [new-expr (` (;_jvm_new (~ (text$ class)) [(~@ (map text$ arg-classes))] [(~@ vars)])) + new-expr (if ex? + (` (try (~ new-expr))) + new-expr)]] + (wrap (@list (` (: (-> (, (~@ var-types)) (^ (~ (symbol$ ["" class])))) + (lambda [[(~@ vars)]] + (let [(~@ var-rebinds)] + (~ new-expr))))))))) (do-template [ ] - [(defsyntax #export ( [class local-symbol^] [method local-symbol^] [args (tuple^ (*^ opt-arg^))] - [ex? (tag?^ ["" "!"])] [opt? (tag?^ ["" "?"])] [return local-symbol^]) + [(defsyntax #export ( [class local-symbol^] [method local-symbol^] [args (tuple^ (*^ exp-input^))] + [expected-output exp-output^]) (do Lux/Monad [[vars var-types var-rebinds arg-classes] (prepare-args args) g!self (gensym "self") - g!temp (gensym "temp") - #let [return-type (` (^ (~ (symbol$ ["" return])))) - body (` ( (~ (text$ class)) (~ (text$ method)) [(~@ (map text$ arg-classes))] (~ g!self) [(~@ vars)])) - [body return-type] (if opt? - [(` (let [(~ g!temp) (~ body)] - (if (;_jvm_null? (~ g!temp)) - #;None - (#;Some (~ g!temp))))) - (` (Maybe (~ return-type)))] - [body return-type]) - [body return-type] (if ex? - [(` (try (~ body))) - (` (Either Text (~ return-type)))] - [body return-type])]] + #let [[body return-type] (gen-expected-output expected-output + (` ( (~ (text$ class)) (~ (text$ method)) [(~@ (map text$ arg-classes))] (~ g!self) [(~@ vars)])))]] (wrap (@list (` (: (-> (, (~@ var-types)) (^ (~ (symbol$ ["" class]))) (~ return-type)) (lambda [[(~@ vars)] (~ g!self)] (let [(~@ var-rebinds)] @@ -210,24 +268,12 @@ [invoke-interface$ ;_jvm_invokeinterface] ) -(defsyntax #export (invoke-static$ [class local-symbol^] [method local-symbol^] [args (tuple^ (*^ opt-arg^))] - [ex? (tag?^ ["" "!"])] [opt? (tag?^ ["" "?"])] [return local-symbol^]) +(defsyntax #export (invoke-static$ [class local-symbol^] [method local-symbol^] [args (tuple^ (*^ exp-input^))] + [expected-output exp-output^]) (do Lux/Monad [[vars var-types var-rebinds arg-classes] (prepare-args args) - g!temp (gensym "temp") - #let [return-type (` (^ (~ (symbol$ ["" return])))) - body (` (;_jvm_invokestatic (~ (text$ class)) (~ (text$ method)) [(~@ (map text$ arg-classes))] [(~@ vars)])) - [body return-type] (if opt? - [(` (let [(~ g!temp) (~ body)] - (if (;_jvm_null? (~ g!temp)) - #;None - (#;Some (~ g!temp))))) - (` (Maybe (~ return-type)))] - [body return-type]) - [body return-type] (if ex? - [(` (try (~ body))) - (` (Either Text (~ return-type)))] - [body return-type])]] + #let [[body return-type] (gen-expected-output expected-output + (` (;_jvm_invokestatic (~ (text$ class)) (~ (text$ method)) [(~@ (map text$ arg-classes))] [(~@ vars)])))]] (wrap (@list (` (: (-> (, (~@ var-types)) (~ return-type)) (lambda [[(~@ vars)]] (let [(~@ var-rebinds)] -- cgit v1.2.3 From d2a4aac2226b5cca59be236d3228fe5e5b17b8de Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 14 Sep 2015 23:37:10 -0400 Subject: - Renamed "this" to "_jvm_this". - Movied lux/data/io to lux/codata/io. --- source/lux/host/io.lux | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/io.lux b/source/lux/host/io.lux index 99e15722d..220f089a2 100644 --- a/source/lux/host/io.lux +++ b/source/lux/host/io.lux @@ -4,8 +4,8 @@ ## You can obtain one at http://mozilla.org/MPL/2.0/. (;import lux - (lux (data io - (list #refer #all #open ("" List/Fold))) + (lux (data (list #refer #all #open ("" List/Fold))) + (codata io) (meta ast syntax lux) -- cgit v1.2.3 From 03bf7b58e6cf45b76b317369aa476443236658f9 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 26 Sep 2015 09:22:21 -0400 Subject: - Both method declarations & method definitions in classes can now include declarations of which exceptions they throw. --- source/lux/host/jvm.lux | 62 +++++++++++++++++++++++++++++++++++++------------ 1 file changed, 47 insertions(+), 15 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index 1e903ad1d..4892ba333 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -42,7 +42,8 @@ (deftype MethodDecl (& #method-inputs (List JvmType) - #method-output JvmType)) + #method-output JvmType + #method-exs (List JvmType))) (deftype ArgDecl (& #arg-name Text @@ -51,7 +52,8 @@ (deftype MethodDef (& #method-vars (List ArgDecl) #return-type JvmType - #return-body AST)) + #return-body AST + #throws-exs (List JvmType))) (deftype ExpectedInput (& #opt-input? Bool @@ -88,11 +90,30 @@ (Parser MemberDecl) (&^ (*^ local-tag^) local-symbol^)) +(def throws-decl'^ + (Parser (List JvmType)) + (do Parser/Monad + [_ (tag!^ ["" "throws"])] + (tuple^ (*^ local-symbol^)))) + +(def throws-decl^ + (Parser (List JvmType)) + (do Parser/Monad + [exs? (?^ throws-decl'^)] + (wrap (? (@list) exs?)))) + +(def method-decl'^ + (Parser MethodDecl) + (do Parser/Monad + [inputs (tuple^ (*^ local-symbol^)) + outputs local-symbol^ + exs throws-decl^] + (wrap [inputs outputs exs]))) + (def method-decl^ (Parser (, MemberDecl MethodDecl)) (form^ (&^ member-decl^ - (&^ (tuple^ (*^ local-symbol^)) - local-symbol^)))) + method-decl'^))) (def field-decl^ (Parser (, MemberDecl FieldDecl)) @@ -103,14 +124,19 @@ (Parser ArgDecl) (form^ (&^ local-symbol^ local-symbol^))) +(def method-def'^ + (Parser MethodDef) + (do Parser/Monad + [inputs (tuple^ (*^ arg-decl^)) + output local-symbol^ + exs throws-decl^ + body id^] + (wrap [inputs output body exs]))) + (def method-def^ (Parser (, MemberDecl MethodDef)) - (form^ (do Parser/Monad - [=member-decl member-decl^ - inputs (tuple^ (*^ arg-decl^)) - output local-symbol^ - body id^] - (wrap [=member-decl [inputs output body]])))) + (form^ (&^ member-decl^ + method-def'^))) (def exp-input^ (Parser ExpectedInput) @@ -126,26 +152,32 @@ (wrap [ex? opt? return]))) ## Generators -(def (gen-method-decl [[modifiers name] [inputs output]]) +(def (gen-method-decl [[modifiers name] [inputs output exs]]) (-> (, MemberDecl MethodDecl) AST) - (` ((~ (text$ name)) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))]))) + (` ((~ (text$ name)) + [(~@ (map text$ modifiers))] + [(~@ (map text$ exs))] + [(~@ (map text$ inputs))] + (~ (text$ output))))) (def (gen-field-decl [[modifiers name] class]) (-> (, MemberDecl FieldDecl) AST) (` ((~ (text$ name)) + [(~@ (map text$ modifiers))] (~ (text$ class)) - [(~@ (map text$ modifiers))]))) + ))) (def (gen-arg-decl [name type]) (-> ArgDecl AST) (form$ (@list (symbol$ ["" name]) (text$ type)))) -(def (gen-method-def [[modifiers name] [inputs output body]]) +(def (gen-method-def [[modifiers name] [inputs output body exs]]) (-> (, MemberDecl MethodDef) AST) (` ((~ (text$ name)) + [(~@ (map text$ modifiers))] + [(~@ (map text$ exs))] [(~@ (map gen-arg-decl inputs))] (~ (text$ output)) - [(~@ (map text$ modifiers))] (~ body)))) (def (gen-expected-output [ex? opt? output] body) -- cgit v1.2.3 From 506ec627005cca8a2e6f7c4fcf374634be3653de Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 26 Sep 2015 18:10:00 -0400 Subject: - Added support for Java annotations. --- source/lux/host/jvm.lux | 70 ++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 60 insertions(+), 10 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index 4892ba333..bbb396874 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -33,9 +33,17 @@ (deftype Modifier Text) (deftype JvmType Text) +(deftype AnnotationParam + (, Text AST)) + +(deftype Annotation + (& #ann-name Text + #ann-params (List AnnotationParam))) + (deftype MemberDecl - (& #member-modifiers (List Modifier) - #member-name Text)) + (& #member-name Text + #member-modifiers (List Modifier) + #member-anns (List Annotation))) (deftype FieldDecl JvmType) @@ -86,9 +94,34 @@ (wrap [vars var-types (list:join var-rebinds) arg-classes]))) ## Parsers +(def annotation-params^ + (Parser (List AnnotationParam)) + (record^ (*^ (tuple^ (&^ local-tag^ id^))))) + +(def annotation^ + (Parser Annotation) + (form^ (&^ local-symbol^ + annotation-params^))) + +(def annotations^' + (Parser (List Annotation)) + (do Parser/Monad + [_ (tag!^ ["" "ann"])] + (tuple^ (*^ annotation^)))) + +(def annotations^ + (Parser (List Annotation)) + (do Parser/Monad + [anns?? (?^ annotations^')] + (wrap (? (@list) anns??)))) + (def member-decl^ (Parser MemberDecl) - (&^ (*^ local-tag^) local-symbol^)) + (do Parser/Monad + [modifiers (*^ local-tag^) + name local-symbol^ + anns annotations^] + (wrap [name modifiers anns]))) (def throws-decl'^ (Parser (List JvmType)) @@ -152,18 +185,29 @@ (wrap [ex? opt? return]))) ## Generators -(def (gen-method-decl [[modifiers name] [inputs output exs]]) +(def (gen-annotation-param [name value]) + (-> AnnotationParam (, AST AST)) + [(text$ name) value]) + +(def (gen-annotation [name params]) + (-> Annotation AST) + (` ((~ (text$ name)) + (~ (record$ (map gen-annotation-param params)))))) + +(def (gen-method-decl [[name modifiers anns] [inputs output exs]]) (-> (, MemberDecl MethodDecl) AST) (` ((~ (text$ name)) [(~@ (map text$ modifiers))] + [(~@ (map gen-annotation anns))] [(~@ (map text$ exs))] [(~@ (map text$ inputs))] (~ (text$ output))))) -(def (gen-field-decl [[modifiers name] class]) +(def (gen-field-decl [[name modifiers anns] class]) (-> (, MemberDecl FieldDecl) AST) (` ((~ (text$ name)) [(~@ (map text$ modifiers))] + [(~@ (map gen-annotation anns))] (~ (text$ class)) ))) @@ -171,10 +215,11 @@ (-> ArgDecl AST) (form$ (@list (symbol$ ["" name]) (text$ type)))) -(def (gen-method-def [[modifiers name] [inputs output body exs]]) +(def (gen-method-def [[name modifiers anns] [inputs output body exs]]) (-> (, MemberDecl MethodDef) AST) (` ((~ (text$ name)) [(~@ (map text$ modifiers))] + [(~@ (map gen-annotation anns))] [(~@ (map text$ exs))] [(~@ (map gen-arg-decl inputs))] (~ (text$ output)) @@ -217,18 +262,23 @@ (|> t get-stack-trace stack-trace->text))) ## [Syntax] -(defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)]) - (emit (@list (` (;_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))] - (~@ (map gen-method-decl members))))))) - (defsyntax #export (defclass [name local-symbol^] [super local-symbol^] [interfaces (tuple^ (*^ local-symbol^))] + [annotations annotations^] [fields (*^ field-decl^)] [methods (*^ method-def^)]) (emit (@list (` (;_jvm_class (~ (text$ name)) (~ (text$ super)) [(~@ (map text$ interfaces))] + [(~@ (map gen-annotation annotations))] [(~@ (map gen-field-decl fields))] [(~@ (map gen-method-def methods))]))))) +(defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] + [annotations annotations^] + [members (*^ method-decl^)]) + (emit (@list (` (;_jvm_interface (~ (text$ name)) [(~@ (map text$ supers))] + [(~@ (map gen-annotation annotations))] + (~@ (map gen-method-decl members))))))) + (defsyntax #export (object [super local-symbol^] [interfaces (tuple^ (*^ local-symbol^))] [methods (*^ method-def^)]) (emit (@list (` (;_jvm_anon-class (~ (text$ super)) -- cgit v1.2.3 From f829e62d2102a60244b9f0950240dc71f74cccff Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 27 Sep 2015 18:59:38 -0400 Subject: - Added support for type-checking generic classes. - Added support for instancing generic objects. --- source/lux/host/jvm.lux | 35 ++++++++++++++++------------------- 1 file changed, 16 insertions(+), 19 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index bbb396874..57d0e9c5d 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -332,32 +332,29 @@ (let [(~@ var-rebinds)] (~ new-expr))))))))) -(do-template [ ] +(do-template [ ] [(defsyntax #export ( [class local-symbol^] [method local-symbol^] [args (tuple^ (*^ exp-input^))] - [expected-output exp-output^]) + [expected-output exp-output^] [unsafe? (tag?^ ["" "unsafe"])]) (do Lux/Monad [[vars var-types var-rebinds arg-classes] (prepare-args args) g!self (gensym "self") - #let [[body return-type] (gen-expected-output expected-output - (` ( (~ (text$ class)) (~ (text$ method)) [(~@ (map text$ arg-classes))] (~ g!self) [(~@ vars)])))]] + #let [included-self (: (List AST) + (if + (@list g!self) + (@list))) + [body return-type] (gen-expected-output expected-output + (` ( (~ (text$ class)) (~ (text$ method)) [(~@ (map text$ arg-classes))] (~@ included-self) [(~@ vars)]))) + [body return-type] (if unsafe? + [(` (try (~ body))) (` (Either Text (~ return-type)))] + [body return-type])]] (wrap (@list (` (: (-> (, (~@ var-types)) (^ (~ (symbol$ ["" class]))) (~ return-type)) - (lambda [[(~@ vars)] (~ g!self)] + (lambda [[(~@ vars)] (~@ included-self)] (let [(~@ var-rebinds)] (~ body))))))) ))] - [invoke-virtual$ ;_jvm_invokevirtual] - [invoke-interface$ ;_jvm_invokeinterface] + [invoke-virtual$ ;_jvm_invokevirtual true] + [invoke-interface$ ;_jvm_invokeinterface true] + [invoke-special$ ;_jvm_invokespecial true] + [invoke-static$ ;_jvm_invokestatic false] ) - -(defsyntax #export (invoke-static$ [class local-symbol^] [method local-symbol^] [args (tuple^ (*^ exp-input^))] - [expected-output exp-output^]) - (do Lux/Monad - [[vars var-types var-rebinds arg-classes] (prepare-args args) - #let [[body return-type] (gen-expected-output expected-output - (` (;_jvm_invokestatic (~ (text$ class)) (~ (text$ method)) [(~@ (map text$ arg-classes))] [(~@ vars)])))]] - (wrap (@list (` (: (-> (, (~@ var-types)) (~ return-type)) - (lambda [[(~@ vars)]] - (let [(~@ var-rebinds)] - (~ body))))))) - )) -- cgit v1.2.3 From 39a00124a102e5479271c2dbd6791979a34e1e2e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 27 Sep 2015 22:20:31 -0400 Subject: - Added generics support for object field access (getting & setting). - Added generics support for object method invocation. --- source/lux/host/jvm.lux | 1 + 1 file changed, 1 insertion(+) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index 57d0e9c5d..cb818eb2b 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -256,6 +256,7 @@ (_jvm_invokevirtual "java.lang.Throwable" "getStackTrace" [] t [])) (def #export (throwable->text t) + (-> (^ java.lang.Throwable) Text) ($ text:++ (_jvm_invokevirtual "java.lang.Object" "toString" [] t []) "\n" -- cgit v1.2.3 From f5c046279de3c28e3d83dda116f2b3742766a93b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 28 Sep 2015 22:25:32 -0400 Subject: - Removed reflection warnings. - Made some improvements to working with object arrays. --- source/lux/host/jvm.lux | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index cb818eb2b..573e181b5 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -246,7 +246,7 @@ (|> idxs (map (: (-> Int Text) (lambda [idx] - (_jvm_invokevirtual "java.lang.Object" "toString" [] (_jvm_aaload "java.lang.StackTraceElement" trace idx) [])))) + (_jvm_invokevirtual "java.lang.Object" "toString" [] (_jvm_aaload trace idx) [])))) (interpose "\n") (foldL text:++ "") ))) -- cgit v1.2.3 From 1ff2c6ced65171a68ef761275a75ba4dc56caf7b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 30 Sep 2015 16:44:42 -0400 Subject: - Changed the license in the project.clj file (had forgotten until now). - Some minor updates to the standard library. - Some minor bug fixes & improvements. - program.lux has been removed. --- source/lux/host/jvm.lux | 28 ++++++++++++++++++++++------ 1 file changed, 22 insertions(+), 6 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index 573e181b5..737c1731d 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -93,6 +93,21 @@ arg-classes (map second args)]] (wrap [vars var-types (list:join var-rebinds) arg-classes]))) +(def (class->type class) + (-> JvmType AST) + (case class + "boolean" (' (;^ java.lang.Boolean)) + "byte" (' (;^ java.lang.Byte)) + "short" (' (;^ java.lang.Short)) + "int" (' (;^ java.lang.Integer)) + "long" (' (;^ java.lang.Long)) + "float" (' (;^ java.lang.Float)) + "double" (' (;^ java.lang.Double)) + "char" (' (;^ java.lang.Character)) + "void" (` ;Unit) + _ + (` (^ (~ (symbol$ ["" class])))))) + ## Parsers (def annotation-params^ (Parser (List AnnotationParam)) @@ -227,7 +242,7 @@ (def (gen-expected-output [ex? opt? output] body) (-> ExpectedOutput AST (, AST AST)) - (let [type (` (^ (~ (symbol$ ["" output])))) + (let [type (class->type output) [body type] (if opt? [(` (;;??? (~ body))) (` (Maybe (~ type)))] @@ -321,14 +336,15 @@ (defsyntax #export (null? obj) (emit (@list (` (;_jvm_null? (~ obj)))))) -(defsyntax #export (new$ [class local-symbol^] [args (tuple^ (*^ exp-input^))] [ex? (tag?^ ["" "!"])]) +(defsyntax #export (new$ [class local-symbol^] [args (tuple^ (*^ exp-input^))] [unsafe? (tag?^ ["" "unsafe"])]) (do Lux/Monad [[vars var-types var-rebinds arg-classes] (prepare-args args) #let [new-expr (` (;_jvm_new (~ (text$ class)) [(~@ (map text$ arg-classes))] [(~@ vars)])) - new-expr (if ex? - (` (try (~ new-expr))) - new-expr)]] - (wrap (@list (` (: (-> (, (~@ var-types)) (^ (~ (symbol$ ["" class])))) + return-type (class->type class) + [new-expr return-type] (if unsafe? + [(` (try (~ new-expr))) (` (Either Text (~ return-type)))] + [new-expr return-type])]] + (wrap (@list (` (: (-> (, (~@ var-types)) (~ return-type)) (lambda [[(~@ vars)]] (let [(~@ var-rebinds)] (~ new-expr))))))))) -- cgit v1.2.3