(.module:
  [lux #- function]
  (lux (control ["ex" exception #+ exception:])
       [io]
       (concurrency [atom #+ Atom atom])
       (data ["e" error]
             [text]
             text/format
             (coll [dict #+ Dict]))
       [host]
       (world [blob #+ Blob]
              [file #+ File]))
  (luxc (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/Class a))

(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: 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 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)))