(.require
 [library
  [lux (.except Type Declaration Double int char is as type)
   [abstract
    ["[0]" monad (.only do)]]
   [control
    ["<>" parser (.use "[1]#[0]" monad)]
    ["[0]" io]
    ["[0]" maybe]
    ["[0]" try (.only Try)]
    ["[0]" exception (.only Exception)]]
   [data
    ["[0]" product]
    ["[0]" text (.use "[1]#[0]" equivalence)
     ["%" \\format (.only format)]
     ["<[1]>" \\parser]]
    [collection
     ["[0]" array]
     ["[0]" list (.use "[1]#[0]" monad mix monoid)]
     ["[0]" dictionary (.only Dictionary)]]]
   [math
    [number
     ["n" nat]]]
   ["[0]" meta (.use "[1]#[0]" monad)
    ["[0]" code (.only)
     ["<[1]>" \\parser(.only Parser)]]
    [macro (.only with_symbols)
     [syntax (.only syntax)]
     ["^" pattern]
     ["[0]" template]
     ["[0]" context]]
    ["[0]" type (.use "[1]#[0]" equivalence)
     ["[0]" check]]
    [target
     ["[0]" jvm
      [encoding
       ["[0]" name (.only External)]]
      ["[1]" type (.only Type Argument Typed)
       ["[0]" category (.only Void Value' Value Return' Return Method Primitive Object Class Array Var Parameter Declaration)]
       ["[0]" box]
       ["[0]" descriptor]
       ["[0]" signature]
       ["[0]" reflection]
       ["[0]" parser]]]]]]])

(def internal
  (-> External Text)
  (|>> name.internal
       name.read))

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

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

