(.module:
  [lux (#- Type)
   [abstract
    [monad (#+ do)]
    ["." enum]]
   [data
    [binary (#+ Binary)]
    ["." product]
    [text
     ["%" format (#+ format)]]
    [collection
     ["." list ("#@." functor)]
     ["." row]]
    [number
     ["n" nat]]]
   ["." math]
   [target
    [jvm
     ["." type (#+ Type)
      ["." category (#+ Void Value' Value Return' Return Primitive Object Class Array Var Parameter Method)]
      ["." reflection]]]]
   [tool
    [compiler (#+ Output)
     [arity (#+ Arity)]
     ["." phase]
     [language
      [lux
       ["." synthesis]
       ["." generation]]]
     [meta
      [archive
       ["." artifact (#+ Registry)]]]]]]
  [luxc
   [lang
    [host
     ["$" jvm (#+ Label Inst Def Operation)
      ["$d" def]
      ["_" inst]]]]]
  ["." // (#+ ByteCode)])

(def: $Text (type.class "java.lang.String" (list)))
(def: #export $Tag type.int)
(def: #export $Flag (type.class "java.lang.Object" (list)))
(def: #export $Value (type.class "java.lang.Object" (list)))
(def: #export $Index type.int)
(def: #export $Stack (type.array $Value))
(def: $Throwable (type.class "java.lang.Throwable" (list)))

(def: nullary-init-methodT
  (type.method [(list) type.void (list)]))

(def: throw-methodT
  (type.method [(list) type.void (list)]))

(def: #export logI
  Inst
  (let [PrintStream (type.class "java.io.PrintStream" (list))
        outI (_.GETSTATIC (type.class "java.lang.System" (list)) "out" PrintStream)
        printI (function (_ method)
                 (_.INVOKEVIRTUAL PrintStream method (type.method [(list $Value) type.void (list)])))]
    (|>> outI (_.string "LOG: ") (printI "print")
         outI _.SWAP (printI "println"))))

(def: variant-method
  (type.method [(list $Tag $Flag $Value) //.$Variant (list)]))

(def: #export variantI
  Inst
  (_.INVOKESTATIC //.$Runtime "variant_make" variant-method))

(def: #export leftI
  Inst
  (|>> _.ICONST_0
       _.NULL
       _.DUP2_X1
       _.POP2
       variantI))

(def: #export rightI
  Inst
  (|>> _.ICONST_1
       (_.string "")
       _.DUP2_X1
       _.POP2
       variantI))

(def: #export someI Inst rightI)

(def: #export noneI
  Inst
  (|>> _.ICONST_0
       _.NULL
       (_.string synthesis.unit)
       variantI))

(def: (tryI unsafeI)
  (-> Inst Inst)
  (<| _.with-label (function (_ @from))
      _.with-label (function (_ @to))
      _.with-label (function (_ @handler))
      (|>> (_.try @from @to @handler (type.class "java.lang.Exception" (list)))
           (_.label @from)
           unsafeI
           someI
           _.ARETURN
           (_.label @to)
           (_.label @handler)
           noneI
           _.ARETURN)))

(def: #export partials-field Text "partials")
(def: #export apply-method Text "apply")
(def: #export num-apply-variants Nat 8)

(def: #export (apply-signature arity)
  (-> Arity (Type Method))
  (type.method [(list.repeat arity $Value) $Value (list)]))

(def: adt-methods
  Def
  (let [store-tagI (|>> _.DUP _.ICONST_0 (_.ILOAD 0) (_.wrap type.int) _.AASTORE)
        store-flagI (|>> _.DUP _.ICONST_1 (_.ALOAD 1) _.AASTORE)
        store-valueI (|>> _.DUP _.ICONST_2 (_.ALOAD 2) _.AASTORE)]
    (|>> ($d.method #$.Public $.staticM "variant_make"
                    (type.method [(list $Tag $Flag $Value) //.$Variant (list)])
                    (|>> _.ICONST_3
                         (_.ANEWARRAY $Value)
                         store-tagI
                         store-flagI
                         store-valueI
                         _.ARETURN)))))

(def: frac-methods
  Def
  (|>> ($d.method #$.Public $.staticM "decode_frac" (type.method [(list $Text) //.$Variant (list)])
                  (tryI
                   (|>> (_.ALOAD 0)
                        (_.INVOKESTATIC (type.class "java.lang.Double" (list)) "parseDouble" (type.method [(list $Text) type.double (list)]))
                        (_.wrap type.double))))
       ))

(def: (illegal-state-exception message)
  (-> Text Inst)
  (let [IllegalStateException (type.class "java.lang.IllegalStateException" (list))]
    (|>> (_.NEW IllegalStateException)
         _.DUP
         (_.string message)
         (_.INVOKESPECIAL IllegalStateException "<init>" (type.method [(list $Text) type.void (list)])))))

(def: pm-methods
  Def
  (let [tuple-sizeI (|>> (_.ALOAD 0)
                         _.ARRAYLENGTH)
        last-rightI (|>> tuple-sizeI
                         _.ICONST_1
                         _.ISUB)
        leftsI (_.ILOAD 1)
        left-indexI leftsI
        sub-leftsI (|>> leftsI
                        last-rightI
                        _.ISUB)
        sub-tupleI (|>> (_.ALOAD 0)
                        last-rightI
                        _.AALOAD
                        (_.CHECKCAST //.$Tuple))
        recurI (: (-> Label Inst)
                  (function (_ @loop)
                    (|>> sub-leftsI (_.ISTORE 1)
                         sub-tupleI (_.ASTORE 0)
                         (_.GOTO @loop))))]
    (|>> ($d.method #$.Public $.staticM "pm_fail" throw-methodT
                    (|>> (illegal-state-exception "Invalid expression for pattern-matching.")
                         _.ATHROW))
         ($d.method #$.Public $.staticM "apply_fail" throw-methodT
                    (|>> (illegal-state-exception "Error while applying function.")
                         _.ATHROW))
         ($d.method #$.Public $.staticM "pm_push" (type.method [(list $Stack $Value) $Stack (list)])
                    (|>> _.ICONST_2
                         (_.ANEWARRAY $Value)
                         _.DUP
                         _.ICONST_1
                         (_.ALOAD 0)
                         _.AASTORE
                         _.DUP
                         _.ICONST_0
                         (_.ALOAD 1)
                         _.AASTORE
                         _.ARETURN))
         ($d.method #$.Public $.staticM "pm_variant" (type.method [(list //.$Variant $Tag $Flag) $Value (list)])
                    (<| _.with-label (function (_ @loop))
                        _.with-label (function (_ @perfect-match!))
                        _.with-label (function (_ @tags-match!))
                        _.with-label (function (_ @maybe-nested))
                        _.with-label (function (_ @mismatch!))
                        (let [$variant (_.ALOAD 0)
                              $tag (_.ILOAD 1)
                              $last? (_.ALOAD 2)
                              
                              variant-partI (: (-> Nat Inst)
                                               (function (_ idx)
                                                 (|>> (_.int (.int idx)) _.AALOAD)))
                              ::tag (: Inst
                                       (|>> (variant-partI 0) (_.unwrap type.int)))
                              ::last? (variant-partI 1)
                              ::value (variant-partI 2)

                              super-nested-tag (|>> _.SWAP ## variant::tag, tag
                                                    _.ISUB)
                              super-nested (|>> super-nested-tag ## super-tag
                                                $variant ::last? ## super-tag, super-last
                                                $variant ::value ## super-tag, super-last, super-value
                                                ..variantI)
                              
                              update-$tag _.ISUB
                              update-$variant (|>> $variant ::value
                                                   (_.CHECKCAST //.$Variant)
                                                   (_.ASTORE 0))
                              iterate! (: (-> Label Inst)
                                          (function (_ @loop)
                                            (|>> update-$variant
                                                 update-$tag
                                                 (_.GOTO @loop))))
                              
                              not-found _.NULL])
                        (|>> $tag ## tag
                             (_.label @loop)
                             $variant ::tag ## tag, variant::tag
                             _.DUP2 (_.IF_ICMPEQ @tags-match!) ## tag, variant::tag
                             _.DUP2 (_.IF_ICMPGT @maybe-nested) ## tag, variant::tag
                             $last? (_.IFNULL @mismatch!) ## tag, variant::tag
                             super-nested ## super-variant
                             _.ARETURN
                             (_.label @tags-match!) ## tag, variant::tag
                             $last? ## tag, variant::tag, last?
                             $variant ::last? ## tag, variant::tag, last?, variant::last?
                             (_.IF_ACMPEQ @perfect-match!) ## tag, variant::tag
                             (_.label @maybe-nested) ## tag, variant::tag
                             $variant ::last? ## tag, variant::tag, variant::last?
                             (_.IFNULL @mismatch!) ## tag, variant::tag
                             (iterate! @loop)
                             (_.label @perfect-match!) ## tag, variant::tag
                             ## _.POP2
                             $variant ::value
                             _.ARETURN
                             (_.label @mismatch!) ## tag, variant::tag
                             ## _.POP2
                             not-found
                             _.ARETURN)))
         ($d.method #$.Public $.staticM "tuple_left" (type.method [(list //.$Tuple $Index) $Value (list)])
                    (<| _.with-label (function (_ @loop))
                        _.with-label (function (_ @recursive))
                        (let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)])
                        (|>> (_.label @loop)
                             leftsI last-rightI (_.IF_ICMPGE @recursive)
                             left-accessI
                             _.ARETURN
                             (_.label @recursive)
                             ## Recursive
                             (recurI @loop))))
         ($d.method #$.Public $.staticM "tuple_right" (type.method [(list //.$Tuple $Index) $Value (list)])
                    (<| _.with-label (function (_ @loop))
                        _.with-label (function (_ @not-tail))
                        _.with-label (function (_ @slice))
                        (let [right-indexI (|>> leftsI
                                                _.ICONST_1
                                                _.IADD)
                              right-accessI (|>> (_.ALOAD 0)
                                                 _.SWAP
                                                 _.AALOAD)
                              sub-rightI (|>> (_.ALOAD 0)
                                              right-indexI
                                              tuple-sizeI
                                              (_.INVOKESTATIC (type.class "java.util.Arrays" (list)) "copyOfRange"
                                                              (type.method [(list //.$Tuple $Index $Index)
                                                                            //.$Tuple
                                                                            (list)])))])
                        (|>> (_.label @loop)
                             last-rightI right-indexI
                             _.DUP2 (_.IF_ICMPNE @not-tail)
                             ## _.POP
                             right-accessI
                             _.ARETURN
                             (_.label @not-tail)
                             (_.IF_ICMPGT @slice)
                             ## Must recurse
                             (recurI @loop)
                             (_.label @slice)
                             sub-rightI
                             _.ARETURN
                             )))
         )))

(def: #export try (type.method [(list //.$Function) //.$Variant (list)]))

(def: io-methods
  Def
  (let [StringWriter (type.class "java.io.StringWriter" (list))
        PrintWriter (type.class "java.io.PrintWriter" (list))
        string-writerI (|>> (_.NEW StringWriter)
                            _.DUP
                            (_.INVOKESPECIAL StringWriter "<init>" nullary-init-methodT))
        print-writerI (|>> (_.NEW PrintWriter)
                           _.SWAP
                           _.DUP2
                           _.POP
                           _.SWAP
                           (_.boolean true)
                           (_.INVOKESPECIAL PrintWriter "<init>" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)]))
                           )]
    (|>> ($d.method #$.Public $.staticM "try" ..try
                    (<| _.with-label (function (_ @from))
                        _.with-label (function (_ @to))
                        _.with-label (function (_ @handler))
                        (|>> (_.try @from @to @handler $Throwable)
                             (_.label @from)
                             (_.ALOAD 0)
                             _.NULL
                             (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature 1))
                             rightI
                             _.ARETURN
                             (_.label @to)
                             (_.label @handler)
                             string-writerI ## TW
                             _.DUP2 ## TWTW
                             print-writerI ## TWTP
                             (_.INVOKEVIRTUAL $Throwable "printStackTrace" (type.method [(list (type.class "java.io.PrintWriter" (list))) type.void (list)])) ## TW
                             (_.INVOKEVIRTUAL StringWriter "toString" (type.method [(list) $Text (list)])) ## TS
                             _.SWAP _.POP leftI
                             _.ARETURN)))
         )))

(def: reflection
  (All [category]
    (-> (Type (<| Return' Value' category)) Text))
  (|>> type.reflection reflection.reflection))

(def: translate-runtime
  (Operation [Text Binary])
  (let [runtime-class (..reflection //.$Runtime)
        bytecode ($d.class #$.V1_6 #$.Public $.finalC runtime-class (list) (type.class "java.lang.Object" (list)) (list)
                           (|>> adt-methods
                                frac-methods
                                pm-methods
                                io-methods))
        directive [runtime-class bytecode]]
    (do phase.monad
      [_ (generation.execute! directive)
       _ (generation.save! "0" directive)]
      (wrap ["0" bytecode]))))

(def: translate-function
  (Operation [Text Binary])
  (let [applyI (|> (enum.range n.enum 2 num-apply-variants)
                   (list@map (function (_ arity)
                               ($d.method #$.Public $.noneM apply-method (apply-signature arity)
                                          (let [preI (|> (enum.range n.enum 0 (dec arity))
                                                         (list@map _.ALOAD)
                                                         _.fuse)]
                                            (|>> preI
                                                 (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature (dec arity)))
                                                 (_.CHECKCAST //.$Function)
                                                 (_.ALOAD arity)
                                                 (_.INVOKEVIRTUAL //.$Function apply-method (apply-signature 1))
                                                 _.ARETURN)))))
                   (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature 1)))
                   $d.fuse)
        $Object (type.class "java.lang.Object" (list))
        function-class (..reflection //.$Function)
        bytecode ($d.abstract #$.V1_6 #$.Public $.noneC function-class (list) $Object (list)
                              (|>> ($d.field #$.Public $.finalF partials-field type.int)
                                   ($d.method #$.Public $.noneM "<init>" (type.method [(list type.int) type.void (list)])
                                              (|>> (_.ALOAD 0)
                                                   (_.INVOKESPECIAL $Object "<init>" nullary-init-methodT)
                                                   (_.ALOAD 0)
                                                   (_.ILOAD 1)
                                                   (_.PUTFIELD //.$Function partials-field type.int)
                                                   _.RETURN))
                                   applyI))
        directive [function-class bytecode]]
    (do phase.monad
      [_ (generation.execute! directive)
       _ (generation.save! "1" directive)]
      (wrap ["1" bytecode]))))

(def: #export translate
  (Operation [Registry Output])
  (do phase.monad
    [runtime-payload ..translate-runtime
     function-payload ..translate-function]
    (wrap [(|> artifact.empty
               artifact.resource
               product.right
               artifact.resource
               product.right)
           (row.row runtime-payload
                    function-payload)])))