(;module:
  lux
  (lux (control monad)
       (concurrency ["A" atom]
                    ["P" promise])
       (data ["R" result]
             [text "T/" Hash<Text>]
             text/format
             (coll ["D" dict]
                   [array #+ Array]))
       [macro #+ Monad<Lux>]
       host
       [io])
  (luxc ["&" base]
        ["&;" io]
        ["&;" module]
        ["&;" parser]
        (compiler ["&&;" runtime]
                  ["&&;" statement]
                  ["&&;" common])
        ))

(def: (compile ast)
  (-> Code (Lux Unit))
  (case ast
    (^ [_ (#;Form (list [_ (#;Symbol ["" "_lux_def"])]
                        [_ (#;Symbol ["" def-name])]
                        def-value
                        def-meta))])
    (&&statement;compile-def def-name def-value def-meta)

    (^ [_ (#;Form (list [_ (#;Symbol ["" "_lux_program"])]
                        [_ (#;Symbol ["" prog-args])]
                        prog-body))])
    (&&statement;compile-program prog-args prog-body)

    _
    (&;fail (format "Unrecognized statement: " (%code ast)))))

(def: (exhaust action)
  (All [a] (-> (Lux a) (Lux Unit)))
  (do Monad<Lux>
    [result action]
    (exhaust action)))

(def: (ensure-new-module! file-hash module-name)
  (-> Nat Text (Lux Unit))
  (do Monad<Lux>
    [module-exists? (macro;module-exists? module-name)
     _ (: (Lux Unit)
          (if module-exists?
            (&;fail (format "Cannot re-define a module: " module-name))
            (wrap [])))
     _ (&module;create file-hash module-name)]
    (wrap [])))

(def: prelude Text "lux")

(def: (with-active-compilation [module-name file-name source-code] action)
  (All [a] (-> [Text Text Text] (Lux a) (Lux a)))
  (do Monad<Lux>
    [_ (ensure-new-module! (T/hash source-code) module-name)
     #let [init-cursor [file-name +0 +0]]
     output (&;with-source-code [init-cursor source-code]
              action)
     _ (&module;flag-compiled! module-name)]
    (wrap output)))

(def: parse
  (Lux Code)
  (function [compiler]
    (case (&parser;parse (get@ #;source compiler))
      (#R;Error error)
      (#R;Error error)

      (#R;Success [source' output])
      (#R;Success [(set@ #;source source' compiler)
                   output]))))

(def: (compile-module source-dirs module-name compiler)
  (-> (List &;Path) Text Compiler (P;Promise (R;Result Compiler)))
  (do P;Monad<Promise>
    [?input (&io;read-module source-dirs module-name)]
    (case ?input
      (#R;Success [file-name file-content])
      (let [compilation (do Monad<Lux>
                          [_ (with-active-compilation [module-name
                                                       file-name
                                                       file-content]
                               (exhaust
                                (do @
                                  [ast parse]
                                  (compile ast))))]
                          (wrap [])
                          ## (&module;generate-descriptor module-name)
                          )]
        (case (macro;run' compiler compilation)
          (#R;Success [compiler module-descriptor])
          (do @
            [## _ (&io;write-module module-name module-descriptor)
             ]
            (wrap (#R;Success compiler)))
          
          (#R;Error error)
          (wrap (#R;Error error))))

      (#R;Error error)
      (wrap (#R;Error error)))))

(jvm-import org.objectweb.asm.MethodVisitor)

(jvm-import java.lang.reflect.AccessibleObject
  (setAccessible [boolean] void))

(jvm-import java.lang.reflect.Method
  (invoke [Object (Array Object)] #try Object))

(jvm-import (java.lang.Class a)
  (getDeclaredMethod [String (Array (Class Object))] #try Method))

(jvm-import java.lang.Object
  (getClass [] (Class Object)))

(jvm-import java.lang.Integer
  (#static TYPE (Class Integer)))

(jvm-import java.lang.ClassLoader)

(def: ClassLoader::defineClass
  Method
  (case (Class.getDeclaredMethod ["defineClass"
                                  (|> (array (Class Object) +4)
                                      (array-store +0 (:! (Class Object) (class-for String)))
                                      (array-store +1 (Object.getClass [] (array byte +0)))
                                      (array-store +2 (:! (Class Object) Integer.TYPE))
                                      (array-store +3 (:! (Class Object) Integer.TYPE)))]
                                 (class-for java.lang.ClassLoader))
    (#R;Success method)
    (do-to method
      (AccessibleObject.setAccessible [true]))

    (#R;Error error)
    (error! error)))

(def: (memory-class-loader store)
  (-> &&common;Class-Store ClassLoader)
  (object ClassLoader []
    []
    (ClassLoader (findClass [class-name String]) void
                 (case (|> store A;get io;run (D;get class-name))
                   (#;Some bytecode)
                   (case (Method.invoke [(:! Object _jvm_this)
                                         (array;from-list (list (:! Object class-name)
                                                                (:! Object bytecode)
                                                                (:! Object (l2i 0))
                                                                (:! Object (l2i (nat-to-int (array-length bytecode))))))]
                                        ClassLoader::defineClass)
                     (#R;Success output)
                     []
                     
                     (#R;Error error)
                     (error! error))

                   _
                   (error! (format "Unknown class: " class-name))))))

(def: (init-host _)
  (-> Top &&common;Host)
  (let [store (: &&common;Class-Store
                 (A;atom (D;new text;Hash<Text>)))]
    {#&&common;visitor #;None
     #&&common;loader (memory-class-loader store)
     #&&common;store store}))

(def: init-cursor Cursor ["" +0 +0])

(def: init-type-context
  Type-Context
  {#;ex-counter +0
   #;var-counter +0
   #;var-bindings (list)})

(def: compiler-version Text "0.6.0")

(def: init-compiler-info
  Compiler-Info
  {#;compiler-version compiler-version
   #;compiler-mode    #;Build})

(def: (init-compiler host)
  (-> &&common;Host Compiler)
  {#;info            init-compiler-info
   #;source          [init-cursor ""]
   #;cursor          init-cursor
   #;modules         (list)
   #;scopes          (list)
   #;type-context    init-type-context
   #;expected        #;None
   #;seed            +0
   #;scope-type-vars (list)
   #;host            (:! Void host)})

(def: (or-crash! action)
  (All [a] (-> (P;Promise (R;Result a)) (P;Promise a)))
  (do P;Monad<Promise>
    [?output action]
    (case ?output
      (#R;Error error)
      (error! error)

      (#R;Success output)
      (wrap output))))

(def: #export (compile-program program target sources)
  (-> &;Path &;Path (List &;Path) (P;Promise Unit))
  (do P;Monad<Promise>
    [#let [compiler (init-compiler (init-host []))]
     compiler (or-crash! (&&runtime;compile-runtime compiler))
     compiler (or-crash! (compile-module sources prelude compiler))
     compiler (or-crash! (compile-module sources program compiler))
     #let [_ (log! "Compilation complete!")]]
    (wrap [])))