aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/common.jvm.lux
diff options
context:
space:
mode:
authorEduardo Julian2018-01-08 21:40:06 -0400
committerEduardo Julian2018-01-08 21:40:06 -0400
commit9eaaaf953ba7ce1eeb805603f4e113aa15f5178f (patch)
treeef134eecc8a5767a997fce0637cd64e0ebcee6b1 /new-luxc/source/luxc/lang/translation/common.jvm.lux
parentf523bc14d43286348aeb200bd0554812dc6ef28d (diff)
- Moved all translation code under the JVM path (in preparation for porting the JS back-end).
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/common.jvm.lux')
-rw-r--r--new-luxc/source/luxc/lang/translation/common.jvm.lux136
1 files changed, 0 insertions, 136 deletions
diff --git a/new-luxc/source/luxc/lang/translation/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common.jvm.lux
deleted file mode 100644
index a4eb5b93b..000000000
--- a/new-luxc/source/luxc/lang/translation/common.jvm.lux
+++ /dev/null
@@ -1,136 +0,0 @@
-(.module:
- lux
- (lux (control [monad #+ do]
- ["ex" exception #+ exception:])
- [io]
- (concurrency [atom #+ Atom atom])
- (data ["e" error #+ Error]
- [text "text/" Hash<Text>]
- text/format
- (coll [dict #+ Dict]))
- [macro]
- [host]
- (world [blob #+ Blob]
- [file #+ File]))
- (luxc [lang]
- (lang [".L" variable #+ Register]
- (host ["$" jvm]
- (jvm ["$t" type]
- ["$d" def]
- ["$i" inst])))))
-
-(host.import org/objectweb/asm/Opcodes
- (#static V1_6 int))
-
-(host.import org/objectweb/asm/Label)
-
-(host.import java/lang/Object)
-
-(host.import java/lang/reflect/Field
- (get [#? Object] #try #? Object))
-
-(host.import (java/lang/Class c)
- (getField [String] #try Field))
-
-(host.import java/lang/ClassLoader
- (loadClass [String] (Class Object)))
-
-(type: #export Bytecode Blob)
-
-(type: #export Class-Store (Atom (Dict Text Bytecode)))
-
-(type: #export Artifacts (Dict File Blob))
-
-(type: #export Host
- {#loader ClassLoader
- #store Class-Store
- #artifacts Artifacts
- #context [Text Nat]
- #anchor (Maybe [Label Register])})
-
-(exception: #export Unknown-Class)
-(exception: #export Class-Already-Stored)
-(exception: #export No-Function-Being-Compiled)
-(exception: #export Cannot-Overwrite-Artifact)
-(exception: #export Cannot-Load-Definition)
-(exception: #export Invalid-Definition-Value)
-
-(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 atom.read io.run))
- (ex.throw Class-Already-Stored name)
- (#e.Success [compiler (io.run (atom.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) atom.read io.run)]
- (if (dict.contains? name store)
- (#e.Success [compiler (ClassLoader::loadClass [name] (get@ #loader host))])
- (ex.throw Unknown-Class name)))))
-
-(def: #export value-field Text "_value")
-(def: #export $Object $.Type ($t.class "java.lang.Object" (list)))
-
-(def: #export (load-definition compiler)
- (-> Compiler
- (-> Ident Blob (Error Top)))
- (function [(^@ def-ident [def-module def-name]) def-bytecode]
- (let [normal-name (format (lang.normalize-name def-name) (%n (text/hash def-name)))
- class-name (format (text.replace-all "/" "." def-module) "." normal-name)]
- (<| (macro.run compiler)
- (do macro.Monad<Meta>
- [_ (..store-class class-name def-bytecode)
- class (..load-class class-name)]
- (case (do e.Monad<Error>
- [field (Class::getField [..value-field] class)]
- (Field::get [#.None] field))
- (#e.Success (#.Some def-value))
- (wrap def-value)
-
- (#e.Success #.None)
- (lang.throw Invalid-Definition-Value (%ident def-ident))
-
- (#e.Error error)
- (lang.throw Cannot-Load-Definition
- (format "Definition: " (%ident def-ident) "\n"
- "Error:\n"
- error))))))))