(.module:
  lux
  (lux (control [monad #+ do]
                ["ex" exception #+ exception:])
       (concurrency ["P" promise]
                    ["T" task])
       (data ["e" error]
             [text "text/" Hash<Text>]
             text/format
             (coll [list "list/" Functor<List>]
                   [dict]))
       [macro]
       (lang [syntax #+ Aliases]
             (type ["tc" check]))
       [host]
       [io #+ IO Process io]
       (world [file #+ File]))
  (luxc ["&" lang]
        ["&." io]
        (lang [".L" module]
              [".L" host]
              [".L" macro]
              (host ["$" jvm])
              (analysis [".A" expression]
                        [".A" common])
              (synthesis [".S" expression])
              (translation [".T" runtime]
                           [".T" statement]
                           [".T" common]
                           [".T" expression]
                           [".T" eval]
                           [".T" imports])
              ["&." eval])
        ))

(def: analyse
  (&.Analyser)
  (expressionA.analyser &eval.eval))

(exception: #export Macro-Expansion-Failed)
(exception: #export Unrecognized-Statement)
(exception: #export Invalid-Alias)

(def: (process-annotations annsC)
  (-> Code (Meta [$.Inst Code]))
  (do macro.Monad<Meta>
    [[_ annsA] (&.with-scope
                 (&.with-type Code
                   (analyse annsC)))
     annsI (expressionT.translate (expressionS.synthesize annsA))
     annsV (evalT.eval annsI)]
    (wrap [annsI (:! Code annsV)])))

(def: (switch-compiler new-compiler)
  (-> Compiler (Meta Aliases))
  (function [old-compiler]
    ((do macro.Monad<Meta>
       [this macro.current-module]
       (wrap (|> this (get@ #.module-aliases) (dict.from-list text.Hash<Text>) (: Aliases))))
     new-compiler)))

(def: (ensure-valid-alias def-name annotations value)
  (-> Text Code Code (Meta Unit))
  (case [annotations value]
    (^multi [[_ (#.Record pairs)] [_ (#.Symbol _)]]
            (|> pairs list.size (n/= +1)))
    (:: macro.Monad<Meta> wrap [])

    _
    (&.throw Invalid-Alias def-name)))

(def: #export (translate translate-module aliases code)
  (-> (-> Text Compiler (Process Compiler)) Aliases Code (Meta Aliases))
  (case code
    (^code ((~ [_ (#.Symbol macro-name)]) (~+ args)))
    (do macro.Monad<Meta>
      [?macro (&.with-error-tracking
                (macro.find-macro macro-name))]
      (case ?macro
        (#.Some macro)
        (do @
          [expansion (: (Meta (List Code))
                        (function [compiler]
                          (case (macroL.expand macro args compiler)
                            (#e.Error error)
                            ((&.throw Macro-Expansion-Failed error) compiler)

                            output
                            output)))
           expansion-aliases (monad.map @ (translate translate-module aliases) expansion)]
          (if (dict.empty? aliases)
            (loop [expansion-aliases expansion-aliases]
              (case expansion-aliases
                #.Nil
                (wrap aliases)

                (#.Cons head tail)
                (if (dict.empty? head)
                  (recur tail)
                  (wrap head))))
            (wrap aliases)))

        #.None
        (&.throw Unrecognized-Statement (%code code))))
    
    (^code ("lux def" (~ [_ (#.Symbol ["" def-name])]) (~ valueC) (~ annsC)))
    (hostL.with-context def-name
      (&.with-fresh-type-env
        (do macro.Monad<Meta>
          [[annsI annsV] (process-annotations annsC)]
          (case (macro.get-symbol-ann (ident-for #.alias) annsV)
            (#.Some real-def)
            (do @
              [_ (ensure-valid-alias def-name annsV valueC)
               _ (&.with-scope
                   (statementT.translate-def def-name Void id annsI annsV))]
              (wrap aliases))

            #.None
            (do @
              [[_ valueT valueA] (&.with-scope
                                   (if (macro.type? (:! Code annsV))
                                     (do @
                                       [valueA (&.with-type Type
                                                 (analyse valueC))]
                                       (wrap [Type valueA]))
                                     (commonA.with-unknown-type
                                       (analyse valueC))))
               valueT (&.with-type-env
                        (tc.clean valueT))
               ## #let [_ (if (or (text/= "string~" def-name))
               ##           (log! (format "{" def-name "}\n"
               ##                         "     TYPE: " (%type valueT) "\n"
               ##                         " ANALYSIS: " (%code valueA) "\n"
               ##                         "SYNTHESIS: " (%code (expressionS.synthesize valueA))))
               ##           [])]
               valueI (expressionT.translate (expressionS.synthesize valueA))
               _ (&.with-scope
                   (statementT.translate-def def-name valueT valueI annsI annsV))]
              (wrap aliases))))))

    (^code ("lux module" (~ annsC)))
    (do macro.Monad<Meta>
      [[annsI annsV] (process-annotations annsC)
       process (importsT.translate-imports translate-module annsV)]
      (case (io.run process)
        (#e.Success compiler')
        (switch-compiler compiler')
        
        (#e.Error error)
        (macro.fail error)))

    (^code ("lux program" (~ [_ (#.Symbol ["" program-args])]) (~ programC)))
    (do macro.Monad<Meta>
      [[_ programA] (&.with-scope
                      (&.with-type (type (io.IO Unit))
                        (analyse programC)))
       programI (expressionT.translate (expressionS.synthesize programA))
       _ (statementT.translate-program program-args programI)]
      (wrap aliases))

    _
    (&.throw Unrecognized-Statement (%code code))))

(def: (forgive-eof action)
  (-> (Meta Unit) (Meta Unit))
  (function [compiler]
    (case (action compiler)
      (#e.Error error)
      (if (ex.match? syntax.End-Of-File error)
        (#e.Success [compiler []])
        (#e.Error error))

      output
      output)))

(def: #export prelude Text "lux")

(def: (with-active-compilation [module-name file-name source-code] action)
  (All [a] (-> [Text Text Text] (Meta a) (Meta a)))
  (do macro.Monad<Meta>
    [#let [init-cursor [file-name +1 +0]]
     output (&.with-source-code [init-cursor +0 source-code]
              action)
     _ (moduleL.flag-compiled! module-name)]
    (wrap output)))

(def: (read current-module aliases)
  (-> Text Aliases (Meta Code))
  (function [compiler]
    (case (syntax.read current-module aliases (get@ #.source compiler))
      (#e.Error error)
      (#e.Error error)

      (#e.Success [source' output])
      (#e.Success [(set@ #.source source' compiler)
                   output]))))

(def: #export (translate-module source-dirs target-dir module-name compiler)
  (-> (List File) File Text Compiler (Process Compiler))
  (do io.Monad<Process>
    [## _ (&io.prepare-module target-dir module-name)
     [file-name file-content] (&io.read-module source-dirs module-name)
     #let [module-hash (text/hash file-content)
           translate-module (translate-module source-dirs target-dir)]]
    (case (macro.run' compiler
                      (do macro.Monad<Meta>
                        [[_ artifacts _] (moduleL.with-module module-hash module-name
                                           (commonT.with-artifacts
                                             (with-active-compilation [module-name
                                                                       file-name
                                                                       file-content]
                                               (forgive-eof
                                                (loop [aliases (: Aliases
                                                                  (dict.new text.Hash<Text>))]
                                                  (do @
                                                    [code (read module-name aliases)
                                                     #let [[cursor _] code]
                                                     aliases' (&.with-cursor cursor
                                                                (translate translate-module aliases code))]
                                                    (forgive-eof (recur aliases'))))))))]
                        (wrap artifacts)))
      (#e.Success [compiler artifacts])
      (do @
        [## _ (monad.map @ (function [[class-name class-bytecode]]
         ##                  (&io.write-file target-dir class-name class-bytecode))
         ##              (dict.entries artifacts))
         ]
        (wrap compiler))
      
      (#e.Error error)
      (io.fail error))))

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

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

(def: #export init-info
  Info
  {#.target  (for {"JVM" "JVM"
                   "JS" "JS"})
   #.version &.version
   #.mode    #.Build})

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

(def: #export (translate-program sources target program)
  (-> (List File) File Text (T.Task Unit))
  (do T.Monad<Task>
    [compiler (|> (case (runtimeT.translate (init-compiler (io.run hostL.init-host)))
                    (#e.Error error)
                    (T.fail error)

                    (#e.Success [compiler [runtime-bc function-bc]])
                    (do @
                      [_ (&io.prepare-target target)
                       _ (&io.write-file target (format hostL.runtime-class ".class") runtime-bc)
                       _ (&io.write-file target (format hostL.function-class ".class") function-bc)]
                      (wrap compiler)))
                  (: (T.Task Compiler))
                  (:: @ map (|>> (translate-module sources target prelude) P.future)) (:: @ join)
                  (:: @ map (|>> (translate-module sources target program) P.future)) (:: @ join))
     #let [_ (log! "Compilation complete!")]]
    (wrap [])))