path: root/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/translation/jvm/host.lux

... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/.

(.require
 [library
  [lux (.except Type)
   [abstract
    ["[0]" monad (.only do)]]
   [control
    ["<>" parser]
    ["[0]" maybe (.use "[1]#[0]" functor)]
    ["[0]" exception (.only Exception)]]
   [data
    ["[0]" product]
    [binary
     ["[0]" \\format]]
    ["[0]" text (.use "[1]#[0]" equivalence)
     ["%" \\format]
     ["<[1]>" \\parser]]
    [collection
     ["[0]" list (.use "[1]#[0]" monad mix monoid)]
     ["[0]" dictionary (.only Dictionary)]
     ["[0]" set (.only Set)]
     ["[0]" sequence]]]
   [math
    [number
     ["n" nat]
     ["[0]" i32]]]
   [meta
    ["[0]" location]
    [macro
     ["^" pattern]
     ["[0]" template]]
    [compiler
     [target
      [jvm
       ["[0]" version]
       ["[0]" modifier (.use "[1]#[0]" monoid)]
       ["[0]" method (.only Method)]
       ["[0]" class (.only Class)]
       [constant
        [pool (.only Resource)]]
       [encoding
        ["[0]" name]]
       ["_" bytecode (.only Bytecode) (.use "[1]#[0]" monad)
        ["__" instruction (.only Primitive_Array_Type)]]
       ["[0]" type (.only Type Typed Argument)
        ["[0]" category (.only Void Value' Value Return' Return Primitive Object Array Var Parameter)]
        ["[0]" box]
        ["[0]" reflection]
        ["[0]" signature]
        ["[0]" parser]]]]]]]]
 ["[0]" //
  [common (.only custom)]
  ["///[1]" ////
   [translation
    [extension (.only Nullary Unary Binary Trinary Variadic
                      nullary unary binary trinary variadic)]
    ["///" jvm (.only)
     ["[1][0]" runtime (.only Operation Bundle Phase Handler)]
     ["[1][0]" reference]
     ["[1][0]" value]
     [function
      [field
       [variable
        ["[0]" foreign]]]]]]
   ["[0]" extension (.only)
    [analysis
     ["/" jvm]]]
   ["/[1]" //
    ["[0]" phase]
    ["[1][0]" translation]
    ["[0]" synthesis (.only Path %synthesis)
     ["<[1]>" \\parser (.only Parser)]]
    [analysis (.only Environment)
     ["[0]" complex]]
    [///
     ["[1][0]" reference (.only)
      ["[2][0]" variable (.only Variable Register)]]
     [meta
      ["[0]" archive (.only Archive)
       ["[0]" artifact]
       ["[0]" unit]]
      ["[0]" cache
       [dependency
        ["[1]/[0]" artifact]]]]]]]])

(with_template [<name> <0>]
  [(def <name>
     (Bytecode Any)
     (all _.composite
          _.l2i
          <0>))]

  [l2s _.i2s]
  [l2b _.i2b]
  [l2c _.i2c]
  )

(with_template [<conversion> <name>]
  [(def (<name> inputG)
     (Unary (Bytecode Any))
     (if (same? _.nop <conversion>)
       inputG
       (all _.composite
            inputG
            <conversion>)))]
  
  [_.d2f conversion::double_to_float]
  [_.d2i conversion::double_to_int]
  [_.d2l conversion::double_to_long]
  
  [_.f2d conversion::float_to_double]
  [_.f2i conversion::float_to_int]
  [_.f2l conversion::float_to_long]
  
  [_.i2b conversion::int_to_byte]
  [_.i2c conversion::int_to_char]
  [_.i2d conversion::int_to_double]
  [_.i2f conversion::int_to_float]
  [_.i2l conversion::int_to_long]
  [_.i2s conversion::int_to_short]
  
  [_.l2d conversion::long_to_double]
  [_.l2f conversion::long_to_float]
  [_.l2i conversion::long_to_int]
  [..l2s conversion::long_to_short]
  [..l2b conversion::long_to_byte]
  [..l2c conversion::long_to_char]
  
  [_.i2b conversion::char_to_byte]
  [_.i2s conversion::char_to_short]
  [_.nop conversion::char_to_int]
  [_.i2l conversion::char_to_long]
  
  [_.i2l conversion::byte_to_long]
  
  [_.i2l conversion::short_to_long]
  )

(def with_conversion_extensions
  (-> Bundle
      Bundle)
  (|>> (dictionary.has (%.format "jvm_" "conversion_" "double_to_float" "#" "|translation") (unary conversion::double_to_float))
       (dictionary.has (%.format "jvm_" "conversion_" "double_to_int" "#" "|translation") (unary conversion::double_to_int))
       (dictionary.has (%.format "jvm_" "conversion_" "double_to_long" "#" "|translation") (unary conversion::double_to_long))
       
       (dictionary.has (%.format "jvm_" "conversion_" "float_to_double" "#" "|translation") (unary conversion::float_to_double))
       (dictionary.has (%.format "jvm_" "conversion_" "float_to_int" "#" "|translation") (unary conversion::float_to_int))
       (dictionary.has (%.format "jvm_" "conversion_" "float_to_long" "#" "|translation") (unary conversion::float_to_long))
       
       (dictionary.has (%.format "jvm_" "conversion_" "int_to_byte" "#" "|translation") (unary conversion::int_to_byte))
       (dictionary.has (%.format "jvm_" "conversion_" "int_to_char" "#" "|translation") (unary conversion::int_to_char))
       (dictionary.has (%.format "jvm_" "conversion_" "int_to_double" "#" "|translation") (unary conversion::int_to_double))
       (dictionary.has (%.format "jvm_" "conversion_" "int_to_float" "#" "|translation") (unary conversion::int_to_float))
       (dictionary.has (%.format "jvm_" "conversion_" "int_to_long" "#" "|translation") (unary conversion::int_to_long))
       (dictionary.has (%.format "jvm_" "conversion_" "int_to_short" "#" "|translation") (unary conversion::int_to_short))
       
       (dictionary.has (%.format "jvm_" "conversion_" "long_to_double" "#" "|translation") (unary conversion::long_to_double))
       (dictionary.has (%.format "jvm_" "conversion_" "long_to_float" "#" "|translation") (unary conversion::long_to_float))
       (dictionary.has (%.format "jvm_" "conversion_" "long_to_int" "#" "|translation") (unary conversion::long_to_int))
       (dictionary.has (%.format "jvm_" "conversion_" "long_to_short" "#" "|translation") (unary conversion::long_to_short))
       (dictionary.has (%.format "jvm_" "conversion_" "long_to_byte" "#" "|translation") (unary conversion::long_to_byte))
       (dictionary.has (%.format "jvm_" "conversion_" "long_to_char" "#" "|translation") (unary conversion::long_to_char))
       
       (dictionary.has (%.format "jvm_" "conversion_" "char_to_byte" "#" "|translation") (unary conversion::char_to_byte))
       (dictionary.has (%.format "jvm_" "conversion_" "char_to_short" "#" "|translation") (unary conversion::char_to_short))
       (dictionary.has (%.format "jvm_" "conversion_" "char_to_int" "#" "|translation") (unary conversion::char_to_int))
       (dictionary.has (%.format "jvm_" "conversion_" "char_to_long" "#" "|translation") (unary conversion::char_to_long))
       
       (dictionary.has (%.format "jvm_" "conversion_" "byte_to_long" "#" "|translation") (unary conversion::byte_to_long))
       
       (dictionary.has (%.format "jvm_" "conversion_" "short_to_long" "#" "|translation") (unary conversion::short_to_long))
       ))

