(.module:
  lux
  (lux (control ["ex" exception #+ exception:]
                [monad #+ do])
       (data [bit]
             [maybe]
             ["e" error #+ Error]
             text/format
             (coll [array]))
       [host])
  (luxc [lang]
        (lang (host [r #+ Expression])))
  [//])

(do-template [<name>]
  [(exception: #export (<name> {message Text})
     message)]

  [Unknown-Kind-Of-Host-Object]
  [Null-Has-No-Lux-Representation]
  [Cannot-Evaluate]
  )

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

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

(host.import: org/renjin/sexp/SEXP)

(host.import: org/renjin/sexp/StringArrayVector
  (getElementAsString [int] String))

(host.import: org/renjin/sexp/LogicalArrayVector
  (getElementAsRawLogical [int] int))

(host.import: org/renjin/sexp/IntArrayVector
  (getElementAsInt [int] int))

(host.import: org/renjin/sexp/DoubleArrayVector
  (getElementAsDouble [int] double))

(host.import: org/renjin/sexp/ListVector
  (length [] int)
  (getElementAsSEXP [int] #try SEXP)
  (getElementAsSEXP #as get-field-sexp [String] #try SEXP))

(host.import: org/renjin/sexp/Null) 

(def: (parse-tuple lux-object host-object)
  (-> (-> Object (Error Any)) ListVector (Error Any))
  (let [size (:coerce Nat (ListVector::length [] host-object))]
    (loop [idx +0
           output (:coerce (Array Any) (array.new size))]
      (if (n/< size idx)
        (case (ListVector::getElementAsSEXP [(:coerce Int idx)] host-object)
          (#e.Error error)
          (#e.Error error)
          
          (#e.Success value)
          (case (lux-object (:coerce Object value))
            (#e.Error error)
            (#e.Error error)

            (#e.Success lux-value)
            (recur (inc idx) (array.write idx (:coerce Any lux-value) output))))
        (#e.Success output)))))

(def: (parse-variant lux-object host-object)
  (-> (-> Object (Error Any)) ListVector (Error Any))
  (do e.Monad<Error>
    [tag (ListVector::get-field-sexp [//.variant-tag-field] host-object)
     flag (ListVector::get-field-sexp [//.variant-flag-field] host-object)
     value (ListVector::get-field-sexp [//.variant-value-field] host-object)
     value (lux-object (:coerce Object value))]
    (wrap [(|> tag
               (:coerce IntArrayVector)
               (IntArrayVector::getElementAsInt [0])
               (Long::intValue []))
           (: Any
              (if (host.instance? Null flag)
                (host.null)
                //.unit))
           value])))

(def: (parse-int host-object)
  (-> ListVector (Error Int))
  (do e.Monad<Error>
    [high (ListVector::get-field-sexp [//.int-high-field] host-object)
     low (ListVector::get-field-sexp [//.int-low-field] host-object)
     #let [get-int-32 (|>> (IntArrayVector::getElementAsInt [0]) (:coerce Nat))
           high (get-int-32 (:coerce IntArrayVector high))
           low (get-int-32 (:coerce IntArrayVector low))]]
    (wrap (:coerce Int
              (n/+ (|> high (bit.left-shift +32))
                   (if (i/< 0 (:coerce Int low))
                     (|> low (bit.left-shift +32) (bit.logical-right-shift +32))
                     low))))))

(def: (lux-object host-object)
  (-> Object (Error Any))
  (cond (host.instance? StringArrayVector host-object)
        (#e.Success (StringArrayVector::getElementAsString [0] (:coerce StringArrayVector host-object)))

        (host.instance? LogicalArrayVector host-object)
        (#e.Success (i/= 1 (LogicalArrayVector::getElementAsRawLogical [0] (:coerce LogicalArrayVector host-object))))

        (host.instance? IntArrayVector host-object)
        (#e.Success (IntArrayVector::getElementAsInt [0] (:coerce IntArrayVector host-object)))

        (host.instance? DoubleArrayVector host-object)
        (#e.Success (DoubleArrayVector::getElementAsDouble [0] (:coerce DoubleArrayVector host-object)))

        (host.instance? ListVector host-object)
        (case (parse-int (:coerce ListVector host-object))
          (#e.Error error)
          (case (parse-variant lux-object (:coerce ListVector host-object))
            (#e.Error error)
            (parse-tuple lux-object (:coerce ListVector host-object))

            output
            output)

          output
          output)

        ## else
        (let [object-class (:coerce Text (Object::toString [] (Object::getClass [] (:coerce Object host-object))))
              text-representation (:coerce Text (Object::toString [] (:coerce Object host-object)))]
          (ex.throw Unknown-Kind-Of-Host-Object (format object-class " --- " text-representation)))))

(def: #export (eval code)
  (-> Expression (Meta Any))
  (function (_ compiler)
    (let [interpreter (|> compiler (get@ #.host) (:coerce //.Host) (get@ #//.interpreter))]
      (case (interpreter code)
        (#e.Error error)
        (exec (log! (format "eval #e.Error\n"
                            "<< " (r.expression code) "\n"
                            error))
          ((lang.throw Cannot-Evaluate error) compiler))

        (#e.Success output)
        (case (lux-object output)
          (#e.Success parsed-output)
          (#e.Success [compiler parsed-output])

          (#e.Error error)
          (exec (log! (format "eval #e.Error\n"
                              "<< " (r.expression code) "\n"
                              error))
            ((lang.throw Cannot-Evaluate error) compiler)))))))