- Changed some of the syntax for macro templating.

- "gensym" now produces Ident instead of Code.

1 files changed, 69 insertions, 68 deletions

diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index a53ec1a5f..29937c041 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -290,7 +290,7 @@
     [[name params] _ _]
     (let [name (sanitize name)
           =params (list/map (class->type' mode type-params in-array?) params)]
-      (` (primitive (~ (code.text name)) [(~@ =params)])))))
+      (` (primitive (~ (code.text name)) [(~+ =params)])))))
 
 (def: (class->type' mode type-params in-array? class)
   (-> Primitive-Mode (List TypeParam) Bool GenericType Code)
@@ -341,7 +341,7 @@
                                  (class->type #ManualPrM class-params bound1))))
                           class-params)]
     (` (primitive (~ (code.text (sanitize class-name)))
-                  [(~@ =params)]))))
+                  [(~+ =params)]))))
 
 (def: empty-imports
   Class-Imports
@@ -579,7 +579,7 @@
                  (s.form ($_ p.seq (s.this (' ::new!)) (s.tuple (p.exactly (list.size arg-decls) s.any)))))
      #let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ params)) arg-decls))]]
     (wrap (` ((~ (code.text (format "jvm new" ":" class-name ":" (text.join-with "," arg-decls'))))
-              (~@ args))))))
+              (~+ args))))))
 
 (def: (make-static-method-parser params class-name method-name arg-decls)
   (-> (List TypeParam) Text Text (List ArgDecl) (Syntax Code))
@@ -589,7 +589,7 @@
                  (s.form ($_ p.seq (s.this (code.symbol ["" dotted-name])) (s.tuple (p.exactly (list.size arg-decls) s.any)))))
      #let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ params)) arg-decls))]]
     (wrap (`' ((~ (code.text (format "jvm invokestatic" ":" class-name ":" method-name ":" (text.join-with "," arg-decls'))))
-               (~@ args))))))
+               (~+ args))))))
 
 (do-template [<name> <jvm-op>]
   [(def: (<name> params class-name method-name arg-decls)
@@ -600,7 +600,7 @@
                     (s.form ($_ p.seq (s.this (code.symbol ["" dotted-name])) (s.tuple (p.exactly (list.size arg-decls) s.any)))))
         #let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ params)) arg-decls))]]
        (wrap (`' ((~ (code.text (format <jvm-op> ":" class-name ":" method-name ":" (text.join-with "," arg-decls'))))