(with_template [<name> <op>]
  [(def (<name> [parameter! subject!])
     (Binary (Bytecode Any))
     (all _.composite
          subject!
          parameter!
          <op>))]

  [int::+ _.iadd]
  [int::- _.isub]
  [int::* _.imul]
  [int::/ _.idiv]
  [int::% _.irem]
  [int::and _.iand]
  [int::or _.ior]
  [int::xor _.ixor]
  [int::shl _.ishl]
  [int::shr _.ishr]
  [int::ushr _.iushr]
  
  [long::+ _.ladd]
  [long::- _.lsub]
  [long::* _.lmul]
  [long::/ _.ldiv]
  [long::% _.lrem]
  [long::and _.land]
  [long::or _.lor]
  [long::xor _.lxor]
  [long::shl _.lshl]
  [long::shr _.lshr]
  [long::ushr _.lushr]

  [float::+ _.fadd]
  [float::- _.fsub]
  [float::* _.fmul]
  [float::/ _.fdiv]
  [float::% _.frem]
  
  [double::+ _.dadd]
  [double::- _.dsub]
  [double::* _.dmul]
  [double::/ _.ddiv]
  [double::% _.drem]
  )

(def $Boolean (type.class box.boolean (list)))
(def falseG (_.getstatic ..$Boolean "FALSE" ..$Boolean))
(def trueG (_.getstatic ..$Boolean "TRUE" ..$Boolean))

(with_template [<name> <op>]
  [(def (<name> [reference subject])
     (Binary (Bytecode Any))
     (do _.monad
       [@then _.new_label
        @end _.new_label]
       (all _.composite
            subject
            reference
            (<op> @then)
            falseG
            (_.goto @end)
            (_.set_label @then)
            trueG
            (_.set_label @end))))]

  [int::= _.if_icmpeq]
  [int::< _.if_icmplt]

  [char::= _.if_icmpeq]
  [char::< _.if_icmplt]
  )

(with_template [<name> <op> <reference>]
  [(def (<name> [reference subject])
     (Binary (Bytecode Any))
     (do _.monad
       [@then _.new_label
        @end _.new_label]
       (all _.composite
            subject
            reference
            <op>
            (_.int (i32.i32 (.i64 <reference>)))
            (_.if_icmpeq @then)
            falseG
            (_.goto @end)
            (_.set_label @then)
            trueG
            (_.set_label @end))))]

  [long::= _.lcmp +0]
  [long::< _.lcmp -1]
  
  [float::= _.fcmpg +0]
  [float::< _.fcmpg -1]

  [double::= _.dcmpg +0]
  [double::< _.dcmpg -1]
  )

(def with_int_extensions
  (-> Bundle
      Bundle)
  (let [type (reflection.reflection reflection.int)]
    (|>> (dictionary.has (%.format "jvm_" type "_" "+" "#" "|translation") (binary int::+))
         (dictionary.has (%.format "jvm_" type "_" "-" "#" "|translation") (binary int::-))
         (dictionary.has (%.format "jvm_" type "_" "*" "#" "|translation") (binary int::*))
         (dictionary.has (%.format "jvm_" type "_" "/" "#" "|translation") (binary int::/))
         (dictionary.has (%.format "jvm_" type "_" "%" "#" "|translation") (binary int::%))
         (dictionary.has (%.format "jvm_" type "_" "=" "#" "|translation") (binary int::=))
         (dictionary.has (%.format "jvm_" type "_" "<" "#" "|translation") (binary int::<))
         (dictionary.has (%.format "jvm_" type "_" "and" "#" "|translation") (binary int::and))
         (dictionary.has (%.format "jvm_" type "_" "or" "#" "|translation") (binary int::or))
         (dictionary.has (%.format "jvm_" type "_" "xor" "#" "|translation") (binary int::xor))
         (dictionary.has (%.format "jvm_" type "_" "shl" "#" "|translation") (binary int::shl))
         (dictionary.has (%.format "jvm_" type "_" "shr" "#" "|translation") (binary int::shr))
         (dictionary.has (%.format "jvm_" type "_" "ushr" "#" "|translation") (binary int::ushr))
         )))

(def with_long_extensions
  (-> Bundle
      Bundle)
  (let [type (reflection.reflection reflection.long)]
    (|>> (dictionary.has (%.format "jvm_" type "_" "+" "#" "|translation") (binary long::+))
         (dictionary.has (%.format "jvm_" type "_" "-" "#" "|translation") (binary long::-))
         (dictionary.has (%.format "jvm_" type "_" "*" "#" "|translation") (binary long::*))
         (dictionary.has (%.format "jvm_" type "_" "/" "#" "|translation") (binary long::/))
         (dictionary.has (%.format "jvm_" type "_" "%" "#" "|translation") (binary long::%))
         (dictionary.has (%.format "jvm_" type "_" "=" "#" "|translation") (binary long::=))
         (dictionary.has (%.format "jvm_" type "_" "<" "#" "|translation") (binary long::<))
         (dictionary.has (%.format "jvm_" type "_" "and" "#" "|translation") (binary long::and))
         (dictionary.has (%.format "jvm_" type "_" "or" "#" "|translation") (binary long::or))
         (dictionary.has (%.format "jvm_" type "_" "xor" "#" "|translation") (binary long::xor))
         (dictionary.has (%.format "jvm_" type "_" "shl" "#" "|translation") (binary long::shl))
         (dictionary.has (%.format "jvm_" type "_" "shr" "#" "|translation") (binary long::shr))
         (dictionary.has (%.format "jvm_" type "_" "ushr" "#" "|translation") (binary long::ushr))
         )))

(def with_float_extensions
  (-> Bundle
      Bundle)
  (let [type (reflection.reflection reflection.float)]
    (|>> (dictionary.has (%.format "jvm_" type "_" "+" "#" "|translation") (binary float::+))
         (dictionary.has (%.format "jvm_" type "_" "-" "#" "|translation") (binary float::-))
         (dictionary.has (%.format "jvm_" type "_" "*" "#" "|translation") (binary float::*))
         (dictionary.has (%.format "jvm_" type "_" "/" "#" "|translation") (binary float::/))
         (dictionary.has (%.format "jvm_" type "_" "%" "#" "|translation") (binary float::%))
         (dictionary.has (%.format "jvm_" type "_" "=" "#" "|translation") (binary float::=))
         (dictionary.has (%.format "jvm_" type "_" "<" "#" "|translation") (binary float::<))
         )))

