aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/host.jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/host.jvm.lux')
-rw-r--r--new-luxc/source/luxc/lang/host.jvm.lux176
1 files changed, 88 insertions, 88 deletions
diff --git a/new-luxc/source/luxc/lang/host.jvm.lux b/new-luxc/source/luxc/lang/host.jvm.lux
index 9f8fcd069..c980eab9d 100644
--- a/new-luxc/source/luxc/lang/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/host.jvm.lux
@@ -1,4 +1,4 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:]
@@ -13,172 +13,172 @@
[host #+ do-to object]
[io])
(luxc ["&" lang]
- (lang [";L" variable #+ Register]
- (translation [";T" common]))))
+ (lang [".L" variable #+ Register]
+ (translation [".T" common]))))
-(host;import org.objectweb.asm.Label)
+(host.import org/objectweb/asm/Label)
-(host;import java.lang.reflect.AccessibleObject
+(host.import java/lang/reflect/AccessibleObject
(setAccessible [boolean] void))
-(host;import java.lang.reflect.Method
+(host.import java/lang/reflect/Method
(invoke [Object (Array Object)] #try Object))
-(host;import (java.lang.Class a)
+(host.import (java/lang/Class a)
(getDeclaredMethod [String (Array (Class Object))] #try Method))
-(host;import java.lang.Object
+(host.import java/lang/Object
(getClass [] (Class Object)))
-(host;import java.lang.Integer
+(host.import java/lang/Integer
(#static TYPE (Class Integer)))
-(host;import java.lang.ClassLoader)
+(host.import java/lang/ClassLoader)
(def: ClassLoader::defineClass
Method
- (case (Class.getDeclaredMethod ["defineClass"
- (|> (host;array (Class Object) +4)
- (host;array-write +0 (:! (Class Object) (host;class-for String)))
- (host;array-write +1 (Object.getClass [] (host;array byte +0)))
- (host;array-write +2 (:! (Class Object) Integer.TYPE))
- (host;array-write +3 (:! (Class Object) Integer.TYPE)))]
- (host;class-for java.lang.ClassLoader))
- (#e;Success method)
+ (case (Class::getDeclaredMethod ["defineClass"
+ (|> (host.array (Class Object) +4)
+ (host.array-write +0 (:! (Class Object) (host.class-for String)))
+ (host.array-write +1 (Object::getClass [] (host.array byte +0)))
+ (host.array-write +2 (:! (Class Object) Integer::TYPE))
+ (host.array-write +3 (:! (Class Object) Integer::TYPE)))]
+ (host.class-for java/lang/ClassLoader))
+ (#e.Success method)
(do-to method
- (AccessibleObject.setAccessible [true]))
+ (AccessibleObject::setAccessible [true]))
- (#e;Error error)
+ (#e.Error error)
(error! error)))
(def: (define-class class-name byte-code loader)
- (-> Text commonT;Bytecode ClassLoader (e;Error Object))
- (Method.invoke [loader
- (array;from-list (list (:! Object class-name)
- (:! Object byte-code)
- (:! Object (host;l2i 0))
- (:! Object (host;l2i (nat-to-int (host;array-length byte-code))))))]
- ClassLoader::defineClass))
+ (-> Text commonT.Bytecode ClassLoader (e.Error Object))
+ (Method::invoke [loader
+ (array.from-list (list (:! Object class-name)
+ (:! Object byte-code)
+ (:! Object (host.l2i 0))
+ (:! Object (host.l2i (nat-to-int (host.array-length byte-code))))))]
+ ClassLoader::defineClass))
(def: (fetch-byte-code class-name store)
- (-> Text commonT;Class-Store (Maybe commonT;Bytecode))
- (|> store atom;read io;run (dict;get class-name)))
+ (-> Text commonT.Class-Store (Maybe commonT.Bytecode))
+ (|> store atom.read io.run (dict.get class-name)))
(def: (memory-class-loader store)
- (-> commonT;Class-Store ClassLoader)
+ (-> commonT.Class-Store ClassLoader)
(object [] ClassLoader []
[]
(ClassLoader (findClass [class-name String]) Class
(case (fetch-byte-code class-name store)
- (#;Some bytecode)
+ (#.Some bytecode)
(case (define-class class-name bytecode (:! ClassLoader _jvm_this))
- (#e;Success class)
+ (#e.Success class)
(:!! class)
- (#e;Error error)
+ (#e.Error error)
(error! (format "Class definition error: " class-name "\n"
error)))
- #;None
+ #.None
(error! (format "Class not found: " class-name))))))
(def: #export init-host
- (io;IO commonT;Host)
- (io;io (let [store (: commonT;Class-Store
- (atom (dict;new text;Hash<Text>)))]
- {#commonT;loader (memory-class-loader store)
- #commonT;store store
- #commonT;artifacts (dict;new text;Hash<Text>)
- #commonT;context ["" +0]
- #commonT;anchor #;None})))
+ (io.IO commonT.Host)
+ (io.io (let [store (: commonT.Class-Store
+ (atom (dict.new text.Hash<Text>)))]
+ {#commonT.loader (memory-class-loader store)
+ #commonT.store store
+ #commonT.artifacts (dict.new text.Hash<Text>)
+ #commonT.context ["" +0]
+ #commonT.anchor #.None})))
(def: #export (with-anchor anchor expr)
(All [a] (-> [Label Register] (Meta a) (Meta a)))
- (;function [compiler]
- (let [old (:! commonT;Host (get@ #;host compiler))]
- (case (expr (set@ #;host
- (:! Void (set@ #commonT;anchor (#;Some anchor) old))
+ (.function [compiler]
+ (let [old (:! commonT.Host (get@ #.host compiler))]
+ (case (expr (set@ #.host
+ (:! Void (set@ #commonT.anchor (#.Some anchor) old))
compiler))
- (#e;Success [compiler' output])
- (#e;Success [(update@ #;host
- (|>. (:! commonT;Host)
- (set@ #commonT;anchor (get@ #commonT;anchor old))
+ (#e.Success [compiler' output])
+ (#e.Success [(update@ #.host
+ (|>> (:! commonT.Host)
+ (set@ #commonT.anchor (get@ #commonT.anchor old))
(:! Void))
compiler')
output])
- (#e;Error error)
- (#e;Error error)))))
+ (#e.Error error)
+ (#e.Error error)))))
(exception: #export No-Anchor)
(def: #export anchor
(Meta [Label Register])
- (;function [compiler]
- (case (|> compiler (get@ #;host) (:! commonT;Host) (get@ #commonT;anchor))
- (#;Some anchor)
- (#e;Success [compiler
+ (.function [compiler]
+ (case (|> compiler (get@ #.host) (:! commonT.Host) (get@ #commonT.anchor))
+ (#.Some anchor)
+ (#e.Success [compiler
anchor])
- #;None
- ((&;throw No-Anchor "") compiler))))
+ #.None
+ ((&.throw No-Anchor "") compiler))))
(def: #export (with-context name expr)
(All [a] (-> Text (Meta a) (Meta a)))
- (;function [compiler]
- (let [old (:! commonT;Host (get@ #;host compiler))]
- (case (expr (set@ #;host
- (:! Void (set@ #commonT;context [(&;normalize-name name) +0] old))
+ (.function [compiler]
+ (let [old (:! commonT.Host (get@ #.host compiler))]
+ (case (expr (set@ #.host
+ (:! Void (set@ #commonT.context [(&.normalize-name name) +0] old))
compiler))
- (#e;Success [compiler' output])
- (#e;Success [(update@ #;host
- (|>. (:! commonT;Host)
- (set@ #commonT;context (get@ #commonT;context old))
+ (#e.Success [compiler' output])
+ (#e.Success [(update@ #.host
+ (|>> (:! commonT.Host)
+ (set@ #commonT.context (get@ #commonT.context old))
(:! Void))
compiler')
output])
- (#e;Error error)
- (#e;Error error)))))
+ (#e.Error error)
+ (#e.Error error)))))
(def: #export (with-sub-context expr)
(All [a] (-> (Meta a) (Meta [Text a])))
- (;function [compiler]
- (let [old (:! commonT;Host (get@ #;host compiler))
- [old-name old-sub] (get@ #commonT;context old)
+ (.function [compiler]
+ (let [old (:! commonT.Host (get@ #.host compiler))
+ [old-name old-sub] (get@ #commonT.context old)
new-name (format old-name "$" (%i (nat-to-int old-sub)))]
- (case (expr (set@ #;host
- (:! Void (set@ #commonT;context [new-name +0] old))
+ (case (expr (set@ #.host
+ (:! Void (set@ #commonT.context [new-name +0] old))
compiler))
- (#e;Success [compiler' output])
- (#e;Success [(update@ #;host
- (|>. (:! commonT;Host)
- (set@ #commonT;context [old-name (n.inc old-sub)])
+ (#e.Success [compiler' output])
+ (#e.Success [(update@ #.host
+ (|>> (:! commonT.Host)
+ (set@ #commonT.context [old-name (n/inc old-sub)])
(:! Void))
compiler')
[new-name output]])
- (#e;Error error)
- (#e;Error error)))))
+ (#e.Error error)
+ (#e.Error error)))))
(def: #export context
(Meta Text)
- (;function [compiler]
- (#e;Success [compiler
- (|> (get@ #;host compiler)
- (:! commonT;Host)
- (get@ #commonT;context)
+ (.function [compiler]
+ (#e.Success [compiler
+ (|> (get@ #.host compiler)
+ (:! commonT.Host)
+ (get@ #commonT.context)
(let> [name sub]
name))])))
(def: #export class-loader
(Meta ClassLoader)
(function [compiler]
- (#e;Success [compiler
+ (#e.Success [compiler
(|> compiler
- (get@ #;host)
- (:! commonT;Host)
- (get@ #commonT;loader))])))
+ (get@ #.host)
+ (:! commonT.Host)
+ (get@ #commonT.loader))])))
(def: #export runtime-class Text "LuxRuntime")
(def: #export function-class Text "LuxFunction")
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-24 05:16:11 +0000