(;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
   #artifacts Artifacts
   #context [Text Nat]})

(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 bytecode-version Int Opcodes.V1_6)

(def: #export value-field Text "_value")
(def: #export $Object $;Type ($t;class "java.lang.Object" (list)))