(.module:
  [lux (#- Definition)
   [control
    [monad (#+ do)]
    ["ex" exception (#+ exception:)]
    pipe]
   [concurrency
    ["." atom (#+ Atom atom)]]
   [data
    ["." error (#+ Error)]
    ["." text ("text/." Hash<Text>)
     format]
    [collection
     ["." array]
     [list ("list/." Functor<List>)]
     ["." dictionary (#+ Dictionary)]]]
   ["." host (#+ import: do-to object)]
   ["." io (#+ IO io)]
   [world
    [binary (#+ Binary)]]
   [compiler
    [default
     ["." name]
     [phase
      ["." translation]]]]]
  [///
   [host
    ["." jvm (#+ Inst Definition Host State)
     ["." type]
     ["." def]
     ["." inst]]]]
  )

(import: org/objectweb/asm/Label)

(import: java/lang/reflect/AccessibleObject
  (setAccessible [boolean] void))

(import: java/lang/reflect/Field
  (get [#? Object] #try #? Object))

(import: java/lang/reflect/Method
  (invoke [Object (Array Object)] #try Object))

(import: (java/lang/Class a)
  (getField [String] #try Field)
  (getDeclaredMethod [String (Array (Class Object))] #try Method))

(import: java/lang/Object
  (getClass [] (Class Object)))

(import: java/lang/Integer
  (#static TYPE (Class Integer)))

(import: java/lang/ClassLoader
  (loadClass [String] #try (Class Object)))

(def: ClassLoader::defineClass
  Method
  (case (Class::getDeclaredMethod ["defineClass"
                                   (|> (host.array (Class Object) 4)
                                       (host.array-write 0 (:coerce (Class Object) (host.class-for String)))
                                       (host.array-write 1 (Object::getClass [] (host.array byte 0)))
                                       (host.array-write 2 (:coerce (Class Object) Integer::TYPE))
                                       (host.array-write 3 (:coerce (Class Object) Integer::TYPE)))]
                                  (host.class-for java/lang/ClassLoader))
    (#error.Success method)
    (do-to method
      (AccessibleObject::setAccessible [#1]))

    (#error.Error error)
    (error! error)))

(type: #export ByteCode Binary)

(def: (define-class class-name bytecode loader)
  (-> Text ByteCode ClassLoader (Error Object))
  (Method::invoke [loader
                   (array.from-list (list (:coerce Object class-name)
                                          (:coerce Object bytecode)
                                          (:coerce Object (host.long-to-int +0))
                                          (:coerce Object (host.long-to-int (.int (host.array-length bytecode))))))]
                  ClassLoader::defineClass))

(type: Store (Atom (Dictionary Text ByteCode)))

(exception: #export (class-already-stored {class Text})
  (ex.report ["Class" class]))

(exception: #export (unknown-class {class Text} {known-classes (List Text)})
  (ex.report ["Class" class]
             ["Known Classes" (|> known-classes
                                  (list/map (|>> (format "\n\t")))
                                  (text.join-with ""))]))

(exception: #export (cannot-define-class {class Text} {error Text})
  (ex.report ["Class" class]
             ["Error" error]))

(def: (memory-class-loader store)
  (-> Store ClassLoader)
  (object [] ClassLoader []
    []
    (ClassLoader (findClass {class-name String}) Class
                 (let [classes (|> store atom.read io.run)]
                   (case (dictionary.get class-name classes)
                     (#.Some bytecode)
                     (case (define-class class-name bytecode (:coerce ClassLoader _jvm_this))
                       (#error.Success class)
                       (:assume class)

                       (#error.Error error)
                       (error! (ex.construct cannot-define-class [class-name error])))

                     #.None
                     (error! (ex.construct unknown-class [class-name (dictionary.keys classes)])))))))

(def: (store! name bytecode store)
  (-> Text ByteCode Store (Error Any))
  (if (dictionary.contains? name (|> store atom.read io.run))
    (ex.throw class-already-stored name)
    (exec (io.run (atom.update (dictionary.put name bytecode) store))
      (#error.Success []))))

(def: (load! name loader)
  (-> Text ClassLoader (Error (Class Object)))
  (ClassLoader::loadClass [name] loader))

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

(exception: #export (cannot-load {class Text} {error Text})
  (ex.report ["Class" class]
             ["Error" error]))

(exception: #export (invalid-field {class Text} {field Text})
  (ex.report ["Class" class]
             ["Field" field]))

(exception: #export (invalid-value {class Text})
  (ex.report ["Class" class]))

(def: (class-value class-name class)
  (-> Text (Class Object) (Error Any))
  (case (Class::getField [..value-field] class)
    (#error.Success field)
    (case (Field::get [#.None] field)
      (#error.Success ?value)
      (case ?value
        (#.Some value)
        (#error.Success value)
        
        #.None
        (ex.throw invalid-value class-name))
      
      (#error.Error error)
      (ex.throw cannot-load [class-name error]))
    
    (#error.Error error)
    (ex.throw invalid-field [class-name ..value-field])))

(def: module-separator "/")
(def: class-path-separator ".")

(def: (evaluate! store loader eval-class valueI)
  (-> Store ClassLoader Text Inst (Error Any))
  (do error.Monad<Error>
    [#let [bytecode-name (text.replace-all class-path-separator module-separator eval-class)
           bytecode (def.class #jvm.V1_6
                               #jvm.Public jvm.noneC
                               bytecode-name
                               (list) ["java.lang.Object" (list)]
                               (list)
                               (|>> (def.field #jvm.Public ($_ jvm.++F jvm.finalF jvm.staticF)
                                               ..value-field ..$Object)
                                    (def.method #jvm.Public ($_ jvm.++M jvm.staticM jvm.strictM)
                                                "<clinit>"
                                                (type.method (list) #.None (list))
                                                (|>> valueI
                                                     (inst.PUTSTATIC bytecode-name ..value-field ..$Object)
                                                     inst.RETURN))))]
     _ (..store! eval-class bytecode store)
     class (..load! eval-class loader)]
    (class-value eval-class class)))

(def: (execute! store loader temp-label [class-name class-bytecode])
  (-> Store ClassLoader Text Definition (Error Any))
  (do error.Monad<Error>
    [_ (..store! class-name class-bytecode store)]
    (..load! class-name loader)))

(def: (define! store loader [module name] valueI)
  (-> Store ClassLoader Name Inst (Error [Text Any]))
  (let [class-name (format (text.replace-all module-separator class-path-separator module)
                           class-path-separator (name.normalize name)
                           "___" (%n (text/hash name)))]
    (do error.Monad<Error>
      [value (evaluate! store loader class-name valueI)]
      (wrap [class-name value]))))

(def: #export init
  (IO Host)
  (io (let [store (: Store (atom (dictionary.new text.Hash<Text>)))
            loader (memory-class-loader store)]
        (: Host
           (structure
            (def: (evaluate! temp-label valueI)
              (let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))]
                (..evaluate! store loader eval-class valueI)))
            (def: execute! (..execute! store loader))
            (def: define! (..define! store loader)))))))

(def: #export runtime-class "LuxRuntime")
(def: #export function-class "LuxFunction")
(def: #export runnable-class "LuxRunnable")
(def: #export unit "")