From a79927892174c3564c83a0e741e5cc0aaaeeb37c Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 30 Jun 2017 18:43:07 -0400
Subject: - WIP: Added generation for common procedures.

---
 new-luxc/source/luxc/generator/host/jvm.lux | 85 +++++++++++++++++++++++++----
 1 file changed, 75 insertions(+), 10 deletions(-)

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

diff --git a/new-luxc/source/luxc/generator/host/jvm.lux b/new-luxc/source/luxc/generator/host/jvm.lux
index f1eb61166..d67b6ef91 100644
--- a/new-luxc/source/luxc/generator/host/jvm.lux
+++ b/new-luxc/source/luxc/generator/host/jvm.lux
@@ -1,12 +1,21 @@
 (;module:
   [lux #- Type Def]
-  (lux [host #+ jvm-import]))
+  (lux (control monad
+                ["p" parser])
+       (data (coll [list "L/" Functor<List>]))
+       [macro]
+       (macro [code]
+              ["s" syntax #+ syntax:])
+       [host #+ jvm-import]))
 
 ## [Host]
 (jvm-import org.objectweb.asm.MethodVisitor)
 
 (jvm-import org.objectweb.asm.ClassWriter)
 
+(jvm-import #long org.objectweb.asm.Label
+  (new []))
+
 ## [Type]
 (type: #export Bound
   #Upper
@@ -27,6 +36,12 @@
   (#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)
@@ -43,19 +58,69 @@
 (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 Method-Config
-  {#staticM Bool
-   #finalM Bool
-   #synchronizedM Bool})
+(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+ (L/map code;local-tag options)
+        g!_left (code;local-symbol "_left")
+        g!_right (code;local-symbol "_right")
+        g!options+ (L/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 (L/map (function [tag]
+                                               [tag (` ;Bool)])
+                                             g!tags+)))))
+
+                 (` (def: (~' #export) (~ g!none)
+                      (~ g!type)
+                      (~ (code;record (L/map (function [tag]
+                                               [tag (` false)])
+                                             g!tags+)))))
+
+                 (` (def: (~' #export) ((~ (code;local-symbol ++)) (~ g!_left) (~ g!_right))
+                      (-> (~ g!type) (~ g!type) (~ g!type))
+                      (~ (code;record (L/map (function [tag]
+                                               [tag (` (and (get@ (~ tag) (~ g!_left))
+                                                            (get@ (~ tag) (~ g!_right))))])
+                                             g!tags+)))))
+
+                 g!options+))))
+
+## Configs
+(config: Class-Config  noneC ++C [finalC])
+(config: Method-Config noneM ++M [staticM finalM synchronizedM])
+(config: Field-Config  noneF ++F [staticF finalF transientF volatileF])
 
-(type: #export Field-Config
-  {#staticF Bool
-   #finalF Bool
-   #transientF Bool
-   #volatileF Bool})
+## Labels
+(def: #export new-label
+  (-> Unit Label)
+  org.objectweb.asm.Label.new)
-- 
cgit v1.2.3