(def with_double_extensions
  (-> Bundle
      Bundle)
  (let [type (reflection.reflection reflection.double)]
    (|>> (dictionary.has (%.format "jvm_" type "_" "+" "#" "|translation") (binary double::+))
         (dictionary.has (%.format "jvm_" type "_" "-" "#" "|translation") (binary double::-))
         (dictionary.has (%.format "jvm_" type "_" "*" "#" "|translation") (binary double::*))
         (dictionary.has (%.format "jvm_" type "_" "/" "#" "|translation") (binary double::/))
         (dictionary.has (%.format "jvm_" type "_" "%" "#" "|translation") (binary double::%))
         (dictionary.has (%.format "jvm_" type "_" "=" "#" "|translation") (binary double::=))
         (dictionary.has (%.format "jvm_" type "_" "<" "#" "|translation") (binary double::<))
         )))

(def with_char_extensions
  (-> Bundle
      Bundle)
  (let [type (reflection.reflection reflection.char)]
    (|>> (dictionary.has (%.format "jvm_" type "_" "=" "#" "|translation") (binary char::=))
         (dictionary.has (%.format "jvm_" type "_" "<" "#" "|translation") (binary char::<))
         )))

(with_template [<name> <category> <parser>]
  [(def .public <name>
     (Parser (Type <category>))
     (<text>.then <parser> <synthesis>.text))]

  [var Var parser.var]
  [class category.Class parser.class]
  [object Object parser.object]
  [value Value parser.value]
  [return Return parser.return]
  )

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

(def signature
  (All (_ category)
    (-> (Type category)
        Text))
  (|>> type.signature signature.signature))

(exception.def .public (not_an_object_array arrayJT)
  (Exception (Type Array))
  (exception.report
   (list ["JVM type" (..signature arrayJT)])))