-                  (~' _jvm_this) (~@ args))))))]
+                  (~' _jvm_this) (~+ args))))))]
 
   [make-special-method-parser "jvm invokespecial"]
   [make-virtual-method-parser "jvm invokevirtual"]
@@ -1206,7 +1206,7 @@
                                                       #let [arg-decls' (: (List Text) (list/map (|>> product.right (simple-class$ (list)))
                                                                                                 arg-decls))]]
                                                      (wrap (`' ((~ (code.text (format "jvm invokespecial" ":" (get@ #super-class-name super-class) ":" name ":" (text.join-with "," arg-decls'))))
-                                                                (~' _jvm_this) (~@ args)))))))]
+                                                                (~' _jvm_this) (~+ args)))))))]
       (with-parens
         (spaced (list "override"
                       (class-decl$ class-decl)
@@ -1259,9 +1259,9 @@
                     (generic-type$ return-type))))
     ))
 
-(def: (complete-call$ obj [method args])
-  (-> Code Partial-Call Code)
-  (` ((~ method) (~ args) (~ obj))))
+(def: (complete-call$ g!obj [method args])
+  (-> Ident Partial-Call Code)
+  (` ((~ method) (~ args) (~@ g!obj))))
 
 ## [Syntax]
 (def: object-super-class
@@ -1402,10 +1402,10 @@
               "=>"
               (#.Some "YOLO"))}
   (with-gensyms [g!temp]
-    (wrap (list (` (let [(~ g!temp) (~ expr)]
-                     (if ("jvm null?" (~ g!temp))
+    (wrap (list (` (let [(~@ g!temp) (~ expr)]
+                     (if ("jvm null?" (~@ g!temp))
                        #.None
-                       (#.Some (~ g!temp)))))))))
+                       (#.Some (~@ g!temp)))))))))
 
 (syntax: #export (!!! expr)
   {#.doc (doc "Takes a (Maybe ObjectType) and returns a ObjectType."
@@ -1418,8 +1418,8 @@
               "YOLO")}
   (with-gensyms [g!value]
     (wrap (list (` ("lux case" (~ expr)
-                    {(#.Some (~ g!value))
-                     (~ g!value)
+                    {(#.Some (~@ g!value))
+                     (~@ g!value)
 
                      #.None
                      ("jvm null")}))))))
@@ -1430,7 +1430,7 @@
               "If it fails, you get (#.Left error+stack-traces-as-text)."
               (try (risky-computation input)))}
   (with-gensyms [g!_]
-    (wrap (list (`' ("lux try" (.function [(~ g!_)] (~ expr))))))))
+    (wrap (list (`' ("lux try" (.function [(~@ g!_)] (~ expr))))))))
 
 (syntax: #export (instance? [#let [imports (class-imports *compiler*)]]
                             [class (generic-type^ imports (list))]
@@ -1446,8 +1446,8 @@
     (do @
       [g!obj (macro.gensym "obj")]
       (wrap (list (` (: (-> (primitive "java.lang.Object") Bool)
-                        (function [(~ g!obj)]
-                          ((~ (code.text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~ g!obj))))))))
+                        (function [(~@ g!obj)]
+                          ((~ (code.text (format "jvm instanceof" ":" (simple-class$ (list) class)))) (~@ g!obj))))))))
     ))
 
 (syntax: #export (synchronized lock body)
@@ -1464,9 +1464,9 @@
                 (ClassName::method1 [arg0 arg1 arg2])
                 (ClassName::method2 [arg3 arg4 arg5])))}
   (with-gensyms [g!obj]
-    (wrap (list (` (let [(~ g!obj) (~ obj)]
-                     (exec (~@ (list/map (complete-call$ g!obj) methods))
-                       (~ g!obj))))))))
+    (wrap (list (` (let [(~@ g!obj) (~ obj)]
+                     (exec (~+ (list/map (complete-call$ g!obj) methods))
+                       (~@ g!obj))))))))
 
 (def: (class-import$ long-name? [full-name params])
   (-> Bool ClassDecl Code)
@@ -1478,9 +1478,9 @@
          {#.type?      true
           #..jvm-class (~ (code.text full-name))}
          Type
-         (All [(~@ params')]
+         (All [(~+ params')]
            (primitive (~ (code.text (sanitize full-name)))
-                      [(~@ params')]))))))
+                      [(~+ params')]))))))
 
 (def: (member-type-vars class-tvars member)
   (-> (List TypeParam) ImportMemberDecl (List TypeParam))
@@ -1509,9 +1509,10 @@
                                (: (-> [Bool GenericType] (Meta [Code Code]))
                                   (function [[maybe? _]]
                                     (with-gensyms [arg-name]
-                                      (wrap [arg-name (if maybe?
-                                                        (` (!!! (~ arg-name)))
-                                                        arg-name)]))))
+                                      (let [arg-name (code.symbol arg-name)]
+                                        (wrap [arg-name (if maybe?
+                                                          (` (!!! (~ arg-name)))
+                                                          arg-name)])))))
                                import-member-args)
          #let [arg-classes (: (List Text)
                               (list/map (|>> product.right (simple-class$ (list/compose type-params import-member-tvars)))
@@ -1550,11 +1551,11 @@
       [(` (Maybe (~ return-type)))
        (` (??? (~ return-term)))]
       [return-type
-       (let [g!temp (code.symbol ["" "Ω"])]
-         (` (let [(~ g!temp) (~ return-term)]
+       (let [g!temp ["" "Ω"]]
+         (` (let [(~@ g!temp) (~ return-term)]
               (if (not (null? (:! (primitive "java.lang.Object")
-                                  (~ g!temp))))
-                (~ g!temp)
+                                  (~@ g!temp))))
+                (~@ g!temp)
                 (error! "Cannot produce null references from method calls.")))))])
 
     _
@@ -1634,7 +1635,7 @@
     body
     
     #AutoPrM
-    (` (let [(~@ (|> inputs
+    (` (let [(~+ (|> inputs
                      (list/map auto-conv)
                      list/join))]
          (~ body)))))
@@ -1653,19 +1654,19 @@
       "float" (` (f2d (~ output)))
       _       output)))
 
-(def: (with-mode-field-set mode class input)
-  (-> Primitive-Mode GenericType Code Code)
+(def: (with-mode-field-set mode class g!input)
+  (-> Primitive-Mode GenericType Ident Code)
   (case mode
     #ManualPrM
-    input
+    (code.symbol g!input)
     
     #AutoPrM
     (case (simple-class$ (list) class)
-      "byte"  (` (l2b (~ input)))
-      "short" (` (l2s (~ input)))
-      "int"   (` (l2i (~ input)))
-      "float" (` (d2f (~ input)))
-      _       input)))
+      "byte"  (` (l2b (~@ g!input)))
+      "short" (` (l2s (~@ g!input)))
+      "int"   (` (l2i (~@ g!input)))
+      "float" (` (d2f (~@ g!input)))
+      _       (code.symbol g!input))))
 
 (def: (member-def-interop type-params kind class [arg-function-inputs arg-method-inputs arg-classes arg-types] member method-prefix)
   (-> (List TypeParam) ClassKind ClassDecl [(List Code) (List Code) (List Text) (List Code)] ImportMemberDecl Text (Meta (List Code)))
@@ -1686,7 +1687,7 @@
                               (let [=class-tvars (|> class-tvars
                                                      (list.filter free-type-param?)
                                                      (list/map type-param->type-arg))]
-                                (` (All [(~@ =class-tvars)] (primitive (~ (code.text full-name)) [(~@ =class-tvars)]))))))
+                                (` (All [(~+ =class-tvars)] (primitive (~ (code.text full-name)) [(~+ =class-tvars)]))))))
                getter-interop (: (-> Text Code)
                                  (function [name]
                                    (let [getter-name (code.symbol ["" (format method-prefix member-separator name)])]
@@ -1701,15 +1702,15 @@
          #let [def-name (code.symbol ["" (format method-prefix member-separator (get@ #import-member-alias commons))])
                def-params (list (code.tuple arg-function-inputs))
                jvm-interop (|> (` ((~ (code.text (format "jvm new" ":" full-name ":" (text.join-with "," arg-classes))))
-                                   (~@ arg-method-inputs)))
+                                   (~+ arg-method-inputs)))
                                (with-mode-inputs (get@ #import-member-mode commons)
                                  (list.zip2 arg-classes arg-function-inputs)))
                [return-type jvm-interop] (|> [return-type jvm-interop]
                                              (decorate-return-maybe member)
                                              (decorate-return-try member)
                                              (decorate-return-io member))]]
-        (wrap (list (` (def: ((~ def-name) (~@ def-params))
-                         (All [(~@ all-params)] (-> [(~@ arg-types)] (~ return-type)))
+        (wrap (list (` (def: ((~ def-name) (~+ def-params))
+                         (All [(~+ all-params)] (-> [(~+ arg-types)] (~ return-type)))
                          (~ jvm-interop))))))
 
       (#MethodDecl [commons method])
@@ -1730,19 +1731,19 @@
                                                  (case kind
                                                    #Class
                                                    ["invokevirtual"
-                                                    (list g!obj)
+                                                    (list (code.symbol g!obj))
                                                     (list (class-decl-type$ class))]
                                                    
                                                    #Interface
                                                    ["invokeinterface"
-                                                    (list g!obj)
+                                                    (list (code.symbol g!obj))
                                                     (list (class-decl-type$ class))]
                                                    )))
                  def-params (#.Cons (code.tuple arg-function-inputs) obj-ast)
-                 def-param-types (#.Cons (` [(~@ arg-types)]) class-ast)
+                 def-param-types (#.Cons (` [(~+ arg-types)]) class-ast)
                  jvm-interop (|> (` ((~ (code.text (format "jvm " jvm-op ":" full-name ":" import-method-name
                                                            ":" (text.join-with "," arg-classes))))
-                                     (~@ obj-ast) (~@ arg-method-inputs)))
+                                     (~+ obj-ast) (~+ arg-method-inputs)))
                                  (with-mode-output (get@ #import-member-mode commons)
                                    (get@ #import-method-return method))
                                  (with-mode-inputs (get@ #import-member-mode commons)
@@ -1751,16 +1752,16 @@
                                                (decorate-return-maybe member)
                                                (decorate-return-try member)
                                                (decorate-return-io member))]]
-          (wrap (list (` (def: ((~ def-name) (~@ def-params))
-                           (All [(~@ all-params)] (-> (~@ def-param-types) (~ return-type)))
+          (wrap (list (` (def: ((~ def-name) (~+ def-params))
+                           (All [(~+ all-params)] (-> (~+ def-param-types) (~ return-type)))
                            (~ jvm-interop)))))))
 
       (#FieldAccessDecl fad)
       (do Monad<Meta>
         [#let [(^open) fad
                base-gtype (class->type import-field-mode type-params import-field-type)
-               g!class (class-decl-type$ class)
-               g!type (if import-field-maybe?
+               classC (class-decl-type$ class)
+               typeC (if import-field-maybe?
                         (` (Maybe (~ base-gtype)))
                         base-gtype)
                tvar-asts (: (List Code)
@@ -1772,19 +1773,19 @@
          getter-interop (with-gensyms [g!obj]
                           (let [getter-call (if import-field-static?
                                               getter-name
-                                              (` ((~ getter-name) (~ g!obj))))
+                                              (` ((~ getter-name) (~@ g!obj))))
                                 getter-type (if import-field-setter?
-                                              (` (IO (~ g!type)))
-                                              g!type)
+                                              (` (IO (~ typeC)))
+                                              typeC)
                                 getter-type (if import-field-static?
                                               getter-type
-                                              (` (-> (~ g!class) (~ getter-type))))
-                                getter-type (` (All [(~@ tvar-asts)] (~ getter-type)))
+                                              (` (-> (~ classC) (~ getter-type))))
+                                getter-type (` (All [(~+ tvar-asts)] (~ getter-type)))
                                 getter-body (if import-field-static?
                                               (with-mode-field-get import-field-mode import-field-type
                                                 (` ((~ (code.text (format "jvm getstatic" ":" full-name ":" import-field-name))))))
                                               (with-mode-field-get import-field-mode import-field-type
-                                                (` ((~ (code.text (format "jvm getfield" ":" full-name ":" import-field-name))) (~ g!obj)))))
+                                                (` ((~ (code.text (format "jvm getfield" ":" full-name ":" import-field-name))) (~@ g!obj)))))
                                 getter-body (if import-field-maybe?
                                               (` (??? (~ getter-body)))
                                               getter-body)
@@ -1797,11 +1798,11 @@
          setter-interop (if import-field-setter?
                           (with-gensyms [g!obj g!value]
                             (let [setter-call (if import-field-static?
-                                                (` ((~ setter-name) (~ g!value)))
-                                                (` ((~ setter-name) (~ g!value) (~ g!obj))))
+                                                (` ((~ setter-name) (~@ g!value)))
+                                                (` ((~ setter-name) (~@ g!value) (~@ g!obj))))
                                   setter-type (if import-field-static?
-                                                (` (All [(~@ tvar-asts)] (-> (~ g!type) (IO Unit))))
-                                                (` (All [(~@ tvar-asts)] (-> (~ g!type) (~ g!class) (IO Unit)))))
+                                                (` (All [(~+ tvar-asts)] (-> (~ typeC) (IO Unit))))
+                                                (` (All [(~+ tvar-asts)] (-> (~ typeC) (~ classC) (IO Unit)))))
                                   setter-value (with-mode-field-set import-field-mode import-field-type g!value)
                                   setter-value (if import-field-maybe?
                                                  (` (!!! (~ setter-value)))
@@ -1980,8 +1981,8 @@
 
     _
     (with-gensyms [g!array]
-      (wrap (list (` (let [(~ g!array) (~ array)]
-                       (..array-read (~ idx) (~ g!array)))))))))
+      (wrap (list (` (let [(~@ g!array) (~ array)]
+                       (..array-read (~ idx) (~@ g!array)))))))))
 
 (syntax: #export (array-write idx value array)
   {#.doc (doc "Stores an element into an array."
@@ -2009,8 +2010,8 @@
 
     _
     (with-gensyms [g!array]
-      (wrap (list (` (let [(~ g!array) (~ array)]
-                       (..array-write (~ idx) (~ value) (~ g!array)))))))))
+      (wrap (list (` (let [(~@ g!array) (~ array)]
+                       (..array-write (~ idx) (~ value) (~@ g!array)))))))))
 
 (def: simple-bindings^
   (Syntax (List [Text Code]))
@@ -2033,10 +2034,10 @@
                              (` (try ("jvm invokevirtual:java.io.Closeable:close:" (~ (code.symbol ["" (product.left res)]))))))
                            bindings)]
       (wrap (list (` (do Monad<IO>
-                       [(~@ inits)
-                        (~ g!output) (~ body)
-                        (~' #let) [(~ g!_) (exec (~@ (list.reverse closes)) [])]]
-                       ((~' wrap) (~ g!output)))))))))
+                       [(~+ inits)
+                        (~@ g!output) (~ body)
+                        (~' #let) [(~@ g!_) (exec (~+ (list.reverse closes)) [])]]
+                       ((~' wrap) (~@ g!output)))))))))
 
 (syntax: #export (class-for [#let [imports (class-imports *compiler*)]]
                             [type (generic-type^ imports (list))])