Moved JVM type machinery to stdlib.

4 files changed, 277 insertions, 72 deletions

diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux
new file mode 100644
index 000000000..23925e468
--- /dev/null
+++ b/stdlib/source/lux/target/jvm/type.lux
@@ -0,0 +1,205 @@
+(.module:
+  [lux (#- Type int char)
+   [data
+    ["." maybe ("#@." functor)]
+    ["." text
+     format]
+    [collection
+     ["." list ("#@." functor)]]]])
+
+(def: array-prefix "[")
+(def: binary-void-name "V")
+(def: binary-boolean-name "Z")
+(def: binary-byte-name    "B")
+(def: binary-short-name   "S")
+(def: binary-int-name     "I")
+(def: binary-long-name    "J")
+(def: binary-float-name   "F")
+(def: binary-double-name  "D")
+(def: binary-char-name    "C")
+(def: binary-object-prefix "L")
+(def: binary-object-suffix ";")
+(def: object-class "java.lang.Object")
+
+(type: #export Bound
+  #Upper
+  #Lower)
+
+(type: #export Primitive
+  #Boolean
+  #Byte
+  #Short
+  #Int
+  #Long
+  #Float
+  #Double
+  #Char)
+
+(type: #export #rec Generic
+  (#Var Text)
+  (#Wildcard (Maybe [Bound Generic]))
+  (#Class Text (List Generic)))
+
+(type: #export Class
+  [Text (List Generic)])
+
+(type: #export Parameter
+  [Text Class (List Class)])
+
+(type: #export #rec Type
+  (#Primitive Primitive)
+  (#Generic Generic)
+  (#Array Type))
+
+(type: #export Method
+  {#args (List Type)
+   #return (Maybe Type)
+   #exceptions (List Generic)})
+
+(template [<name> <primitive>]
+  [(def: #export <name> Type (#Primitive <primitive>))]
+
+  [boolean #Boolean]
+  [byte    #Byte]
+  [short   #Short]
+  [int     #Int]
+  [long    #Long]
+  [float   #Float]
+  [double  #Double]
+  [char    #Char]
+  )
+
+(template: #export (class name params)
+  (#..Generic (#..Class name params)))
+
+(template: #export (var name)
+  (#..Generic (#..Var name)))
+
+(template: #export (wildcard bound)
+  (#..Generic (#..Wildcard bound)))
+
+(def: #export (array depth elemT)
+  (-> Nat Type Type)
+  (case depth
+    0 elemT
+    _ (#Array (array (dec depth) elemT))))
+
+(def: #export binary-name
+  (-> Text Text)
+  (text.replace-all "." "/"))
+
+(def: #export (descriptor type)
+  (-> Type Text)
+  (case type
+    (#Primitive prim)
+    (case prim
+      #Boolean ..binary-boolean-name
+      #Byte    ..binary-byte-name
+      #Short   ..binary-short-name
+      #Int     ..binary-int-name
+      #Long    ..binary-long-name
+      #Float   ..binary-float-name
+      #Double  ..binary-double-name
+      #Char    ..binary-char-name)
+
+    (#Array sub)
+    (format ..array-prefix (descriptor sub))
+
+    (#Generic generic)
+    (case generic
+      (#Class class params)
+      (format ..binary-object-prefix (binary-name class) ..binary-object-suffix)
+
+      (^or (#Var name) (#Wildcard ?bound))
+      (descriptor (#Generic (#Class ..object-class (list)))))
+    ))
+
+(def: #export (class-name type)
+  (-> Type (Maybe Text))
+  (case type
+    (#Primitive prim)
+    #.None
+
+    (#Array sub)
+    (#.Some (descriptor type))
+
+    (#Generic generic)
+    (case generic
+      (#Class class params)
+      (#.Some class)
+
+      (^or (#Var name) (#Wildcard ?bound))
+      (#.Some ..object-class))
+    ))
+
+(def: #export (signature type)
+  (-> Type Text)
+  (case type
+    (#Primitive prim)
+    (case prim
+      #Boolean ..binary-boolean-name
+      #Byte    ..binary-byte-name
+      #Short   ..binary-short-name
+      #Int     ..binary-int-name
+      #Long    ..binary-long-name
+      #Float   ..binary-float-name
+      #Double  ..binary-double-name
+      #Char    ..binary-char-name)
+
+    (#Array sub)
+    (format ..array-prefix (signature sub))
+
+    (#Generic generic)
+    (case generic
+      (#Class class params)
+      (let [=params (if (list.empty? params)
+                      ""
+                      (format "<"
+                              (|> params
+                                  (list@map (|>> #Generic signature))
+                                  (text.join-with ""))
+                              ">"))]
+        (format ..binary-object-prefix (binary-name class) =params ..binary-object-suffix))
+
+      (#Var name)
+      (format "T" name ..binary-object-suffix)
+
+      (#Wildcard #.None)
+      "*"
+
+      (^template [<tag> <prefix>]
+        (#Wildcard (#.Some [<tag> bound]))
+        (format <prefix> (signature (#Generic bound))))
+      ([#Upper "+"]
+       [#Lower "-"]))
+    ))
+
+(def: #export (method args return exceptions)
+  (-> (List Type) (Maybe Type) (List Generic) Method)
+  {#args args #return return #exceptions exceptions})
+
+(def: method-args
+  (text.enclose ["(" ")"]))
+
+(def: #export (method-descriptor method)
+  (-> Method Text)
+  (format (|> (get@ #args method) (list@map descriptor) (text.join-with "") ..method-args)
+          (case (get@ #return method)
+            #.None
+            ..binary-void-name
+
+            (#.Some return)
+            (descriptor return))))
+
+(def: #export (method-signature method)
+  (-> Method Text)
+  (format (|> (get@ #args method) (list@map signature) (text.join-with "") ..method-args)
+          (case (get@ #return method)
+            #.None
+            ..binary-void-name
+
+            (#.Some return)
+            (signature return))
+          (|> (get@ #exceptions method)
+              (list@map (|>> #Generic signature (format "^")))
+              (text.join-with ""))))
diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux
index b60616f03..bd1efd73b 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/context.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux
@@ -1,5 +1,6 @@
 (.module:
   [lux (#- Module Code)
+   ["@" target]
    [abstract
     [monad (#+ Monad do)]]
    [control
@@ -19,8 +20,7 @@
    ["#/" // #_
     [archive
      [descriptor (#+ Module)]]
-    ["#/" // (#+ Input)
-     ["#." host]]]])
+    ["#/" // (#+ Input)]]])
 
 (template [<name>]
   [(exception: #export (<name> {module Module})
@@ -38,16 +38,16 @@
 
 (def: partial-host-extension
   Extension
-  (`` (for {(~~ (static ////host.common-lisp)) ".cl"
-            (~~ (static ////host.js))          ".js"
-            (~~ (static ////host.old))         ".jvm"
-            (~~ (static ////host.jvm))         ".jvm"
-            (~~ (static ////host.lua))         ".lua"
-            (~~ (static ////host.php))         ".php"
-            (~~ (static ////host.python))      ".py"
-            (~~ (static ////host.r))           ".r"
-            (~~ (static ////host.ruby))        ".rb"
-            (~~ (static ////host.scheme))      ".scm"})))
+  (`` (for {(~~ (static @.common-lisp)) ".cl"
+            (~~ (static @.js))          ".js"
+            (~~ (static @.old))         ".jvm"
+            (~~ (static @.jvm))         ".jvm"
+            (~~ (static @.lua))         ".lua"
+            (~~ (static @.php))         ".php"
+            (~~ (static @.python))      ".py"
+            (~~ (static @.r))           ".r"
+            (~~ (static @.ruby))        ".rb"
+            (~~ (static @.scheme))      ".scm"})))
 
 (def: full-host-extension
   Extension
diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux
index effcff8a3..cc5258724 100644
--- a/stdlib/source/lux/world/console.lux
+++ b/stdlib/source/lux/world/console.lux
@@ -1,5 +1,7 @@
 (.module:
   [lux #*
+   [host (#+ import:)]
+   ["@" target]
    [abstract
     [monad (#+ do)]]
    [control
@@ -12,11 +14,7 @@
    [data
     ["." error (#+ Error)]
     ["." text
-     format]]
-   [host (#+ import:)]
-   [tool
-    [compiler
-     ["." host]]]])
+     format]]])
 
 (template [<name>]
   [(exception: #export (<name>)
@@ -57,59 +55,63 @@
                        [can-write ..can-write]
                        [can-close ..can-close])))))
 
-(`` (for {(~~ (static host.old))
-          (as-is (import: java/lang/String)
-
-                 (import: #long java/io/Console
-                   (readLine [] #io #try String))
-
-                 (import: java/io/InputStream
-                   (read [] #io #try int))
-
-                 (import: java/io/PrintStream
-                   (print [String] #io #try void))
-
-                 (import: java/lang/System
-                   (#static console [] #io #? java/io/Console)
-                   (#static in java/io/InputStream)
-                   (#static out java/io/PrintStream))
-
-                 (def: #export system
-                   (IO (Error (Console IO)))
-                   (do io.monad
-                     [?jvm-console (System::console)]
-                     (case ?jvm-console
-                       #.None
-                       (wrap (ex.throw cannot-open []))
-
-                       (#.Some jvm-console)
-                       (let [jvm-input (System::in)
-                             jvm-output (System::out)]
-                         (<| wrap
-                             ex.return
-                             (: (Console IO)) ## TODO: Remove ASAP
-                             (structure
-                              (def: can-read
-                                (..can-read
-                                 (function (_ _)
-                                   (|> jvm-input
-                                       InputStream::read
-                                       (:: (error.with io.monad) map .nat)))))
-                              
-                              (def: can-read-line
-                                (..can-read
-                                 (function (_ _)
-                                   (java/io/Console::readLine jvm-console))))
-                              
-                              (def: can-write
-                                (..can-write
-                                 (function (_ message)
-                                   (PrintStream::print message jvm-output))))
-                              
-                              (def: can-close
-                                (..can-close
-                                 (|>> (ex.throw cannot-close) wrap))))))))))
-          }))
+(with-expansions [<form-jvm> (as-is (import: java/lang/String)
+
+                                    (import: #long java/io/Console
+                                      (readLine [] #io #try String))
+
+                                    (import: java/io/InputStream
+                                      (read [] #io #try int))
+
+                                    (import: java/io/PrintStream
+                                      (print [String] #io #try void))
+
+                                    (import: java/lang/System
+                                      (#static console [] #io #? java/io/Console)
+                                      (#static in java/io/InputStream)
+                                      (#static out java/io/PrintStream))
+
+                                    (def: #export system
+                                      (IO (Error (Console IO)))
+                                      (do io.monad
+                                        [?jvm-console (System::console)]
+                                        (case ?jvm-console
+                                          #.None
+                                          (wrap (ex.throw cannot-open []))
+
+                                          (#.Some jvm-console)
+                                          (let [jvm-input (System::in)
+                                                jvm-output (System::out)]
+                                            (<| wrap
+                                                ex.return
+                                                (: (Console IO)) ## TODO: Remove ASAP
+                                                (structure
+                                                 (def: can-read
+                                                   (..can-read
+                                                    (function (_ _)
+                                                      (|> jvm-input
+                                                          InputStream::read
+                                                          (:: (error.with io.monad) map .nat)))))
+                                                 
+                                                 (def: can-read-line
+                                                   (..can-read
+                                                    (function (_ _)
+                                                      (java/io/Console::readLine jvm-console))))
+                                                 
+                                                 (def: can-write
+                                                   (..can-write
+                                                    (function (_ message)
+                                                      (PrintStream::print message jvm-output))))
+                                                 
+                                                 (def: can-close
+                                                   (..can-close
+                                                    (|>> (ex.throw cannot-close) wrap))))))))))]
+  (`` (for {(~~ (static @.old))
+            (as-is <form-jvm>)
+
+            (~~ (static @.jvm))
+            (as-is <form-jvm>)
+            })))
 
 (def: #export (write-line message console)
   (All [!] (-> Text (Console !) (! Any)))
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index 5dd2fd1ba..c39544019 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -20,8 +20,6 @@
      ["." list ("#@." functor fold)]]]
    [time
     ["." instant (#+ Instant)]]
-   [host
-    ["_" js]]
    [world
     ["." file (#+ File)]
     ["." console]]