(with_template [<name> <class>]
  [(`` (def .public <name>
         .Type
         {.#Nominal <class> {.#End}}))]

  [Boolean   box.boolean]
  [Byte      box.byte]
  [Short     box.short]
  [Integer   box.int]
  [Long      box.long]
  [Float     box.float]
  [Double    box.double]
  [Character box.char]
  [String    "java.lang.String"]
  )

(with_template [<name> <class>]
  [(`` (def .public <name>
         .Type
         {.#Nominal (reflection.reflection <class>) {.#End}}))]

  ... Primitives
  [boolean   reflection.boolean]
  [byte      reflection.byte]
  [short     reflection.short]
  [int       reflection.int]
  [long      reflection.long]
  [float     reflection.float]
  [double    reflection.double]
  [char      reflection.char]
  )

(def (get_static_field class field)
  (-> Text Text Code)
  (` (.jvm_member_get_static# (, (code.text class))
                              (, (code.text field)))))

(def (get_virtual_field class field object)
  (-> Text Text Code Code)
  (` (.jvm_member_get_virtual# (, (code.text class))
                               (, (code.text field))
                               (, object))))

(def boxes
  (Dictionary (Type Value) Text)
  (|> (list [jvm.boolean box.boolean]
            [jvm.byte    box.byte]
            [jvm.short   box.short]
            [jvm.int     box.int]
            [jvm.long    box.long]
            [jvm.float   box.float]
            [jvm.double  box.double]
            [jvm.char    box.char])
      (dictionary.of_list jvm.hash)))

(with_template [<name> <pre> <post>]
  [(def (<name> unboxed boxed raw)
     (-> (Type Value) Text Code Code)
     (let [unboxed (..reflection unboxed)]
       (` (|> (, raw)
              (.is (.Nominal (, (code.text <pre>))))
              .jvm_object_cast#
              (.is (.Nominal (, (code.text <post>))))))))]

  [unbox boxed unboxed]
  [box unboxed boxed]
  )

(with_template [<name> <op> <from> <to>]
  [(def .public <name>
     (template (<name> value)
       [(|> value
            (.is <from>)
            .jvm_object_cast#
            <op>
            .jvm_object_cast#
            (.is <to>))]))]

  [byte_to_long    .jvm_conversion_byte_to_long#    ..Byte      ..Long]

  [short_to_long   .jvm_conversion_short_to_long#   ..Short     ..Long]
  
  [double_to_int   .jvm_conversion_double_to_int#   ..Double    ..Integer]
  [double_to_long  .jvm_conversion_double_to_long#  ..Double    ..Long]
  [double_to_float .jvm_conversion_double_to_float# ..Double    ..Float]

  [float_to_int    .jvm_conversion_float_to_int#    ..Float     ..Integer]
  [float_to_long   .jvm_conversion_float_to_long#   ..Float     ..Long]
  [float_to_double .jvm_conversion_float_to_double# ..Float     ..Double]
  
  [int_to_byte     .jvm_conversion_int_to_byte#     ..Integer   ..Byte]
  [int_to_short    .jvm_conversion_int_to_short#    ..Integer   ..Short]
  [int_to_long     .jvm_conversion_int_to_long#     ..Integer   ..Long]
  [int_to_float    .jvm_conversion_int_to_float#    ..Integer   ..Float]
  [int_to_double   .jvm_conversion_int_to_double#   ..Integer   ..Double]
  [int_to_char     .jvm_conversion_int_to_char#     ..Integer   ..Character]

  [long_to_byte    .jvm_conversion_long_to_byte#    ..Long      ..Byte]
  [long_to_short   .jvm_conversion_long_to_short#   ..Long      ..Short]
  [long_to_int     .jvm_conversion_long_to_int#     ..Long      ..Integer]
  [long_to_float   .jvm_conversion_long_to_float#   ..Long      ..Float]
  [long_to_double  .jvm_conversion_long_to_double#  ..Long      ..Double]

  [char_to_byte    .jvm_conversion_char_to_byte#    ..Character ..Byte]
  [char_to_short   .jvm_conversion_char_to_short#   ..Character ..Short]
  [char_to_int     .jvm_conversion_char_to_int#     ..Character ..Integer]
  [char_to_long    .jvm_conversion_char_to_long#    ..Character ..Long]
  )

(with_template [<name> <from> <to> <0> <1>]
  [(def .public <name>
     (template (<name> value)
       [(|> value <0> <1>)]))]

  [long_to_char ..Long ..Character ..long_to_int ..int_to_char]
  [byte_to_int ..Byte ..Integer ..byte_to_long ..long_to_int]
  [short_to_int ..Short ..Integer ..short_to_long ..long_to_int]
  [byte_to_char ..Byte ..Character ..byte_to_int ..int_to_char]
  [short_to_char ..Short ..Character ..short_to_int ..int_to_char]
  )

(def constructor_method_name
  "<init>")

(.type Primitive_Mode
  (Variant
   {#ManualPrM}
   {#AutoPrM}))

(.type .public Privacy
  (Variant
   {#PublicP}
   {#PrivateP}
   {#ProtectedP}
   {#DefaultP}))

(.type .public State
  (Variant
   {#VolatileS}
   {#FinalS}
   {#DefaultS}))

(.type .public Inheritance
  (Variant
   {#FinalI}
   {#AbstractI}
   {#DefaultI}))

(.type Class_Kind
  (Variant
   {#Class}
   {#Interface}))

(.type StackFrame
  (.Nominal "java/lang/StackTraceElement"))

(.type StackTrace
  (array.Array StackFrame))

(.type Annotation_Parameter
  [Text Code])

(.type Annotation
  (Record
   [#ann_name   Text
    #ann_params (List Annotation_Parameter)]))

(.type Member_Declaration
  (Record
   [#member_name Text
    #member_privacy Privacy
    #member_anns (List Annotation)]))

(.type FieldDecl
  (Variant
   {#ConstantField (Type Value) Code}
   {#VariableField [State Bit (Type Value)]}))

(.type MethodDecl
  (Record
   [#method_tvars  (List (Type Var))
    #method_inputs (List (Type Value))
    #method_output (Type Return)
    #method_exs    (List (Type Class))]))

(.type Method_Definition
  (Variant
   {#ConstructorMethod [Bit
                        (List (Type Var))
                        Text
                        (List Argument)
                        (List (Typed Code))
                        Code
                        (List (Type Class))]}
   {#VirtualMethod [Bit
                    Bit
                    (List (Type Var))
                    Text
                    (List Argument)
                    (Type Return)
                    Code
                    (List (Type Class))]}
   {#OverridenMethod [Bit
                      (Type Declaration)
                      (List (Type Var))
                      Text
                      (List Argument)
                      (Type Return)
                      Code
                      (List (Type Class))]}
   {#StaticMethod [Bit
                   (List (Type Var))
                   (List Argument)
                   (Type Return)
                   Code
                   (List (Type Class))]}
   {#AbstractMethod [(List (Type Var))
                     (List Argument)
                     (Type Return)
                     (List (Type Class))]}
   {#NativeMethod [(List (Type Var))
                   (List Argument)
                   (Type Return)
                   (List (Type Class))]}))

(.type Partial_Call
  (Record
   [#pc_method Symbol
    #pc_args   (List Code)]))

(.type ImportMethodKind
  (Variant
   {#StaticIMK}
   {#VirtualIMK}))

(.type ImportMethodCommons
  (Record
   [#import_member_mode   Primitive_Mode
    #import_member_alias  Text
    #import_member_kind   ImportMethodKind
    #import_member_tvars  (List (Type Var))
    #import_member_args   (List [Bit (Type Value)])
    #import_member_maybe? Bit
    #import_member_try?   Bit
    #import_member_io?    Bit]))

(.type ImportConstructorDecl
  (Record
   []))

(.type ImportMethodDecl
  (Record
   [#import_method_name   Text
    #import_method_return (Type Return)]))

(.type ImportFieldDecl
  (Record
   [#import_field_mode    Primitive_Mode
    #import_field_name    Text
    #import_field_static? Bit
    #import_field_maybe?  Bit
    #import_field_setter? Bit
    #import_field_type    (Type Value)]))

(.type Import_Member_Declaration
  (Variant
   {#EnumDecl        (List Text)}
   {#ConstructorDecl [ImportMethodCommons ImportConstructorDecl]}
   {#MethodDecl      [ImportMethodCommons ImportMethodDecl]}
   {#FieldAccessDecl ImportFieldDecl}))

(def (primitive_type mode type)
  (-> Primitive_Mode (Type Primitive) Code)
  (when mode
    {#ManualPrM}
    (cond (of jvm.equivalence = jvm.boolean type) (` ..Boolean)
          (of jvm.equivalence = jvm.byte type) (` ..Byte)
          (of jvm.equivalence = jvm.short type) (` ..Short)
          (of jvm.equivalence = jvm.int type) (` ..Integer)
          (of jvm.equivalence = jvm.long type) (` ..Long)
          (of jvm.equivalence = jvm.float type) (` ..Float)
          (of jvm.equivalence = jvm.double type) (` ..Double)
          (of jvm.equivalence = jvm.char type) (` ..Character)
          ... else
          (undefined))
    
    {#AutoPrM}
    (cond (of jvm.equivalence = jvm.boolean type)
          (` .Bit)
          
          (or (of jvm.equivalence = jvm.short type)
              (of jvm.equivalence = jvm.byte type)
              (of jvm.equivalence = jvm.int type)
              (of jvm.equivalence = jvm.long type))
          (` .Int)
          
          (or (of jvm.equivalence = jvm.float type)
              (of jvm.equivalence = jvm.double type))
          (` .Frac)

          (of jvm.equivalence = jvm.char type)
          (` .Nat)

          ... else
          (undefined))))

(def (parameter_type value_type type)
  (-> (-> (Type Value) Code)
      (-> (Type Parameter) Code))
  (`` (<| (,, (with_template [<when> <binding> <then>]
                [(when (<when> type)
                   {.#Some <binding>}
                   <then>

                   {.#None})]

                [parser.var? name (code.symbol ["" name])]
                [parser.wildcard? _ (` .Any)]
                [parser.lower? _ (` .Any)]
                [parser.upper? limit (parameter_type value_type limit)]
                [parser.class? [name parameters]
                 (` (.Nominal (, (code.text name))
                              [(,* (list#each (parameter_type value_type) parameters))]))]
                [parser.array? elementT
                 (when (parser.primitive? elementT)
                   {.#Some elementT}
                   (` {.#Nominal (, (code.text (..reflection (jvm.array elementT)))) {.#End}})
                   
                   {.#None}
                   (` (array.Array (, (value_type elementT)))))]))
          ... else
          (undefined)
          )))

(def (value_type mode type)
  (-> Primitive_Mode (Type Value) Code)
  (`` (<| (,, (with_template [<when> <binding> <then>]
                [(when (<when> type)
                   {.#Some <binding>}
                   <then>

                   {.#None})]

                [parser.primitive? type (primitive_type mode type)]
                [parser.parameter? type (parameter_type (value_type mode) type)]))
          (undefined)
          )))

(def declaration_type$
  (-> (Type Declaration) Code)
  (|>> ..signature code.text))

(def (decorate_input [class value])
  (-> [(Type Value) Code] Code)
  (` [(, (code.text (..signature class))) (, value)]))

(def privacy_modifier^
  (Parser Privacy)
  (let [(open "[0]") <>.monad]
    (all <>.or
         (<code>.this (' "public"))
         (<code>.this (' "private"))
         (<code>.this (' "protected"))
         (in []))))

(def inheritance_modifier^
  (Parser Inheritance)
  (let [(open "[0]") <>.monad]
    (all <>.or
         (<code>.this (' "final"))
         (<code>.this (' "abstract"))
         (in []))))

(exception.def .public (class_names_cannot_contain_periods name)
  (Exception Text)
  (exception.report
   (list ["Name" (%.text name)])))

(exception.def .public (class_name_cannot_be_a_type_variable [name type_vars])
  (Exception [Text (List (Type Var))])
  (exception.report
   (list ["Name" (%.text name)]
         ["Type Variables" (exception.listing parser.name type_vars)])))

(def (assertion exception payload test)
  (All (_ e) (-> (Exception e) e Bit (Parser Any)))
  (<>.assertion (exception.error exception payload)
                test))

(def (valid_class_name type_vars)
  (-> (List (Type Var)) (Parser External))
  (do <>.monad
    [name <code>.local
     _ (..assertion ..class_names_cannot_contain_periods [name]
                    (not (text.contains? name.external_separator name)))
     _ (..assertion ..class_name_cannot_be_a_type_variable [name type_vars]
                    (not (list.member? text.equivalence
                                       (list#each parser.name type_vars)
                                       name)))]
    (in name)))

(def (class^' parameter^ type_vars)
  (-> (-> (List (Type Var)) (Parser (Type Parameter)))
      (-> (List (Type Var)) (Parser (Type Class))))
  (do <>.monad
    [.let [class_name^ (..valid_class_name type_vars)]
     [name parameters] (.is (Parser [External (List (Type Parameter))])
                            (all <>.either
                                 (<>.and class_name^ (<>#in (list)))
                                 (<code>.form (<>.and class_name^ (<>.some (parameter^ type_vars))))))]
    (in (jvm.class (name.safe name) parameters))))

(exception.def .public (unknown_type_variable [name type_vars])
  (Exception [Text (List (Type Var))])
  (exception.report
   (list ["Unexpected type variable" (%.text name)]
         ["Expected type variables" (exception.listing parser.name type_vars)])))

(def (type_variable options)
  (-> (List (Type Var)) (Parser (Type Parameter)))
  (do <>.monad
    [name <code>.local
     _ (..assertion ..unknown_type_variable [name options]
                    (list.member? text.equivalence (list#each parser.name options) name))]
    (in (jvm.var name))))

(def wildcard^
  (Parser (Type Parameter))
  (do <>.monad
    [_ (<code>.this (' ?))]
    (in jvm.wildcard)))

(with_template [<name> <comparison> <constructor>]
  [(def <name>
     (-> (Parser (Type Class)) (Parser (Type Parameter)))
     (|>> (<>.after (<code>.this (' <comparison>)))
          (<>.after ..wildcard^)
          <code>.tuple
          (of <>.monad each <constructor>)))]

  [upper^ < jvm.upper]
  [lower^ > jvm.lower]
  )

(def (parameter^ type_vars)
  (-> (List (Type Var)) (Parser (Type Parameter)))
  (<>.rec
   (function (_ _)
     (let [class^ (..class^' parameter^ type_vars)]
       (all <>.either
            (..type_variable type_vars)
            ..wildcard^
            (upper^ class^)
            (lower^ class^)
            class^
            )))))

(def (itself^ type)
  (All (_ category)
    (-> (Type (<| Return' Value' category))
        (Parser (Type (<| Return' Value' category)))))
  (do <>.monad
    [_ (<code>.this_symbol ["" (..reflection type)])]
    (in type)))

(def primitive^
  (Parser (Type Primitive))
  (all <>.either
       (itself^ jvm.boolean)
       (itself^ jvm.byte)
       (itself^ jvm.short)
       (itself^ jvm.int)
       (itself^ jvm.long)
       (itself^ jvm.float)
       (itself^ jvm.double)
       (itself^ jvm.char)
       ))

(def array^
  (-> (Parser (Type Value)) (Parser (Type Array)))
  (|>> <code>.tuple
       (of <>.monad each jvm.array)))

(def (type^ type_vars)
  (-> (List (Type Var)) (Parser (Type Value)))
  (<>.rec
   (function (_ type^)
     (all <>.either
          ..primitive^
          (..parameter^ type_vars)
          (..array^ type^)
          ))))

(def void^
  (Parser (Type Void))
  (do <>.monad
    [_ (<code>.this_symbol ["" (reflection.reflection reflection.void)])]
    (in jvm.void)))

(def (return^ type_vars)
  (-> (List (Type Var)) (Parser (Type Return)))
  (<>.either ..void^
             (..type^ type_vars)))

(def var^
  (Parser (Type Var))
  (of <>.monad each jvm.var <code>.local))

(def vars^
  (Parser (List (Type Var)))
  (<code>.tuple (<>.some var^)))

(def declaration^
  (Parser (Type Declaration))
  (do <>.monad
    [[name variables] (.is (Parser [External (List (Type Var))])
                           (<>.either (<>.and (..valid_class_name (list))
                                              (<>#in (list)))
                                      (<code>.form (<>.and (..valid_class_name (list))
                                                           (<>.some var^)))
                                      ))]
    (in (jvm.declaration name variables))))

(def (class^ type_vars)
  (-> (List (Type Var)) (Parser (Type Class)))
  (class^' parameter^ type_vars))

(def annotation_parameters^
  (Parser (List Annotation_Parameter))
  (<code>.tuple (<>.some (<>.and <code>.text <code>.any))))

(def annotation^
  (Parser Annotation)
  (<>.either (do <>.monad
               [ann_name <code>.local]
               (in [ann_name (list)]))
             (<code>.form (<>.and <code>.local
                                  annotation_parameters^))))

(def annotations^
  (Parser (List Annotation))
  (<| (<>.else (list))
      (do <>.monad
        [_ (<code>.this (' "ann"))]
        (<code>.tuple (<>.some ..annotation^)))))

(def (throws_decl^ type_vars)
  (-> (List (Type Var)) (Parser (List (Type Class))))
  (<| (<>.else (list))
      (do <>.monad
        [_ (<code>.this (' "throws"))]
        (<code>.tuple (<>.some (..class^ type_vars))))))

(def (method_decl^ type_vars)
  (-> (List (Type Var)) (Parser [Member_Declaration MethodDecl]))
  (<code>.form (do <>.monad
                 [tvars (<>.else (list) ..vars^)
                  .let [total_vars (list#composite tvars type_vars)]
                  name <code>.local
                  anns ..annotations^
                  inputs (<code>.tuple (<>.some (..type^ total_vars)))
                  output (..return^ total_vars)
                  exs (..throws_decl^ total_vars)]
                 (in [[name {#PublicP} anns] [#method_tvars tvars
                                              #method_inputs inputs
                                              #method_output output
                                              #method_exs exs]]))))

(def state_modifier^
  (Parser State)
  (all <>.or
       (<code>.this (' "volatile"))
       (<code>.this (' "final"))
       (of <>.monad in [])))

(def (field_decl^ type_vars)
  (-> (List (Type Var)) (Parser [Member_Declaration FieldDecl]))
  (<>.either (<code>.form (do <>.monad
                            [_ (<code>.this (' "const"))
                             name <code>.local
                             anns ..annotations^
                             type (..type^ type_vars)
                             body <code>.any]
                            (in [[name {#PublicP} anns] {#ConstantField [type body]}])))
             (<code>.form (do <>.monad
                            [pm privacy_modifier^
                             sm state_modifier^
                             static? (<>.parses? (<code>.this (' "static")))
                             name <code>.local
                             anns ..annotations^
                             type (..type^ type_vars)]
                            (in [[name pm anns] {#VariableField [sm static? type]}])))))

(def (argument^ type_vars)
  (-> (List (Type Var)) (Parser Argument))
  (<>.and <code>.local
          (..type^ type_vars)))

(def (arguments^ type_vars)
  (-> (List (Type Var)) (Parser (List Argument)))
  (<code>.tuple (<>.some (..argument^ type_vars))))

(def (constructor_arg^ type_vars)
  (-> (List (Type Var)) (Parser (Typed Code)))
  (<>.and (..type^ type_vars) <code>.any))

(def (constructor_args^ type_vars)
  (-> (List (Type Var)) (Parser (List (Typed Code))))
  (<code>.tuple (<>.some (..constructor_arg^ type_vars))))

(def (constructor_method^ class_vars)
  (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition]))
  (<code>.form (do <>.monad
                 [pm privacy_modifier^
                  strict_fp? (<>.parses? (<code>.this_text "strict"))
                  method_vars (<>.else (list) ..vars^)
                  .let [total_vars (list#composite class_vars method_vars)]
                  [_ self_name arguments] (<code>.form (all <>.and
                                                            (<code>.this (' new))
                                                            <code>.local
                                                            (..arguments^ total_vars)))
                  constructor_args (..constructor_args^ total_vars)
                  exs (throws_decl^ total_vars)
                  annotations ..annotations^
                  body <code>.any]
                 (in [[#member_name constructor_method_name
                       #member_privacy pm
                       #member_anns annotations]
                      {#ConstructorMethod strict_fp? method_vars self_name arguments constructor_args body exs}]))))

(def (virtual_method_def^ class_vars)
  (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition]))
  (<code>.form (do <>.monad
                 [pm privacy_modifier^
                  strict_fp? (<>.parses? (<code>.this (' "strict")))
                  final? (<>.parses? (<code>.this (' "final")))
                  method_vars (<>.else (list) ..vars^)
                  .let [total_vars (list#composite class_vars method_vars)]
                  [name self_name arguments] (<code>.form (all <>.and
                                                               <code>.local
                                                               <code>.local
                                                               (..arguments^ total_vars)))
                  return_type (..return^ total_vars)
                  exs (throws_decl^ total_vars)
                  annotations ..annotations^
                  body <code>.any]
                 (in [[#member_name name
                       #member_privacy pm
                       #member_anns annotations]
                      {#VirtualMethod final? strict_fp? method_vars self_name arguments return_type body exs}]))))

(def overriden_method_def^
  (Parser [Member_Declaration Method_Definition])
  (<code>.form (do <>.monad
                 [strict_fp? (<>.parses? (<code>.this (' "strict")))
                  owner_class ..declaration^
                  method_vars (<>.else (list) ..vars^)
                  .let [total_vars (list#composite (product.right (parser.declaration owner_class))
                                                   method_vars)]
                  [name self_name arguments] (<code>.form (all <>.and
                                                               <code>.local
                                                               <code>.local
                                                               (..arguments^ total_vars)))
                  return_type (..return^ total_vars)
                  exs (throws_decl^ total_vars)
                  annotations ..annotations^
                  body <code>.any]
                 (in [[#member_name name
                       #member_privacy {#PublicP}
                       #member_anns annotations]
                      {#OverridenMethod strict_fp? owner_class method_vars self_name arguments return_type body exs}]))))

(def static_method_def^
  (Parser [Member_Declaration Method_Definition])
  (<code>.form (do <>.monad
                 [pm privacy_modifier^
                  strict_fp? (<>.parses? (<code>.this (' "strict")))
                  _ (<code>.this (' "static"))
                  method_vars (<>.else (list) ..vars^)
                  .let [total_vars method_vars]
                  [name arguments] (<code>.form (<>.and <code>.local
                                                        (..arguments^ total_vars)))
                  return_type (..return^ total_vars)
                  exs (throws_decl^ total_vars)
                  annotations ..annotations^
                  body <code>.any]
                 (in [[#member_name name
                       #member_privacy pm
                       #member_anns annotations]
                      {#StaticMethod strict_fp? method_vars arguments return_type body exs}]))))

(def abstract_method_def^
  (Parser [Member_Declaration Method_Definition])
  (<code>.form (do <>.monad
                 [pm privacy_modifier^
                  _ (<code>.this (' "abstract"))
                  method_vars (<>.else (list) ..vars^)
                  .let [total_vars method_vars]
                  [name arguments] (<code>.form (<>.and <code>.local
                                                        (..arguments^ total_vars)))
                  return_type (..return^ total_vars)
                  exs (throws_decl^ total_vars)
                  annotations ..annotations^]
                 (in [[#member_name name
                       #member_privacy pm
                       #member_anns annotations]
                      {#AbstractMethod method_vars arguments return_type exs}]))))

(def native_method_def^
  (Parser [Member_Declaration Method_Definition])
  (<code>.form (do <>.monad
                 [pm privacy_modifier^
                  _ (<code>.this (' "native"))
                  method_vars (<>.else (list) ..vars^)
                  .let [total_vars method_vars]
                  [name arguments] (<code>.form (<>.and <code>.local
                                                        (..arguments^ total_vars)))
                  return_type (..return^ total_vars)
                  exs (throws_decl^ total_vars)
                  annotations ..annotations^]
                 (in [[#member_name name
                       #member_privacy pm
                       #member_anns annotations]
                      {#NativeMethod method_vars arguments return_type exs}]))))

(def (method_def^ class_vars)
  (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition]))
  (all <>.either
       (..constructor_method^ class_vars)
       (..virtual_method_def^ class_vars)
       ..overriden_method_def^
       ..static_method_def^
       ..abstract_method_def^
       ..native_method_def^))

(def partial_call^
  (Parser Partial_Call)
  (<code>.form (<>.and <code>.symbol (<>.some <code>.any))))

(def import_member_alias^
  (Parser (Maybe Text))
  (<>.maybe (do <>.monad
              [_ (<code>.this (' "as"))]
              <code>.local)))

(def (import_member_args^ type_vars)
  (-> (List (Type Var)) (Parser (List [Bit (Type Value)])))
  (<code>.tuple (<>.some (<>.and (<>.parses? (<code>.this (' "?")))
                                 (..type^ type_vars)))))

(def import_member_return_flags^
  (Parser [Bit Bit Bit])
  (all <>.and
       (<>.parses? (<code>.this (' "io")))
       (<>.parses? (<code>.this (' "try")))
       (<>.parses? (<code>.this (' "?")))))

(def primitive_mode^
  (Parser Primitive_Mode)
  (<>.or (<code>.this (' "manual"))
         (<code>.this (' "auto"))))

(def (import_member_decl^ owner_vars)
  (-> (List (Type Var)) (Parser Import_Member_Declaration))
  (all <>.either
       (<code>.form (do <>.monad
                      [_ (<code>.this (' "enum"))
                       enum_members (<>.some <code>.local)]
                      (in {#EnumDecl enum_members})))
       (<code>.form (do <>.monad
                      [tvars (<>.else (list) ..vars^)
                       _ (<code>.this_symbol ["" "new"])
                       ?alias import_member_alias^
                       .let [total_vars (list#composite owner_vars tvars)]
                       ?prim_mode (<>.maybe primitive_mode^)
                       args (..import_member_args^ total_vars)
                       [io? try? maybe?] import_member_return_flags^]
                      (in {#ConstructorDecl [[#import_member_mode    (maybe.else {#AutoPrM} ?prim_mode)
                                              #import_member_alias   (maybe.else "new" ?alias)
                                              #import_member_kind    {#VirtualIMK}
                                              #import_member_tvars   tvars
                                              #import_member_args    args
                                              #import_member_maybe?  maybe?
                                              #import_member_try?    try?
                                              #import_member_io?     io?]
                                             []]})
                      ))
       (<code>.form (do <>.monad
                      [kind (.is (Parser ImportMethodKind)
                                 (<>.or (<code>.this (' "static"))
                                        (in [])))
                       tvars (<>.else (list) ..vars^)
                       name <code>.local
                       ?alias import_member_alias^
                       .let [total_vars (list#composite owner_vars tvars)]
                       ?prim_mode (<>.maybe primitive_mode^)
                       args (..import_member_args^ total_vars)
                       [io? try? maybe?] import_member_return_flags^
                       return (..return^ total_vars)]
                      (in {#MethodDecl [[#import_member_mode    (maybe.else {#AutoPrM} ?prim_mode)
                                         #import_member_alias   (maybe.else name ?alias)
                                         #import_member_kind    kind
                                         #import_member_tvars   tvars
                                         #import_member_args    args
                                         #import_member_maybe?  maybe?
                                         #import_member_try?    try?
                                         #import_member_io?     io?]
                                        [#import_method_name    name
                                         #import_method_return  return]]})))
       (<code>.form (do <>.monad
                      [read_only? (<>.parses? (<code>.this (' "read_only")))
                       static? (<>.parses? (<code>.this (' "static")))
                       name <code>.local
                       ?prim_mode (<>.maybe primitive_mode^)
                       maybe? (<>.parses? (<code>.this (' "?")))
                       gtype (..type^ owner_vars)]
                      (in {#FieldAccessDecl [#import_field_mode    (maybe.else {#AutoPrM} ?prim_mode)
                                             #import_field_name    name
                                             #import_field_static? static?
                                             #import_field_maybe?  maybe?
                                             #import_field_setter? (not read_only?)
                                             #import_field_type    gtype]})))
       ))

(def (privacy_modifier$ pm)
  (-> Privacy Code)
  (when pm
    {#PublicP}    (code.text "public")
    {#PrivateP}   (code.text "private")
    {#ProtectedP} (code.text "protected")
    {#DefaultP}   (code.text "default")))

(def (inheritance_modifier$ im)
  (-> Inheritance Code)
  (when im
    {#FinalI}    (code.text "final")
    {#AbstractI} (code.text "abstract")
    {#DefaultI}  (code.text "default")))

(def (annotation_parameter$ [name value])
  (-> Annotation_Parameter Code)
  (` [(, (code.text name)) (, value)]))

(def (annotation$ [name params])
  (-> Annotation Code)
  (` ((, (code.text name)) (,* (list#each annotation_parameter$ params)))))

(with_template [<name> <category>]
  [(def <name>
     (-> (Type <category>) Code)
     (|>> ..signature code.text))]

  [var$ Var]
  [parameter$ Parameter]
  [value$ Value]
  [return$ Return]
  [declaration$ Declaration]
  [class$ Class]
  )

(def var$'
  (-> (Type Var) Code)
  (|>> ..signature code.local))

(def (method_decl$ [[name pm anns] method_decl])
  (-> [Member_Declaration MethodDecl] Code)
  (let [(open "[0]") method_decl]
    (` ((, (code.text name))
        [(,* (list#each annotation$ anns))]
        [(,* (list#each var$ #method_tvars))]
        [(,* (list#each class$ #method_exs))]
        [(,* (list#each value$ #method_inputs))]
        (, (return$ #method_output))))))

(def (state_modifier$ it)
  (-> State Code)
  (when it
    {#VolatileS} (' "volatile")
    {#FinalS}    (' "final")
    {#DefaultS}  (' "default")))

(def (field_decl$ [[name pm anns] field])
  (-> [Member_Declaration FieldDecl] Code)
  (when field
    {#ConstantField class value}
    (` ("constant" (, (code.text name))
        [(,* (list#each annotation$ anns))]
        (, (value$ class))
        (, value)
        ))

    {#VariableField [state static? class]}
    (` ("variable" (, (code.text name))
        (, (privacy_modifier$ pm))
        (, (state_modifier$ state))
        (,* (if static?
              (list (' "static"))
              (list)))
        [(,* (list#each annotation$ anns))]
        (, (value$ class))
        ))
    ))

(def (argument$ [name type])
  (-> Argument Code)
  (` [(, (code.text name)) (, (value$ type))]))

(def (constructor_arg$ [class term])
  (-> (Typed Code) Code)
  (` [(, (value$ class)) (, term)]))

(.type Super
  [[External (List (Type Var))]
   [Member_Declaration MethodDecl]])

(context.def
  [super_context]
  [super_expression]
  [super_declaration]
  Super)

(def var^^
  (Parser (Type Var))
  (<text>.then parser.var <code>.text))

(def class^^
  (Parser (Type Class))
  (<text>.then parser.class <code>.text))

(def value^^
  (Parser (Type Value))
  (<text>.then parser.value <code>.text))

(def return^^
  (Parser (Type Return))
  (<text>.then parser.return <code>.text))

(def method_decl^^
  (Parser [Member_Declaration MethodDecl])
  (<code>.form
   (do <>.monad
     [tvars (<code>.tuple (<>.some var^^))
      name <code>.text
      anns (<code>.tuple (<>.some ..annotation^))
      inputs (<code>.tuple (<>.some value^^))
      output return^^
      exs (<code>.tuple (<>.some class^^))]
     (in [[name {#PublicP} anns] [#method_tvars tvars
                                  #method_inputs inputs
                                  #method_output output
                                  #method_exs exs]]))))

(def (method_decl$$ [[name pm anns] method_decl])
  (-> [Member_Declaration MethodDecl] Code)
  (let [(open "[0]") method_decl]
    (` ([(,* (list#each var$ #method_tvars))]
        (, (code.text name))
        [(,* (list#each annotation$ anns))]
        [(,* (list#each value$ #method_inputs))]
        (, (return$ #method_output))
        [(,* (list#each class$ #method_exs))]))))

(def .public with_super
  (syntax (_ [declaration,method (<code>.tuple
                                  (all <>.and
                                       (<text>.then parser.declaration' <code>.text)
                                       method_decl^^))
              body <code>.any])
    (do meta.monad
      [body (super_expression declaration,method body)]
      (in (list body)))))

(exception.def .public (insufficient_parameters [expected actual])
  (Exception [Nat Nat])
  (exception.report
   (list ["Expected" (%.nat expected)]
         ["Actual" (%.nat actual)])))

(def .public super
  (syntax (_ [inputs (<code>.tuple (<>.some <code>.any))
              self <code>.any])
    (do meta.monad
      [[[super_name super_vars] [member method]] (context.peek ..super_context)
       .let [expected_arguments (list.size (the #method_inputs method))
             actual_arguments (list.size inputs)]]
      (if (n.= expected_arguments actual_arguments)
        (in (list (` (.jvm_member_invoke_special# [(,* (list#each (|>> ..signature code.text) super_vars))]
                                                  (, (code.text super_name))
                                                  (, (code.text (the #member_name member)))
                                                  [(,* (list#each (|>> ..signature code.text) (the #method_tvars method)))]
                                                  (.jvm_object_cast# (, self))
                                                  (,* (|> inputs
                                                          (list#each (|>> , .jvm_object_cast# `))
                                                          (list.zipped_2 (the #method_inputs method))
                                                          (list#each ..decorate_input)))))))
        (meta.failure (exception.error ..insufficient_parameters [expected_arguments actual_arguments]))))))

(.type Get|Set
  [External
   (List [Member_Declaration FieldDecl])])

(context.def
  [get|set_context]
  [get|set_expression]
  [get|set_declaration]
  Get|Set)

(def privacy_modifier^^
  (Parser Privacy)
  (all <>.or
       (<code>.this (' "public"))
       (<code>.this (' "private"))
       (<code>.this (' "protected"))
       (<code>.this (' "default"))))

(def state_modifier^^
  (Parser State)
  (all <>.or
       (<code>.this (' "volatile"))
       (<code>.this (' "final"))
       (<code>.this (' "default"))))

(def field_decl^^
  (Parser [Member_Declaration FieldDecl])
  (<>.either (<code>.form (do <>.monad
                            [_ (<code>.this (' "constant"))
                             name <code>.text
                             anns (<code>.tuple (<>.some ..annotation^))
                             type value^^
                             value <code>.any]
                            (in [[name {#PublicP} anns] {#ConstantField [type value]}])))
             (<code>.form (do <>.monad
                            [_ (<code>.this (' "variable"))
                             name <code>.text
                             pm privacy_modifier^^
                             sm state_modifier^^
                             static? (<>.parses? (<code>.this (' "static")))
                             anns (<code>.tuple (<>.some ..annotation^))
                             type value^^]
                            (in [[name pm anns] {#VariableField [sm static? type]}])))))

(def .public with_get|set
  (syntax (_ [declaration,fields (<code>.tuple
                                  (all <>.and
                                       <code>.text
                                       (<code>.tuple (<>.some field_decl^^))))
              body <code>.any])
    (do meta.monad
      [body (get|set_expression declaration,fields body)]
      (in (list body)))))

(with_template [<member> <name>]
  [(exception.def .public (<name> [class member])
     (Exception [Text Text])
     (exception.report
      (list ["Class" (%.text class)]
            [<member> (%.text member)])))]

  ["Field" cannot_get_field]
  ["Field" cannot_set_field]
  ["Member" cannot_call_method]
  )

(def .public get
  (syntax (_ [field <code>.local
              this (<>.maybe <code>.any)])
    (do meta.monad
      [[class_name member,field/*] (context.peek ..get|set_context)
       .let [fields (|> member,field/*
                        (list#each (function (_ [member field])
                                     [(the #member_name member) [member field]]))
                        (dictionary.of_list text.hash))]]
      (when (dictionary.value field fields)
        {.#Some [member {#VariableField _ static? :field:}]}
        (when [static? this]
          [.true {.#None}]
          (in (list (` (.jvm_member_get_static# (, (code.text class_name))
                                                (, (code.text (the #member_name member)))))))
          
          [.false {.#Some this}]
          (in (list (` (.jvm_member_get_virtual# (, (code.text class_name))
                                                 (, (code.text (the #member_name member)))
                                                 (, this)))))

          _
          (meta.failure (exception.error ..cannot_get_field [class_name field])))

        _
        (meta.failure (exception.error ..cannot_get_field [class_name field]))))))

(def .public set
  (syntax (_ [field <code>.local
              value <code>.any
              this (<>.maybe <code>.any)])
    (do meta.monad
      [[class_name member,field/*] (context.peek ..get|set_context)
       .let [fields (|> member,field/*
                        (list#each (function (_ [member field])
                                     [(the #member_name member) [member field]]))
                        (dictionary.of_list text.hash))]]
      (when (dictionary.value field fields)
        {.#Some [member {#VariableField state static? :field:}]}
        (when state
          {#FinalS}
          (meta.failure (exception.error ..cannot_set_field [class_name field]))

          _
          (when [static? this]
            [.true {.#None}]
            (in (list (` (.jvm_member_put_static# (, (code.text class_name))
                                                  (, (code.text (the #member_name member)))
                                                  (, value)))))
            
            [.false {.#Some this}]
            (in (list (` (.jvm_member_put_virtual# (, (code.text class_name))
                                                   (, (code.text (the #member_name member)))
                                                   (, value)
                                                   (, this)))))

            _
            (meta.failure (exception.error ..cannot_set_field [class_name field]))))

        _
        (meta.failure (exception.error ..cannot_set_field [class_name field]))))))

(.type Call
  [[External (List (Type Var))]
   (List [Member_Declaration MethodDecl])])

(context.def
  [call_context]
  [call_expression]
  [call_declaration]
  Call)

(def .public with_call
  (syntax (_ [declaration,methods (<code>.tuple
                                   (all <>.and
                                        (<text>.then parser.declaration' <code>.text)
                                        (<code>.tuple (<>.some method_decl^^))))
              body <code>.any])
    (do meta.monad
      [body (call_expression declaration,methods body)]
      (in (list body)))))

(def .public call
  (syntax (_ [method <code>.local
              inputs (<code>.tuple (<>.some <code>.any))
              self <code>.any])
    (do meta.monad
      [[[class_name class_vars] member,virtual/*] (context.peek ..call_context)
       .let [virtuals (|> member,virtual/*
                          (list#each (function (_ [member virtual])
                                       [(the #member_name member) [member virtual]]))
                          (dictionary.of_list text.hash))]]
      (when (dictionary.value method virtuals)
        {.#Some [member method]}
        (let [expected_arguments (list.size (the #method_inputs method))
              actual_arguments (list.size inputs)]
          (if (n.= expected_arguments actual_arguments)
            (in (list (` (.jvm_member_invoke_virtual# [(,* (list#each (|>> ..signature code.text) class_vars))]
                                                      (, (code.text class_name))
                                                      (, (code.text (the #member_name member)))
                                                      [(,* (list#each (|>> ..signature code.text) (the #method_tvars method)))]
                                                      (.jvm_object_cast# (, self))
                                                      (,* (|> inputs
                                                              (list#each (|>> , .jvm_object_cast# `))
                                                              (list.zipped_2 (the #method_inputs method))
                                                              (list#each ..decorate_input)))))))
            (meta.failure (exception.error ..insufficient_parameters [expected_arguments actual_arguments]))))

        _
        (meta.failure (exception.error ..cannot_call_method [class_name method]))))))

(def (method_declaration [member definition])
  (-> [Member_Declaration Method_Definition]
      (Maybe [Member_Declaration MethodDecl]))
  (when definition
    {#VirtualMethod final? strict_fp? type_vars self_name arguments return_type body exs}
    {.#Some [member
             [#method_tvars  type_vars
              #method_inputs (list#each product.right arguments)
              #method_output return_type
              #method_exs    exs]]}

    _
    {.#None}))

(def (method_def$ fully_qualified_class_name class_vars super_class fields methods [method_declaration method_def])
  (-> External (List (Type Var)) (Type Class) (List [Member_Declaration FieldDecl]) (List [Member_Declaration Method_Definition]) [Member_Declaration Method_Definition] (Meta Code))
  (let [[name pm anns] method_declaration
        virtual_methods (when (list.all ..method_declaration methods)
                          {.#End}
                          (list)

                          virtual_methods
                          (list (` (..with_call [(, (declaration$ (jvm.declaration fully_qualified_class_name class_vars)))
                                                 [(,* (list#each method_decl$$ virtual_methods))]]))))]
    (when method_def
      {#ConstructorMethod strict_fp? type_vars self_name arguments constructor_args body exs}
      (meta#in (` ("init"
                   (, (privacy_modifier$ pm))
                   (, (code.bit strict_fp?))
                   [(,* (list#each annotation$ anns))]
                   [(,* (list#each var$ type_vars))]
                   [(,* (list#each class$ exs))]
                   (, (code.text self_name))
                   [(,* (list#each argument$ arguments))]
                   [(,* (list#each constructor_arg$ constructor_args))]
                   (<| (..with_get|set [(, (code.text fully_qualified_class_name))
                                        [(,* (list#each field_decl$ fields))]])
                       (,* virtual_methods)
                       (, body))
                   )))
      
      {#VirtualMethod final? strict_fp? type_vars self_name arguments return_type body exs}
      (meta#in (` ("virtual"
                   (, (code.text name))
                   (, (privacy_modifier$ pm))
                   (, (code.bit final?))
                   (, (code.bit strict_fp?))
                   [(,* (list#each annotation$ anns))]
                   [(,* (list#each var$ type_vars))]
                   (, (code.text self_name))
                   [(,* (list#each argument$ arguments))]
                   (, (return$ return_type))
                   [(,* (list#each class$ exs))]
                   (<| (..with_get|set [(, (code.text fully_qualified_class_name))
                                        [(,* (list#each field_decl$ fields))]])
                       (,* virtual_methods)
                       (, body))
                   )))
      
      {#OverridenMethod strict_fp? declaration type_vars self_name expected_arguments return_type body exs}
      (do meta.monad
        [@ meta.current_module_name]
        (in (` ("override"
                (, (declaration$ declaration))
                (, (code.text name))
                (, (code.bit strict_fp?))
                [(,* (list#each annotation$ anns))]
                [(,* (list#each var$ type_vars))]
                (, (code.text self_name))
                [(,* (list#each argument$ expected_arguments))]
                (, (return$ return_type))
                [(,* (list#each class$ exs))]
                (<| (..with_super [(, (declaration$ declaration))
                                   (, (method_decl$$ [method_declaration
                                                      [#method_tvars  type_vars
                                                       #method_inputs (list#each product.right expected_arguments)
                                                       #method_output return_type
                                                       #method_exs    exs]]))])
                    (..with_get|set [(, (code.text fully_qualified_class_name))
                                     [(,* (list#each field_decl$ fields))]])
                    (,* virtual_methods)
                    (, body))
                ))))

      {#StaticMethod strict_fp? type_vars arguments return_type body exs}
      (meta#in (` ("static"
                   (, (code.text name))
                   (, (privacy_modifier$ pm))
                   (, (code.bit strict_fp?))
                   [(,* (list#each annotation$ anns))]
                   [(,* (list#each var$ type_vars))]
                   [(,* (list#each argument$ arguments))]
                   (, (return$ return_type))
                   [(,* (list#each class$ exs))]
                   (, body))))

      {#AbstractMethod type_vars arguments return_type exs}
      (meta#in (` ("abstract"
                   (, (code.text name))
                   (, (privacy_modifier$ pm))
                   [(,* (list#each annotation$ anns))]
                   [(,* (list#each var$ type_vars))]
                   [(,* (list#each argument$ arguments))]
                   (, (return$ return_type))
                   [(,* (list#each class$ exs))])))

      {#NativeMethod type_vars arguments return_type exs}
      (meta#in (` ("native"
                   (, (code.text name))
                   (, (privacy_modifier$ pm))
                   [(,* (list#each annotation$ anns))]
                   [(,* (list#each var$ type_vars))]
                   [(,* (list#each class$ exs))]
                   [(,* (list#each argument$ arguments))]
                   (, (return$ return_type)))))
      )))

(def (complete_call$ g!obj [method args])
  (-> Code Partial_Call Code)
  (` ((, (code.symbol method)) (,* args) (, g!obj))))

(def $Object
  (Type Class)
  (jvm.class "java.lang.Object" (list)))

(def .public class
  (syntax (_ [.let [! <>.monad]
              im inheritance_modifier^
              [full_class_name class_vars] (of ! each parser.declaration ..declaration^)
              super (<>.else $Object
                             (class^ class_vars))
              interfaces (<>.else (list)
                                  (<code>.tuple (<>.some (class^ class_vars))))
              annotations ..annotations^
              fields (<>.some (..field_decl^ class_vars))
              methods (<>.some (..method_def^ class_vars))])
    (do meta.monad
      [methods (monad.each ! (method_def$ full_class_name class_vars super fields methods) methods)]
      (in (list (` (.jvm_class# (, (declaration$ (jvm.declaration full_class_name class_vars)))
                                (, (class$ super))
                                [(,* (list#each class$ interfaces))]
                                (, (inheritance_modifier$ im))
                                [(,* (list#each annotation$ annotations))]
                                [(,* (list#each field_decl$ fields))]
                                [(,* methods)])))))))

(def .public interface
  (syntax (_ [.let [! <>.monad]
              [full_class_name class_vars] (of ! each parser.declaration ..declaration^)
              supers (<>.else (list)
                              (<code>.tuple (<>.some (class^ class_vars))))
              annotations ..annotations^
              members (<>.some (..method_decl^ class_vars))])
    (in (list (` (.jvm_class_interface# (, (declaration$ (jvm.declaration full_class_name class_vars)))
                                        [(,* (list#each class$ supers))]
                                        [(,* (list#each annotation$ annotations))]
                                        (,* (list#each method_decl$ members))))))))

(def .public object
  (syntax (_ [class_vars ..vars^
              super (<>.else $Object
                             (class^ class_vars))
              interfaces (<>.else (list)
                                  (<code>.tuple (<>.some (class^ class_vars))))
              constructor_args (..constructor_args^ class_vars)
              methods (<>.some ..overriden_method_def^)])
    (do [! meta.monad]
      [methods (monad.each ! (method_def$ "" (list) super (list) methods) methods)]
      (in (list (` (.jvm_class_anonymous# [(,* (list#each var$ class_vars))]
                                          (, (class$ super))
                                          [(,* (list#each class$ interfaces))]
                                          [(,* (list#each constructor_arg$ constructor_args))]
                                          [(,* methods)])))))))

(def .public null
  (syntax (_ [])
    (in (list (` (.jvm_object_null#))))))

(def .public (null? obj)
  (-> (.Nominal "java.lang.Object") Bit)
  (.jvm_object_null?# obj))

(def .public ???
  (syntax (_ [expr <code>.any])
    (with_symbols [g!temp]
      (in (list (` (let [(, g!temp) (, expr)]
                     (if (not (.jvm_object_null?# (, g!temp)))
                       {.#Some (, g!temp)}
                       {.#None}))))))))

(def .public !!!
  (syntax (_ [expr <code>.any])
    (with_symbols [g!value]
      (in (list (` (.when (, expr)
                     {.#Some (, g!value)}
                     (, g!value)

                     {.#None}
                     (.jvm_object_null#))))))))

(def .public as
  (syntax (_ [class (..type^ (list))
              unchecked (<>.maybe <code>.any)])
    (with_symbols [g!_ g!unchecked]
      (let [class_name (..reflection class)
            class_type (` (.Nominal (, (code.text class_name))))
            check_type (` (.Maybe (, class_type)))
            check_code (` (if (.jvm_object_instance?# (, (code.text class_name)) (, g!unchecked))
                            {.#Some (.as (, class_type)
                                         (, g!unchecked))}
                            {.#None}))]
        (when unchecked
          {.#Some unchecked}
          (in (list (` (.is (, check_type)
                            (let [(, g!unchecked) (, unchecked)]
                              (, check_code))))))

          {.#None}
          (in (list (` (.is (-> (.Nominal "java.lang.Object") (, check_type))
                            (function ((, g!_) (, g!unchecked))
                              (, check_code))))))
          )))))

(def .public synchronized
  (syntax (_ [lock <code>.any
              body <code>.any])
    (in (list (` (.jvm_object_synchronized# (, lock) (, body)))))))

(def .public to
  (syntax (_ [obj <code>.any
              methods (<>.some partial_call^)])
    (with_symbols [g!obj]
      (in (list (` (let [(, g!obj) (, obj)]
                     (exec (,* (list#each (complete_call$ g!obj) methods))
                       (, g!obj)))))))))

(def (class_import$ declaration)
  (-> (Type Declaration) Code)
  (let [[full_name params] (parser.declaration declaration)
        def_name (..internal full_name)
        params' (list#each ..var$' params)]
    (template.with_locals [g!_]
      (` (def (, (code.symbol ["" def_name]))
           .Type
           (All ((, (' g!_)) (,* params'))
             (.Nominal (, (code.text full_name))
                       [(,* params')])))))))

(def (member_type_vars class_tvars member)
  (-> (List (Type Var)) Import_Member_Declaration (List (Type Var)))
  (when member
    {#ConstructorDecl [commons _]}
    (list#composite class_tvars (the #import_member_tvars commons))

    {#MethodDecl [commons _]}
    (when (the #import_member_kind commons)
      {#StaticIMK}
      (the #import_member_tvars commons)

      _
      (list#composite class_tvars (the #import_member_tvars commons)))

    _
    class_tvars))

(def (member_def_arg_bindings vars member)
  (-> (List (Type Var)) Import_Member_Declaration (Meta [(List [Bit Code]) (List (Type Value)) (List Code)]))
  (when member
    (^.or {#ConstructorDecl [commons _]} {#MethodDecl [commons _]})
    (let [(open "[0]") commons]
      (do [! meta.monad]
        [arg_inputs (monad.each !
                                (.is (-> [Bit (Type Value)] (Meta [Bit Code]))
                                     (function (_ [maybe? _])
                                       (with_symbols [arg_name]
                                         (in [maybe? arg_name]))))
                                #import_member_args)
         .let [input_jvm_types (list#each product.right #import_member_args)
               arg_types (list#each (.is (-> [Bit (Type Value)] Code)
                                         (function (_ [maybe? arg])
                                           (let [arg_type (value_type (the #import_member_mode commons) arg)]
                                             (if maybe?
                                               (` (Maybe (, arg_type)))
                                               arg_type))))
                                    #import_member_args)]]
        (in [arg_inputs input_jvm_types arg_types])))

    _
    (of meta.monad in [(list) (list) (list)])))

(def (with_return_maybe member never_null? unboxed return_term)
  (-> Import_Member_Declaration Bit (Type Value) Code Code)
  (when member
    (^.or {#ConstructorDecl [commons _]} {#MethodDecl [commons _]})
    (cond (or never_null?
              (dictionary.key? ..boxes unboxed))
          return_term

          (the #import_member_maybe? commons)
          (` (??? (, return_term)))

          ... else
          (let [g!temp (` ((,' ,') (, (code.symbol ["" " Ω "]))))]
            (` (let [(, g!temp) (, return_term)]
                 (if (not (..null? (.as (.Nominal "java.lang.Object")
                                        (, g!temp))))
                   (, g!temp)
                   (panic! "Cannot produce null references from method calls."))))))

    _
    return_term))

(with_template [<name> <tag> <term_trans>]
  [(def (<name> member return_term)
     (-> Import_Member_Declaration Code Code)
     (when member
       (^.or {#ConstructorDecl [commons _]} {#MethodDecl [commons _]})
       (if (the <tag> commons)
         <term_trans>
         return_term)

       _
       return_term))]

  [with_return_try #import_member_try? (` (.try (, return_term)))]
  [with_return_io  #import_member_io?  (` (io.io (, return_term)))]
  )

(with_template [<input?> <name> <unbox/box> <special+>]
  [(def (<name> mode [unboxed raw])
     (-> Primitive_Mode [(Type Value) Code] Code)
     (let [[unboxed refined post] (.is [(Type Value) Code (List Code)]
                                       (when mode
                                         {#ManualPrM}
                                         [unboxed raw (list)]
                                         
                                         {#AutoPrM}
                                         (with_expansions [<special+>' (template.spliced <special+>)
                                                           <cond_cases> (with_template [<primitive> <pre> <post>]
                                                                          [(of jvm.equivalence = <primitive> unboxed)
                                                                           (with_expansions [<post>' (template.spliced <post>)]
                                                                             [<primitive>
                                                                              (` (.|> (, raw) (,* <pre>)))
                                                                              (list <post>')])]

                                                                          <special+>')]
                                           (cond <cond_cases>
                                                 ... else
                                                 [unboxed
                                                  (if <input?>
                                                    (` (.jvm_object_cast# (, raw)))
                                                    raw)
                                                  (list)]))))
           unboxed/boxed (when (dictionary.value unboxed ..boxes)
                           {.#Some boxed}
                           (<unbox/box> unboxed boxed refined)
                           
                           {.#None}
                           refined)]
       (when post
         {.#End}
         unboxed/boxed

         _
         (` (.|> (, unboxed/boxed) (,* post))))))]

  [#1 with_automatic_input_conversion ..unbox
   [[jvm.boolean (list (` (.as (.Nominal (, (code.text box.boolean)))))) []]
    [jvm.byte (list (` (.as (.Nominal (, (code.text box.byte)))))) []]
    [jvm.short (list (` (.as (.Nominal (, (code.text box.short)))))) []]
    [jvm.int (list (` (.is (.Nominal (, (code.text box.int)))))) []]
    [jvm.long (list (` (.as (.Nominal (, (code.text box.long)))))) []]
    [jvm.char (list (` (.as (.Nominal (, (code.text box.char)))))) []]
    [jvm.float (list (` (.as (.Nominal (, (code.text box.float)))))) []]
    [jvm.double (list (` (.as (.Nominal (, (code.text box.double)))))) []]]]
  [#0 with_automatic_output_conversion ..box
   [[jvm.boolean (list) [(` (.is (.Nominal (, (code.text box.boolean)))))]]
    [jvm.byte (list) [(` (.is (.Nominal (, (code.text box.byte)))))]]
    [jvm.short (list) [(` (.is (.Nominal (, (code.text box.short)))))]]
    [jvm.int (list) [(` (.is (.Nominal (, (code.text box.int)))))]]
    [jvm.long (list) [(` (.is (.Nominal (, (code.text box.long)))))]]
    [jvm.char (list) [(` (.is (.Nominal (, (code.text box.char)))))]]
    [jvm.float (list) [(` (.is (.Nominal (, (code.text box.float)))))]]
    [jvm.double (list) [(` (.is (.Nominal (, (code.text box.double)))))]]]]
  )

(def (un_quoted quoted)
  (-> Code Code)
  (` ((,' ,) (, quoted))))

(def (jvm_invoke_inputs mode classes inputs)
  (-> Primitive_Mode (List (Type Value)) (List [Bit Code]) (List Code))
  (|> inputs
      (list.zipped_2 classes)
      (list#each (function (_ [class [maybe? input]])
                   (|> (if maybe?
                         (` (.is (.Nominal (, (code.text (..reflection class))))
                                 (!!! (, (..un_quoted input)))))
                         (..un_quoted input))
                       [class]
                       (with_automatic_input_conversion mode))))))

(def (import_name format class member)
  (-> Text Text Text Text)
  (|> format
      (text.replaced "[1]" class)
      (text.replaced "[0]" member)))

(def syntax_inputs
  (-> (List Code) (List Code))
  (|>> (list#each (function (_ name)
                    (list name (` <code>.any))))
       list#conjoint))

(exception.def .public (cannot_write_to_field [class field])
  (Exception [Text Text])
  (exception.report
   (list ["Class" (%.text class)]
         ["Field" (%.text field)])))

(def (member_def_interop vars kind class [arg_function_inputs input_jvm_types arg_types] member method_prefix import_format)
  (-> (List (Type Var)) Class_Kind (Type Declaration) [(List [Bit Code]) (List (Type Value)) (List Code)] Import_Member_Declaration Text Text (Meta (List Code)))
  (let [[full_name class_tvars] (parser.declaration class)]
    (when member
      {#EnumDecl enum_members}
      (with_symbols [g!_]
        (do meta.monad
          [.let [enum_type (.is Code
                                (when class_tvars
                                  {.#End}
                                  (` (.Nominal (, (code.text full_name))))

                                  _
                                  (let [=class_tvars (list#each ..var$' class_tvars)]
                                    (` (All ((, g!_) (,* =class_tvars))
                                         (.Nominal (, (code.text full_name)) [(,* =class_tvars)]))))))
                 getter_interop (.is (-> Text Code)
                                     (function (_ name)
                                       (let [getter_name (code.symbol ["" (..import_name import_format method_prefix name)])]
                                         (` (def (, getter_name)
                                              (, enum_type)
                                              (, (get_static_field full_name name)))))))]]
          (in (list#each getter_interop enum_members))))
      
      {#ConstructorDecl [commons _]}
      (do meta.monad
        [.let [classT (jvm.class full_name (list))
               def_name (code.symbol ["" (..import_name import_format method_prefix (the #import_member_alias commons))])
               jvm_interop (|> [classT
                                (` (.jvm_member_invoke_constructor# [(,* (list#each ..var$ class_tvars))]
                                                                    (, (code.text full_name))
                                                                    [(,* (list#each ..var$ (the #import_member_tvars commons)))]
                                                                    (,* (|> (jvm_invoke_inputs (the #import_member_mode commons) input_jvm_types arg_function_inputs)
                                                                            (list.zipped_2 input_jvm_types)
                                                                            (list#each ..decorate_input)))))]
                               (with_automatic_output_conversion (the #import_member_mode commons))
                               (with_return_maybe member true classT)
                               (with_return_try member)
                               (with_return_io member))]]
        (in (list (` (def (, def_name)
                       (syntax ((, def_name) [(,* (syntax_inputs (list#each product.right arg_function_inputs)))])
                         ((,' in) (.list (.` (, jvm_interop))))))))))

      {#MethodDecl [commons method]}
      (with_symbols [g!obj]
        (do meta.monad
          [.let [def_name (code.symbol ["" (..import_name import_format method_prefix (the #import_member_alias commons))])
                 (open "[0]") commons
                 (open "[0]") method
                 [jvm_op object_ast] (.is [Code (List Code)]
                                          (when #import_member_kind
                                            {#StaticIMK}
                                            [(` .jvm_member_invoke_static#)
                                             (list)]

                                            {#VirtualIMK}
                                            (when kind
                                              {#Class}
                                              [(` .jvm_member_invoke_virtual#)
                                               (list g!obj)]
                                              
                                              {#Interface}
                                              [(` .jvm_member_invoke_interface#)
                                               (list g!obj)]
                                              )))
                 method_return (the #import_method_return method)
                 callC (.is Code
                            (` ((, jvm_op)
                                [(,* (list#each ..var$ class_tvars))]
                                (, (code.text full_name))
                                (, (code.text #import_method_name))
                                [(,* (list#each ..var$ (the #import_member_tvars commons)))]
                                (,* (|> object_ast
                                        (list#each ..un_quoted)
                                        (list.zipped_2 (list (jvm.class full_name (list))))
                                        (list#each (with_automatic_input_conversion (the #import_member_mode commons)))))
                                (,* (|> (jvm_invoke_inputs (the #import_member_mode commons) input_jvm_types arg_function_inputs)
                                        (list.zipped_2 input_jvm_types)
                                        (list#each ..decorate_input))))))
                 jvm_interop (.is Code
                                  (when (jvm.void? method_return)
                                    {.#Left method_return}
                                    (|> [method_return
                                         callC]
                                        (with_automatic_output_conversion (the #import_member_mode commons))
                                        (with_return_maybe member false method_return)
                                        (with_return_try member)
                                        (with_return_io member))
                                    
                                    
                                    {.#Right method_return}
                                    (|> callC
                                        (with_return_try member)
                                        (with_return_io member))))]]
          (in (list (` (def (, def_name)
                         (syntax ((, def_name) [(,* (syntax_inputs (list#each product.right arg_function_inputs)))
                                                (,* (syntax_inputs object_ast))])
                           ((,' in) (.list (.` (, jvm_interop)))))))))))

      {#FieldAccessDecl fad}
      (do meta.monad
        [.let [(open "_[0]") fad
               g!name (code.symbol ["" (..import_name import_format method_prefix _#import_field_name)])]]
        (with_symbols [g!obj g!value write|read]
          (in (let [getter_body (<| (with_automatic_output_conversion _#import_field_mode)
                                    [_#import_field_type
                                     (if _#import_field_static?
                                       (get_static_field full_name _#import_field_name)
                                       (get_virtual_field full_name _#import_field_name (..un_quoted g!obj)))])
                    getter_body (if _#import_field_maybe?
                                  (` (??? (, getter_body)))
                                  getter_body)
                    getter_body (if _#import_field_setter?
                                  (` (io.io (, getter_body)))
                                  getter_body)
                    
                    setter_value (|> [_#import_field_type (..un_quoted g!value)]
                                     (with_automatic_input_conversion _#import_field_mode))
                    setter_value (if _#import_field_maybe?
                                   (` (!!! (, setter_value)))
                                   setter_value)
                    setter_command (if _#import_field_static? (` .jvm_member_put_static#) (` .jvm_member_put_virtual#))
                    g!obj+ (.is (List Code)
                                (if _#import_field_static?
                                  (list)
                                  (list (..un_quoted g!obj))))

                    parser (let [write (if _#import_field_static?
                                         (` <code>.any)
                                         (` (<>.and <code>.any
                                                    <code>.any)))
                                 read (if _#import_field_static?
                                        (` <code>.end)
                                        (` <code>.any))]
                             (` (<>.or (, write) (, read))))
                    write (list (if _#import_field_static?
                                  (` {.#Left [(, g!value)]})
                                  (` {.#Left [(, g!value) (, g!obj)]}))
                                (if _#import_field_setter?
                                  (` ((,' in) (.list (.` (io.io ((, setter_command)
                                                                 (, (code.text full_name))
                                                                 (, (code.text _#import_field_name))
                                                                 (, setter_value)
                                                                 (,* g!obj+)))))))
                                  (` (meta.failure (, (code.text (exception.error ..cannot_write_to_field [full_name _#import_field_name])))))))
                    read (list (if _#import_field_static?
                                 (` {.#Right []})
                                 (` {.#Right [(, g!obj)]}))
                               (` ((,' in) (.list (.` (, getter_body))))))]
                (list (` (def (, g!name)
                           (syntax ((, g!name) [(, write|read) (, parser)])
                             (when (, write|read)
                               (,* write)
                               (,* read))))))))))
      )))

(def (member_import$ vars kind class [import_format member])
  (-> (List (Type Var)) Class_Kind (Type Declaration) [Text Import_Member_Declaration] (Meta (List Code)))
  (let [[full_name _] (parser.declaration class)
        method_prefix (..internal full_name)]
    (do meta.monad
      [=args (member_def_arg_bindings vars member)]
      (member_def_interop vars kind class =args member method_prefix import_format))))

(def interface?
  (All (_ a) (-> (.Nominal "java.lang.Class" [a]) Bit))
  (|>> (.jvm_member_invoke_virtual# [] "java.lang.Class" "isInterface" [])
       .jvm_object_cast#
       (.is ..Boolean)
       (.as Bit)))

(def load_class
  (-> External (Try (.Nominal "java.lang.Class" [Any])))
  (|>> (.as (.Nominal "java.lang.String"))
       ["Ljava/lang/String;"]
       (.jvm_member_invoke_static# [] "java.lang.Class" "forName" [])
       try))

(def (class_kind declaration)
  (-> (Type Declaration) (Meta Class_Kind))
  (let [[class_name _] (parser.declaration declaration)]
    (when (load_class class_name)
      {.#Right class}
      (of meta.monad in (if (interface? class)
                          {#Interface}
                          {#Class}))

      {.#Left _}
      (meta.failure (format "Unknown class: " class_name)))))

(def .public import
  (syntax (_ [declaration ..declaration^
              .let [[class_name class_type_vars] (parser.declaration declaration)]
              import_format <code>.text
              members (<>.some (..import_member_decl^ class_type_vars))])
    (do [! meta.monad]
      [kind (class_kind declaration)
       =members (|> members
                    (list#each (|>> [import_format]))
                    (monad.each ! (member_import$ class_type_vars kind declaration)))]
      (in (list.partial (class_import$ declaration) (list#conjoint =members))))))

(def .public array
  (syntax (_ [type (..type^ (list))
              size <code>.any])
    (let [g!size (` (|> (, size)
                        (.is .Nat)
                        (.as (.Nominal (, (code.text box.long))))
                        .jvm_object_cast#
                        .jvm_conversion_long_to_int#))]
      (`` (cond (,, (with_template [<primitive> <array_op>]
                      [(of jvm.equivalence = <primitive> type)
                       (in (list (` (<array_op> (, g!size)))))]

                      [jvm.boolean .jvm_array_new_boolean#]
                      [jvm.byte    .jvm_array_new_byte#]
                      [jvm.short   .jvm_array_new_short#]
                      [jvm.int     .jvm_array_new_int#]
                      [jvm.long    .jvm_array_new_long#]
                      [jvm.float   .jvm_array_new_float#]
                      [jvm.double  .jvm_array_new_double#]
                      [jvm.char    .jvm_array_new_char#]))
                ... else
                (in (list (` (.as (array.Array (, (value_type {#ManualPrM} type)))
                                  (.is (, (value_type {#ManualPrM} (jvm.array type)))
                                       (.jvm_array_new_object# (, g!size))))))))))))

(exception.def .public (cannot_convert_to_jvm_type type)
  (Exception .Type)
  (exception.report
   (list ["Lux type" (%.type type)])))

(with_expansions [<failure> (these (meta.failure (exception.error ..cannot_convert_to_jvm_type [type])))]
  (def (lux_type->jvm_type context type)
    (-> Type_Context .Type (Meta (Type Value)))
    (if (type#= .Any type)
      (of meta.monad in $Object)
      (when type
        {.#Nominal name params}
        (`` (cond (,, (with_template [<type>]
                        [(text#= (..reflection <type>) name)
                         (when params
                           {.#End}
                           (of meta.monad in <type>)

                           _
                           <failure>)]
                        
                        [jvm.boolean]
                        [jvm.byte]
                        [jvm.short]
                        [jvm.int]
                        [jvm.long]
                        [jvm.float]
                        [jvm.double]
                        [jvm.char]))

                  (,, (with_template [<type>]
                        [(text#= (..reflection (jvm.array <type>)) name)
                         (when params
                           {.#End}
                           (of meta.monad in (jvm.array <type>))

                           _
                           <failure>)]
                        
                        [jvm.boolean]
                        [jvm.byte]
                        [jvm.short]
                        [jvm.int]
                        [jvm.long]
                        [jvm.float]
                        [jvm.double]
                        [jvm.char]))

                  (text#= array.nominal name)
                  (when params
                    {.#Item {.#Apply writeLT {.#Apply readLT _Mutable}} {.#End}}
                    (of meta.monad each jvm.array
                        (lux_type->jvm_type context readLT))

                    _
                    <failure>)

                  (text.starts_with? descriptor.array_prefix name)
                  (when params
                    {.#End}
                    (let [[_ unprefixed] (maybe.trusted (text.split_by descriptor.array_prefix name))]
                      (of meta.monad each jvm.array
                          (lux_type->jvm_type context {.#Nominal unprefixed (list)})))

                    _
                    <failure>)

                  ... else
                  (of meta.monad each (jvm.class name)
                      (.is (Meta (List (Type Parameter)))
                           (monad.each meta.monad
                                       (function (_ paramLT)
                                         (do meta.monad
                                           [paramJT (lux_type->jvm_type context paramLT)]
                                           (when (parser.parameter? paramJT)
                                             {.#Some paramJT}
                                             (in paramJT)

                                             {.#None}
                                             <failure>)))
                                       params)))))

        {.#Apply A F}
        (when (type.applied (list A) F)
          {.#None}
          <failure>

          {.#Some type'}
          (lux_type->jvm_type context type'))
        
        {.#Named _ type'}
        (lux_type->jvm_type context type')

        {.#Var @it}
        (when (check.result context (check.peek @it))
          {try.#Success {.#Some :it:}}
          (lux_type->jvm_type context :it:)

          _
          <failure>)

        _
        <failure>))))

(def .public length
  (syntax (_ [array <code>.any])
    (when array
      [_ {.#Symbol array_name}]
      (do meta.monad
        [array_type (meta.type array_name)
         context meta.type_context
         array_jvm_type (lux_type->jvm_type context array_type)
         .let [g!extension (`` (cond (,, (with_template [<primitive> <extension>]
                                           [(of jvm.equivalence =
                                                (jvm.array <primitive>)
                                                array_jvm_type)
                                            (` <extension>)]

                                           [jvm.boolean .jvm_array_length_boolean#]
                                           [jvm.byte .jvm_array_length_byte#]
                                           [jvm.short .jvm_array_length_short#]
                                           [jvm.int .jvm_array_length_int#]
                                           [jvm.long .jvm_array_length_long#]
                                           [jvm.float .jvm_array_length_float#]
                                           [jvm.double .jvm_array_length_double#]
                                           [jvm.char .jvm_array_length_char#]))
                                     
                                     ... else
                                     (` .jvm_array_length_object#)))]]
        (in (list (` (.|> ((, g!extension) (, array))
                          .jvm_conversion_int_to_long#
                          .jvm_object_cast#
                          (.is (.Nominal (, (code.text box.long))))
                          (.as .Nat))))))

      _
      (with_symbols [g!array]
        (in (list (` (let [(, g!array) (, array)]
                       (..length (, g!array))))))))))

(def .public read!
  (syntax (_ [idx <code>.any
              array <code>.any])
    (when array
      [_ {.#Symbol array_name}]
      (do meta.monad
        [array_type (meta.type array_name)
         context meta.type_context
         array_jvm_type (lux_type->jvm_type context array_type)
         .let [g!idx (` (.|> (, idx)
                             (.is .Nat)
                             (.as (.Nominal (, (code.text box.long))))
                             .jvm_object_cast#
                             .jvm_conversion_long_to_int#))]]
        (`` (cond (,, (with_template [<primitive> <extension> <box>]
                        [(of jvm.equivalence =
                             (jvm.array <primitive>)
                             array_jvm_type)
                         (in (list (` (.|> (<extension> (, g!idx) (, array))
                                           .jvm_object_cast#
                                           (.is (.Nominal (, (code.text <box>))))))))]

                        [jvm.boolean .jvm_array_read_boolean# box.boolean]
                        [jvm.byte .jvm_array_read_byte# box.byte]
                        [jvm.short .jvm_array_read_short# box.short]
                        [jvm.int .jvm_array_read_int# box.int]
                        [jvm.long .jvm_array_read_long# box.long]
                        [jvm.float .jvm_array_read_float# box.float]
                        [jvm.double .jvm_array_read_double# box.double]
                        [jvm.char .jvm_array_read_char# box.char]))
                  
                  ... else
                  (in (list (` (.jvm_array_read_object# (, g!idx) (, array))))))))

      _
      (with_symbols [g!array]
        (in (list (` (let [(, g!array) (, array)]
                       (..read! (, idx) (, g!array))))))))))

(def .public write!
  (syntax (_ [idx <code>.any
              value <code>.any
              array <code>.any])
    (when array
      [_ {.#Symbol array_name}]
      (do meta.monad
        [array_type (meta.type array_name)
         context meta.type_context
         array_jvm_type (lux_type->jvm_type context array_type)
         .let [g!idx (` (.|> (, idx)
                             (.is .Nat)
                             (.as (.Nominal (, (code.text box.long))))
                             .jvm_object_cast#
                             .jvm_conversion_long_to_int#))]]
        (`` (cond (,, (with_template [<primitive> <extension> <box>]
                        [(of jvm.equivalence =
                             (jvm.array <primitive>)
                             array_jvm_type)
                         (let [g!value (` (.|> (, value)
                                               (.as (.Nominal (, (code.text <box>))))
                                               .jvm_object_cast#))]
                           (in (list (` (<extension> (, g!idx) (, g!value) (, array))))))]

                        [jvm.boolean .jvm_array_write_boolean# box.boolean]
                        [jvm.byte .jvm_array_write_byte# box.byte]
                        [jvm.short .jvm_array_write_short# box.short]
                        [jvm.int .jvm_array_write_int# box.int]
                        [jvm.long .jvm_array_write_long# box.long]
                        [jvm.float .jvm_array_write_float# box.float]
                        [jvm.double .jvm_array_write_double# box.double]
                        [jvm.char .jvm_array_write_char# box.char]))
                  
                  ... else
                  (in (list (` (.jvm_array_write_object# (, g!idx) (, value) (, array))))))))

      _
      (with_symbols [g!array]
        (in (list (` (let [(, g!array) (, array)]
                       (..write! (, idx) (, value) (, g!array))))))))))

(def .public class_for
  (syntax (_ [type (..type^ (list))])
    (in (list (` (.jvm_object_class# (, (code.text (..reflection type)))))))))

(def .public type
  (syntax (_ [type (..type^ (list))])
    (in (list (..value_type {#ManualPrM} type)))))

(exception.def .public (cannot_cast_to_non_object type)
  (Exception (Type Value))
  (exception.report
   (list ["Signature" (..signature type)]
         ["Reflection" (..reflection type)])))

(def .public is
  (syntax (_ [type (..type^ (list))
              object <code>.any])
    (when [(parser.array? type)
           (parser.class? type)]
      (^.or [{.#Some _} _] [_ {.#Some _}])
      (in (list (` (.is (, (..value_type {#ManualPrM} type))
                        (.jvm_object_cast# (, object))))))

      _
      (meta.failure (exception.error ..cannot_cast_to_non_object [type])))))

(with_template [<forward> <from> <to> <backward>]
  [(def .public <forward>
     (template (<forward> it)
       [(|> it (.is <from>) (.as <to>))]))

   (def .public <backward>
     (template (<backward> it)
       [(|> it (.is <to>) (.as <from>))]))]

  [as_boolean .Bit ..Boolean of_boolean]
  [as_long .Int ..Long of_long]
  [as_double .Frac ..Double of_double]
  [as_string .Text ..String of_string]
  )

(with_template [<forward> <from> <$> <mid> <$'> <to> <backward>]
  [(def .public <forward>
     (template (<forward> it)
       [(|> it (.is <from>) (.as <mid>) <$> (.is <to>))]))

   (def .public <backward>
     (template (<backward> it)
       [(|> it (.is <to>) <$'> (.is <mid>) (.as <from>))]))]

  [as_byte .Int ..long_to_byte ..Long ..byte_to_long ..Byte of_byte]
  [as_short .Int ..long_to_short ..Long ..short_to_long ..Short of_short]
  [as_int .Int ..long_to_int ..Long ..int_to_long ..Integer of_int]
  [as_char .Int ..long_to_char ..Long ..char_to_long ..Character of_char]
  [as_float .Frac ..double_to_float ..Double ..float_to_double ..Float of_float]
  )