From 4433c9bcd6c6cac44c018aad2e21a5b4d7cc4896 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 29 Nov 2017 22:49:56 -0400 Subject: - Adapted main codebase to the latest syntatic changes. --- new-luxc/source/luxc/lang/host.jvm.lux | 176 ++++++++++++++++----------------- 1 file changed, 88 insertions(+), 88 deletions(-) (limited to 'new-luxc/source/luxc/lang/host.jvm.lux') 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)))] - {#commonT;loader (memory-class-loader store) - #commonT;store store - #commonT;artifacts (dict;new text;Hash) - #commonT;context ["" +0] - #commonT;anchor #;None}))) + (io.IO commonT.Host) + (io.io (let [store (: commonT.Class-Store + (atom (dict.new text.Hash)))] + {#commonT.loader (memory-class-loader store) + #commonT.store store + #commonT.artifacts (dict.new text.Hash) + #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") -- cgit v1.2.3