From 012f6bd41e527479dddbccbdab10daa78fd9a0fd Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 1 Nov 2017 00:51:45 -0400
Subject: - Re-organized code-generation, and re-named it "translation".

---
 .../source/luxc/lang/translation/statement.jvm.lux | 82 ++++++++++++++++++++++
 1 file changed, 82 insertions(+)
 create mode 100644 new-luxc/source/luxc/lang/translation/statement.jvm.lux

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

diff --git a/new-luxc/source/luxc/lang/translation/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/statement.jvm.lux
new file mode 100644
index 000000000..0234d738c
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/statement.jvm.lux
@@ -0,0 +1,82 @@
+(;module:
+  lux
+  (lux (control monad
+                ["ex" exception #+ exception:])
+       (data ["e" error]
+             [maybe]
+             [text "text/" Monoid<Text>]
+             text/format
+             (coll [list "list/" Functor<List> Fold<List>]))
+       [meta]
+       [host])
+  (luxc ["&" base]
+        ["&;" scope]
+        ["&;" module]
+        ["&;" io]
+        (host ["$" jvm]
+              (jvm ["$t" type]
+                   ["$d" def]
+                   ["$i" inst]))
+        (lang (translation [";T" eval]
+                           [";T" common]))))
+
+(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) commonT;value-field commonT;$Object)
+                                   ($d;method #$;Public $;staticM "<clinit>" ($t;method (list) #;None (list))
+                                              (|>. valueI
+                                                   ($i;PUTSTATIC bytecode-name commonT;value-field commonT;$Object)
+                                                   $i;RETURN))))]
+     _ (commonT;store-class class-name bytecode)
+     class (commonT;load-class class-name)
+     valueV (: (Meta Top)
+               (case (do e;Monad<Error>
+                       [field (Class.getField [commonT;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 [])
+
+           tags
+           (&module;declare-tags tags (meta;export? metaV) (:! Type valueV)))
+         (wrap []))
+     #let [_ (log! (format "DEF " current-module ";" def-name))]]
+    (commonT;record-artifact bytecode-name bytecode)))
+
+(def: #export (generate-program program-args programI)
+  (-> Text $;Inst (Meta Unit))
+  (do meta;Monad<Meta>
+    []
+    (&;fail "'lux program' is unimplemented.")))
-- 
cgit v1.2.3