- Heavy refactoring.

1 files changed, 0 insertions, 185 deletions

diff --git a/new-luxc/source/luxc/host.jvm.lux b/new-luxc/source/luxc/host.jvm.lux
deleted file mode 100644
index e8dc4e17a..000000000
--- a/new-luxc/source/luxc/host.jvm.lux
+++ /dev/null
@@ -1,185 +0,0 @@
-(;module:
-  lux
-  (lux (control [monad #+ do]
-                ["ex" exception #+ exception:]
-                pipe)
-       (concurrency ["A" atom])
-       (data ["e" error]
-             [text]
-             text/format
-             (coll [dict]
-                   [array]))
-       [meta #+ Monad<Meta>]
-       [host #+ do-to object]
-       [io])
-  (luxc ["&" base]
-        (lang [";L" variable #+ Register]
-              (translation [";T" common]))))
-
-(host;import org.objectweb.asm.Label)
-
-(host;import java.lang.reflect.AccessibleObject
-  (setAccessible [boolean] void))
-
-(host;import java.lang.reflect.Method
-  (invoke [Object (Array Object)] #try Object))
-
-(host;import (java.lang.Class a)
-  (getDeclaredMethod [String (Array (Class Object))] #try Method))
-
-(host;import java.lang.Object
-  (getClass [] (Class Object)))
-
-(host;import java.lang.Integer
-  (#static TYPE (Class Integer)))
-
-(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)
-    (do-to method
-      (AccessibleObject.setAccessible [true]))
-
-    (#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))
-
-(def: (fetch-byte-code class-name store)
-  (-> Text commonT;Class-Store (Maybe commonT;Bytecode))
-  (|> store A;get io;run (dict;get class-name)))
-
-(def: (memory-class-loader store)
-  (-> commonT;Class-Store ClassLoader)
-  (object ClassLoader []
-    []
-    (ClassLoader (findClass [class-name String]) Class
-                 (case (fetch-byte-code class-name store)
-                   (#;Some bytecode)
-                   (case (define-class class-name bytecode (:! ClassLoader _jvm_this))
-                     (#e;Success class)
-                     (:!! class)
-
-                     (#e;Error error)
-                     (error! (format "Class definition error: " class-name "\n"
-                                     error)))
-
-                   #;None
-                   (error! (format "Class not found: " class-name))))))
-
-(def: #export init-host
-  (io;IO commonT;Host)
-  (io;io (let [store (: commonT;Class-Store
-                        (A;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))
-                        compiler))
-        (#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)))))
-
-(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
-                   anchor])
-
-      #;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))
-                        compiler))
-        (#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)))))
-
-(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)
-          new-name (format old-name "$" (%i (nat-to-int old-sub)))]
-      (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)])
-                                   (:! Void))
-                              compiler')
-                     [new-name output]])
-
-        (#e;Error error)
-        (#e;Error error)))))
-
-(def: #export context
-  (Meta Text)
-  (;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
-                 (|> compiler
-                     (get@ #;host)
-                     (:! commonT;Host)
-                     (get@ #commonT;loader))])))
-
-(def: #export runtime-class Text "LuxRuntime")
-(def: #export function-class Text "LuxFunction")
-(def: #export unit Text "\u0000")