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 +-
 10 files changed, 346 insertions(+), 396 deletions(-)
 delete mode 100644 source/lux/host/java.lux
 create mode 100644 source/lux/host/jvm.lux

(limited to 'source')

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 @@
      (-> <type> <type> Bool)
      (<cmp> 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 [<name> <type> <eq> <lt> <gt>]
   [(defstruct #export <name> (O;Ord <type>)
      (def O;_eq <eq>)
@@ -89,8 +83,8 @@
      (def B;top <top>)
      (def B;bottom <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 [<name> <type> <unit> <++>]
@@ -114,6 +108,6 @@
      (def (S;show x)
        <body>))]
 
-  [ 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 [<name> <method>]
   [(def #export (<name> x)
      (-> Text Text)
-     (_jvm_invokevirtual java.lang.String <method> []
+     (_jvm_invokevirtual "java.lang.String" <method> []
                          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 [<common> <general> <method>]
   [(def #export (<general> 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 <method> [java.lang.String int]
+       (case (_jvm_i2l (_jvm_invokevirtual "java.lang.String" <method> ["java.lang.String" "int"]
                                            x [pattern (_jvm_l2i from)]))
          -1  #;None
          idx (#;Some idx))
@@ -82,13 +82,13 @@
    
    (def #export (<common> pattern x)
      (-> Text Text (Maybe Int))
-     (case (_jvm_i2l (_jvm_invokevirtual java.lang.String <method> [java.lang.String]
+     (case (_jvm_i2l (_jvm_invokevirtual "java.lang.String" <method> ["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 [<name> <op>]
+    [(def (<name> x y)
+       (<op> (_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 <init> [] void
-##            (_jvm_invokespecial java.lang.Object <init> [] 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"])]
-##   (<init> [] "void"
-##           ["public"]
-##           (_jvm_invokespecial java.lang.Object <init> [] 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 <init> [] void
+##            (_jvm_invokespecial java.lang.Object <init> [] 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"])]
+##   (<init> [] "void"
+##           ["public"]
+##           (_jvm_invokespecial java.lang.Object <init> [] 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 [<name> <value>]
   [(def #export <name>
      Real
-     (_jvm_getstatic java.lang.Math <value>))]
+     (_jvm_getstatic "java.lang.Math" <value>))]
 
-  [e  E]
-  [pi PI]
+  [e  "E"]
+  [pi "PI"]
   )
 
 ## [Functions]
 (do-template [<name> <method>]
   [(def #export (<name> n)
      (-> Real Real)
-     (_jvm_invokestatic java.lang.Math <method> [double] [n]))]
+     (_jvm_invokestatic "java.lang.Math" <method> ["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 [<name> <method>]
   [(def #export (<name> x y)
      (-> Real Real Real)
-     (_jvm_invokestatic java.lang.Math <method> [double double] [x y]))]
+     (_jvm_invokestatic "java.lang.Math" <method> ["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)
-- 
cgit v1.2.3