1 files changed, 205 insertions, 0 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 ""))))