From 1fabe19f7eacb668ef26cccde681dce5e2f98072 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 26 Oct 2017 14:48:05 -0400
Subject: - WIP: Wiring everything to get the compiler to work fully. - Fixed a
 bug when combining field/method/class modifiers.

---
 new-luxc/source/luxc/generator/statement.jvm.lux | 97 +++++++++++++++++++-----
 1 file changed, 78 insertions(+), 19 deletions(-)

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

diff --git a/new-luxc/source/luxc/generator/statement.jvm.lux b/new-luxc/source/luxc/generator/statement.jvm.lux
index ed66f3ecb..830935dda 100644
--- a/new-luxc/source/luxc/generator/statement.jvm.lux
+++ b/new-luxc/source/luxc/generator/statement.jvm.lux
@@ -1,25 +1,84 @@
 (;module:
   lux
-  (lux (control monad)
-       [io #- run]
-       (data [text "T/" Eq<Text>]
-             text/format)
-       [meta #+ Monad<Meta>])
+  (lux (control monad
+                ["ex" exception #+ exception:])
+       (concurrency ["T" task])
+       (data ["e" error]
+             [maybe]
+             [text "text/" Monoid<Text>]
+             text/format
+             (coll [list "list/" Functor<List> Fold<List>]))
+       [meta]
+       [host])
   (luxc ["&" base]
-        ["&;" module]
         ["&;" scope]
-        (compiler ["&;" expr])))
+        ["&;" module]
+        ["&;" io]
+        (generator ["&;" expr]
+                   ["&;" eval]
+                   ["&;" common]
+                   (host ["$" jvm]
+                         (jvm ["$t" type]
+                              ["$d" def]
+                              ["$i" inst])))))
+
+(exception: #export Invalid-Definition-Value)
+
+(host;import java.lang.Object
+  (toString [] String))
+
+(host;import java.lang.reflect.Field
+  (get [#? Object] #try #? Object))
+
+(host;import (java.lang.Class c)
+  (getField [String] #try Field))
+
+(def: #export (generate-def def-name valueT valueI metaI metaV)
+  (-> Text Type $;Inst $;Inst Code (Meta Unit))
+  (do meta;Monad<Meta>
+    [current-module meta;current-module-name
+     #let [def-ident [current-module def-name]
+           normal-name (&;normalize-name def-name)
+           bytecode-name (format current-module "/" normal-name)
+           class-name (format current-module "." normal-name)
+           bytecode ($d;class #$;V1.6
+                              #$;Public $;finalC
+                              bytecode-name
+                              (list) ["java.lang.Object" (list)]
+                              (list)
+                              (|>. ($d;field #$;Public ($;++F $;finalF $;staticF) &common;value-field &common;$Object)
+                                   ($d;method #$;Public $;staticM "<clinit>" ($t;method (list) #;None (list))
+                                              (|>. valueI
+                                                   ($i;PUTSTATIC bytecode-name &common;value-field &common;$Object)
+                                                   $i;RETURN))))]
+     _ (&common;store-class class-name bytecode)
+     class (&common;load-class class-name)
+     valueV (: (Meta Top)
+               (case (do e;Monad<Error>
+                       [field (Class.getField [&common;value-field] class)]
+                       (Field.get [#;None] field))
+                 (#e;Success #;None)
+                 (&;throw Invalid-Definition-Value (format current-module ";" def-name))
+                 
+                 (#e;Success (#;Some valueV))
+                 (wrap valueV)
+                 
+                 (#e;Error error)
+                 (&;fail error)))
+     _ (&module;define [current-module def-name] [valueT metaV valueV])
+     _ (if (meta;type? metaV)
+         (case (meta;declared-tags metaV)
+           #;Nil
+           (wrap [])
 
-(def: #export (compile-def def-name def-value def-meta)
-  (-> Text Code Code (Meta Unit))
-  (do Monad<Meta>
-    [=def-value (&expr;compile def-value)
-     =def-meta (&expr;compile def-meta)]
-    (undefined)))
+           tags
+           (&module;declare-tags tags (meta;export? metaV) (:! Type valueV)))
+         (wrap []))
+     #let [_ (log! (format "DEF " current-module ";" def-name))]]
+    (&common;record-artifact bytecode-name bytecode)))
 
-(def: #export (compile-program prog-args prog-body)
-  (-> Text Code (Meta Unit))
-  (do Monad<Meta>
-    [=prog-body (&scope;with-local [prog-args (type (List Text))]
-                  (&expr;compile prog-body))]
-    (undefined)))
+(def: #export (generate-program program-args programI)
+  (-> Text $;Inst (Meta Unit))
+  (do meta;Monad<Meta>
+    []
+    (&;fail "'lux program' is unimplemented.")))
-- 
cgit v1.2.3