(def .public object_array
  (Parser (Type Object))
  (do <>.monad
    [arrayJT (<text>.then parser.array <synthesis>.text)]
    (when (parser.array? arrayJT)
      {.#Some elementJT}
      (when (parser.object? elementJT)
        {.#Some elementJT}
        (in elementJT)

        {.#None}
        (<>.failure (exception.error ..not_an_object_array [arrayJT])))
      
      {.#None}
      (undefined))))

(def (primitive_array_length_handler jvm_primitive)
  (-> (Type Primitive)
      Handler)
  (..custom
   [<synthesis>.any
    (function (_ translate archive arrayS)
      (do phase.monad
        [arrayG (translate archive arrayS)]
        (in (all _.composite
                 arrayG
                 (_.checkcast (type.array jvm_primitive))
                 _.arraylength))))]))

(def array::length::object
  Handler
  (..custom
   [(all <>.and ..object_array <synthesis>.any)
    (function (_ translate archive [elementJT arrayS])
      (do phase.monad
        [arrayG (translate archive arrayS)]
        (in (all _.composite
                 arrayG
                 (_.checkcast (type.array elementJT))
                 _.arraylength))))]))

(def (new_primitive_array_handler jvm_primitive)
  (-> Primitive_Array_Type
      Handler)
  (..custom
   [<synthesis>.any
    (function (_ translate archive [lengthS])
      (do phase.monad
        [lengthG (translate archive lengthS)]
        (in (all _.composite
                 lengthG
                 (_.newarray jvm_primitive)))))]))

(def array::new::object
  Handler
  (..custom
   [(all <>.and ..object <synthesis>.any)
    (function (_ translate archive [objectJT lengthS])
      (do phase.monad
        [lengthG (translate archive lengthS)]
        (in (all _.composite
                 lengthG
                 (_.anewarray objectJT)))))]))

(def (read_primitive_array_handler jvm_primitive loadG)
  (-> (Type Primitive) (Bytecode Any)
      Handler)
  (..custom
   [(all <>.and <synthesis>.any <synthesis>.any)
    (function (_ translate archive [idxS arrayS])
      (do phase.monad
        [arrayG (translate archive arrayS)
         idxG (translate archive idxS)]
        (in (all _.composite
                 arrayG
                 (_.checkcast (type.array jvm_primitive))
                 idxG
                 loadG))))]))

(def array::read::object
  Handler
  (..custom
   [(all <>.and ..object_array <synthesis>.any <synthesis>.any)
    (function (_ translate archive [elementJT idxS arrayS])
      (do phase.monad
        [arrayG (translate archive arrayS)
         idxG (translate archive idxS)]
        (in (all _.composite
                 arrayG
                 (_.checkcast (type.array elementJT))
                 idxG
                 _.aaload))))]))

(def (write_primitive_array_handler jvm_primitive storeG)
  (-> (Type Primitive) (Bytecode Any)
      Handler)
  (..custom
   [(all <>.and <synthesis>.any <synthesis>.any <synthesis>.any)
    (function (_ translate archive [idxS valueS arrayS])
      (do phase.monad
        [arrayG (translate archive arrayS)
         idxG (translate archive idxS)
         valueG (translate archive valueS)]
        (in (all _.composite
                 arrayG
                 (_.checkcast (type.array jvm_primitive))
                 _.dup
                 idxG
                 valueG
                 storeG))))]))

(def array::write::object
  Handler
  (..custom
   [(all <>.and ..object_array <synthesis>.any <synthesis>.any <synthesis>.any)
    (function (_ translate archive [elementJT idxS valueS arrayS])
      (do phase.monad
        [arrayG (translate archive arrayS)
         idxG (translate archive idxS)
         valueG (translate archive valueS)]
        (in (all _.composite
                 arrayG
                 (_.checkcast (type.array elementJT))
                 _.dup
                 idxG
                 valueG
                 _.aastore))))]))

(def with_array_extensions
  (-> Bundle
      Bundle)
  (|>> (dictionary.has (%.format "jvm_" "array_" "length_" (reflection.reflection reflection.boolean) "#" "|translation") (primitive_array_length_handler type.boolean))
       (dictionary.has (%.format "jvm_" "array_" "length_" (reflection.reflection reflection.byte) "#" "|translation") (primitive_array_length_handler type.byte))
       (dictionary.has (%.format "jvm_" "array_" "length_" (reflection.reflection reflection.short) "#" "|translation") (primitive_array_length_handler type.short))
       (dictionary.has (%.format "jvm_" "array_" "length_" (reflection.reflection reflection.int) "#" "|translation") (primitive_array_length_handler type.int))
       (dictionary.has (%.format "jvm_" "array_" "length_" (reflection.reflection reflection.long) "#" "|translation") (primitive_array_length_handler type.long))
       (dictionary.has (%.format "jvm_" "array_" "length_" (reflection.reflection reflection.float) "#" "|translation") (primitive_array_length_handler type.float))
       (dictionary.has (%.format "jvm_" "array_" "length_" (reflection.reflection reflection.double) "#" "|translation") (primitive_array_length_handler type.double))
       (dictionary.has (%.format "jvm_" "array_" "length_" (reflection.reflection reflection.char) "#" "|translation") (primitive_array_length_handler type.char))
       (dictionary.has (%.format "jvm_" "array_" "length_" "object" "#" "|translation") array::length::object)

       (dictionary.has (%.format "jvm_" "array_" "new_" (reflection.reflection reflection.boolean) "#" "|translation") (new_primitive_array_handler __.t_boolean))
       (dictionary.has (%.format "jvm_" "array_" "new_" (reflection.reflection reflection.byte) "#" "|translation") (new_primitive_array_handler __.t_byte))
       (dictionary.has (%.format "jvm_" "array_" "new_" (reflection.reflection reflection.short) "#" "|translation") (new_primitive_array_handler __.t_short))
       (dictionary.has (%.format "jvm_" "array_" "new_" (reflection.reflection reflection.int) "#" "|translation") (new_primitive_array_handler __.t_int))
       (dictionary.has (%.format "jvm_" "array_" "new_" (reflection.reflection reflection.long) "#" "|translation") (new_primitive_array_handler __.t_long))
       (dictionary.has (%.format "jvm_" "array_" "new_" (reflection.reflection reflection.float) "#" "|translation") (new_primitive_array_handler __.t_float))
       (dictionary.has (%.format "jvm_" "array_" "new_" (reflection.reflection reflection.double) "#" "|translation") (new_primitive_array_handler __.t_double))
       (dictionary.has (%.format "jvm_" "array_" "new_" (reflection.reflection reflection.char) "#" "|translation") (new_primitive_array_handler __.t_char))
       (dictionary.has (%.format "jvm_" "array_" "new_" "object" "#" "|translation") array::new::object)

       (dictionary.has (%.format "jvm_" "array_" "read_" (reflection.reflection reflection.boolean) "#" "|translation") (read_primitive_array_handler type.boolean _.baload))
       (dictionary.has (%.format "jvm_" "array_" "read_" (reflection.reflection reflection.byte) "#" "|translation") (read_primitive_array_handler type.byte _.baload))
       (dictionary.has (%.format "jvm_" "array_" "read_" (reflection.reflection reflection.short) "#" "|translation") (read_primitive_array_handler type.short _.saload))
       (dictionary.has (%.format "jvm_" "array_" "read_" (reflection.reflection reflection.int) "#" "|translation") (read_primitive_array_handler type.int _.iaload))
       (dictionary.has (%.format "jvm_" "array_" "read_" (reflection.reflection reflection.long) "#" "|translation") (read_primitive_array_handler type.long _.laload))
       (dictionary.has (%.format "jvm_" "array_" "read_" (reflection.reflection reflection.float) "#" "|translation") (read_primitive_array_handler type.float _.faload))
       (dictionary.has (%.format "jvm_" "array_" "read_" (reflection.reflection reflection.double) "#" "|translation") (read_primitive_array_handler type.double _.daload))
       (dictionary.has (%.format "jvm_" "array_" "read_" (reflection.reflection reflection.char) "#" "|translation") (read_primitive_array_handler type.char _.caload))
       (dictionary.has (%.format "jvm_" "array_" "read_" "object" "#" "|translation") array::read::object)

       (dictionary.has (%.format "jvm_" "array_" "write_" (reflection.reflection reflection.boolean) "#" "|translation") (write_primitive_array_handler type.boolean _.bastore))
       (dictionary.has (%.format "jvm_" "array_" "write_" (reflection.reflection reflection.byte) "#" "|translation") (write_primitive_array_handler type.byte _.bastore))
       (dictionary.has (%.format "jvm_" "array_" "write_" (reflection.reflection reflection.short) "#" "|translation") (write_primitive_array_handler type.short _.sastore))
       (dictionary.has (%.format "jvm_" "array_" "write_" (reflection.reflection reflection.int) "#" "|translation") (write_primitive_array_handler type.int _.iastore))
       (dictionary.has (%.format "jvm_" "array_" "write_" (reflection.reflection reflection.long) "#" "|translation") (write_primitive_array_handler type.long _.lastore))
       (dictionary.has (%.format "jvm_" "array_" "write_" (reflection.reflection reflection.float) "#" "|translation") (write_primitive_array_handler type.float _.fastore))
       (dictionary.has (%.format "jvm_" "array_" "write_" (reflection.reflection reflection.double) "#" "|translation") (write_primitive_array_handler type.double _.dastore))
       (dictionary.has (%.format "jvm_" "array_" "write_" (reflection.reflection reflection.char) "#" "|translation") (write_primitive_array_handler type.char _.castore))
       (dictionary.has (%.format "jvm_" "array_" "write_" "object" "#" "|translation") array::write::object)
       ))

(def (object::null _)
  (Nullary (Bytecode Any))
  _.aconst_null)

(def (object::null? objectG)
  (Unary (Bytecode Any))
  (do _.monad
    [@then _.new_label
     @end _.new_label]
    (all _.composite
         objectG
         (_.ifnull @then)
         ..falseG
         (_.goto @end)
         (_.set_label @then)
         ..trueG
         (_.set_label @end))))

(def (object::synchronized [monitorG exprG])
  (Binary (Bytecode Any))
  (all _.composite
       monitorG
       _.dup
       _.monitorenter
       exprG
       _.swap
       _.monitorexit))

(def unitG
  (_.string synthesis.unit))

(def (object::throw exceptionG)
  (Unary (Bytecode Any))
  (all _.composite
       exceptionG
       (_.checkcast (type.class "java.lang.Throwable" (list)))
       ///runtime.throw
       unitG))

(def $Class (type.class "java.lang.Class" (list)))
(def $String (type.class "java.lang.String" (list)))

(def object::class
  Handler
  (..custom
   [<synthesis>.text
    (function (_ translate archive [class])
      (do phase.monad
        []
        (in (all _.composite
                 (_.string class)
                 (_.invokestatic ..$Class "forName" (type.method [(list) (list ..$String) ..$Class (list)]))))))]))

(def object::instance?
  Handler
  (..custom
   [(all <>.and <synthesis>.text <synthesis>.any)
    (function (_ translate archive [class objectS])
      (do phase.monad
        [objectG (translate archive objectS)]
        (in (all _.composite
                 objectG
                 (_.instanceof (type.class class (list)))
                 (///value.boxed type.boolean)))))]))

(def object::cast
  Handler
  (..custom
   [(all <>.and <synthesis>.text <synthesis>.text <synthesis>.any)
    (function (_ translate archive [from to valueS])
      (do phase.monad
        [valueG (translate archive valueS)]
        (in (`` (cond (,, (with_template [<object> <type>]
                            [(and (text#= (..reflection <type>) from)
                                  (text#= <object> to))
                             (all _.composite
                                  valueG
                                  (///value.boxed <type>))

                             (and (text#= <object> from)
                                  (text#= (..reflection <type>) to))
                             (all _.composite
                                  valueG
                                  (///value.primitive <type>))]
                            
                            [box.boolean type.boolean]
                            [box.byte    type.byte]
                            [box.short   type.short]
                            [box.int     type.int]
                            [box.long    type.long]
                            [box.char    type.char]
                            [box.float   type.float]
                            [box.double  type.double]))
                      ... else
                      valueG)))))]))

(def with_object_extensions
  (-> Bundle
      Bundle)
  (|>> (dictionary.has (%.format "jvm_" "object_" "null" "#" "|translation") (nullary object::null))
       (dictionary.has (%.format "jvm_" "object_" "null?" "#" "|translation") (unary object::null?))
       (dictionary.has (%.format "jvm_" "object_" "synchronized" "#" "|translation") (binary object::synchronized))
       (dictionary.has (%.format "jvm_" "object_" "throw" "#" "|translation") (unary object::throw))
       (dictionary.has (%.format "jvm_" "object_" "class" "#" "|translation") object::class)
       (dictionary.has (%.format "jvm_" "object_" "instance?" "#" "|translation") object::instance?)
       (dictionary.has (%.format "jvm_" "object_" "cast" "#" "|translation") object::cast)
       ))

(def get::static
  Handler
  (..custom
   [(all <>.and <synthesis>.text <synthesis>.text ..value)
    (function (_ translate archive [class field :unboxed:])
      (of phase.monad in (_.getstatic (type.class class (list)) field :unboxed:)))]))

(def put::static
  Handler
  (..custom
   [(all <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any)
    (function (_ translate archive [class field :unboxed: valueS])
      (do phase.monad
        [valueG (translate archive valueS)]
        (in (all _.composite
                 valueG
                 (when (parser.object? :unboxed:)
                   {.#Some :unboxed:}
                   (_.checkcast :unboxed:)
                   
                   {.#None}
                   (_#in []))
                 (_.putstatic (type.class class (list)) field :unboxed:)
                 ..unitG))))]))

(def get::virtual
  Handler
  (..custom
   [(all <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any)
    (function (_ translate archive [class field :unboxed: objectS])
      (do phase.monad
        [objectG (translate archive objectS)
         .let [:class: (type.class class (list))
               getG (_.getfield :class: field :unboxed:)]]
        (in (all _.composite
                 objectG
                 (_.checkcast :class:)
                 getG))))]))

(def put::virtual
  Handler
  (..custom
   [(all <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any <synthesis>.any)
    (function (_ translate archive [class field :unboxed: valueS objectS])
      (do phase.monad
        [valueG (translate archive valueS)
         objectG (translate archive objectS)
         .let [:class: (type.class class (list))
               putG (when (parser.object? :unboxed:)
                      {.#Some :unboxed:}
                      (all _.composite
                           (_.checkcast :unboxed:)
                           (_.putfield :class: field :unboxed:))
                      
                      {.#None}
                      (_.putfield :class: field :unboxed:))]]
        (in (all _.composite
                 objectG
                 (_.checkcast :class:)
                 _.dup
                 valueG
                 putG))))]))

(type Input
  (Typed synthesis.Term))

(def input
  (Parser Input)
  (<synthesis>.tuple (<>.and ..value <synthesis>.any)))

(def (translate_input translate archive [valueT valueS])
  (-> Phase Archive Input
      (Operation (Typed (Bytecode Any))))
  (do phase.monad
    [valueG (translate archive valueS)]
    (when (type.primitive? valueT)
      {.#Right valueT}
      (in [valueT valueG])
      
      {.#Left valueT}
      (in [valueT (all _.composite
                       valueG
                       (_.checkcast valueT))]))))

(def (prepare_output outputT)
  (-> (Type Return)
      (Bytecode Any))
  (when (type.void? outputT)
    {.#Right outputT}
    ..unitG
    
    {.#Left outputT}
    (_#in [])))

(def invoke::static
  Handler
  (..custom
   [(all <>.and ..class <synthesis>.text ..return (<>.some ..input))
    (function (_ translate archive [class method outputT inputsTS])
      (do [! phase.monad]
        [inputsTG (monad.each ! (translate_input translate archive) inputsTS)]
        (in (all _.composite
                 (monad.each _.monad product.right inputsTG)
                 (_.invokestatic class method (type.method [(list) (list#each product.left inputsTG) outputT (list)]))
                 (prepare_output outputT)))))]))

(with_template [<check_cast?> <name> <invoke>]
  [(def <name>
     Handler
     (..custom
      [(all <>.and ..class <synthesis>.text ..return <synthesis>.any (<>.some ..input))
       (function (_ translate archive [class method outputT objectS inputsTS])
         (do [! phase.monad]
           [objectG (translate archive objectS)
            inputsTG (monad.each ! (translate_input translate archive) inputsTS)]
           (in (all _.composite
                    objectG
                    (if <check_cast?>
                      (_.checkcast class)
                      (_#in []))
                    (monad.each _.monad product.right inputsTG)
                    (<invoke> class method (type.method [(list) (list#each product.left inputsTG) outputT (list)]))
                    (prepare_output outputT)))))]))]

  [#1 invoke::virtual _.invokevirtual]
  [#0 invoke::special _.invokespecial]
  [#1 invoke::interface _.invokeinterface]
  )

(def invoke::constructor
  Handler
  (..custom
   [(all <>.and ..class (<>.some ..input))
    (function (_ translate archive [class inputsTS])
      (do [! phase.monad]
        [inputsTG (monad.each ! (translate_input translate archive) inputsTS)]
        (in (all _.composite
                 (_.new class)
                 _.dup
                 (monad.each _.monad product.right inputsTG)
                 (_.invokespecial class "<init>" (type.method [(list) (list#each product.left inputsTG) type.void (list)]))))))]))

(def with_member_extensions
  (-> Bundle
      Bundle)
  (|>> (dictionary.has (%.format "jvm_" "member_" "get_" "static" "#" "|translation") get::static)
       (dictionary.has (%.format "jvm_" "member_" "get_" "virtual" "#" "|translation") get::virtual)
       
       (dictionary.has (%.format "jvm_" "member_" "put_" "static" "#" "|translation") put::static)
       (dictionary.has (%.format "jvm_" "member_" "put_" "virtual" "#" "|translation") put::virtual)
       
       (dictionary.has (%.format "jvm_" "member_" "invoke_" "static" "#" "|translation") invoke::static)
       (dictionary.has (%.format "jvm_" "member_" "invoke_" "virtual" "#" "|translation") invoke::virtual)
       (dictionary.has (%.format "jvm_" "member_" "invoke_" "special" "#" "|translation") invoke::special)
       (dictionary.has (%.format "jvm_" "member_" "invoke_" "interface" "#" "|translation") invoke::interface)
       (dictionary.has (%.format "jvm_" "member_" "invoke_" "constructor" "#" "|translation") invoke::constructor)
       ))

(def annotation_parameter
  (Parser (/.Annotation_Parameter synthesis.Term))
  (<synthesis>.tuple (<>.and <synthesis>.text <synthesis>.any)))

(def annotation
  (Parser (/.Annotation synthesis.Term))
  (<synthesis>.tuple (<>.and <synthesis>.text (<>.some ..annotation_parameter))))

(def argument
  (Parser Argument)
  (<synthesis>.tuple (<>.and <synthesis>.text ..value)))

(def .public (hidden_method_body arity body)
  (-> Nat synthesis.Term
      synthesis.Term)
  (with_expansions [<oops> (panic! (%.format (%.nat arity) " " (synthesis.%synthesis body)))]
    (when [arity body]
      (^.or [0 _]
            [1 _])
      body
      
      [2 [@ {synthesis.#Control {synthesis.#Branch {synthesis.#Let _ 2 (synthesis.tuple @ (list _ hidden))}}}]]
      hidden
      
      [_ [@ {synthesis.#Control {synthesis.#Branch {synthesis.#When _ path}}}]]
      (loop (again [path (is Path path)])
        (when path
          {synthesis.#Seq _ next}
          (again next)
          
          {synthesis.#Then (synthesis.tuple @ (list _ hidden))}
          hidden
          
          _
          <oops>))

      _
      <oops>)))

(def (without_fake_parameter#path without_fake_parameter)
  (-> (-> synthesis.Term synthesis.Term)
      (-> Path Path))
  (function (again it)
    (when it
      (^.or {synthesis.#Pop}
            {synthesis.#Access _})
      it
      
      {synthesis.#Bind it}
      {synthesis.#Bind (-- it)}
      
      {synthesis.#Bit_Fork when then else}
      {synthesis.#Bit_Fork when
                           (again then)
                           (maybe#each again else)}

      (^.with_template [<tag>]
        [{<tag> [head tail]}
         {<tag> [(revised synthesis.#then again head)
                 (list#each (revised synthesis.#then again) tail)]}])
      ([synthesis.#I64_Fork]
       [synthesis.#F64_Fork]
       [synthesis.#Text_Fork])
      
      (^.with_template [<tag>]
        [{<tag> left right}
         {<tag> (again left) (again right)}])
      ([synthesis.#Seq]
       [synthesis.#Alt])
      
      {synthesis.#Then it}
      {synthesis.#Then (without_fake_parameter it)})))

(def .public (without_fake_parameter it)
  (-> synthesis.Term
      synthesis.Term)
  (when it
    [@ {synthesis.#Simple _}]
    it
    
    [@ {synthesis.#Structure it}]
    [@ {synthesis.#Structure
        (when it
          {complex.#Variant it}
          {complex.#Variant (revised complex.#value without_fake_parameter it)}

          {complex.#Tuple it}
          {complex.#Tuple (list#each without_fake_parameter it)})}]
    
    [@ {synthesis.#Reference it}]
    [@ {synthesis.#Reference
        (when it
          {//////reference.#Variable it}
          {//////reference.#Variable
           (when it
             {//////variable.#Local it}
             {//////variable.#Local (-- it)}
             
             {//////variable.#Foreign _}
             it)}
          
          {//////reference.#Constant _}
          it)}]
    
    [@ {synthesis.#Control it}]
    [@ {synthesis.#Control
        (when it
          {synthesis.#Branch it}
          {synthesis.#Branch
           (when it
             {synthesis.#Exec before after}
             {synthesis.#Exec (without_fake_parameter before)
                              (without_fake_parameter after)}
             
             {synthesis.#Let value register body}
             {synthesis.#Let (without_fake_parameter value)
                             (-- register)
                             (without_fake_parameter body)}
             
             {synthesis.#If when then else}
             {synthesis.#If (without_fake_parameter when)
                            (without_fake_parameter then)
                            (without_fake_parameter else)}
             
             {synthesis.#Get members record}
             {synthesis.#Get members
                             (without_fake_parameter record)}
             
             {synthesis.#When value path}
             {synthesis.#When (without_fake_parameter value)
                              (without_fake_parameter#path without_fake_parameter path)})}
          
          {synthesis.#Loop it}
          {synthesis.#Loop
           (when it
             {synthesis.#Scope [synthesis.#start start
                                synthesis.#inits inits
                                synthesis.#iteration iteration]}
             {synthesis.#Scope [synthesis.#start (-- start)
                                synthesis.#inits (list#each without_fake_parameter inits)
                                synthesis.#iteration iteration]}
             
             {synthesis.#Again _}
             it)}
          
          {synthesis.#Function it}
          {synthesis.#Function
           (when it
             {synthesis.#Abstraction [synthesis.#environment environment
                                      synthesis.#arity arity
                                      synthesis.#body body]}
             {synthesis.#Abstraction [synthesis.#environment (list#each without_fake_parameter environment)
                                      synthesis.#arity arity
                                      synthesis.#body body]}
             
             {synthesis.#Apply [synthesis.#function function
                                synthesis.#arguments arguments]}
             {synthesis.#Apply [synthesis.#function (without_fake_parameter function)
                                synthesis.#arguments (list#each without_fake_parameter arguments)]})})}]

    [@ {synthesis.#Extension name parameters}]
    [@ {synthesis.#Extension name (list#each without_fake_parameter parameters)}]))

(def overriden_method_definition
  (Parser [(Environment synthesis.Term) (/.Overriden_Method synthesis.Term)])
  (<synthesis>.tuple (do <>.monad
                       [_ (<synthesis>.this_text /.overriden_tag)
                        ownerT ..class
                        name <synthesis>.text
                        strict_fp? <synthesis>.bit
                        annotations (<synthesis>.tuple (<>.some ..annotation))
                        vars (<synthesis>.tuple (<>.some ..var))
                        self_name <synthesis>.text
                        arguments (<synthesis>.tuple (<>.some ..argument))
                        returnT ..return
                        exceptionsT (<synthesis>.tuple (<>.some ..class))
                        [environment _ _ body] (<| (<synthesis>.function 1)
                                                   (<synthesis>.loop (<>.exactly 0 <synthesis>.any))
                                                   <synthesis>.tuple
                                                   (<>.after <synthesis>.any)
                                                   <synthesis>.any)
                        .let [arity (list.size arguments)]]
                       (in [environment
                            [ownerT name
                             strict_fp? annotations vars
                             self_name arguments returnT exceptionsT
                             (<| (..hidden_method_body arity)
                                 (when arity
                                   0 (without_fake_parameter body)
                                   _ body))]]))))

(def (normalize_path normalize)
  (-> (-> synthesis.Term synthesis.Term)
      (-> Path Path))
  (function (again path)
    (when path
      (synthesis.path/then bodyS)
      (synthesis.path/then (normalize bodyS))

      (^.with_template [<tag>]
        [{<tag> leftP rightP}
         {<tag> (again leftP) (again rightP)}])
      ([synthesis.#Alt]
       [synthesis.#Seq])

      (^.with_template [<tag>]
        [{<tag> _}
         path])
      ([synthesis.#Pop]
       [synthesis.#Bind]
       [synthesis.#Access])

      {synthesis.#Bit_Fork when then else}
      {synthesis.#Bit_Fork when (again then) (maybe#each again else)}

      (^.with_template [<tag>]
        [{<tag> [[exampleH nextH] tail]}
         {<tag> [[exampleH (again nextH)]
                 (list#each (function (_ [example next])
                              [example (again next)])
                            tail)]}])
      ([synthesis.#I64_Fork]
       [synthesis.#F64_Fork]
       [synthesis.#Text_Fork]))))

(type Mapping
  (Dictionary synthesis.Term Variable))

(def (normalize_method_body mapping)
  (-> Mapping synthesis.Term
      synthesis.Term)
  (function (again body)
    (when body
      (^.with_template [<tag>]
        [<tag>
         body])
      ([[@ {synthesis.#Simple _}]]
       [(synthesis.constant @ _)])

      (synthesis.variant @ [lefts right? sub])
      (synthesis.variant @ [lefts right? (again sub)])

      (synthesis.tuple @ members)
      (synthesis.tuple @ (list#each again members))

      (synthesis.variable @ var)
      (|> mapping
          (dictionary.value body)
          (maybe.else var)
          (synthesis.variable @))

      (synthesis.branch/when @ [inputS pathS])
      (synthesis.branch/when @ [(again inputS) (normalize_path again pathS)])

      (synthesis.branch/exec @ [this that])
      (synthesis.branch/exec @ [(again this) (again that)])

      (synthesis.branch/let @ [inputS register outputS])
      (synthesis.branch/let @ [(again inputS) register (again outputS)])

      (synthesis.branch/if @ [testS thenS elseS])
      (synthesis.branch/if @ [(again testS) (again thenS) (again elseS)])

      (synthesis.branch/get @ [path recordS])
      (synthesis.branch/get @ [path (again recordS)])

      (synthesis.loop/scope @ [offset initsS+ bodyS])
      (synthesis.loop/scope @ [offset (list#each again initsS+) (again bodyS)])

      (synthesis.loop/again @ updatesS+)
      (synthesis.loop/again @ (list#each again updatesS+))

      (synthesis.function/abstraction @ [environment arity bodyS])
      (synthesis.function/abstraction @ [(list#each (function (_ captured)
                                                      (when captured
                                                        (synthesis.variable @ var)
                                                        (|> mapping
                                                            (dictionary.value captured)
                                                            (maybe.else var)
                                                            (synthesis.variable @))

                                                        _
                                                        captured))
                                                    environment)
                                         arity
                                         bodyS])

      (synthesis.function/apply @ [functionS inputsS+])
      (synthesis.function/apply @ [(again functionS) (list#each again inputsS+)])

      [@ {synthesis.#Extension [name inputsS+]}]
      [@ {synthesis.#Extension [name (list#each again inputsS+)]}])))

(def $Object
  (type.class "java.lang.Object" (list)))

(def (anonymous_init_method env inputsTI)
  (-> (Environment synthesis.Term) (List (Typed (Bytecode Any)))
      (Type category.Method))
  (type.method [(list)
                (list.repeated (n.+ (list.size inputsTI) (list.size env)) ..$Object)
                type.void
                (list)]))

(def (with_anonymous_init class env super_class inputsTG)
  (-> (Type category.Class) (Environment synthesis.Term) (Type category.Class) (List (Typed (Bytecode Any)))
      (Resource Method))
  (let [inputs_offset (list.size inputsTG)
        inputs! (|> inputsTG
                    list.enumeration
                    (list#each (function (_ [register [type term]])
                                 (let [then! (when (type.primitive? type)
                                               {.#Right type}
                                               (///value.primitive type)
                                               
                                               {.#Left type}
                                               (_.checkcast type))]
                                   (all _.composite
                                        (_.aload (++ register))
                                        then!))))
                    list.reversed
                    (list#mix _.composite (_#in [])))
        store_captured! (|> env
                            list.size
                            list.indices
                            (monad.each _.monad (.function (_ register)
                                                  (all _.composite
                                                       (_.aload 0)
                                                       (_.aload (n.+ inputs_offset (++ register)))
                                                       (_.putfield class (///reference.foreign_name register) $Object)))))]
    (method.method method.public "<init>"
      true (anonymous_init_method env inputsTG)
      (list)
      {.#Some (all _.composite
                   (_.aload 0)
                   inputs!
                   (_.invokespecial super_class "<init>" (type.method [(list) (list#each product.left inputsTG) type.void (list)]))
                   store_captured!
                   _.return)})))

(def (anonymous_instance translate archive class env inputsTI)
  (-> Phase Archive (Type category.Class) (Environment synthesis.Term) (List (Typed (Bytecode Any)))
      (Operation (Bytecode Any)))
  (do [! phase.monad]
    [captureG+ (monad.each ! (translate archive) env)]
    (in (all _.composite
             (_.new class)
             _.dup
             (|> inputsTI
                 (list#each product.right)
                 list.reversed
                 (list#mix _.composite (_#in [])))
             (monad.all _.monad captureG+)
             (_.invokespecial class "<init>" (anonymous_init_method env inputsTI))))))

(def (returnG returnT)
  (-> (Type Return)
      (Bytecode Any))
  (when (type.void? returnT)
    {.#Right returnT}
    _.return

    {.#Left returnT}
    (when (type.primitive? returnT)
      {.#Left returnT}
      (when (type.class? returnT)
        {.#Some class_name}
        (all _.composite
             (_.checkcast returnT)
             _.areturn)

        {.#None}
        _.areturn)
      
      {.#Right returnT}
      (template.let [(unwrap_primitive <return> <type>)
                     [(all _.composite
                           (///value.primitive <type>)
                           <return>)]]
        (`` (cond (,, (with_template [<return> <type>]
                        [(of type.equivalence = <type> returnT)
                         (unwrap_primitive <return> <type>)]

                        [_.ireturn type.boolean]
                        [_.ireturn type.byte]
                        [_.ireturn type.short]
                        [_.ireturn type.int]
                        [_.ireturn type.char]
                        [_.freturn type.float]
                        [_.lreturn type.long]))

                  ... (of type.equivalence = type.double returnT)
                  (unwrap_primitive _.dreturn type.double)))))))

(def (method_dependencies archive method)
  (-> Archive (/.Overriden_Method synthesis.Term)
      (Operation (Set unit.ID)))
  (let [[_super _name _strict_fp? _annotations
         _t_vars _this _arguments _return _exceptions
         bodyS] method]
    (cache/artifact.dependencies archive bodyS)))

(def (anonymous_dependencies archive inputsTS overriden_methods)
  (-> Archive (List Input) (List [(Environment synthesis.Term) (/.Overriden_Method synthesis.Term)])
      (Operation (Set unit.ID)))
  (do [! phase.monad]
    [all_input_dependencies (monad.each ! (|>> product.right (cache/artifact.dependencies archive)) inputsTS)
     all_closure_dependencies (|> overriden_methods
                                  (list#each product.left)
                                  list.together
                                  (monad.each ! (cache/artifact.dependencies archive)))
     all_method_dependencies (monad.each ! (|>> product.right (method_dependencies archive)) overriden_methods)]
    (in (cache/artifact.all (all list#composite
                                 all_input_dependencies
                                 all_closure_dependencies
                                 all_method_dependencies)))))

(def (prepare_argument lux_register argumentT jvm_register)
  (-> Register (Type Value) Register
      [Register (Bytecode Any)])
  (when (type.primitive? argumentT)
    {.#Left argumentT}
    [(n.+ 1 jvm_register)
     (if (n.= lux_register jvm_register)
       (_#in [])
       (all _.composite
            (_.aload jvm_register)
            (_.astore lux_register)))]
    
    {.#Right argumentT}
    (template.let [(wrap_primitive <shift> <load> <type>)
                   [[(n.+ <shift> jvm_register)
                     (all _.composite
                          (<load> jvm_register)
                          (///value.boxed <type>)
                          (_.astore lux_register))]]]
      (`` (cond (,, (with_template [<shift> <load> <type>]
                      [(of type.equivalence = <type> argumentT)
                       (wrap_primitive <shift> <load> <type>)]

                      [1 _.iload type.boolean]
                      [1 _.iload type.byte]
                      [1 _.iload type.short]
                      [1 _.iload type.int]
                      [1 _.iload type.char]
                      [1 _.fload type.float]
                      [2 _.lload type.long]))

                ... (of type.equivalence = type.double argumentT)
                (wrap_primitive 2 _.dload type.double))))))

(def .public (prepare_arguments offset types)
  (-> Nat (List (Type Value))
      (Bytecode Any))
  (|> types
      list.enumeration
      (list#mix (function (_ [lux_register type] [jvm_register before])
                  (let [[jvm_register' after] (prepare_argument (n.+ offset lux_register) type jvm_register)]
                    [jvm_register'
                     (all _.composite
                          before
                          after)]))
                (is [Register (Bytecode Any)]
                    [offset
                     (_#in [])]))
      product.right))

(def (normalized_method global_mapping [environment method])
  (-> Mapping [(Environment synthesis.Term) (/.Overriden_Method synthesis.Term)]
      (/.Overriden_Method synthesis.Term))
  (let [[ownerT name strict_fp? annotations vars self_name arguments returnT exceptionsT body] method
        local_mapping (|> environment
                          list.enumeration
                          (list#each (function (_ [foreign_id capture])
                                       [(synthesis.variable/foreign location.dummy foreign_id)
                                        (|> global_mapping
                                            (dictionary.value capture)
                                            maybe.trusted)]))
                          (dictionary.of_list synthesis.hash))]
    [ownerT name
     strict_fp? annotations vars
     self_name arguments returnT exceptionsT
     (normalize_method_body local_mapping body)]))

(def (total_environment overriden_methods)
  (-> (List [(Environment synthesis.Term) (/.Overriden_Method synthesis.Term)])
      (List synthesis.Term))
  (|> overriden_methods
      ... Get all the environments.
      (list#each product.left)
      ... Combine them.
      list#conjoint
      ... Remove duplicates.
      (set.of_list synthesis.hash)
      set.list))

(def (global_mapping total_environment)
  (-> (List synthesis.Term)
      Mapping)
  (|> total_environment
      ... Give them names as "foreign" variables.
      list.enumeration
      (list#each (function (_ [id capture])
                   [capture {//////variable.#Foreign id}]))
      (dictionary.of_list synthesis.hash)))

(def (method_definition phase archive artifact_id method)
  (-> Phase Archive artifact.ID (/.Overriden_Method synthesis.Term)
      (Operation (Resource Method)))
  (let [[ownerT name strict_fp? annotations vars self_name arguments returnT exceptionsT bodyS] method]
    (do phase.monad
      [bodyG (//////translation.with_context artifact_id
               (phase archive bodyS))
       .let [argumentsT (list#each product.right arguments)
             methodT (type.method [vars argumentsT returnT exceptionsT])]]
      (in (method.method (all modifier#composite
                              method.public
                              method.final
                              (if strict_fp?
                                method.strict
                                modifier#identity))
            name
            true methodT
            (list)
            {.#Some (all _.composite
                         (prepare_arguments 1 argumentsT)
                         bodyG
                         (returnG returnT))})))))

(def class::anonymous
  Handler
  (..custom
   [(all <>.and
         ..class
         (<synthesis>.tuple (<>.some ..class))
         (<synthesis>.tuple (<>.some ..input))
         (<synthesis>.tuple (<>.some ..overriden_method_definition)))
    (function (_ translate archive [super_class
                                    super_interfaces
                                    inputsTS
                                    overriden_methods])
      (do [! phase.monad]
        [all_dependencies (anonymous_dependencies archive inputsTS overriden_methods)
         [context _] (//////translation.with_new_context archive all_dependencies (in []))
         .let [[module_id artifact_id] context
               anonymous_class_name (///runtime.class_name context)
               class (type.class anonymous_class_name (list))
               total_environment (..total_environment overriden_methods)
               global_mapping (..global_mapping total_environment)]
         inputsTI (monad.each ! (translate_input translate archive) inputsTS)
         methods! (|> overriden_methods
                      (list#each (normalized_method global_mapping))
                      (monad.each ! (method_definition translate archive artifact_id)))
         bytecode (<| (of ! each (\\format.result class.format))
                      phase.of_try
                      (class.class version.v6_0 (all modifier#composite class.public class.final)
                        (name.internal anonymous_class_name)
                        {.#None}
                        (name.internal (..reflection super_class))
                        (list#each (|>> ..reflection name.internal) super_interfaces)
                        (foreign.variables total_environment)
                        (list.partial (..with_anonymous_init class total_environment super_class inputsTI)
                                      methods!)
                        (list)))
         .let [artifact [anonymous_class_name bytecode]]
         _ (//////translation.execute! artifact)
         _ (//////translation.save! artifact_id {.#None} artifact)]
        (anonymous_instance translate archive class total_environment inputsTI)))]))

(def with_class_extensions
  (-> Bundle
      Bundle)
  (dictionary.has (%.format "jvm_" "class_" "anonymous" "#" "|translation") class::anonymous))

(def .public bundle
  Bundle
  (<| with_conversion_extensions
      with_int_extensions
      with_long_extensions
      with_float_extensions
      with_double_extensions
      with_char_extensions
      with_array_extensions
      with_object_extensions
      with_member_extensions
      with_class_extensions
      extension.empty))