From b4d0eba7485caf0c6cf58de1193a9114fa273d8b Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 30 May 2020 15:19:28 -0400
Subject: Split new-luxc into lux-jvm and lux-r.

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

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

diff --git a/lux-jvm/source/luxc/lang/host/jvm.lux b/lux-jvm/source/luxc/lang/host/jvm.lux
new file mode 100644
index 000000000..d957bdb1d
--- /dev/null
+++ b/lux-jvm/source/luxc/lang/host/jvm.lux
@@ -0,0 +1,131 @@
+(.module:
+  [lux (#- Definition Type)
+   [host (#+ import:)]
+   [abstract
+    monad]
+   [control
+    ["p" parser
+     ["s" code]]]
+   [data
+    [binary (#+ Binary)]
+    [collection
+     ["." list ("#/." functor)]]]
+   [macro
+    ["." code]
+    [syntax (#+ syntax:)]]
+   [target
+    [jvm
+     ["." type (#+ Type)
+      [category (#+ Class)]]]]
+   [tool
+    [compiler
+     [reference (#+ Register)]
+     [language
+      [lux
+       ["." generation]]]
+     [meta
+      [archive (#+ Archive)]]]]])
+
+(import: org/objectweb/asm/MethodVisitor)
+
+(import: org/objectweb/asm/ClassWriter)
+
+(import: #long org/objectweb/asm/Label
+  (new []))
+
+(type: #export Def
+  (-> ClassWriter ClassWriter))
+
+(type: #export Inst
+  (-> MethodVisitor MethodVisitor))
+
+(type: #export Label
+  org/objectweb/asm/Label)
+
+(type: #export Visibility
+  #Public
+  #Protected
+  #Private
+  #Default)
+
+(type: #export Version
+  #V1_1
+  #V1_2
+  #V1_3
+  #V1_4
+  #V1_5
+  #V1_6
+  #V1_7
+  #V1_8)
+
+(type: #export ByteCode Binary)
+
+(type: #export Definition [Text ByteCode])
+
+(type: #export Anchor [Label Register])
+
+(type: #export Host
+  (generation.Host Inst Definition))
+
+(template [<name> <base>]
+  [(type: #export <name>
+     (<base> ..Anchor Inst Definition))]
+
+  [State     generation.State]
+  [Operation generation.Operation]
+  [Phase     generation.Phase]
+  [Handler   generation.Handler]
+  [Bundle    generation.Bundle]
+  [Extender  generation.Extender]
+  )
+
+(type: #export (Generator i)
+  (-> Phase Archive i (Operation Inst)))
+
+(syntax: (config: {type s.local-identifier}
+           {none s.local-identifier}
+           {++ s.local-identifier}
+           {options (s.tuple (p.many s.local-identifier))})
+  (let [g!type (code.local-identifier type)
+        g!none (code.local-identifier none)
+        g!tags+ (list/map code.local-tag options)
+        g!_left (code.local-identifier "_left")
+        g!_right (code.local-identifier "_right")
+        g!options+ (list/map (function (_ option)
+                               (` (def: (~' #export) (~ (code.local-identifier option))
+                                    (~ g!type)
+                                    (|> (~ g!none)
+                                        (set@ (~ (code.local-tag option)) #1)))))
+                             options)]
+    (wrap (list& (` (type: (~' #export) (~ g!type)
+                      (~ (code.record (list/map (function (_ tag)
+                                                  [tag (` .Bit)])
+                                                g!tags+)))))
+
+                 (` (def: (~' #export) (~ g!none)
+                      (~ g!type)
+                      (~ (code.record (list/map (function (_ tag)
+                                                  [tag (` #0)])
+                                                g!tags+)))))
+
+                 (` (def: (~' #export) ((~ (code.local-identifier ++)) (~ g!_left) (~ g!_right))
+                      (-> (~ g!type) (~ g!type) (~ g!type))
+                      (~ (code.record (list/map (function (_ tag)
+                                                  [tag (` (or (get@ (~ tag) (~ g!_left))
+                                                              (get@ (~ tag) (~ g!_right))))])
+                                                g!tags+)))))
+
+                 g!options+))))
+
+(config: Class-Config  noneC ++C [finalC])
+(config: Method-Config noneM ++M [finalM staticM synchronizedM strictM])
+(config: Field-Config  noneF ++F [finalF staticF transientF volatileF])
+
+(def: #export new-label
+  (-> Any Label)
+  (function (_ _)
+    (org/objectweb/asm/Label::new)))
+
+(def: #export (simple-class name)
+  (-> Text (Type Class))
+  (type.class name (list)))
-- 
cgit v1.2.3