From 7e8b265ed6549df6f9bbac1f995b4005f5385257 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 28 Dec 2018 20:23:55 -0400
Subject: Added machinery for descriptors.

---
 stdlib/source/lux/host/jvm/constant/pool.lux | 10 +++-
 stdlib/source/lux/host/jvm/descriptor.lux    | 85 ++++++++++++++++++++++++++++
 2 files changed, 94 insertions(+), 1 deletion(-)
 create mode 100644 stdlib/source/lux/host/jvm/descriptor.lux

(limited to 'stdlib')

diff --git a/stdlib/source/lux/host/jvm/constant/pool.lux b/stdlib/source/lux/host/jvm/constant/pool.lux
index b21477b61..5761fd6fc 100644
--- a/stdlib/source/lux/host/jvm/constant/pool.lux
+++ b/stdlib/source/lux/host/jvm/constant/pool.lux
@@ -15,7 +15,8 @@
   ["." // (#+ UTF8 Class Constant) ("class/." Equivalence<Class>)
    [//
     ["." encoding]
-    ["." index (#+ Index)]]])
+    ["." index (#+ Index)]
+    ["." descriptor (#+ Descriptor)]]])
 
 (def: offset 1)
 
@@ -56,6 +57,13 @@
     [@name (utf8 name)]
     (class' (//.class @name))))
 
+(def: #export (descriptor value)
+  (All [kind]
+    (-> (Descriptor kind)
+        (State Pool (Index (Descriptor kind)))))
+  (let [value (descriptor.descriptor value)]
+    (!add value #//.UTF8 text/=)))
+
 (def: #export format
   (Format Pool)
   (binary.row/16' ..offset //.format))
diff --git a/stdlib/source/lux/host/jvm/descriptor.lux b/stdlib/source/lux/host/jvm/descriptor.lux
new file mode 100644
index 000000000..6127f7025
--- /dev/null
+++ b/stdlib/source/lux/host/jvm/descriptor.lux
@@ -0,0 +1,85 @@
+(.module:
+  [lux (#- int char)
+   [data
+    ["." text
+     format]
+    [collection
+     [list ("list/." Functor<List>)]]]
+   [type
+    abstract]]
+  [//
+   ["//." constant (#+ UTF8)]
+   ["//." name (#+ Internal)]])
+
+(abstract: #export Base' {} Any)
+(abstract: #export Object' {} Any)
+(abstract: #export Array' {} Any)
+(abstract: #export Void' {} Any)
+
+(abstract: #export (Value' kind) {} Any)
+(abstract: #export (Return kind) {} Any)
+
+(abstract: #export Method {} Any)
+
+(abstract: #export (Descriptor kind)
+  {}
+
+  Text
+
+  (type: #export (Value kind) (Return (Value' kind)))
+  (type: #export Void (Return Void'))
+
+  (do-template [<refined> <raw>]
+    [(type: #export <refined> (Value <raw>))]
+
+    [Base Base']
+    [Object Object']
+    [Array Array'])
+
+  (do-template [<sigil> <name> <kind>]
+    [(def: #export <name>
+       (Descriptor <kind>)
+       (:abstraction <sigil>))]
+
+    ["Z" boolean Base]
+
+    ["B" byte Base]
+    ["S" short Base]
+    ["I" int Base]
+    ["J" long Base]
+
+    ["C" char Base]
+
+    ["F" float Base]
+    ["D" double Base]
+
+    ["V" void Void])
+
+  (def: #export object
+    (-> Internal (Descriptor Object))
+    (|>> //name.read
+         (text.enclose ["L" ";"])
+         :abstraction))
+
+  (def: #export array
+    (-> (Descriptor (Value Any))
+        (Descriptor Array))
+    (|>> :representation
+         (format "[")
+         :abstraction))
+
+  (def: #export (method inputs output)
+    (-> (List (Descriptor (Value Any)))
+        (Descriptor (Return Any))
+        (Descriptor Method))
+    (:abstraction
+     (format (|> inputs
+                 (list/map (|>> :representation))
+                 (text.join-with "")
+                 (text.enclose ["(" ")"]))
+             (:representation output))))
+
+  (def: #export descriptor
+    (-> (Descriptor Any) UTF8)
+    (|>> :representation))
+  )
-- 
cgit v1.2.3