From 8fb7683f9029127be9cf36336c367813c88f681b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 26 Jul 2015 23:09:47 -0400 Subject: - Changed the name of lux/host/java to lux/host/jvm - Completed lux/host/jvm - Modified (slightly) the syntax used in several host (JVM) special forms. - The "defsyntax" macro now binds all of the arguments it receives inside a variable named "tokens". --- source/lux.lux | 27 ++-- source/lux/data/char.lux | 2 +- source/lux/data/io.lux | 4 +- source/lux/data/number.lux | 14 +- source/lux/data/text.lux | 61 ++++----- source/lux/host/java.lux | 310 --------------------------------------------- source/lux/host/jvm.lux | 270 +++++++++++++++++++++++++++++++++++++++ source/lux/math.lux | 50 ++++---- source/lux/meta/syntax.lux | 2 +- source/program.lux | 2 +- src/lux/analyser.clj | 38 +++--- src/lux/analyser/case.clj | 4 +- src/lux/analyser/host.clj | 22 +--- src/lux/compiler/lux.clj | 5 +- src/lux/host.clj | 8 -- 15 files changed, 375 insertions(+), 444 deletions(-) delete mode 100644 source/lux/host/java.lux create mode 100644 source/lux/host/jvm.lux diff --git a/source/lux.lux b/source/lux.lux index 8f7e4fa04..c51929635 100644 --- a/source/lux.lux +++ b/source/lux.lux @@ -8,7 +8,7 @@ ## First things first, must define functions (_jvm_interface "Function" [] - (apply ["java.lang.Object"] "java.lang.Object" ["public" "abstract"])) + ("apply" ["java.lang.Object"] "java.lang.Object" ["public" "abstract"])) ## Basic types (_lux_def Bool (#DataT "java.lang.Boolean")) @@ -860,8 +860,9 @@ [true (#Meta [_ (#FormS (#Cons [(#Meta [_ (#SymbolS ["" "~"])]) (#Cons [unquoted #Nil])]))])] unquoted - [_ (#Meta [_ (#FormS elems)])] - (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems) + [_ (#Meta [meta (#FormS elems)])] + (let [(#Meta [_ form']) (splice replace? (untemplate replace? subst) (tag$ ["lux" "FormS"]) elems)] + (#Meta [meta form'])) [_ (#Meta [_ (#RecordS fields)])] (wrap-meta (form$ (list (tag$ ["lux" "RecordS"]) @@ -1071,7 +1072,7 @@ (def'' (text:= x y) (-> Text Text Bool) - (_jvm_invokevirtual java.lang.Object equals [java.lang.Object] + (_jvm_invokevirtual "java.lang.Object" "equals" ["java.lang.Object"] x [y])) (def'' (get-rep key env) @@ -1146,9 +1147,9 @@ (-> Bool) ( x y))] - [i= _jvm_leq Int] - [i> _jvm_lgt Int] - [i< _jvm_llt Int] + [i= _jvm_leq Int] + [i> _jvm_lgt Int] + [i< _jvm_llt Int] [r= _jvm_deq Real] [r> _jvm_dgt Real] [r< _jvm_dlt Real] @@ -1198,7 +1199,7 @@ (def'' (text:++ x y) (-> Text Text Text) - (_jvm_invokevirtual java.lang.String concat [java.lang.String] + (_jvm_invokevirtual "java.lang.String" "concat" ["java.lang.String"] x [y])) (def'' (ident->text ident) @@ -1396,7 +1397,7 @@ (def'' #export (->text x) (-> (^ java.lang.Object) Text) - (_jvm_invokevirtual java.lang.Object toString [] x [])) + (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])) (def'' (interpose sep xs) (All [a] @@ -2039,22 +2040,22 @@ (def (last-index-of part text) (-> Text Text Int) - (_jvm_i2l (_jvm_invokevirtual java.lang.String lastIndexOf [java.lang.String] + (_jvm_i2l (_jvm_invokevirtual "java.lang.String" "lastIndexOf" ["java.lang.String"] text [part]))) (def (index-of part text) (-> Text Text Int) - (_jvm_i2l (_jvm_invokevirtual java.lang.String indexOf [java.lang.String] + (_jvm_i2l (_jvm_invokevirtual "java.lang.String" "indexOf" ["java.lang.String"] text [part]))) (def (substring1 idx text) (-> Int Text Text) - (_jvm_invokevirtual java.lang.String substring [int] + (_jvm_invokevirtual "java.lang.String" "substring" ["int"] text [(_jvm_l2i idx)])) (def (substring2 idx1 idx2 text) (-> Int Int Text Text) - (_jvm_invokevirtual java.lang.String substring [int int] + (_jvm_invokevirtual "java.lang.String" "substring" ["int" "int"] text [(_jvm_l2i idx1) (_jvm_l2i idx2)])) (def (split-module-contexts module) diff --git a/source/lux/data/char.lux b/source/lux/data/char.lux index 5dac9a3c7..5a811c006 100644 --- a/source/lux/data/char.lux +++ b/source/lux/data/char.lux @@ -18,4 +18,4 @@ (defstruct #export Char/Show (S;Show Char) (def (S;show x) - ($ text:++ "#\"" (_jvm_invokevirtual java.lang.Object toString [] x []) "\""))) + ($ text:++ "#\"" (_jvm_invokevirtual "java.lang.Object" "toString" [] x []) "\""))) diff --git a/source/lux/data/io.lux b/source/lux/data/io.lux index 17e8d727a..a194fc854 100644 --- a/source/lux/data/io.lux +++ b/source/lux/data/io.lux @@ -44,8 +44,8 @@ ## Functions (def #export (print x) (-> Text (IO (,))) - (io (_jvm_invokevirtual java.io.PrintStream print [java.lang.Object] - (_jvm_getstatic java.lang.System out) [x]))) + (io (_jvm_invokevirtual "java.io.PrintStream" "print" ["java.lang.Object"] + (_jvm_getstatic "java.lang.System" "out") [x]))) (def #export (println x) (-> Text (IO (,))) diff --git a/source/lux/data/number.lux b/source/lux/data/number.lux index b222de15c..453c30a13 100644 --- a/source/lux/data/number.lux +++ b/source/lux/data/number.lux @@ -62,12 +62,6 @@ (def E;= r=)) ## Ord -## (def #export Int/Ord (O;Ord Int) -## (O;ord$ Int/Eq i< i>)) - -## (def #export Real/Ord (O;Ord Real) -## (O;ord$ Real/Eq r< r>)) - (do-template [ ] [(defstruct #export (O;Ord ) (def O;_eq ) @@ -89,8 +83,8 @@ (def B;top ) (def B;bottom ))] - [ Int/Bounded Int (_jvm_getstatic java.lang.Long MAX_VALUE) (_jvm_getstatic java.lang.Long MIN_VALUE)] - [Real/Bounded Real (_jvm_getstatic java.lang.Double MAX_VALUE) (_jvm_getstatic java.lang.Double MIN_VALUE)]) + [ Int/Bounded Int (_jvm_getstatic "java.lang.Long" "MAX_VALUE") (_jvm_getstatic "java.lang.Long" "MIN_VALUE")] + [Real/Bounded Real (_jvm_getstatic "java.lang.Double" "MAX_VALUE") (_jvm_getstatic "java.lang.Double" "MIN_VALUE")]) ## Monoid (do-template [ <++>] @@ -114,6 +108,6 @@ (def (S;show x) ))] - [ Int/Show Int (_jvm_invokevirtual java.lang.Object toString [] x [])] - [Real/Show Real (_jvm_invokevirtual java.lang.Object toString [] x [])] + [ Int/Show Int (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])] + [Real/Show Real (_jvm_invokevirtual "java.lang.Object" "toString" [] x [])] ) diff --git a/source/lux/data/text.lux b/source/lux/data/text.lux index a3192a1d5..f7f1a86c0 100644 --- a/source/lux/data/text.lux +++ b/source/lux/data/text.lux @@ -15,30 +15,30 @@ ## [Functions] (def #export (size x) (-> Text Int) - (_jvm_i2l (_jvm_invokevirtual java.lang.String length [] + (_jvm_i2l (_jvm_invokevirtual "java.lang.String" "length" [] x []))) (def #export (@ idx x) (-> Int Text (Maybe Char)) (if (and (i< idx (size x)) (i>= idx 0)) - (#;Some (_jvm_invokevirtual java.lang.String charAt [int] + (#;Some (_jvm_invokevirtual "java.lang.String" "charAt" ["int"] x [(_jvm_l2i idx)])) #;None)) (def #export (contains? x y) (-> Text Text Bool) - (_jvm_invokevirtual java.lang.String contains [java.lang.CharSequence] + (_jvm_invokevirtual "java.lang.String" "contains" ["java.lang.CharSequence"] x [y])) (do-template [ ] [(def #export ( x) (-> Text Text) - (_jvm_invokevirtual java.lang.String [] + (_jvm_invokevirtual "java.lang.String" [] x []))] - [lower-case toLowerCase] - [upper-case toUpperCase] - [trim trim] + [lower-case "toLowerCase"] + [upper-case "toUpperCase"] + [trim "trim"] ) (def #export (sub' from to x) @@ -46,7 +46,7 @@ (if (and (i< from to) (i>= from 0) (i<= to (size x))) - (_jvm_invokevirtual java.lang.String substring [int int] + (_jvm_invokevirtual "java.lang.String" "substring" ["int" "int"] x [(_jvm_l2i from) (_jvm_l2i to)]) #;None)) @@ -58,23 +58,23 @@ (-> Int Text (Maybe (, Text Text))) (if (and (i< at (size x)) (i>= at 0)) - (let [pre (_jvm_invokevirtual java.lang.String substring [int int] + (let [pre (_jvm_invokevirtual "java.lang.String" "substring" ["int" "int"] x [(_jvm_l2i 0) (_jvm_l2i at)]) - post (_jvm_invokevirtual java.lang.String substring [int] + post (_jvm_invokevirtual "java.lang.String" "substring" ["int"] x [(_jvm_l2i at)])] (#;Some [pre post])) #;None)) (def #export (replace pattern value template) (-> Text Text Text Text) - (_jvm_invokevirtual java.lang.String replace [java.lang.CharSequence java.lang.CharSequence] + (_jvm_invokevirtual "java.lang.String" "replace" ["java.lang.CharSequence" "java.lang.CharSequence"] template [pattern value])) (do-template [ ] [(def #export ( pattern from x) (-> Text Int Text (Maybe Int)) (if (and (i< from (size x)) (i>= from 0)) - (case (_jvm_i2l (_jvm_invokevirtual java.lang.String [java.lang.String int] + (case (_jvm_i2l (_jvm_invokevirtual "java.lang.String" ["java.lang.String" "int"] x [pattern (_jvm_l2i from)])) -1 #;None idx (#;Some idx)) @@ -82,13 +82,13 @@ (def #export ( pattern x) (-> Text Text (Maybe Int)) - (case (_jvm_i2l (_jvm_invokevirtual java.lang.String [java.lang.String] + (case (_jvm_i2l (_jvm_invokevirtual "java.lang.String" ["java.lang.String"] x [pattern])) -1 #;None idx (#;Some idx)))] - [index-of index-of' indexOf] - [last-index-of last-index-of' lastIndexOf] + [index-of index-of' "indexOf"] + [last-index-of last-index-of' "lastIndexOf"] ) (def #export (starts-with? prefix x) @@ -113,27 +113,22 @@ ## [Structures] (defstruct #export Text/Eq (E;Eq Text) (def (E;= x y) - (_jvm_invokevirtual java.lang.Object equals [java.lang.Object] + (_jvm_invokevirtual "java.lang.Object" "equals" ["java.lang.Object"] x [y]))) (defstruct #export Text/Ord (O;Ord Text) (def O;_eq Text/Eq) - (def (O;< x y) - (i< (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String] - x [y])) - 0)) - (def (O;<= x y) - (i<= (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String] - x [y])) - 0)) - (def (O;> x y) - (i> (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String] - x [y])) - 0)) - (def (O;>= x y) - (i>= (_jvm_i2l (_jvm_invokevirtual java.lang.String compareTo [java.lang.String] - x [y])) - 0))) + + (do-template [ ] + [(def ( x y) + ( (_jvm_i2l (_jvm_invokevirtual "java.lang.String" "compareTo" ["java.lang.String"] + x [y])) + 0))] + + [O;< i<] + [O;<= i<=] + [O;> i>] + [O;>= i>=])) (defstruct #export Text/Show (S;Show Text) (def (S;show x) @@ -142,5 +137,5 @@ (defstruct #export Text/Monoid (m;Monoid Text) (def m;unit "") (def (m;++ x y) - (_jvm_invokevirtual java.lang.String concat [java.lang.String] + (_jvm_invokevirtual "java.lang.String" "concat" ["java.lang.String"] x [y]))) diff --git a/source/lux/host/java.lux b/source/lux/host/java.lux deleted file mode 100644 index 9bd0c838c..000000000 --- a/source/lux/host/java.lux +++ /dev/null @@ -1,310 +0,0 @@ -## 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. - -(;import lux - (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)) - (meta lux - macro - syntax))) - -## [Utils/Parsers] -(def finally^ - (Parser Syntax) - (form^ (do Parser/Monad - [_ (symbol?^ ["" "finally"]) - expr id^ - _ end^] - (M;wrap expr)))) - -(def catch^ - (Parser (, Text Ident Syntax)) - (form^ (do Parser/Monad - [_ (symbol?^ ["" "catch"]) - ex-class local-symbol^ - ex symbol^ - expr id^ - _ end^] - (M;wrap [ex-class ex expr])))) - -(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^ - _ end^] - (M;wrap [modifiers name inputs output])))) - -(def field-decl^ - (Parser (, (List Text) Text Text)) - (form^ (do Parser/Monad - [modifiers (*^ local-tag^) - name local-symbol^ - class local-symbol^ - _ end^] - (M;wrap [modifiers name class])))) - -(def arg-decl^ - (Parser (, Text Text)) - (form^ (do Parser/Monad - [arg-name local-symbol^ - arg-class local-symbol^ - _ end^] - (M;wrap [arg-name arg-class])))) - -(def method-def^ - (Parser (, (List Text) Text (List (, Text Text)) Text Syntax)) - (form^ (do Parser/Monad - [modifiers (*^ local-tag^) - name local-symbol^ - inputs (tuple^ (*^ arg-decl^)) - output local-symbol^ - body id^ - _ end^] - (M;wrap [modifiers name inputs output body])))) - -(def method-call^ - (Parser (, Text (List Text) (List Syntax))) - (form^ (do Parser/Monad - [method local-symbol^ - arity-classes (tuple^ (*^ local-symbol^)) - arity-args (tuple^ (*^ id^)) - _ end^ - _ (: (Parser (,)) - (if (i= (size arity-classes) - (size arity-args)) - (M;wrap []) - (lambda [_] #;None)))] - (M;wrap [method arity-classes arity-args]) - ))) - -## [Utils/Lux] -## (def (find-class-field field class) -## (-> Text Text (Lux Type)) -## ...) - -## (def (find-virtual-method method class) -## (-> Text Text (Lux (List (, (List Type) Type)))) -## ...) - -## (def (find-static-method method class) -## (-> Text Text (Lux (List (, (List Type) Type)))) -## ...) - - -## [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 Syntax) Syntax) - (lambda [catch] - (let [[class ex body] catch] - (` (_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body)))))) - catches) - (case finally - #;None - (list) - - (#;Some finally) - (list (` (_jvm_finally (~ finally))))))))))))) - -(defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)]) - (do Lux/Monad - [current-module get-module-name - #let [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module) - name))]] - (let [members' (map (: (-> (, (List Text) Text (List Text) Text) Syntax) - (lambda [member] - (let [[modifiers name inputs output] member] - (` ((~ (symbol$ ["" name])) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))]))))) - members)] - (emit (list (` (_jvm_interface (~ (text$ full-name)) [(~@ (map text$ supers))] - (~@ 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 [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module) - name)) - fields' (map (: (-> (, (List Text) Text Text) Syntax) - (lambda [field] - (let [[modifiers name class] field] - (` ((~ (symbol$ ["" name])) - (~ (text$ class)) - [(~@ (map text$ modifiers))]))))) - fields) - methods' (map (: (-> (, (List Text) Text (List (, Text Text)) Text Syntax) Syntax) - (lambda [methods] - (let [[modifiers name inputs output body] methods] - (` ((~ (symbol$ ["" name])) - [(~@ (map (: (-> (, Text Text) Syntax) - (lambda [in] - (let [[left right] in] - (form$ (list (text$ left) - (text$ right)))))) - inputs))] - (~ (text$ output)) - [(~@ (map text$ modifiers))] - (~ body)))))) - methods)]] - (emit (list (` (_jvm_class (~ (text$ full-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)]))))) - -(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 "")] - (emit (list (` (;let [(~ g!lock) (~ lock) - _ (_jvm_monitor-enter (~ g!lock)) - (~ g!body) (~ body) - _ (_jvm_monitor-exit (~ 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 -## (#;Meta [_ (#;SymbolS obj-name)]) -## (do Lux/Monad -## [obj-type (find-var-type obj-name)] -## (case obj-type -## (#;DataT class) -## (do Lux/Monad -## [field-class (find-field field class)] -## (_jvm_getfield (~ (text$ class)) (~ (text$ field)) (~ (text$ field-class)))) - -## _ -## (fail "Can only get field from object."))) - -## _ -## (do Lux/Monad -## [g!obj (gensym "")] -## (emit (list (` (;let [(~ g!obj) (~ obj)] -## (.? (~ field) (~ g!obj))))))))) - -## (defsyntax #export (.= [field local-symbol^] value obj) -## (case obj -## (#;Meta [_ (#;SymbolS obj-name)]) -## (do Lux/Monad -## [obj-type (find-var-type obj-name)] -## (case obj-type -## (#;DataT class) -## (do Lux/Monad -## [field-class (find-field field class)] -## (_jvm_putfield (~ (text$ class)) (~ (text$ field)) (~ (text$ field-class)) (~ value))) - -## _ -## (fail "Can only set field of object."))) - -## _ -## (do Lux/Monad -## [g!obj (gensym "")] -## (emit (list (` (;let [(~ g!obj) (~ obj)] -## (.= (~ field) (~ value) (~ g!obj))))))))) - -## (defsyntax #export (.! [call method-call^] obj) -## (case obj -## (#;Meta [_ (#;SymbolS obj-name)]) -## (do Lux/Monad -## [obj-type (find-var-type obj-name)] -## (case obj-type -## (#;DataT class) -## (do Lux/Monad -## [#let [[m-name ?m-classes m-args] call] -## all-m-details (find-virtual-method m-name class) -## m-ins (case [?m-classes all-m-details] -## (\ [#;None (list [m-ins m-out])]) -## (M;wrap m-ins) - -## (\ [(#;Some m-ins) _]) -## (M;wrap m-ins) - -## _ -## #;None)] -## (emit (list (` (_jvm_invokevirtual (~ (text$ m-name)) (~ (text$ class)) [(~@ (:: List/Functor (F;map text$ m-ins)))] -## (~ obj) [(~@ m-args)]))))) - -## _ -## (fail "Can only call method on object."))) - -## _ -## (do Lux/Monad -## [g!obj (gensym "")] -## (emit (list (` (;let [(~ g!obj) (~ obj)] -## (.! (~@ *tokens*))))))))) - -## (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^]) -## (do Lux/Monad -## [#let [[m-name ?m-classes m-args] call] -## all-m-details (find-static-method m-name class) -## m-ins (case [?m-classes all-m-details] -## (\ [#;None (list [m-ins m-out])]) -## (M;wrap m-ins) - -## (\ [(#;Some m-ins) _]) -## (M;wrap m-ins) - -## _ -## #;None)] -## (emit (list (` (_jvm_invokestatic (~ (text$ m-name)) (~ (text$ class)) -## [(~@ (:: List/Functor (F;map text$ m-ins)))] -## [(~@ m-args)])))) -## )) - -## (definterface Function [] -## (#public #abstract apply [java.lang.Object] java.lang.Object)) - -## (_jvm_interface "Function" [] -## (apply ["java.lang.Object"] "java.lang.Object" ["public" "abstract"])) - -## (defclass MyFunction [Function] -## (#public #static foo java.lang.Object) -## (#public [] void -## (_jvm_invokespecial java.lang.Object [] this [])) -## (#public apply [(arg java.lang.Object)] java.lang.Object -## "YOLO")) - -## (_jvm_class "lux.MyFunction" "java.lang.Object" ["lux.Function"] -## [(foo "java.lang.Object" ["public" "static"])] -## ( [] "void" -## ["public"] -## (_jvm_invokespecial java.lang.Object [] this [])) -## (apply [(arg "java.lang.Object")] "java.lang.Object" -## ["public"] -## "YOLO")) diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux new file mode 100644 index 000000000..a3a74d608 --- /dev/null +++ b/source/lux/host/jvm.lux @@ -0,0 +1,270 @@ +## 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. + +(;import lux + (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)) + (meta lux + macro + syntax))) + +## [Utils] +## Parsers +(def finally^ + (Parser Syntax) + (form^ (do Parser/Monad + [_ (symbol?^ ["" "finally"]) + expr id^ + _ end^] + (M;wrap expr)))) + +(def catch^ + (Parser (, Text Ident Syntax)) + (form^ (do Parser/Monad + [_ (symbol?^ ["" "catch"]) + ex-class local-symbol^ + ex symbol^ + expr id^ + _ end^] + (M;wrap [ex-class ex expr])))) + +(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^ + _ end^] + (M;wrap [modifiers name inputs output])))) + +(def field-decl^ + (Parser (, (List Text) Text Text)) + (form^ (do Parser/Monad + [modifiers (*^ local-tag^) + name local-symbol^ + class local-symbol^ + _ end^] + (M;wrap [modifiers name class])))) + +(def arg-decl^ + (Parser (, Text Text)) + (form^ (do Parser/Monad + [arg-name local-symbol^ + arg-class local-symbol^ + _ end^] + (M;wrap [arg-name arg-class])))) + +(def method-def^ + (Parser (, (List Text) Text (List (, Text Text)) Text Syntax)) + (form^ (do Parser/Monad + [modifiers (*^ local-tag^) + name local-symbol^ + inputs (tuple^ (*^ arg-decl^)) + output local-symbol^ + body id^ + _ end^] + (M;wrap [modifiers name inputs output body])))) + +(def method-call^ + (Parser (, Text (List Text) (List Syntax))) + (form^ (do Parser/Monad + [method local-symbol^ + arity-classes (tuple^ (*^ local-symbol^)) + arity-args (tuple^ (*^ id^)) + _ end^ + _ (: (Parser (,)) + (if (i= (size arity-classes) + (size arity-args)) + (M;wrap []) + (lambda [_] #;None)))] + (M;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 Syntax) Syntax) + (lambda [catch] + (let [[class ex body] catch] + (` (_jvm_catch (~ (text$ class)) (~ (symbol$ ex)) (~ body)))))) + catches) + (case finally + #;None + (list) + + (#;Some finally) + (list (` (_jvm_finally (~ finally))))))))))))) + +(defsyntax #export (definterface [name local-symbol^] [supers (tuple^ (*^ local-symbol^))] [members (*^ method-decl^)]) + (do Lux/Monad + [current-module get-module-name + #let [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module) + name))]] + (let [members' (map (: (-> (, (List Text) Text (List Text) Text) Syntax) + (lambda [member] + (let [[modifiers name inputs output] member] + (` ((~ (symbol$ ["" name])) [(~@ (map text$ inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))]))))) + members)] + (emit (list (` (_jvm_interface (~ (text$ full-name)) [(~@ (map text$ supers))] + (~@ 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 [full-name (:: text;Text/Monoid (m;++ (text;replace "/" "." current-module) + name)) + fields' (map (: (-> (, (List Text) Text Text) Syntax) + (lambda [field] + (let [[modifiers name class] field] + (` ((~ (symbol$ ["" name])) + (~ (text$ class)) + [(~@ (map text$ modifiers))]))))) + fields) + methods' (map (: (-> (, (List Text) Text (List (, Text Text)) Text Syntax) Syntax) + (lambda [methods] + (let [[modifiers name inputs output body] methods] + (` ((~ (symbol$ ["" name])) + [(~@ (map (: (-> (, Text Text) Syntax) + (lambda [in] + (let [[left right] in] + (form$ (list (text$ left) + (text$ right)))))) + inputs))] + (~ (text$ output)) + [(~@ (map text$ modifiers))] + (~ body)))))) + methods)]] + (emit (list (` (_jvm_class (~ (text$ full-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)]))))) + +(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 "")] + (emit (list (` (;let [(~ g!lock) (~ lock) + _ (_jvm_monitor-enter (~ g!lock)) + (~ g!body) (~ body) + _ (_jvm_monitor-exit (~ 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 + (#;Meta [_ (#;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 + (#;Meta [_ (#;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) + (case obj + (#;Meta [_ (#;SymbolS obj-name)]) + (do Lux/Monad + [obj-type (find-var-type obj-name)] + (case obj-type + (#;DataT class) + (let [[m-name ?m-classes m-args] call] + (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)] + (.! (~@ *tokens*))))))))) + +(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)])))))) + +## (definterface Function [] +## (#public #abstract apply [java.lang.Object] java.lang.Object)) + +## (_jvm_interface "Function" [] +## (apply ["java.lang.Object"] "java.lang.Object" ["public" "abstract"])) + +## (defclass MyFunction [Function] +## (#public #static foo java.lang.Object) +## (#public [] void +## (_jvm_invokespecial java.lang.Object [] this [])) +## (#public apply [(arg java.lang.Object)] java.lang.Object +## "YOLO")) + +## (_jvm_class "lux.MyFunction" "java.lang.Object" ["lux.Function"] +## [(foo "java.lang.Object" ["public" "static"])] +## ( [] "void" +## ["public"] +## (_jvm_invokespecial java.lang.Object [] this [])) +## (apply [(arg "java.lang.Object")] "java.lang.Object" +## ["public"] +## "YOLO")) diff --git a/source/lux/math.lux b/source/lux/math.lux index 2e29c5da7..8a9432261 100644 --- a/source/lux/math.lux +++ b/source/lux/math.lux @@ -12,49 +12,49 @@ (do-template [ ] [(def #export Real - (_jvm_getstatic java.lang.Math ))] + (_jvm_getstatic "java.lang.Math" ))] - [e E] - [pi PI] + [e "E"] + [pi "PI"] ) ## [Functions] (do-template [ ] [(def #export ( n) (-> Real Real) - (_jvm_invokestatic java.lang.Math [double] [n]))] + (_jvm_invokestatic "java.lang.Math" ["double"] [n]))] - [cos cos] - [sin sin] - [tan tan] + [cos "cos"] + [sin "sin"] + [tan "tan"] - [acos acos] - [asin asin] - [atan atan] + [acos "acos"] + [asin "asin"] + [atan "atan"] - [cosh cosh] - [sinh sinh] - [tanh tanh] + [cosh "cosh"] + [sinh "sinh"] + [tanh "tanh"] - [ceil ceil] - [floor floor] - [round round] + [ceil "ceil"] + [floor "floor"] + [round "round"] - [exp exp] - [log log] + [exp "exp"] + [log "log"] - [cbrt cbrt] - [sqrt sqrt] + [cbrt "cbrt"] + [sqrt "sqrt"] - [->degrees toDegrees] - [->radians toRadians] + [->degrees "toDegrees"] + [->radians "toRadians"] ) (do-template [ ] [(def #export ( x y) (-> Real Real Real) - (_jvm_invokestatic java.lang.Math [double double] [x y]))] + (_jvm_invokestatic "java.lang.Math" ["double" "double"] [x y]))] - [atan2 atan2] - [pow pow] + [atan2 "atan2"] + [pow "pow"] ) diff --git a/source/lux/meta/syntax.lux b/source/lux/meta/syntax.lux index 83702f75d..fcee80b8f 100644 --- a/source/lux/meta/syntax.lux +++ b/source/lux/meta/syntax.lux @@ -235,7 +235,7 @@ _ (l;fail "Syntax pattern expects 2-tuples or symbols.")))) args) - g!tokens (gensym "tokens") + #let [g!tokens (m;symbol$ ["" "*tokens*"])] g!_ (gensym "_") #let [names (:: List/Functor (F;map first names+parsers)) error-msg (text$ (text:++ "Wrong syntax for " name)) diff --git a/source/program.lux b/source/program.lux index 18a2a76ab..37391eda9 100644 --- a/source/program.lux +++ b/source/program.lux @@ -32,7 +32,7 @@ state (text #as t #open ("text:" Text/Monoid)) writer) - (host java) + (host jvm) (meta lux macro syntax) diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index f85b3d619..1606a95c2 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -166,57 +166,57 @@ (&&host/analyse-jvm-null? analyse ?object) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_instanceof"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] ["lux;Cons" [?object ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-instanceof analyse ?class ?object) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_new"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?class]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-new analyse ?class ?classes ?args) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_getstatic"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]] ["lux;Nil" _]]]]]]]]] (&&host/analyse-jvm-getstatic analyse ?class ?field) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_getfield"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]] ["lux;Cons" [?object ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-getfield analyse ?class ?field ?object) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_putstatic"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]] ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]] (&&host/analyse-jvm-putstatic analyse ?class ?field ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_putfield"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?field]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field]]] ["lux;Cons" [?object ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-putfield analyse ?class ?field ?object ?value) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokestatic"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] ["lux;Nil" _]]]]]]]]]]]]] (&&host/analyse-jvm-invokestatic analyse ?class ?method ?classes ?args) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokevirtual"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] ["lux;Cons" [?object ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] @@ -224,8 +224,8 @@ (&&host/analyse-jvm-invokevirtual analyse ?class ?method ?classes ?object ?args) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokeinterface"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] ["lux;Cons" [?object ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] @@ -233,8 +233,8 @@ (&&host/analyse-jvm-invokeinterface analyse ?class ?method ?classes ?object ?args) [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_jvm_invokespecial"]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?class]]]] - ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?method]]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?class]]] + ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?classes]]] ["lux;Cons" [?object ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?args]]] @@ -408,7 +408,7 @@ ["lux;Cons" [?value ["lux;Nil" _]]]]]]]]] (&&lux/analyse-def analyse ?name ?value) - + [["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ "_lux_declare-macro"]]]] ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" ["" ?name]]]] ["lux;Nil" _]]]]]]] diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj index cb76d8d54..ebbb6911a 100644 --- a/src/lux/analyser/case.clj +++ b/src/lux/analyser/case.clj @@ -101,8 +101,8 @@ (fail "##9##")))] (adjust-type* up type*)) - [_] - (assert false (aget type 0)) + ;; [_] + ;; (assert false (aget type 0)) )) (defn adjust-type [type] diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index e490bc62f..11d43ce9e 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -18,14 +18,6 @@ [env :as &&env]))) ;; [Utils] -(defn ^:private extract-ident [ident] - (matchv ::M/objects [ident] - [["lux;Meta" [_ ["lux;SymbolS" [_ ?ident]]]]] - (return ?ident) - - [_] - (fail "[Analyser Error] Can't extract Symbol."))) - (defn ^:private extract-text [text] (matchv ::M/objects [text] [["lux;Meta" [_ ["lux;TextS" ?text]]]] @@ -115,7 +107,7 @@ (return (&/|list (&/T (&/V "jvm-putfield" (&/T ?class ?field =object =value)) =type))))) (defn analyse-jvm-invokestatic [analyse ?class ?method ?classes ?args] - (|do [=classes (&/map% &host/extract-jvm-param ?classes) + (|do [=classes (&/map% extract-text ?classes) =return (&host/lookup-static-method ?class ?method =classes) ;; :let [_ (matchv ::M/objects [=return] ;; [["lux;DataT" _return-class]] @@ -138,7 +130,7 @@ (do-template [ ] (defn [analyse ?class ?method ?classes ?object ?args] - (|do [=classes (&/map% &host/extract-jvm-param ?classes) + (|do [=classes (&/map% extract-text ?classes) =return (&host/lookup-virtual-method ?class ?method =classes) =object (&&/analyse-1 analyse (&/V "lux;DataT" ?class) ?object) =args (&/map2% (fn [?c ?o] @@ -151,7 +143,7 @@ ) (defn analyse-jvm-invokespecial [analyse ?class ?method ?classes ?object ?args] - (|do [=classes (&/map% &host/extract-jvm-param ?classes) + (|do [=classes (&/map% extract-text ?classes) =return (if (= "" ?method) (return &type/$Void) (&host/lookup-virtual-method ?class ?method =classes)) @@ -166,7 +158,7 @@ (return (&/|list (&/T (&/V "jvm-null?" =object) (&/V "lux;DataT" "java.lang.Boolean")))))) (defn analyse-jvm-new [analyse ?class ?classes ?args] - (|do [=classes (&/map% &host/extract-jvm-param ?classes) + (|do [=classes (&/map% extract-text ?classes) =args (&/flat-map% analyse ?args)] (return (&/|list (&/T (&/V "jvm-new" (&/T ?class =classes =args)) (&/V "lux;DataT" ?class)))))) @@ -239,7 +231,7 @@ (|do [=interfaces (&/map% extract-text ?interfaces) =fields (&/map% (fn [?field] (matchv ::M/objects [?field] - [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?field-name]]]] + [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field-name]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?field-type]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?field-modifiers]]] ["lux;Nil" _]]]]]]]]]]] @@ -253,7 +245,7 @@ ?fields) =methods (&/map% (fn [?method] (matchv ::M/objects [?method] - [[?idx ["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?method-name]]]] + [[?idx ["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method-name]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?method-inputs]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method-output]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?method-modifiers]]] @@ -297,7 +289,7 @@ (|do [=supers (&/map% extract-text ?supers) =methods (&/map% (fn [method] (matchv ::M/objects [method] - [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;SymbolS" [_ ?method-name]]]] + [["lux;Meta" [_ ["lux;FormS" ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?method-name]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?inputs]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TextS" ?output]]] ["lux;Cons" [["lux;Meta" [_ ["lux;TupleS" ?modifiers]]] diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index f1c261d6b..b1023689e 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -64,10 +64,7 @@ (|do [:let [_ (doto *writer* (.visitInsn Opcodes/DUP) (.visitLdcInsn (int idx)))] - ret (try (compile elem) - (catch Exception e - (prn 'compile-tuple (aget elem 0) (->> ?elems (&/|map #(aget % 0)) &/->seq)) - (throw e))) + ret (compile elem) :let [_ (.visitInsn *writer* Opcodes/AASTORE)]] (return ret))) (&/|range num-elems) ?elems)] diff --git a/src/lux/host.clj b/src/lux/host.clj index d248c708e..cf9830169 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -75,14 +75,6 @@ "V" )) -(defn extract-jvm-param [token] - (matchv ::M/objects [token] - [["lux;Meta" [_ ["lux;SymbolS" [_ ?ident]]]]] - (return ?ident) - - [_] - (fail (str "[Host] Unknown JVM param: " (pr-str token))))) - (do-template [ ] (defn [target field] (if-let [type* (first (for [^Field =field (.getDeclaredFields (Class/forName target)) -- cgit v1.2.3