From c79621772c862e9b94e1fc43e11996cbac54fed1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 29 Jul 2015 20:20:26 -0400 Subject: - lux;using no longer prefixes variables. - Fixed several bugs with host (JVM) interop. - Now packaging everything in a .jar file ("program.jar"). --- source/lux/host/jvm.lux | 108 +++++++++++++++++------------------------------- 1 file changed, 38 insertions(+), 70 deletions(-) (limited to 'source/lux/host') diff --git a/source/lux/host/jvm.lux b/source/lux/host/jvm.lux index a3a74d608..7af043969 100644 --- a/source/lux/host/jvm.lux +++ b/source/lux/host/jvm.lux @@ -22,8 +22,7 @@ (Parser Syntax) (form^ (do Parser/Monad [_ (symbol?^ ["" "finally"]) - expr id^ - _ end^] + expr id^] (M;wrap expr)))) (def catch^ @@ -32,8 +31,7 @@ [_ (symbol?^ ["" "catch"]) ex-class local-symbol^ ex symbol^ - expr id^ - _ end^] + expr id^] (M;wrap [ex-class ex expr])))) (def method-decl^ @@ -42,8 +40,7 @@ [modifiers (*^ local-tag^) name local-symbol^ inputs (tuple^ (*^ local-symbol^)) - output local-symbol^ - _ end^] + output local-symbol^] (M;wrap [modifiers name inputs output])))) (def field-decl^ @@ -51,16 +48,14 @@ (form^ (do Parser/Monad [modifiers (*^ local-tag^) name local-symbol^ - class local-symbol^ - _ end^] + class local-symbol^] (M;wrap [modifiers name class])))) (def arg-decl^ (Parser (, Text Text)) (form^ (do Parser/Monad [arg-name local-symbol^ - arg-class local-symbol^ - _ end^] + arg-class local-symbol^] (M;wrap [arg-name arg-class])))) (def method-def^ @@ -70,8 +65,7 @@ name local-symbol^ inputs (tuple^ (*^ arg-decl^)) output local-symbol^ - body id^ - _ end^] + body id^] (M;wrap [modifiers name inputs output body])))) (def method-call^ @@ -80,7 +74,6 @@ [method local-symbol^ arity-classes (tuple^ (*^ local-symbol^)) arity-args (tuple^ (*^ id^)) - _ end^ _ (: (Parser (,)) (if (i= (size arity-classes) (size arity-args)) @@ -108,47 +101,41 @@ (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')))))))) + (let [members' (map (: (-> (, (List Text) Text (List Text) Text) Syntax) + (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'))))))) (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) + #let [fields' (map (: (-> (, (List Text) Text Text) Syntax) (lambda [field] (let [[modifiers name class] field] - (` ((~ (symbol$ ["" name])) + (` ((~ (text$ 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])) + (` ((~ (text$ name)) [(~@ (map (: (-> (, Text Text) Syntax) (lambda [in] (let [[left right] in] - (form$ (list (text$ left) + (form$ (list (symbol$ ["" left]) (text$ right)))))) inputs))] (~ (text$ output)) [(~@ (map text$ modifiers))] (~ body)))))) methods)]] - (emit (list (` (_jvm_class (~ (text$ full-name)) (~ (text$ super)) + (emit (list (` (_jvm_class (~ (text$ name)) (~ (text$ super)) [(~@ (map text$ interfaces))] [(~@ fields')] [(~@ methods')])))))) @@ -166,9 +153,9 @@ [g!lock (gensym "") g!body (gensym "")] (emit (list (` (;let [(~ g!lock) (~ lock) - _ (_jvm_monitor-enter (~ g!lock)) + _ (_jvm_monitorenter (~ g!lock)) (~ g!body) (~ body) - _ (_jvm_monitor-exit (~ g!lock))] + _ (_jvm_monitorexit (~ g!lock))] (~ g!body))))) )) @@ -216,24 +203,27 @@ (.= (~ (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] + (let [[m-name ?m-classes m-args] call] + (case obj + (#;Meta [_ (#;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)]))))) + (~ obj) [(~@ m-args)])))) - _ - (fail "Can only call method on object."))) + _ + (fail "Can only call method on object."))) - _ - (do Lux/Monad - [g!obj (gensym "")] - (emit (list (` (;let [(~ g!obj) (~ obj)] - (.! (~@ *tokens*))))))))) + _ + (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))))))) @@ -246,25 +236,3 @@ (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")) -- cgit v1.2.3