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.lux | 130 +++++++++++++++++++++++++++++++++
 1 file changed, 130 insertions(+)
 create mode 100644 new-luxc/source/luxc/lang/host/jvm.lux

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

diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux
new file mode 100644
index 000000000..24d4a9ea9
--- /dev/null
+++ b/new-luxc/source/luxc/lang/host/jvm.lux
@@ -0,0 +1,130 @@
+(;module:
+  [lux #- Type Def]
+  (lux (control monad
+                ["p" parser])
+       (data (coll [list "list/" Functor<List>]))
+       [meta]
+       (meta [code]
+             ["s" syntax #+ syntax:])
+       [host]))
+
+## [Host]
+(host;import org.objectweb.asm.MethodVisitor)
+
+(host;import org.objectweb.asm.ClassWriter)
+
+(host;import #long org.objectweb.asm.Label
+  (new []))
+
+## [Type]
+(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)})
+
+(type: #export Def
+  (-> ClassWriter ClassWriter))
+
+(type: #export Inst
+  (-> MethodVisitor MethodVisitor))
+
+(type: #export Label
+  org.objectweb.asm.Label)
+
+(type: #export Register Nat)
+
+(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)
+
+## [Values]
+(syntax: (config: [type s;local-symbol]
+           [none s;local-symbol]
+           [++ s;local-symbol]
+           [options (s;tuple (p;many s;local-symbol))])
+  (let [g!type (code;local-symbol type)
+        g!none (code;local-symbol none)
+        g!tags+ (list/map code;local-tag options)
+        g!_left (code;local-symbol "_left")
+        g!_right (code;local-symbol "_right")
+        g!options+ (list/map (function [option]
+                               (` (def: (~' #export) (~ (code;local-symbol option))
+                                    (~ g!type)
+                                    (|> (~ g!none)
+                                        (set@ (~ (code;local-tag option)) true)))))
+                             options)]
+    (wrap (list& (` (type: (~' #export) (~ g!type)
+                      (~ (code;record (list/map (function [tag]
+                                                  [tag (` ;Bool)])
+                                                g!tags+)))))
+
+                 (` (def: (~' #export) (~ g!none)
+                      (~ g!type)
+                      (~ (code;record (list/map (function [tag]
+                                                  [tag (` false)])
+                                                g!tags+)))))
+
+                 (` (def: (~' #export) ((~ (code;local-symbol ++)) (~ 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+))))
+
+## Configs
+(config: Class-Config  noneC ++C [finalC])
+(config: Method-Config noneM ++M [finalM staticM synchronizedM strictM])
+(config: Field-Config  noneF ++F [finalF staticF transientF volatileF])
+
+## Labels
+(def: #export new-label
+  (-> Unit Label)
+  org.objectweb.asm.Label.new)
+
+(def: #export (simple-class name)
+  (-> Text Class)
+  [name (list)])
-- 
cgit v1.2.3