aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator/statement.jvm.lux
diff options
context:
space:
mode:
authorEduardo Julian2017-11-01 00:51:45 -0400
committerEduardo Julian2017-11-01 00:51:45 -0400
commit012f6bd41e527479dddbccbdab10daa78fd9a0fd (patch)
tree621f344a09acd52736f343d94582b3f1a2f0c5f9 /new-luxc/source/luxc/generator/statement.jvm.lux
parent71d7a4c7206155e09f3e1e1d8699561ea6967382 (diff)
- Re-organized code-generation, and re-named it "translation".
Diffstat (limited to 'new-luxc/source/luxc/generator/statement.jvm.lux')
-rw-r--r--new-luxc/source/luxc/generator/statement.jvm.lux82
1 files changed, 0 insertions, 82 deletions
diff --git a/new-luxc/source/luxc/generator/statement.jvm.lux b/new-luxc/source/luxc/generator/statement.jvm.lux
deleted file mode 100644
index e91e99fc9..000000000
--- a/new-luxc/source/luxc/generator/statement.jvm.lux
+++ /dev/null
@@ -1,82 +0,0 @@
-(;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]))
- (generator ["&;" eval]
- ["&;" 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) &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 [])
-
- 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 (generate-program program-args programI)
- (-> Text $;Inst (Meta Unit))
- (do meta;Monad<Meta>
- []
- (&;fail "'lux program' is unimplemented.")))