From 296d087530cb142efec1dea159770346bb43c3c0 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 15 Nov 2017 19:51:33 -0400
Subject: - Heavy refactoring.

---
 new-luxc/source/luxc/lang/host/jvm/type.lux | 138 ++++++++++++++++++++++++++++
 1 file changed, 138 insertions(+)
 create mode 100644 new-luxc/source/luxc/lang/host/jvm/type.lux

(limited to 'new-luxc/source/luxc/lang/host/jvm/type.lux')

diff --git a/new-luxc/source/luxc/lang/host/jvm/type.lux b/new-luxc/source/luxc/lang/host/jvm/type.lux
new file mode 100644
index 000000000..3825d443b
--- /dev/null
+++ b/new-luxc/source/luxc/lang/host/jvm/type.lux
@@ -0,0 +1,138 @@
+(;module:
+  [lux #- char]
+  (lux (data [text]
+             text/format
+             (coll [list "L/" Functor<List>])))
+  ["$" ..])
+
+## Types
+(do-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]
+  )
+
+(def: #export (class name params)
+  (-> Text (List $;Generic) $;Type)
+  (#$;Generic (#$;Class name params)))
+
+(def: #export (var name)
+  (-> Text $;Type)
+  (#$;Generic (#$;Var name)))
+
+(def: #export (wildcard bound)
+  (-> (Maybe [$;Bound $;Generic]) $;Type)
+  (#$;Generic (#$;Wildcard bound)))
+
+(def: #export (array depth elemT)
+  (-> Nat $;Type $;Type)
+  (case depth
+    +0 elemT
+    _ (#$;Array (array (n.dec depth) elemT))))
+
+(def: #export (binary-name class)
+  (-> Text Text)
+  (text;replace-all "." "/" class))
+
+(def: #export (descriptor type)
+  (-> $;Type Text)
+  (case type
+    (#$;Primitive prim)
+    (case prim
+      #$;Boolean "Z"
+      #$;Byte    "B"
+      #$;Short   "S"
+      #$;Int     "I"
+      #$;Long    "J"
+      #$;Float   "F"
+      #$;Double  "D"
+      #$;Char    "C")
+
+    (#$;Array sub)
+    (format "[" (descriptor sub))
+
+    (#$;Generic generic)
+    (case generic
+      (#$;Class class params)
+      (format "L" (binary-name class) ";")
+
+      (^or (#$;Var name) (#$;Wildcard ?bound))
+      (descriptor (#$;Generic (#$;Class "java.lang.Object" (list)))))
+    ))
+
+(def: #export (signature type)
+  (-> $;Type Text)
+  (case type
+    (#$;Primitive prim)
+    (case prim
+      #$;Boolean "Z"
+      #$;Byte    "B"
+      #$;Short   "S"
+      #$;Int     "I"
+      #$;Long    "J"
+      #$;Float   "F"
+      #$;Double  "D"
+      #$;Char    "C")
+
+    (#$;Array sub)
+    (format "[" (signature sub))
+
+    (#$;Generic generic)
+    (case generic
+      (#$;Class class params)
+      (let [=params (if (list;empty? params)
+                      ""
+                      (format "<"
+                              (|> params
+                                  (L/map (|>. #$;Generic signature))
+                                  (text;join-with ""))
+                              ">"))]
+        (format "L" (binary-name class) =params ";"))
+
+      (#$;Var name)
+      (format "T" name ";")
+
+      (#$;Wildcard #;None)
+      "*"
+
+      (^template [<tag> <prefix>]
+        (#$;Wildcard (#;Some [<tag> bound]))
+        (format <prefix> (signature (#$;Generic bound))))
+      ([#$;Upper "+"]
+       [#$;Lower "-"]))
+    ))
+
+## Methods
+(def: #export (method args return exceptions)
+  (-> (List $;Type) (Maybe $;Type) (List $;Generic) $;Method)
+  {#$;args args #$;return return #$;exceptions exceptions})
+
+(def: #export (method-descriptor method)
+  (-> $;Method Text)
+  (format "(" (text;join-with "" (L/map descriptor (get@ #$;args method))) ")"
+          (case (get@ #$;return method)
+            #;None
+            "V"
+
+            (#;Some return)
+            (descriptor return))))
+
+(def: #export (method-signature method)
+  (-> $;Method Text)
+  (format "(" (|> (get@ #$;args method) (L/map signature) (text;join-with "")) ")"
+          (case (get@ #$;return method)
+            #;None
+            "V"
+
+            (#;Some return)
+            (signature return))
+          (|> (get@ #$;exceptions method)
+              (L/map (|>. #$;Generic signature (format "^")))
+              (text;join-with ""))))
-- 
cgit v1.2.3