diff options
Diffstat (limited to 'new-luxc/source/luxc/generator/common.jvm.lux')
-rw-r--r-- | new-luxc/source/luxc/generator/common.jvm.lux | 131 |
1 files changed, 0 insertions, 131 deletions
diff --git a/new-luxc/source/luxc/generator/common.jvm.lux b/new-luxc/source/luxc/generator/common.jvm.lux deleted file mode 100644 index 1870530c2..000000000 --- a/new-luxc/source/luxc/generator/common.jvm.lux +++ /dev/null @@ -1,131 +0,0 @@ -(;module: - [lux #- function] - (lux (control ["ex" exception #+ exception:]) - [io] - (concurrency ["A" atom]) - (data ["e" error] - [text] - text/format - (coll [dict #+ Dict])) - [host] - (world [blob #+ Blob])) - (luxc (host ["$" jvm] - (jvm ["$t" type] - ["$d" def] - ["$i" inst])))) - -(host;import org.objectweb.asm.Opcodes - (#static V1_6 int)) - -(host;import java.lang.Object) - -(host;import (java.lang.Class a)) - -(host;import java.lang.ClassLoader - (loadClass [String] (Class Object))) - -(type: #export Bytecode (host;type (Array byte))) - -(type: #export Class-Store (A;Atom (Dict Text Bytecode))) - -(type: #export Artifacts (Dict Text Blob)) - -(type: #export Host - {#loader ClassLoader - #store Class-Store - #function-class (Maybe Text) - #artifacts Artifacts}) - -(exception: Unknown-Class) -(exception: Class-Already-Stored) -(exception: No-Function-Being-Compiled) -(exception: Cannot-Overwrite-Artifact) - -(def: #export (with-artifacts action) - (All [a] (-> (Meta a) (Meta [Artifacts a]))) - (;function [compiler] - (case (action (update@ #;host - (|>. (:! Host) - (set@ #artifacts (dict;new text;Hash<Text>)) - (:! Void)) - compiler)) - (#e;Success [compiler' output]) - (#e;Success [(update@ #;host - (|>. (:! Host) - (set@ #artifacts (|> (get@ #;host compiler) (:! Host) (get@ #artifacts))) - (:! Void)) - compiler') - [(|> compiler' (get@ #;host) (:! Host) (get@ #artifacts)) - output]]) - - (#e;Error error) - (#e;Error error)))) - -(def: #export (record-artifact name content) - (-> Text Blob (Meta Unit)) - (;function [compiler] - (if (|> compiler (get@ #;host) (:! Host) (get@ #artifacts) (dict;contains? name)) - (ex;throw Cannot-Overwrite-Artifact name) - (#e;Success [(update@ #;host - (|>. (:! Host) - (update@ #artifacts (dict;put name content)) - (:! Void)) - compiler) - []])))) - -(def: #export (store-class name byte-code) - (-> Text Bytecode (Meta Unit)) - (;function [compiler] - (let [store (|> (get@ #;host compiler) - (:! Host) - (get@ #store))] - (if (dict;contains? name (|> store A;get io;run)) - (ex;throw Class-Already-Stored name) - (#e;Success [compiler (io;run (A;update (dict;put name byte-code) store))]) - )))) - -(def: #export (load-class name) - (-> Text (Meta (Class Object))) - (;function [compiler] - (let [host (:! Host (get@ #;host compiler)) - store (|> host (get@ #store) A;get io;run)] - (if (dict;contains? name store) - (#e;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))]) - (ex;throw Unknown-Class name))))) - -(def: #export (with-function class expr) - (All [a] (-> Text (Meta a) (Meta a))) - (;function [compiler] - (let [host (:! Host (get@ #;host compiler)) - old-function-class (get@ #function-class host)] - (case (expr (set@ #;host - (:! Void (set@ #function-class - (#;Some class) - host)) - compiler)) - (#e;Success [compiler' output]) - (#e;Success [(update@ #;host - (|>. (:! Host) - (set@ #function-class old-function-class) - (:! Void)) - compiler') - output]) - - (#e;Error error) - (#e;Error error))))) - -(def: #export function - (Meta Text) - (;function [compiler] - (let [host (:! Host (get@ #;host compiler))] - (case (get@ #function-class host) - #;None - (ex;throw No-Function-Being-Compiled "") - - (#;Some function-class) - (#e;Success [compiler function-class]))))) - -(def: #export bytecode-version Int Opcodes.V1_6) - -(def: #export value-field Text "_value") -(def: #export $Object $;Type ($t;class "java.lang.Object" (list))) |