(.module:
  [lux #*
   [program (#+ program:)]
   ["." host]
   ["." debug]
   [abstract
    ["." monad (#+ do)]]
   [control
    [pipe (#+ exec> case>)]
    ["." try (#+ Try)]
    ["." exception (#+ exception:)]
    ["." io (#+ IO io)]
    [concurrency
     ["." promise (#+ Promise)]]]
   [data
    ["." maybe]
    ["." text ("#\." hash)
     ["%" format (#+ format)]
     ["." encoding]]
    [collection
     ["." array (#+ Array)]]]
   [macro
    ["." template]]
   [math
    [number (#+ hex)
     ["n" nat]
     ["." i64]]]
   ["." world #_
    ["." file]
    ["#/." program]]
   ["@" target
    ["_" scheme]]
   [tool
    [compiler
     [phase (#+ Operation Phase)]
     [reference
      [variable (#+ Register)]]
     [language
      [lux
       [program (#+ Program)]
       [generation (#+ Context Host)]
       ["." synthesis]
       [analysis
        [macro (#+ Expander)]]
       [phase
        ["." extension (#+ Extender Handler)
         ["#/." bundle]
         ["." analysis #_
          ["#" scheme]]
         ["." generation #_
          ["#" scheme]]]
        [generation
         ["." reference]
         ["." scheme
          ["." runtime]]]]]]
     [default
      ["." platform (#+ Platform)]]
     [meta
      ["." packager #_
       ["#" script]]]]]]
  [program
   ["/" compositor
    ["#." cli]
    ["#." static]]])

(host.import: java/lang/Boolean)
(host.import: java/lang/String)

(host.import: (java/lang/Class a))

(host.import: java/lang/Object
  ["#::."
   (toString [] java/lang/String)
   (getClass [] (java/lang/Class java/lang/Object))])

(host.import: java/lang/Long
  ["#::."
   (intValue [] java/lang/Integer)])

(host.import: java/lang/Integer
  ["#::."
   (longValue [] java/lang/Long)])

(host.import: gnu/math/IntNum
  ["#::."
   (new #manual [int])
   (longValue [] long)])

(host.import: gnu/math/DFloNum
  ["#::."
   (doubleValue [] double)])

(host.import: gnu/lists/FString
  ["#::."
   (toString [] String)])

(host.import: gnu/lists/Pair
  ["#::."
   (getCar [] java/lang/Object)
   (getCdr [] java/lang/Object)])

(host.import: (gnu/lists/FVector E)
  ["#::."
   (getBufferLength [] int)
   (getRaw [int] E)])

(host.import: gnu/mapping/Procedure
  ["#::."
   (apply2 [java/lang/Object java/lang/Object] #try java/lang/Object)])

(host.import: gnu/mapping/Environment)

(host.import: gnu/expr/Language
  ["#::."
   (eval [java/lang/String] #try java/lang/Object)])

(host.import: kawa/standard/Scheme
  ["#::."
   (#static getR7rsInstance [] kawa/standard/Scheme)])

(def: (variant? value)
  (-> Any Bit)
  (case (host.check [java/lang/Object] (:coerce java/lang/Object value))
    (#.Some array)
    ## TODO: Get rid of this coercion ASAP.
    (let [array (:coerce (Array java/lang/Object) array)]
      (and (n.= 3 (array.size array))
           (case (array.read 0 array)
             (#.Some tag)
             (case (host.check java/lang/Integer tag)
               (#.Some _)
               true

               #.None
               false)
             
             #.None
             false)))
    
    #.None
    false))

(template [<name>]
  [(host.interface: <name>
     (getValue [] java/lang/Object))

   (`` (host.import: (~~ (template.identifier ["program/" <name>]))
         ["#::."
          (getValue [] java/lang/Object)]))]

  [VariantValue]
  [TupleValue]
  )

(def: (variant_value lux_value cdr? value)
  (-> (-> java/lang/Object java/lang/Object) Bit (Array java/lang/Object) gnu/lists/Pair)
  (host.object [] gnu/lists/Pair [program/VariantValue]
    []
    ## Methods
    (program/VariantValue
     [] (getValue self) java/lang/Object
     (:coerce java/lang/Object value))
    (gnu/lists/Pair
     [] (getCar self) java/lang/Object
     (if cdr?
       (case (array.read 1 value)
         (#.Some flag_is_set)
         (:coerce java/lang/Object "")
         
         #.None
         (host.null))
       (|> value
           (array.read 0)
           maybe.assume
           (:coerce java/lang/Integer)
           gnu/math/IntNum::new)))
    (gnu/lists/Pair
     [] (getCdr self) java/lang/Object
     (if cdr?
       (|> value
           (array.read 2)
           maybe.assume
           lux_value)
       (variant_value lux_value true value)))))

(def: (tuple_value lux_value value)
  (-> (-> java/lang/Object java/lang/Object) (Array java/lang/Object) gnu/lists/FVector)
  (host.object [] gnu/lists/SimpleVector [program/TupleValue]
    []
    ## Methods
    (program/TupleValue
     [] (getValue self) java/lang/Object
     (:coerce java/lang/Object value))
    (gnu/lists/SimpleVector
     [] (getBufferLength self) int
     (host.long_to_int (array.size value)))
    (gnu/lists/SimpleVector
     [] (getRaw self {idx int}) java/lang/Object
     (|> value
         (array.read (|> idx java/lang/Integer::longValue (:coerce Nat)))
         maybe.assume
         lux_value))
    (gnu/lists/SimpleVector
     [] (getBuffer self) java/lang/Object
     (undefined))
    (gnu/lists/SimpleVector
     [] (setBuffer self {_ java/lang/Object}) void
     (undefined))
    (gnu/lists/SimpleVector
     [] (clearBuffer self {_ int} {_ int}) void
     (undefined))
    (gnu/lists/SimpleVector
     [] (copyBuffer self {_ int}) void
     (undefined))
    (gnu/lists/SimpleVector
     [] (newInstance self {_ int}) gnu/lists/SimpleVector
     (undefined))
    ))

(exception: (unknown_kind_of_host_object {object java/lang/Object})
  (exception.report
   ["Class" (java/lang/Object::toString (java/lang/Object::getClass object))]
   ["Object" (java/lang/Object::toString object)]))

(exception: (cannot_apply_a_non_function {object java/lang/Object})
  (exception.report
   ["Class" (java/lang/Object::toString (java/lang/Object::getClass object))]
   ["Object" (java/lang/Object::toString object)]))

(def: (lux_value value)
  (-> java/lang/Object java/lang/Object)
  (<| (case (host.check [java/lang/Object] value)
        (#.Some value)
        ## TODO: Get rid of the coercions below.
        (if (variant? value)
          (variant_value lux_value false (:coerce (Array java/lang/Object) value))
          (tuple_value lux_value (:coerce (Array java/lang/Object) value)))
        #.None)
      value))

(type: (Reader a)
  (-> a (Try Any)))

(def: (variant tag flag value)
  (-> Nat Bit Any Any)
  [(java/lang/Long::intValue (:coerce java/lang/Long tag))
   (: Any
      (if flag
        synthesis.unit
        (host.null)))
   value])

(def: (read_variant read host_object)
  (-> (Reader java/lang/Object) (Reader gnu/lists/Pair))
  (do try.monad
    [tag (read (gnu/lists/Pair::getCar host_object))
     #let [host_object (:coerce gnu/lists/Pair (gnu/lists/Pair::getCdr host_object))
           flag (case (host.check java/lang/String (gnu/lists/Pair::getCar host_object))
                  (#.Some _)
                  true
                  
                  #.None
                  false)]
     value (read (gnu/lists/Pair::getCdr host_object))]
    (wrap (..variant (:coerce Nat tag) flag value))))

(def: (read_tuple read host_object)
  (-> (Reader java/lang/Object) (Reader (gnu/lists/FVector java/lang/Object)))
  (let [size (.nat (gnu/lists/FVector::getBufferLength host_object))]
    (loop [idx 0
           output (: (Array Any)
                     (array.new size))]
      (if (n.< size idx)
        (case (read (gnu/lists/FVector::getRaw (.int idx) host_object))
          (#try.Failure error)
          (#try.Failure error)

          (#try.Success lux_value)
          (recur (inc idx) (array.write! idx (: Any lux_value) output)))
        (#try.Success output)))))

(def: (read host_object)
  (Reader java/lang/Object)
  (`` (<| (~~ (template [<class>]
                [(case (host.check <class> host_object)
                   (#.Some host_object)
                   (#try.Success host_object)
                   #.None)]

                [java/lang/Boolean] [java/lang/String] [gnu/mapping/Procedure]
                ))
          (~~ (template [<class> <method>]
                [(case (host.check <class> host_object)
                   (#.Some host_object)
                   (#try.Success (<method> host_object))
                   #.None)]

                [gnu/math/IntNum gnu/math/IntNum::longValue]
                [gnu/math/DFloNum gnu/math/DFloNum::doubleValue]
                [gnu/lists/FString gnu/lists/FString::toString]
                [program/VariantValue program/VariantValue::getValue]
                [program/TupleValue program/TupleValue::getValue]
                ))
          (case (host.check gnu/lists/Pair host_object)
            (#.Some host_object)
            (read_variant read host_object)
            #.None)
          (case (host.check gnu/lists/FVector host_object)
            (#.Some host_object)
            (read_tuple read (:coerce (gnu/lists/FVector java/lang/Object) host_object))
            #.None)
          ## else
          (exception.throw ..unknown_kind_of_host_object host_object))))

(def: ensure_macro
  (-> Macro (Maybe gnu/mapping/Procedure))
  (|>> (:coerce java/lang/Object) (host.check gnu/mapping/Procedure)))

(def: (expander macro inputs lux)
  Expander
  (case (ensure_macro macro)
    (#.Some macro)
    (case (gnu/mapping/Procedure::apply2 (lux_value (:coerce java/lang/Object inputs))
                                         (lux_value (:coerce java/lang/Object lux))
                                         macro)
      (#try.Success output)
      (|> output
          ..read
          (:coerce (Try (Try [Lux (List Code)]))))

      (#try.Failure error)
      (#try.Failure error))

    #.None
    (exception.throw ..cannot_apply_a_non_function (:coerce java/lang/Object macro)))
  )

(def: separator "$")

(def: host
  (IO (Host _.Expression _.Expression))
  (io (let [interpreter (kawa/standard/Scheme::getR7rsInstance)
            run! (: (-> (_.Code Any) (Try Any))
                    (function (_ input)
                      (do try.monad
                        [output (gnu/expr/Language::eval (_.code input) interpreter)]
                        (read output))))]
        (: (Host _.Expression _.Expression)
           (structure
            (def: (evaluate! context code)
              (run! code))
            
            (def: (execute! input)
              (gnu/expr/Language::eval (_.code input) interpreter))
            
            (def: (define! context input)
              (let [global (reference.artifact context)
                    @global (_.var global)]
                (do try.monad
                  [#let [definition (_.define_constant @global input)]
                   _ (gnu/expr/Language::eval (_.code definition) interpreter)
                   value (run! @global)]
                  (wrap [global value definition]))))

            (def: (ingest context content)
              (|> content (\ encoding.utf8 decode) try.assume (:coerce _.Expression)))

            (def: (re_learn context content)
              (run! content))
            
            (def: (re_load context content)
              (do try.monad
                [_ (run! content)]
                (run! (_.var (reference.artifact context)))))
            )))))

(def: platform
  (IO (Platform _.Var _.Expression _.Expression))
  (do io.monad
    [host ..host]
    (wrap {#platform.&file_system (file.async file.default)
           #platform.host host
           #platform.phase scheme.generate
           #platform.runtime runtime.generate
           #platform.write (|>> _.code (\ encoding.utf8 encode))})))

(def: (program context program)
  (Program _.Expression _.Expression)
  (_.apply/2 program
             ## TODO: Figure out how to always get the command-line
             ## arguments.
             ## It appears that it differs between Scheme implementations.
             (runtime.lux//program_args _.nil)
             _.nil))

(for {@.old
      (def: extender
        Extender
        ## TODO: Stop relying on coercions ASAP.
        (<| (:coerce Extender)
            (function (@self handler))
            (:coerce Handler)
            (function (@self name phase))
            (:coerce Phase)
            (function (@self archive parameters))
            (:coerce Operation)
            (function (@self state))
            (:coerce Try)
            try.assume
            (:coerce Try)
            (#try.Failure "YOLO")))

      @.scheme
      (def: (extender handler)
        Extender
        (:assume handler))})

(def: (declare_success! _)
  (-> Any (Promise Any))
  (promise.future (\ world/program.default exit +0)))

(def: (then pre post)
  (-> _.Expression _.Expression _.Expression)
  (_.manual (format (_.code pre)
                    text.new_line
                    (_.code post))))

(def: (scope body)
  (-> _.Expression _.Expression)
  (let [@program (_.var "lux_program")]
    ($_ ..then
        (_.define_function @program [(list) #.None] body)
        (_.apply/* (list) @program)
        )))

(`` (program: [{service /cli.service}]
      (let [extension ".scm"]
        (do io.monad
          [platform ..platform]
          (exec (do promise.monad
                  [_ (/.compiler {#/static.host @.scheme
                                  #/static.host_module_extension extension
                                  #/static.target (/cli.target service)
                                  #/static.artifact_extension extension}
                                 ..expander
                                 analysis.bundle
                                 (io.io platform)
                                 generation.bundle
                                 extension/bundle.empty
                                 ..program
                                 [_.Var _.Expression _.Expression]
                                 ..extender
                                 service
                                 [(packager.package (_.manual "")
                                                    _.code
                                                    ..then
                                                    ..scope)
                                  (format (/cli.target service)
                                          (\ file.default separator)
                                          "program"
                                          extension)])]
                  (..declare_success! []))
            (io.io []))))))