(.module:
  [lux (#- Type type int char)
   ["." type ("#@." equivalence)]
   [abstract
    ["." monad (#+ Monad do)]
    ["." enum]]
   [control
    ["." function]
    ["." io]
    ["." try (#+ Try)]
    ["p" parser ("#@." monad)
     ["s" code (#+ Parser)]]]
   [data
    ["." maybe]
    ["." product]
    ["." bit ("#@." codec)]
    number
    ["." text ("#@." equivalence monoid)
     ["%" format (#+ format)]]
    [collection
     ["." array (#+ Array)]
     ["." list ("#@." monad fold monoid)]
     ["." dictionary (#+ Dictionary)]]]
   ["." macro (#+ with-gensyms)
    [syntax (#+ syntax:)]
    ["." code]
    ["." template]]
   [target
    ["." jvm #_
     ["#" type (#+ Primitive Var Bound Class Generic Type Argument Return Typed)
      ["." box]
      ["." reflection]]]]])

(template [<name> <class>]
  [(def: #export <name> .Type (#.Primitive <class> #.Nil))]

  ## Boxes
  [Boolean   box.boolean]
  [Byte      box.byte]
  [Short     box.short]
  [Integer   box.int]
  [Long      box.long]
  [Float     box.float]
  [Double    box.double]
  [Character box.char]

  ## 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 static get"
      (~ (code.text class))
      (~ (code.text field)))))

(def: (get-virtual-field class field object)
  (-> Text Text Code Code)
  (` ("jvm member virtual get"
      (~ (code.text class))
      (~ (code.text field))
      (~ object))))

(def: boxes
  (Dictionary Text Text)
  (|> (list [jvm.boolean-descriptor box.boolean]
            [jvm.byte-descriptor    box.byte]
            [jvm.short-descriptor   box.short]
            [jvm.int-descriptor     box.int]
            [jvm.long-descriptor    box.long]
            [jvm.float-descriptor   box.float]
            [jvm.double-descriptor  box.double]
            [jvm.char-descriptor    box.char])
      (dictionary.from-list text.hash)))

(def: reflections
  (Dictionary Text Text)
  (|> (list [jvm.boolean-descriptor reflection.boolean]
            [jvm.byte-descriptor    reflection.byte]
            [jvm.short-descriptor   reflection.short]
            [jvm.int-descriptor     reflection.int]
            [jvm.long-descriptor    reflection.long]
            [jvm.float-descriptor   reflection.float]
            [jvm.double-descriptor  reflection.double]
            [jvm.char-descriptor    reflection.char])
      (dictionary.from-list text.hash)))

(template [<name> <pre> <post>]
  [(def: (<name> unboxed boxed raw)
     (-> Text Text Code Code)
     (let [unboxed (|> reflections (dictionary.get unboxed) (maybe.default unboxed))]
       (` (|> (~ raw)
              (: (primitive (~ (code.text <pre>))))
              "jvm object cast"
              (: (primitive (~ (code.text <post>))))))))]

  [unbox boxed unboxed]
  [box unboxed boxed]
  )

(template [<name> <op> <from> <to>]
  [(template: #export (<name> value)
     {#.doc (doc "Type converter."
                 (: <to>
                    (<name> (: <from> foo))))}
     (|> value
         (: <from>)
         "jvm object cast"
         <op>
         "jvm object cast"
         (: <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]
  )

(def: constructor-method-name "<init>")
(def: member-separator "::")

(type: Primitive-Mode
  #ManualPrM
  #AutoPrM)

(type: PrivacyModifier
  #PublicPM
  #PrivatePM
  #ProtectedPM
  #DefaultPM)

(type: StateModifier
  #VolatileSM
  #FinalSM
  #DefaultSM)

(type: InheritanceModifier
  #FinalIM
  #AbstractIM
  #DefaultIM)

(type: Class-Kind
  #Class
  #Interface)

(type: Class-Declaration
  {#class-name   Text
   #class-params (List Var)})

(type: StackFrame (primitive "java/lang/StackTraceElement"))
(type: StackTrace (Array StackFrame))

(type: AnnotationParam
  [Text Code])

(type: Annotation
  {#ann-name   Text
   #ann-params (List AnnotationParam)})

(type: Member-Declaration
  {#member-name Text
   #member-privacy PrivacyModifier
   #member-anns (List Annotation)})

(type: FieldDecl
  (#ConstantField Type Code)
  (#VariableField StateModifier Type))

(type: MethodDecl
  {#method-tvars  (List Var)
   #method-inputs (List Type)
   #method-output Return
   #method-exs    (List Class)})

(type: Method-Definition
  (#ConstructorMethod [Bit
                       (List Var)
                       Text
                       (List Argument)
                       (List (Typed Code))
                       Code
                       (List Class)])
  (#VirtualMethod [Bit
                   Bit
                   (List Var)
                   Text
                   (List Argument)
                   Return
                   Code
                   (List Class)])
  (#OverridenMethod [Bit
                     Class-Declaration
                     (List Var)
                     Text
                     (List Argument)
                     Return
                     Code
                     (List Class)])
  (#StaticMethod [Bit
                  (List Var)
                  (List Argument)
                  Return
                  Code
                  (List Class)])
  (#AbstractMethod [(List Var)
                    (List Argument)
                    Return
                    (List Class)])
  (#NativeMethod [(List Var)
                  (List Argument)
                  Return
                  (List Class)]))

(type: Partial-Call
  {#pc-method Name
   #pc-args   (List Code)})

(type: ImportMethodKind
  #StaticIMK
  #VirtualIMK)

(type: ImportMethodCommons
  {#import-member-mode   Primitive-Mode
   #import-member-alias  Text
   #import-member-kind   ImportMethodKind
   #import-member-tvars  (List Var)
   #import-member-args   (List [Bit Type])
   #import-member-maybe? Bit
   #import-member-try?   Bit
   #import-member-io?    Bit})

(type: ImportConstructorDecl
  {})

(type: ImportMethodDecl
  {#import-method-name    Text
   #import-method-return  Return})

(type: ImportFieldDecl
  {#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})

(type: Import-Member-Declaration
  (#EnumDecl        (List Text))
  (#ConstructorDecl [ImportMethodCommons ImportConstructorDecl])
  (#MethodDecl      [ImportMethodCommons ImportMethodDecl])
  (#FieldAccessDecl ImportFieldDecl))

(type: Class-Imports
  (List [Text Text]))

(def: binary-class-separator "/")
(def: syntax-class-separator ".")

(def: (short-class-name name)
  (-> Text Text)
  (case (list.reverse (text.split-all-with ..binary-class-separator name))
    (#.Cons short-name _)
    short-name

    #.Nil
    name))

(def: sanitize
  (-> Text Text)
  (text.replace-all ..binary-class-separator ..syntax-class-separator))

(def: (generic-type generic)
  (-> Generic Code)
  (case generic
    (#jvm.Var name)
    (code.identifier ["" name])

    (#jvm.Wildcard wilcard)
    (case wilcard
      (^or #.None (#.Some [#jvm.Lower _]))
      (` .Any)

      (#.Some [#jvm.Upper bound])
      (generic-type bound))
    
    (#jvm.Class [name params])
    (` (.primitive (~ (code.text (sanitize name)))
                   [(~+ (list@map generic-type params))]))))

(def: (jvm-type mode type)
  (-> Primitive-Mode Type Code)
  (case type
    (#jvm.Primitive primitive)
    (case mode
      #ManualPrM
      (case primitive
        #jvm.Boolean (` ..Boolean)
        #jvm.Byte (` ..Byte)
        #jvm.Short (` ..Short)
        #jvm.Int (` ..Integer)
        #jvm.Long (` ..Long)
        #jvm.Float (` ..Float)
        #jvm.Double (` ..Double)
        #jvm.Char (` ..Character))
      
      #AutoPrM
      (case primitive
        #jvm.Boolean (` .Bit)
        #jvm.Byte (` .Int)
        #jvm.Short (` .Int)
        #jvm.Int (` .Int)
        #jvm.Long (` .Int)
        #jvm.Float (` .Frac)
        #jvm.Double (` .Frac)
        #jvm.Char (` .Nat)))

    (#jvm.Generic generic)
    (generic-type generic)
    
    (#jvm.Array elementT)
    (case elementT
      (#jvm.Primitive primitive)
      (let [array-type-name (jvm.descriptor (jvm.array 1 (case primitive
                                                           #jvm.Boolean jvm.boolean
                                                           #jvm.Byte jvm.byte
                                                           #jvm.Short jvm.short
                                                           #jvm.Int jvm.int
                                                           #jvm.Long jvm.long
                                                           #jvm.Float jvm.float
                                                           #jvm.Double jvm.double
                                                           #jvm.Char jvm.char)))]
        (` (#.Primitive (~ (code.text array-type-name)) #.Nil)))

      _
      (` (#.Primitive (~ (code.text array.type-name))
                      (#.Cons (~ (jvm-type mode elementT)) #.Nil))))
    ))

(def: (declaration-type$ (^slots [#class-name #class-params]))
  (-> Class-Declaration Code)
  (` (primitive (~ (code.text (sanitize class-name)))
                [(~+ (list@map code.local-identifier class-params))])))

(def: empty-imports
  Class-Imports
  (list))

(def: (get-import name imports)
  (-> Text Class-Imports (Maybe Text))
  (:: maybe.functor map product.right
      (list.find (|>> product.left (text@= name))
                 imports)))

(def: (add-import short+full imports)
  (-> [Text Text] Class-Imports Class-Imports)
  (#.Cons short+full imports))

(def: (class-imports compiler)
  (-> Lux Class-Imports)
  (case (macro.run compiler
                   (: (Meta Class-Imports)
                      (do macro.monad
                        [current-module macro.current-module-name
                         definitions (macro.definitions current-module)]
                        (wrap (list@fold (: (-> [Text Global] Class-Imports Class-Imports)
                                            (function (_ [short-name constant] imports)
                                              (case constant
                                                (#.Left _)
                                                imports
                                                
                                                (#.Right [_ _ meta _])
                                                (case (macro.get-text-ann (name-of #..jvm-class) meta)
                                                  (#.Some full-class-name)
                                                  (add-import [short-name full-class-name] imports)

                                                  _
                                                  imports))))
                                         empty-imports
                                         definitions)))))
    (#.Left _)        (list)
    (#.Right imports) imports))

(def: (qualify imports name)
  (-> Class-Imports Text Text)
  (|> imports (get-import name) (maybe.default name)))

(def: (make-get-const-parser class-name field-name)
  (-> Text Text (Parser Code))
  (do p.monad
    [#let [dotted-name (format "::" field-name)]
     _ (s.this! (code.identifier ["" dotted-name]))]
    (wrap (get-static-field class-name field-name))))

(def: (make-get-var-parser class-name field-name)
  (-> Text Text (Parser Code))
  (do p.monad
    [#let [dotted-name (format "::" field-name)]
     _ (s.this! (code.identifier ["" dotted-name]))]
    (wrap (get-virtual-field class-name field-name (' _jvm_this)))))

(def: (make-put-var-parser class-name field-name)
  (-> Text Text (Parser Code))
  (do p.monad
    [#let [dotted-name (format "::" field-name)]
     [_ _ value] (: (Parser [Any Any Code])
                    (s.form ($_ p.and (s.this! (' :=)) (s.this! (code.identifier ["" dotted-name])) s.any)))]
    (wrap (`' ((~ (code.text (format "jvm putfield" ":" class-name ":" field-name))) _jvm_this (~ value))))))

(def: (pre-walk-replace f input)
  (-> (-> Code Code) Code Code)
  (case (f input)
    (^template [<tag>]
      [meta (<tag> parts)]
      [meta (<tag> (list@map (pre-walk-replace f) parts))])
    ([#.Form]
     [#.Tuple])
    
    [meta (#.Record pairs)]
    [meta (#.Record (list@map (: (-> [Code Code] [Code Code])
                                 (function (_ [key val])
                                   [(pre-walk-replace f key) (pre-walk-replace f val)]))
                              pairs))]
    
    ast'
    ast'))

(def: (parser->replacer p ast)
  (-> (Parser Code) (-> Code Code))
  (case (p.run p (list ast))
    (#.Right [#.Nil ast'])
    ast'

    _
    ast
    ))

(def: (field->parser class-name [[field-name _ _] field])
  (-> Text [Member-Declaration FieldDecl] (Parser Code))
  (case field
    (#ConstantField _)
    (make-get-const-parser class-name field-name)
    
    (#VariableField _)
    (p.either (make-get-var-parser class-name field-name)
              (make-put-var-parser class-name field-name))))

(def: (decorate-input [class value])
  (-> [Text Code] Code)
  (` [(~ (code.text class)) (~ value)]))

(def: (make-constructor-parser class-name arguments)
  (-> Text (List Argument) (Parser Code))
  (do p.monad
    [args (: (Parser (List Code))
             (s.form (p.after (s.this! (' ::new!))
                              (s.tuple (p.exactly (list.size arguments) s.any)))))
     #let [arguments' (list@map (|>> product.right jvm.signature) arguments)]]
    (wrap (` ("jvm member invoke constructor" (~ (code.text class-name))
              (~+ (|> args
                      (list.zip2 arguments')
                      (list@map ..decorate-input))))))))

(def: (make-static-method-parser class-name method-name arguments)
  (-> Text Text (List Argument) (Parser Code))
  (do p.monad
    [#let [dotted-name (format "::" method-name "!")]
     args (: (Parser (List Code))
             (s.form (p.after (s.this! (code.identifier ["" dotted-name]))
                              (s.tuple (p.exactly (list.size arguments) s.any)))))
     #let [arguments' (list@map (|>> product.right jvm.signature) arguments)]]
    (wrap (` ("jvm member invoke static" (~ (code.text class-name)) (~ (code.text method-name))
              (~+ (|> args
                      (list.zip2 arguments')
                      (list@map ..decorate-input))))))))

(template [<name> <jvm-op>]
  [(def: (<name> class-name method-name arguments)
     (-> Text Text (List Argument) (Parser Code))
     (do p.monad
       [#let [dotted-name (format "::" method-name "!")]
        args (: (Parser (List Code))
                (s.form (p.after (s.this! (code.identifier ["" dotted-name]))
                                 (s.tuple (p.exactly (list.size arguments) s.any)))))
        #let [arguments' (list@map (|>> product.right jvm.signature) arguments)]]
       (wrap (` (<jvm-op> (~ (code.text class-name)) (~ (code.text method-name))
                          (~' _jvm_this)
                          (~+ (|> args
                                  (list.zip2 arguments')
                                  (list@map ..decorate-input))))))))]

  [make-special-method-parser "jvm member invoke special"]
  [make-virtual-method-parser "jvm member invoke virtual"]
  )

(def: (method->parser class-name [[method-name _ _] meth-def])
  (-> Text [Member-Declaration Method-Definition] (Parser Code))
  (case meth-def
    (#ConstructorMethod strict? type-vars self-name args constructor-args return-expr exs)
    (make-constructor-parser class-name args)
    
    (#StaticMethod strict? type-vars args return-type return-expr exs)
    (make-static-method-parser class-name method-name args)
    
    (^or (#VirtualMethod final? strict? type-vars self-name args return-type return-expr exs)
         (#OverridenMethod strict? owner-class type-vars self-name args return-type return-expr exs))
    (make-special-method-parser class-name method-name args)

    (#AbstractMethod type-vars args return-type exs)
    (make-virtual-method-parser class-name method-name args)

    (#NativeMethod type-vars args return-type exs)
    (make-virtual-method-parser class-name method-name args)))

(def: (full-class-name^ imports)
  (-> Class-Imports (Parser Text))
  (do p.monad
    [name s.local-identifier]
    (wrap (qualify imports name))))

(def: privacy-modifier^
  (Parser PrivacyModifier)
  (let [(^open ".") p.monad]
    ($_ p.or
        (s.this! (' #public))
        (s.this! (' #private))
        (s.this! (' #protected))
        (wrap []))))

(def: inheritance-modifier^
  (Parser InheritanceModifier)
  (let [(^open ".") p.monad]
    ($_ p.or
        (s.this! (' #final))
        (s.this! (' #abstract))
        (wrap []))))

(def: bound^
  (Parser Bound)
  (p.or (s.this! (' >))
        (s.this! (' <))))

(def: (assert-valid-class-name type-vars name)
  (-> (List Var) Text (Parser Any))
  (do p.monad
    [_ (p.assert "Names in class declarations cannot contain periods."
                 (not (text.contains? ..syntax-class-separator name)))]
    (p.assert (format name " cannot be a type-var!")
              (not (list.member? text.equivalence type-vars name)))))

(def: (valid-class-name imports type-vars)
  (-> Class-Imports (List Var) (Parser Text))
  (do p.monad
    [name (full-class-name^ imports)
     _ (assert-valid-class-name type-vars name)]
    (wrap name)))

(def: (class^' generic^ imports type-vars)
  (-> (-> Class-Imports (List Var) (Parser Generic))
      (-> Class-Imports (List Var) (Parser Class)))
  ($_ p.either
      (p.and (valid-class-name imports type-vars)
             (p@wrap (list)))
      (s.form (p.and (full-class-name^ imports)
                     (p.some (generic^ imports type-vars))))
      ))

(def: (generic^ imports type-vars)
  (-> Class-Imports (List Var) (Parser Generic))
  (p.rec
   (function (_ recur^)
     ($_ p.or
         (do p.monad
           [name (full-class-name^ imports)
            _ (p.assert "Var name must ne one of the expected type-vars."
                        (list.member? text.equivalence type-vars name))]
           (wrap name))
         (p.or (s.this! (' ?))
               (s.tuple (p.after (s.this! (' ?))
                                 (p.and ..bound^
                                        recur^))))
         (class^' generic^ imports type-vars)
         ))))

(def: primitive^
  (Parser Primitive)
  ($_ p.or
      (s.identifier! ["" reflection.boolean])
      (s.identifier! ["" reflection.byte])
      (s.identifier! ["" reflection.short])
      (s.identifier! ["" reflection.int])
      (s.identifier! ["" reflection.long])
      (s.identifier! ["" reflection.float])
      (s.identifier! ["" reflection.double])
      (s.identifier! ["" reflection.char])
      ))

(def: (type^ imports type-vars)
  (-> Class-Imports (List Var) (Parser Type))
  (p.rec
   (function (_ recur^)
     ($_ p.or
         ..primitive^
         (generic^ imports type-vars)
         (s.tuple recur^)
         ))))

(def: (return^ imports type-vars)
  (-> Class-Imports (List Var) (Parser Return))
  (p.or (s.identifier! ["" "void"])
        (..type^ imports type-vars)))

(def: var^
  (Parser Var)
  s.local-identifier)

(def: vars^
  (Parser (List Var))
  (s.tuple (p.some var^)))

(def: (declaration^ imports)
  (-> Class-Imports (Parser Class-Declaration))
  (p.either (p.and (valid-class-name imports (list))
                   (p@wrap (list)))
            (s.form (p.and (valid-class-name imports (list))
                           (p.some var^)))
            ))

(def: (class^ imports type-vars)
  (-> Class-Imports (List Var) (Parser Class))
  (class^' generic^ imports type-vars))

(def: annotation-params^
  (Parser (List AnnotationParam))
  (s.record (p.some (p.and s.local-tag s.any))))

(def: (annotation^ imports)
  (-> Class-Imports (Parser Annotation))
  (p.either (do p.monad
              [ann-name (full-class-name^ imports)]
              (wrap [ann-name (list)]))
            (s.form (p.and (full-class-name^ imports)
                           annotation-params^))))

(def: (annotations^' imports)
  (-> Class-Imports (Parser (List Annotation)))
  (do p.monad
    [_ (s.this! (' #ann))]
    (s.tuple (p.some (annotation^ imports)))))

(def: (annotations^ imports)
  (-> Class-Imports (Parser (List Annotation)))
  (do p.monad
    [anns?? (p.maybe (annotations^' imports))]
    (wrap (maybe.default (list) anns??))))

(def: (throws-decl^ imports type-vars)
  (-> Class-Imports (List Var) (Parser (List Class)))
  (<| (p.default (list))
      (do p.monad
        [_ (s.this! (' #throws))]
        (s.tuple (p.some (..class^ imports type-vars))))))

(def: (method-decl^ imports type-vars)
  (-> Class-Imports (List Var) (Parser [Member-Declaration MethodDecl]))
  (s.form (do p.monad
            [tvars (p.default (list) ..vars^)
             name s.local-identifier
             anns (annotations^ imports)
             inputs (s.tuple (p.some (..type^ imports type-vars)))
             output (..return^ imports type-vars)
             exs (throws-decl^ imports type-vars)]
            (wrap [[name #PublicPM anns] {#method-tvars tvars
                                          #method-inputs inputs
                                          #method-output output
                                          #method-exs    exs}]))))

(def: state-modifier^
  (Parser StateModifier)
  ($_ p.or
      (s.this! (' #volatile))
      (s.this! (' #final))
      (:: p.monad wrap [])))

(def: (field-decl^ imports type-vars)
  (-> Class-Imports (List Var) (Parser [Member-Declaration FieldDecl]))
  (p.either (s.form (do p.monad
                      [_ (s.this! (' #const))
                       name s.local-identifier
                       anns (annotations^ imports)
                       type (..type^ imports type-vars)
                       body s.any]
                      (wrap [[name #PublicPM anns] (#ConstantField [type body])])))
            (s.form (do p.monad
                      [pm privacy-modifier^
                       sm state-modifier^
                       name s.local-identifier
                       anns (annotations^ imports)
                       type (..type^ imports type-vars)]
                      (wrap [[name pm anns] (#VariableField [sm type])])))))

(def: (argument^ imports type-vars)
  (-> Class-Imports (List Var) (Parser Argument))
  (s.record (p.and s.local-identifier
                   (..type^ imports type-vars))))

(def: (arguments^ imports type-vars)
  (-> Class-Imports (List Var) (Parser (List Argument)))
  (p.some (argument^ imports type-vars)))

(def: (constructor-arg^ imports type-vars)
  (-> Class-Imports (List Var) (Parser (Typed Code)))
  (s.record (p.and (..type^ imports type-vars) s.any)))

(def: (constructor-args^ imports type-vars)
  (-> Class-Imports (List Var) (Parser (List (Typed Code))))
  (s.tuple (p.some (constructor-arg^ imports type-vars))))

(def: (constructor-method^ imports class-vars)
  (-> Class-Imports (List Var) (Parser [Member-Declaration Method-Definition]))
  (s.form (do p.monad
            [pm privacy-modifier^
             strict-fp? (p.parses? (s.this! (' #strict)))
             method-vars (p.default (list) ..vars^)
             #let [total-vars (list@compose class-vars method-vars)]
             [_ self-name arguments] (s.form ($_ p.and
                                                 (s.this! (' new))
                                                 s.local-identifier
                                                 (arguments^ imports total-vars)))
             constructor-args (constructor-args^ imports total-vars)
             exs (throws-decl^ imports total-vars)
             annotations (annotations^ imports)
             body s.any]
            (wrap [{#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^ imports class-vars)
  (-> Class-Imports (List Var) (Parser [Member-Declaration Method-Definition]))
  (s.form (do p.monad
            [pm privacy-modifier^
             strict-fp? (p.parses? (s.this! (' #strict)))
             final? (p.parses? (s.this! (' #final)))
             method-vars (p.default (list) ..vars^)
             #let [total-vars (list@compose class-vars method-vars)]
             [name self-name arguments] (s.form ($_ p.and
                                                    s.local-identifier
                                                    s.local-identifier
                                                    (arguments^ imports total-vars)))
             return-type (..return^ imports total-vars)
             exs (throws-decl^ imports total-vars)
             annotations (annotations^ imports)
             body s.any]
            (wrap [{#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^ imports)
  (-> Class-Imports (Parser [Member-Declaration Method-Definition]))
  (s.form (do p.monad
            [strict-fp? (p.parses? (s.this! (' #strict)))
             owner-class (declaration^ imports)
             method-vars (p.default (list) ..vars^)
             #let [total-vars (list@compose (product.right owner-class) method-vars)]
             [name self-name arguments] (s.form ($_ p.and
                                                    s.local-identifier
                                                    s.local-identifier
                                                    (arguments^ imports total-vars)))
             return-type (..return^ imports total-vars)
             exs (throws-decl^ imports total-vars)
             annotations (annotations^ imports)
             body s.any]
            (wrap [{#member-name name
                    #member-privacy #PublicPM
                    #member-anns annotations}
                   (#OverridenMethod strict-fp? owner-class method-vars self-name arguments return-type body exs)]))))

(def: (static-method-def^ imports)
  (-> Class-Imports (Parser [Member-Declaration Method-Definition]))
  (s.form (do p.monad
            [pm privacy-modifier^
             strict-fp? (p.parses? (s.this! (' #strict)))
             _ (s.this! (' #static))
             method-vars (p.default (list) ..vars^)
             #let [total-vars method-vars]
             [name arguments] (s.form (p.and s.local-identifier
                                             (arguments^ imports total-vars)))
             return-type (..return^ imports total-vars)
             exs (throws-decl^ imports total-vars)
             annotations (annotations^ imports)
             body s.any]
            (wrap [{#member-name name
                    #member-privacy pm
                    #member-anns annotations}
                   (#StaticMethod strict-fp? method-vars arguments return-type body exs)]))))

(def: (abstract-method-def^ imports)
  (-> Class-Imports (Parser [Member-Declaration Method-Definition]))
  (s.form (do p.monad
            [pm privacy-modifier^
             _ (s.this! (' #abstract))
             method-vars (p.default (list) ..vars^)
             #let [total-vars method-vars]
             [name arguments] (s.form (p.and s.local-identifier
                                             (arguments^ imports total-vars)))
             return-type (..return^ imports total-vars)
             exs (throws-decl^ imports total-vars)
             annotations (annotations^ imports)]
            (wrap [{#member-name name
                    #member-privacy pm
                    #member-anns annotations}
                   (#AbstractMethod method-vars arguments return-type exs)]))))

(def: (native-method-def^ imports)
  (-> Class-Imports (Parser [Member-Declaration Method-Definition]))
  (s.form (do p.monad
            [pm privacy-modifier^
             _ (s.this! (' #native))
             method-vars (p.default (list) ..vars^)
             #let [total-vars method-vars]
             [name arguments] (s.form (p.and s.local-identifier
                                             (arguments^ imports total-vars)))
             return-type (..return^ imports total-vars)
             exs (throws-decl^ imports total-vars)
             annotations (annotations^ imports)]
            (wrap [{#member-name name
                    #member-privacy pm
                    #member-anns annotations}
                   (#NativeMethod method-vars arguments return-type exs)]))))

(def: (method-def^ imports class-vars)
  (-> Class-Imports (List Var) (Parser [Member-Declaration Method-Definition]))
  ($_ p.either
      (constructor-method^ imports class-vars)
      (virtual-method-def^ imports class-vars)
      (overriden-method-def^ imports)
      (static-method-def^ imports)
      (abstract-method-def^ imports)
      (native-method-def^ imports)))

(def: partial-call^
  (Parser Partial-Call)
  (s.form (p.and s.identifier (p.some s.any))))

(def: class-kind^
  (Parser Class-Kind)
  (p.either (do p.monad
              [_ (s.this! (' #class))]
              (wrap #Class))
            (do p.monad
              [_ (s.this! (' #interface))]
              (wrap #Interface))
            ))

(def: import-member-alias^
  (Parser (Maybe Text))
  (p.maybe (do p.monad
             [_ (s.this! (' #as))]
             s.local-identifier)))

(def: (import-member-args^ imports type-vars)
  (-> Class-Imports (List Var) (Parser (List [Bit Type])))
  (s.tuple (p.some (p.and (p.parses? (s.tag! ["" "?"]))
                          (..type^ imports type-vars)))))

(def: import-member-return-flags^
  (Parser [Bit Bit Bit])
  ($_ p.and (p.parses? (s.this! (' #io))) (p.parses? (s.this! (' #try))) (p.parses? (s.this! (' #?)))))

(def: primitive-mode^
  (Parser Primitive-Mode)
  (p.or (s.tag! ["" "manual"])
        (s.tag! ["" "auto"])))

(def: (import-member-decl^ imports owner-vars)
  (-> Class-Imports (List Var) (Parser Import-Member-Declaration))
  ($_ p.either
      (s.form (do p.monad
                [_ (s.this! (' #enum))
                 enum-members (p.some s.local-identifier)]
                (wrap (#EnumDecl enum-members))))
      (s.form (do p.monad
                [tvars (p.default (list) ..vars^)
                 _ (s.identifier! ["" "new"])
                 ?alias import-member-alias^
                 #let [total-vars (list@compose owner-vars tvars)]
                 ?prim-mode (p.maybe primitive-mode^)
                 args (import-member-args^ imports total-vars)
                 [io? try? maybe?] import-member-return-flags^]
                (wrap (#ConstructorDecl [{#import-member-mode    (maybe.default #AutoPrM ?prim-mode)
                                          #import-member-alias   (maybe.default "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?}
                                         {}]))
                ))
      (s.form (do p.monad
                [kind (: (Parser ImportMethodKind)
                         (p.or (s.tag! ["" "static"])
                               (wrap [])))
                 tvars (p.default (list) ..vars^)
                 name s.local-identifier
                 ?alias import-member-alias^
                 #let [total-vars (list@compose owner-vars tvars)]
                 ?prim-mode (p.maybe primitive-mode^)
                 args (import-member-args^ imports total-vars)
                 [io? try? maybe?] import-member-return-flags^
                 return (..return^ imports total-vars)]
                (wrap (#MethodDecl [{#import-member-mode    (maybe.default #AutoPrM ?prim-mode)
                                     #import-member-alias   (maybe.default 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}]))))
      (s.form (do p.monad
                [static? (p.parses? (s.this! (' #static)))
                 name s.local-identifier
                 ?prim-mode (p.maybe primitive-mode^)
                 gtype (..type^ imports owner-vars)
                 maybe? (p.parses? (s.this! (' #?)))
                 setter? (p.parses? (s.this! (' #!)))]
                (wrap (#FieldAccessDecl {#import-field-mode    (maybe.default #AutoPrM ?prim-mode)
                                         #import-field-name    name
                                         #import-field-static? static?
                                         #import-field-maybe?  maybe?
                                         #import-field-setter? setter?
                                         #import-field-type    gtype}))))
      ))

(def: (privacy-modifier$ pm)
  (-> PrivacyModifier Code)
  (case pm
    #PublicPM    (' "public")
    #PrivatePM   (' "private")
    #ProtectedPM (' "protected")
    #DefaultPM   (' "default")))

(def: (inheritance-modifier$ im)
  (-> InheritanceModifier Code)
  (case im
    #FinalIM    (' "final")
    #AbstractIM (' "abstract")
    #DefaultIM  (' "default")))

(def: (annotation-param$ [name value])
  (-> AnnotationParam Code)
  (` [(~ (code.text name)) (~ value)]))

(def: (annotation$ [name params])
  (-> Annotation Code)
  (` ((~ (code.text name)) (~+ (list@map annotation-param$ params)))))

(def: (bound$ kind)
  (-> Bound Code)
  (case kind
    #jvm.Lower (code.local-identifier ">")
    #jvm.Upper (code.local-identifier "<")))

(def: var$
  (-> Var Code)
  code.text)

(def: (generic$ generic)
  (-> Generic Code)
  (case generic
    (#jvm.Var var)
    (var$ var)

    (#jvm.Class name params)
    (` ((~ (code.text (sanitize name))) (~+ (list@map generic$ params))))
    
    (#jvm.Wildcard wilcard)
    (case wilcard
      #.None
      (code.local-identifier "?")

      (#.Some [bound bound])
      (` ((~ (..bound$ bound)) (~ (generic$ bound)))))))

(def: (type$ type)
  (-> Type Code)
  (case type
    (#jvm.Primitive primitive)
    (case primitive
      #jvm.Boolean (code.local-identifier reflection.boolean)
      #jvm.Byte (code.local-identifier reflection.byte)
      #jvm.Short (code.local-identifier reflection.short)
      #jvm.Int (code.local-identifier reflection.int)
      #jvm.Long (code.local-identifier reflection.long)
      #jvm.Float (code.local-identifier reflection.float)
      #jvm.Double (code.local-identifier reflection.double)
      #jvm.Char (code.local-identifier reflection.char))
    
    (#jvm.Generic generic)
    (generic$ generic)
    
    (#jvm.Array elementT)
    (` [(~ (type$ elementT))])))

(def: (return$ return)
  (-> Return Code)
  (case return
    #.None
    (code.local-identifier "void")
    
    (#.Some type)
    (type$ type)))

(def: (declaration$ (^open "."))
  (-> Class-Declaration Code)
  (` ((~ (code.text (sanitize class-name)))
      (~+ (list@map var$ class-params)))))

(def: (class$ [name params])
  (-> Class Code)
  (` ((~ (code.text (sanitize name)))
      (~+ (list@map generic$ params)))))

(def: (method-decl$ [[name pm anns] method-decl])
  (-> [Member-Declaration MethodDecl] Code)
  (let [(^slots [#method-tvars #method-inputs #method-output #method-exs]) method-decl]
    (` ((~ (code.text name))
        [(~+ (list@map annotation$ anns))]
        [(~+ (list@map var$ method-tvars))]
        [(~+ (list@map class$ method-exs))]
        [(~+ (list@map type$ method-inputs))]
        (~ (return$ method-output))))))

(def: (state-modifier$ sm)
  (-> StateModifier Code)
  (case sm
    #VolatileSM (' "volatile")
    #FinalSM    (' "final")
    #DefaultSM  (' "default")))

(def: (field-decl$ [[name pm anns] field])
  (-> [Member-Declaration FieldDecl] Code)
  (case field
    (#ConstantField class value)
    (` ("constant" (~ (code.text name))
        [(~+ (list@map annotation$ anns))]
        (~ (type$ class))
        (~ value)
        ))

    (#VariableField sm class)
    (` ("variable" (~ (code.text name))
        (~ (privacy-modifier$ pm))
        (~ (state-modifier$ sm))
        [(~+ (list@map annotation$ anns))]
        (~ (type$ class))
        ))
    ))

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

(def: (constructor-arg$ [class term])
  (-> (Typed Code) Code)
  (` [(~ (type$ class)) (~ term)]))

(def: (method-def$ replacer super-class [[name pm anns] method-def])
  (-> (-> Code Code) Class [Member-Declaration Method-Definition] Code)
  (case method-def
    (#ConstructorMethod strict-fp? type-vars self-name arguments constructor-args body exs)
    (` ("init"
        (~ (privacy-modifier$ pm))
        (~ (code.bit strict-fp?))
        [(~+ (list@map annotation$ anns))]
        [(~+ (list@map var$ type-vars))]
        [(~+ (list@map class$ exs))]
        (~ (code.text self-name))
        [(~+ (list@map argument$ arguments))]
        [(~+ (list@map constructor-arg$ constructor-args))]
        (~ (pre-walk-replace replacer body))
        ))
    
    (#VirtualMethod final? strict-fp? type-vars self-name arguments return-type body exs)
    (` ("virtual"
        (~ (code.text name))
        (~ (privacy-modifier$ pm))
        (~ (code.bit final?))
        (~ (code.bit strict-fp?))
        [(~+ (list@map annotation$ anns))]
        [(~+ (list@map var$ type-vars))]
        (~ (code.text self-name))
        [(~+ (list@map argument$ arguments))]
        (~ (return$ return-type))
        [(~+ (list@map class$ exs))]
        (~ (pre-walk-replace replacer body))))
    
    (#OverridenMethod strict-fp? declaration type-vars self-name arguments return-type body exs)
    (let [super-replacer (parser->replacer (s.form (do p.monad
                                                     [_ (s.this! (' ::super!))
                                                      args (s.tuple (p.exactly (list.size arguments) s.any))
                                                      #let [arguments' (list@map (|>> product.right jvm.signature) arguments)]]
                                                     (wrap (` ("jvm member invoke special"
                                                               (~ (code.text (product.left super-class)))
                                                               (~ (code.text name))
                                                               (~' _jvm_this)
                                                               (~+ (|> args
                                                                       (list.zip2 arguments')
                                                                       (list@map ..decorate-input)))))))))]
      (` ("override"
          (~ (declaration$ declaration))
          (~ (code.text name))
          (~ (code.bit strict-fp?))
          [(~+ (list@map annotation$ anns))]
          [(~+ (list@map var$ type-vars))]
          (~ (code.text self-name))
          [(~+ (list@map argument$ arguments))]
          (~ (return$ return-type))
          [(~+ (list@map class$ exs))]
          (~ (|> body
                 (pre-walk-replace replacer)
                 (pre-walk-replace super-replacer)))
          )))

    (#StaticMethod strict-fp? type-vars arguments return-type body exs)
    (` ("static"
        (~ (code.text name))
        (~ (privacy-modifier$ pm))
        (~ (code.bit strict-fp?))
        [(~+ (list@map annotation$ anns))]
        [(~+ (list@map var$ type-vars))]
        [(~+ (list@map class$ exs))]
        [(~+ (list@map argument$ arguments))]
        (~ (return$ return-type))
        (~ (pre-walk-replace replacer body))))

    (#AbstractMethod type-vars arguments return-type exs)
    (` ("abstract"
        (~ (code.text name))
        (~ (privacy-modifier$ pm))
        [(~+ (list@map annotation$ anns))]
        [(~+ (list@map var$ type-vars))]
        [(~+ (list@map class$ exs))]
        [(~+ (list@map argument$ arguments))]
        (~ (return$ return-type))))

    (#NativeMethod type-vars arguments return-type exs)
    (` ("native"
        (~ (code.text name))
        (~ (privacy-modifier$ pm))
        [(~+ (list@map annotation$ anns))]
        [(~+ (list@map var$ type-vars))]
        [(~+ (list@map class$ exs))]
        [(~+ (list@map argument$ arguments))]
        (~ (return$ return-type))))
    ))

(def: (complete-call$ g!obj [method args])
  (-> Code Partial-Call Code)
  (` ((~ (code.identifier method)) (~+ args) (~ g!obj))))

(def: object-class
  Class
  ["java/lang/Object" (list)])

(syntax: #export (class:
                   {#let [imports (class-imports *compiler*)]}
                   {im inheritance-modifier^}
                   {declaration (declaration^ imports)}
                   {#let [full-class-name (product.left declaration)
                          imports (add-import [(short-class-name full-class-name) full-class-name]
                                              (class-imports *compiler*))]}
                   {#let [class-vars (product.right declaration)]}
                   {super (p.default object-class
                                     (class^ imports class-vars))}
                   {interfaces (p.default (list)
                                          (s.tuple (p.some (class^ imports class-vars))))}
                   {annotations (annotations^ imports)}
                   {fields (p.some (field-decl^ imports class-vars))}
                   {methods (p.some (method-def^ imports class-vars))})
  {#.doc (doc "Allows defining JVM classes in Lux code."
              "For example:"
              (class: #final (TestClass A) [Runnable]
                ## Fields
                (#private foo boolean)
                (#private bar A)
                (#private baz java/lang/Object)
                ## Methods
                (#public [] (new [value A]) []
                         (exec (:= ::foo #1)
                           (:= ::bar value)
                           (:= ::baz "")
                           []))
                (#public (virtual) java/lang/Object
                         "")
                (#public #static (static) java/lang/Object
                         "")
                (Runnable [] (run) void
                          [])
                )

              "The tuple corresponds to parent interfaces."
              "An optional super-class can be specified before the tuple. If not specified, java.lang.Object will be assumed."
              "Fields and methods defined in the class can be used with special syntax."
              "For example:"
              "::resolved, for accessing the 'resolved' field."
              "(:= ::resolved #1) for modifying it."
              "(::new! []) for calling the class's constructor."
              "(::resolve! container [value]) for calling the 'resolve' method."
              )}
  (do macro.monad
    [current-module macro.current-module-name
     #let [fully-qualified-class-name (format (sanitize current-module) ..syntax-class-separator full-class-name)
           field-parsers (list@map (field->parser fully-qualified-class-name) fields)
           method-parsers (list@map (method->parser fully-qualified-class-name) methods)
           replacer (parser->replacer (list@fold p.either
                                                 (p.fail "")
                                                 (list@compose field-parsers method-parsers)))]]
    (wrap (list (` ("jvm class"
                    (~ (declaration$ (update@ #class-name
                                              (|>> (format (text.replace-all ..binary-class-separator
                                                                             ..syntax-class-separator
                                                                             current-module)
                                                           ..syntax-class-separator))
                                              declaration)))
                    (~ (class$ super))
                    [(~+ (list@map class$ interfaces))]
                    (~ (inheritance-modifier$ im))
                    [(~+ (list@map annotation$ annotations))]
                    [(~+ (list@map field-decl$ fields))]
                    [(~+ (list@map (method-def$ replacer super) methods))]))))))

(syntax: #export (interface:
                   {#let [imports (class-imports *compiler*)]}
                   {declaration (declaration^ imports)}
                   {#let [full-class-name (product.left declaration)
                          imports (add-import [(short-class-name full-class-name) full-class-name]
                                              (class-imports *compiler*))]}
                   {#let [class-vars (product.right declaration)]}
                   {supers (p.default (list)
                                      (s.tuple (p.some (class^ imports class-vars))))}
                   {annotations (annotations^ imports)}
                   {members (p.some (method-decl^ imports class-vars))})
  {#.doc (doc "Allows defining JVM interfaces."
              (interface: TestInterface
                ([] foo [boolean String] void #throws [Exception])))}
  (wrap (list (` ("jvm class interface"
                  (~ (declaration$ declaration))
                  [(~+ (list@map class$ supers))]
                  [(~+ (list@map annotation$ annotations))]
                  (~+ (list@map method-decl$ members)))))))

(syntax: #export (object
                   {#let [imports (class-imports *compiler*)]}
                   {class-vars ..vars^}
                   {super (p.default object-class
                                     (class^ imports class-vars))}
                   {interfaces (p.default (list)
                                          (s.tuple (p.some (class^ imports class-vars))))}
                   {constructor-args (constructor-args^ imports class-vars)}
                   {methods (p.some (overriden-method-def^ imports))})
  {#.doc (doc "Allows defining anonymous classes."
              "The 1st tuple corresponds to class-level type-variables."
              "The 2nd tuple corresponds to parent interfaces."
              "The 3rd tuple corresponds to arguments to the super class constructor."
              "An optional super-class can be specified before the 1st tuple. If not specified, java.lang.Object will be assumed."
              (object [] [Runnable]
                []
                (Runnable [] (run self) void
                          (exec (do-something some-value)
                            [])))
              )}
  (wrap (list (` ("jvm class anonymous"
                  [(~+ (list@map var$ class-vars))]
                  (~ (class$ super))
                  [(~+ (list@map class$ interfaces))]
                  [(~+ (list@map constructor-arg$ constructor-args))]
                  [(~+ (list@map (method-def$ function.identity super) methods))])))))

(syntax: #export (null)
  {#.doc (doc "Null object reference."
              (null))}
  (wrap (list (` ("jvm object null")))))

(def: #export (null? obj)
  {#.doc (doc "Test for null object reference."
              (= (null? (null))
                 true)
              (= (null? "YOLO")
                 false))}
  (-> (primitive "java.lang.Object") Bit)
  ("jvm object null?" obj))

(syntax: #export (??? expr)
  {#.doc (doc "Takes a (potentially null) ObjectType reference and creates a (Maybe ObjectType) for it."
              (= (??? (: java/lang/String (null)))
                 #.None)
              (= (??? "YOLO")
                 (#.Some "YOLO")))}
  (with-gensyms [g!temp]
    (wrap (list (` (let [(~ g!temp) (~ expr)]
                     (if ("jvm object null?" (~ g!temp))
                       #.None
                       (#.Some (~ g!temp)))))))))

(syntax: #export (!!! expr)
  {#.doc (doc "Takes a (Maybe ObjectType) and returns a ObjectType."
              "A #.None would get translated into a (null)."
              (= (null)
                 (!!! (??? (: java/lang/Thread (null)))))
              (= "foo"
                 (!!! (??? "foo"))))}
  (with-gensyms [g!value]
    (wrap (list (` ({(#.Some (~ g!value))
                     (~ g!value)

                     #.None
                     ("jvm object null")}
                    (~ expr)))))))

(syntax: #export (try expression)
  {#.doc (doc (case (try (risky-computation input))
                (#.Right success)
                (do-something success)

                (#.Left error)
                (recover-from-failure error)))}
  (with-gensyms [g!_]
    (wrap (list (` ("lux try" ((~! io.label) (.function ((~ g!_) (~ g!_))
                                               (~ expression)))))))))

(syntax: #export (check {#let [imports (class-imports *compiler*)]}
                        {class (..type^ imports (list))}
                        {unchecked (p.maybe s.any)})
  {#.doc (doc "Checks whether an object is an instance of a particular class."
              "Caveat emptor: Cannot check for polymorphism, so avoid using parameterized classes."
              (case (check String "YOLO")
                (#.Some value-as-string)
                #.None))}
  (with-gensyms [g!_ g!unchecked]
    (let [class-name (reflection.class class)
          class-type (` (.primitive (~ (code.text class-name))))
          check-type (` (.Maybe (~ class-type)))
          check-code (` (if ("jvm object instance?" (~ (code.text class-name)) (~ g!unchecked))
                          (#.Some (.:coerce (~ class-type)
                                            (~ g!unchecked)))
                          #.None))]
      (case unchecked
        (#.Some unchecked)
        (wrap (list (` (: (~ check-type)
                          (let [(~ g!unchecked) (~ unchecked)]
                            (~ check-code))))))

        #.None
        (wrap (list (` (: (-> (primitive "java.lang.Object") (~ check-type))
                          (function ((~ g!_) (~ g!unchecked))
                            (~ check-code))))))
        ))))

(syntax: #export (synchronized lock body)
  {#.doc (doc "Evaluates body, while holding a lock on a given object."
              (synchronized object-to-be-locked
                (exec (do-something ___)
                  (do-something-else ___)
                  (finish-the-computation ___))))}
  (wrap (list (` ("jvm object synchronized" (~ lock) (~ body))))))

(syntax: #export (do-to obj {methods (p.some partial-call^)})
  {#.doc (doc "Call a variety of methods on an object. Then, return the object."
              (do-to object
                (ClassName::method1 arg0 arg1 arg2)
                (ClassName::method2 arg3 arg4 arg5)))}
  (with-gensyms [g!obj]
    (wrap (list (` (let [(~ g!obj) (~ obj)]
                     (exec (~+ (list@map (complete-call$ g!obj) methods))
                       (~ g!obj))))))))

(def: (class-import$ long-name? [full-name params])
  (-> Bit Class-Declaration Code)
  (let [def-name (if long-name?
                   full-name
                   (short-class-name full-name))
        params' (list@map code.local-identifier params)]
    (` (def: (~ (code.identifier ["" def-name]))
         {#..jvm-class (~ (code.text full-name))}
         .Type
         (All [(~+ params')]
           (primitive (~ (code.text (sanitize full-name)))
                      [(~+ params')]))))))

(def: (member-type-vars class-tvars member)
  (-> (List Var) Import-Member-Declaration (List Var))
  (case member
    (#ConstructorDecl [commons _])
    (list@compose class-tvars (get@ #import-member-tvars commons))

    (#MethodDecl [commons _])
    (case (get@ #import-member-kind commons)
      #StaticIMK
      (get@ #import-member-tvars commons)

      _
      (list@compose class-tvars (get@ #import-member-tvars commons)))

    _
    class-tvars))

(def: (member-def-arg-bindings vars class member)
  (-> (List Var) Class-Declaration Import-Member-Declaration (Meta [(List [Bit Code]) (List Text) (List Code)]))
  (case member
    (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
    (let [(^slots [#import-member-tvars #import-member-args]) commons]
      (do macro.monad
        [arg-inputs (monad.map @
                               (: (-> [Bit Type] (Meta [Bit Code]))
                                  (function (_ [maybe? _])
                                    (with-gensyms [arg-name]
                                      (wrap [maybe? arg-name]))))
                               import-member-args)
         #let [arg-classes (list@map (|>> product.right jvm.descriptor) import-member-args)
               arg-types (list@map (: (-> [Bit Type] Code)
                                      (function (_ [maybe? arg])
                                        (let [arg-type (jvm-type (get@ #import-member-mode commons) arg)]
                                          (if maybe?
                                            (` (Maybe (~ arg-type)))
                                            arg-type))))
                                   import-member-args)]]
        (wrap [arg-inputs arg-classes arg-types])))

    _
    (:: macro.monad wrap [(list) (list) (list)])))

(def: (decorate-return-maybe member never-null? unboxed return-term)
  (-> Import-Member-Declaration Bit Text Code Code)
  (case member
    (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
    (cond (or never-null?
              (dictionary.contains? unboxed ..boxes))
          return-term

          (get@ #import-member-maybe? commons)
          (` (??? (~ return-term)))

          ## else
          (let [g!temp (` ((~' ~') (~ (code.identifier ["" " Ω "]))))]
            (` (let [(~ g!temp) (~ return-term)]
                 (if (not (..null? (:coerce (primitive "java.lang.Object")
                                            (~ g!temp))))
                   (~ g!temp)
                   (error! "Cannot produce null references from method calls."))))))

    _
    return-term))

(template [<name> <tag> <term-trans>]
  [(def: (<name> member return-term)
     (-> Import-Member-Declaration Code Code)
     (case member
       (^or (#ConstructorDecl [commons _]) (#MethodDecl [commons _]))
       (if (get@ <tag> commons)
         <term-trans>
         return-term)

       _
       return-term))]

  [decorate-return-try #import-member-try? (` (..try (~ return-term)))]
  [decorate-return-io  #import-member-io?  (` ((~! io.io) (~ return-term)))]
  )

(def: var->type-arg
  (-> Var Code)
  code.local-identifier)

(template [<jvm> <class> <descriptor>]
  [(def: <class> <jvm>)
   (def: <descriptor> (jvm.signature (jvm.class <jvm> (list))))]

  ["java.lang.String" string-class string-descriptor]
  [box.boolean boolean-box-class boolean-box-descriptor]
  [box.byte byte-box-class byte-box-descriptor]
  [box.short short-box-class short-box-descriptor]
  [box.int int-box-class int-box-descriptor]
  [box.long long-box-class long-box-descriptor]
  [box.float float-box-class float-box-descriptor]
  [box.double double-box-class double-box-descriptor]
  [box.char char-box-class char-box-descriptor]
  )

(template [<input?> <name> <unbox/box> <special+>]
  [(def: (<name> mode [unboxed raw])
     (-> Primitive-Mode [Text Code] Code)
     (let [[unboxed refined post] (: [Text Code (List Code)]
                                     (case mode
                                       #ManualPrM
                                       [unboxed raw (list)]
                                       
                                       #AutoPrM
                                       (`` (case unboxed
                                             (^template [<old> <new> <pre> <post>]
                                               (^ (static <old>))
                                               (with-expansions [<post>' (template.splice <post>)]
                                                 [<new>
                                                  (` (.|> (~ raw) (~+ <pre>)))
                                                  (list <post>')]))
                                             ((~~ (template.splice <special+>)))
                                             
                                             _
                                             [unboxed
                                              (if <input?>
                                                (` ("jvm object cast" (~ raw)))
                                                raw)
                                              (list)]))))
           unboxed/boxed (case (dictionary.get unboxed boxes)
                           (#.Some boxed)
                           (<unbox/box> unboxed boxed refined)
                           
                           #.None
                           refined)]
       (case post
         #.Nil
         unboxed/boxed

         _
         (` (.|> (~ unboxed/boxed) (~+ post))))))]

  [#1 auto-convert-input ..unbox
   [[jvm.boolean-descriptor jvm.boolean-descriptor (list (` (.: .Bit)) (` (.:coerce (.primitive (~ (code.text box.boolean)))))) []]
    [jvm.byte-descriptor jvm.byte-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long-to-byte)) []]
    [jvm.short-descriptor jvm.short-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long-to-short)) []]
    [jvm.int-descriptor jvm.int-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long-to-int)) []]
    [jvm.long-descriptor jvm.long-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long)))))) []]
    [jvm.float-descriptor jvm.float-descriptor (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text box.double))))) (` ..double-to-float)) []]
    [jvm.double-descriptor jvm.double-descriptor (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text box.double)))))) []]
    [..string-descriptor ..string-descriptor (list (` (.: .Text)) (` (.:coerce (.primitive (~ (code.text ..string-class)))))) []]
    [..boolean-box-descriptor ..boolean-box-descriptor (list (` (.: .Bit)) (` (.:coerce (.primitive (~ (code.text ..boolean-box-class)))))) []]
    [..long-box-descriptor ..long-box-descriptor (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text ..long-box-class)))))) []]
    [..double-box-descriptor ..double-box-descriptor (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text ..double-box-class)))))) []]]]
  [#0 auto-convert-output ..box
   [[jvm.boolean-descriptor jvm.boolean-descriptor (list) [(` (.: (.primitive (~ (code.text box.boolean))))) (` (.:coerce .Bit))]]
    [jvm.byte-descriptor jvm.long-descriptor (list (` "jvm conversion byte-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]]
    [jvm.short-descriptor jvm.long-descriptor (list (` "jvm conversion short-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]]
    [jvm.int-descriptor jvm.long-descriptor (list (` "jvm conversion int-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]]
    [jvm.long-descriptor jvm.long-descriptor (list) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]]
    [jvm.float-descriptor jvm.double-descriptor (list (` "jvm conversion float-to-double")) [(` (.: (.primitive (~ (code.text box.double))))) (` (.:coerce .Frac))]]
    [jvm.double-descriptor jvm.double-descriptor (list) [(` (.: (.primitive (~ (code.text box.double))))) (` (.:coerce .Frac))]]
    [..string-descriptor ..string-descriptor (list) [(` (.: (.primitive (~ (code.text ..string-class))))) (` (.:coerce .Text))]]
    [..boolean-box-descriptor ..boolean-box-descriptor (list) [(` (.: (.primitive (~ (code.text ..boolean-box-class))))) (` (.:coerce .Bit))]]
    [..long-box-descriptor ..long-box-descriptor (list) [(` (.: (.primitive (~ (code.text ..long-box-class))))) (` (.:coerce .Int))]]
    [..double-box-descriptor ..double-box-descriptor (list) [(` (.: (.primitive (~ (code.text ..double-box-class))))) (` (.:coerce .Frac))]]]]
  )

(def: (un-quote quoted)
  (-> Code Code)
  (` ((~' ~) (~ quoted))))

(def: (jvm-invoke-inputs mode classes inputs)
  (-> Primitive-Mode (List Text) (List [Bit Code]) (List Code))
  (|> inputs
      (list@map (function (_ [maybe? input])
                  (if maybe?
                    (` ((~! !!!) (~ (un-quote input))))
                    (un-quote input))))
      (list.zip2 classes)
      (list@map (auto-convert-input mode))))

(def: (with-class-type class expression)
  (-> Text Code Code)
  (` (.: (.primitive (~ (code.text class))) (~ expression))))

(def: (member-def-interop vars kind class [arg-function-inputs arg-classes arg-types] member method-prefix)
  (-> (List Var) Class-Kind Class-Declaration [(List [Bit Code]) (List Text) (List Code)] Import-Member-Declaration Text (Meta (List Code)))
  (let [[full-name class-tvars] class
        full-name (sanitize full-name)
        all-params (list@map var->type-arg (member-type-vars class-tvars member))]
    (case member
      (#EnumDecl enum-members)
      (do macro.monad
        [#let [enum-type (: Code
                            (case class-tvars
                              #.Nil
                              (` (primitive (~ (code.text full-name))))

                              _
                              (let [=class-tvars (list@map var->type-arg class-tvars)]
                                (` (All [(~+ =class-tvars)] (primitive (~ (code.text full-name)) [(~+ =class-tvars)]))))))
               getter-interop (: (-> Text Code)
                                 (function (_ name)
                                   (let [getter-name (code.identifier ["" (format method-prefix member-separator name)])]
                                     (` (def: (~ getter-name)
                                          (~ enum-type)
                                          (~ (get-static-field full-name name)))))))]]
        (wrap (list@map getter-interop enum-members)))
      
      (#ConstructorDecl [commons _])
      (do macro.monad
        [#let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))])
               jvm-interop (|> [(jvm.signature (jvm.class full-name (list)))
                                (` ("jvm member invoke constructor"
                                    (~ (code.text full-name))
                                    (~+ (|> (jvm-invoke-inputs (get@ #import-member-mode commons) arg-classes arg-function-inputs)
                                            (list.zip2 arg-classes)
                                            (list@map ..decorate-input)))))]
                               (auto-convert-output (get@ #import-member-mode commons))
                               (decorate-return-maybe member true full-name)
                               (decorate-return-try member)
                               (decorate-return-io member))]]
        (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list@map product.right arg-function-inputs)))
                        ((~' wrap) (.list (.` (~ jvm-interop)))))))))

      (#MethodDecl [commons method])
      (with-gensyms [g!obj]
        (do @
          [#let [def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))])
                 (^slots [#import-member-kind]) commons
                 (^slots [#import-method-name]) method
                 [jvm-op object-ast] (: [Text (List Code)]
                                        (case import-member-kind
                                          #StaticIMK
                                          ["jvm member invoke static"
                                           (list)]

                                          #VirtualIMK
                                          (case kind
                                            #Class
                                            ["jvm member invoke virtual"
                                             (list g!obj)]
                                            
                                            #Interface
                                            ["jvm member invoke interface"
                                             (list g!obj)]
                                            )))
                 method-return-class (case (get@ #import-method-return method)
                                       #.None
                                       jvm.void-descriptor

                                       (#.Some return)
                                       (jvm.signature return))
                 jvm-interop (|> [method-return-class
                                  (` ((~ (code.text jvm-op))
                                      (~ (code.text full-name))
                                      (~ (code.text import-method-name))
                                      (~+ (|> object-ast
                                              (list@map ..un-quote)
                                              (list.zip2 (list (jvm.signature (jvm.class full-name (list)))))
                                              (list@map (auto-convert-input (get@ #import-member-mode commons)))))
                                      (~+ (|> (jvm-invoke-inputs (get@ #import-member-mode commons) arg-classes arg-function-inputs)
                                              (list.zip2 arg-classes)
                                              (list@map ..decorate-input)))))]
                                 (auto-convert-output (get@ #import-member-mode commons))
                                 (decorate-return-maybe member false method-return-class)
                                 (decorate-return-try member)
                                 (decorate-return-io member))]]
          (wrap (list (` ((~! syntax:) ((~ def-name) (~+ (list@map product.right arg-function-inputs)) (~+ object-ast))
                          ((~' wrap) (.list (.` (~ jvm-interop))))))))))

      (#FieldAccessDecl fad)
      (do macro.monad
        [#let [(^open ".") fad
               base-gtype (jvm-type import-field-mode import-field-type)
               classC (declaration-type$ class)
               typeC (if import-field-maybe?
                       (` (Maybe (~ base-gtype)))
                       base-gtype)
               tvar-asts (list@map var->type-arg class-tvars)
               getter-name (code.identifier ["" (format method-prefix member-separator import-field-name)])
               setter-name (code.identifier ["" (format method-prefix member-separator import-field-name "!")])]
         getter-interop (with-gensyms [g!obj]
                          (let [getter-call (if import-field-static?
                                              (` ((~ getter-name)))
                                              (` ((~ getter-name) (~ g!obj))))
                                getter-body (<| (auto-convert-output import-field-mode)
                                                [(jvm.signature import-field-type)
                                                 (if import-field-static?
                                                   (get-static-field full-name import-field-name)
                                                   (get-virtual-field full-name import-field-name (un-quote g!obj)))])
                                getter-body (if import-field-maybe?
                                              (` ((~! ???) (~ getter-body)))
                                              getter-body)
                                getter-body (if import-field-setter?
                                              (` ((~! io.io) (~ getter-body)))
                                              getter-body)]
                            (wrap (` ((~! syntax:) (~ getter-call)
                                      ((~' wrap) (.list (.` (~ getter-body)))))))))
         setter-interop (: (Meta (List Code))
                           (if import-field-setter?
                             (with-gensyms [g!obj g!value]
                               (let [setter-call (if import-field-static?
                                                   (` ((~ setter-name) (~ g!value)))
                                                   (` ((~ setter-name) (~ g!value) (~ g!obj))))
                                     setter-value (|> [(jvm.signature import-field-type) (un-quote g!value)]
                                                      (auto-convert-input import-field-mode))
                                     setter-value (if import-field-maybe?
                                                    (` ((~! !!!) (~ setter-value)))
                                                    setter-value)
                                     setter-command (format (if import-field-static? "jvm putstatic" "jvm putfield")
                                                            ":" full-name ":" import-field-name)
                                     g!obj+ (: (List Code)
                                               (if import-field-static?
                                                 (list)
                                                 (list (un-quote g!obj))))]
                                 (wrap (list (` ((~! syntax:) (~ setter-call)
                                                 ((~' wrap) (.list (.` ((~! io.io) ((~ (code.text setter-command)) (~+ g!obj+) (~ setter-value))))))))))))
                             (wrap (list))))]
        (wrap (list& getter-interop setter-interop)))
      )))

(def: (member-import$ vars long-name? kind class member)
  (-> (List Var) Bit Class-Kind Class-Declaration Import-Member-Declaration (Meta (List Code)))
  (let [[full-name _] class
        method-prefix (if long-name?
                        full-name
                        (short-class-name full-name))]
    (do macro.monad
      [=args (member-def-arg-bindings vars class member)]
      (member-def-interop vars kind class =args member method-prefix))))

(def: interface?
  (All [a] (-> (primitive "java.lang.Class" [a]) Bit))
  (|>> ("jvm member invoke virtual" "java.lang.Class" "isInterface")
       "jvm object cast"
       (: ..Boolean)
       (:coerce Bit)))

(def: load-class
  (-> Text (Try (primitive "java.lang.Class" [Any])))
  (|>> (:coerce (primitive "java.lang.String"))
       ["Ljava/lang/String;"]
       ("jvm member invoke static" "java.lang.Class" "forName")
       try))

(def: (class-kind [class-name _])
  (-> Class-Declaration (Meta Class-Kind))
  (let [class-name (sanitize class-name)]
    (case (load-class class-name)
      (#.Right class)
      (:: macro.monad wrap (if (interface? class)
                             #Interface
                             #Class))

      (#.Left _)
      (macro.fail (format "Unknown class: " class-name)))))

(syntax: #export (import:
                   {#let [imports (class-imports *compiler*)]}
                   {long-name? (p.parses? (s.this! (' #long)))}
                   {declaration (declaration^ imports)}
                   {#let [full-class-name (product.left declaration)
                          imports (add-import [(short-class-name full-class-name) full-class-name]
                                              (class-imports *compiler*))]}
                   {members (p.some (import-member-decl^ imports (product.right declaration)))})
  {#.doc (doc "Allows importing JVM classes, and using them as types."
              "Their methods, fields and enum options can also be imported."
              "Also, classes which get imported into a module can also be referred-to with their short names in other macros that require JVM classes."
              (import: java/lang/Object
                (new [])
                (equals [Object] boolean)
                (wait [int] #io #try void))
              
              "Special options can also be given for the return values."
              "#? means that the values will be returned inside a Maybe type. That way, null becomes #.None."
              "#try means that the computation might throw an exception, and the return value will be wrapped by the Try type."
              "#io means the computation has side effects, and will be wrapped by the IO type."
              "These options must show up in the following order [#io #try #?] (although, each option can be used independently)."
              (import: java/lang/String
                (new [[byte]])
                (#static valueOf [char] String)
                (#static valueOf #as int-valueOf [int] String))

              (import: #long (java/util/List e)
                (size [] int)
                (get [int] e))

              (import: (java/util/ArrayList a)
                ([T] toArray [[T]] [T]))
              
              "#long makes it so the class-type that is generated is of the fully-qualified name."
              "In this case, it avoids a clash between the java.util.List type, and Lux's own List type."
              "All enum options to be imported must be specified."
              (import: java/lang/Character$UnicodeScript
                (#enum ARABIC CYRILLIC LATIN))

              "It should also be noted, the only types that may show up in method arguments or return values may be Java classes, arrays, primitives, void or type-vars."
              "Lux types, such as Maybe cannot be named (otherwise, they'd be confused for Java classes)."
              (import: #long (lux/concurrency/promise/JvmPromise A)
                (resolve [A] boolean)
                (poll [] A)
                (wasResolved [] boolean)
                (waitOn [lux/Function] void)
                (#static [A] make [A] (JvmPromise A)))
              
              "Also, the names of the imported members will look like Class::member"
              (Object::new [])
              (Object::equals [other-object] my-object)
              (java/util/List::size [] my-list)
              Character$UnicodeScript::LATIN
              )}
  (do macro.monad
    [kind (class-kind declaration)
     =members (monad.map @ (member-import$ (product.right declaration) long-name? kind declaration) members)]
    (wrap (list& (class-import$ long-name? declaration) (list@join =members)))))

(syntax: #export (array {#let [imports (class-imports *compiler*)]}
                        {type (..type^ imports (list))}
                        size)
  {#.doc (doc "Create an array of the given type, with the given size."
              (array java/lang/Object 10))}
  (let [g!size (` (|>  (~ size)
                       (.: .Nat)
                       (.:coerce (.primitive (~ (code.text box.long))))
                       "jvm object cast"
                       "jvm conversion long-to-int"))]
    (case type
      (^template [<primitive> <array-op>]
        (^ (#jvm.Primitive <primitive>))
        (wrap (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"])

      _
      (wrap (list (` (: (~ (jvm-type #ManualPrM (jvm.array 1 type)))
                        ("jvm array new object" (~ g!size)))))))))

(def: (type->class-name type)
  (-> .Type (Meta Text))
  (if (type@= Any type)
    (:: macro.monad wrap "java.lang.Object")
    (case type
      (#.Primitive name params)
      (:: macro.monad wrap name)

      (#.Apply A F)
      (case (type.apply (list A) F)
        #.None
        (macro.fail (format "Cannot apply type: " (type.to-text F) " to " (type.to-text A)))

        (#.Some type')
        (type->class-name type'))
      
      (#.Named _ type')
      (type->class-name type')

      _
      (macro.fail (format "Cannot convert to JVM type: " (type.to-text type))))))

(syntax: #export (array-length array)
  {#.doc (doc "Gives the length of an array."
              (array-length my-array))}
  (case array
    [_ (#.Identifier array-name)]
    (do macro.monad
      [array-type (macro.find-type array-name)
       array-jvm-type (type->class-name array-type)
       #let [g!extension (code.text (case array-jvm-type
                                      "[Z" "jvm array length boolean"
                                      "[B" "jvm array length byte"
                                      "[S" "jvm array length short"
                                      "[I" "jvm array length int"
                                      "[J" "jvm array length long"
                                      "[F" "jvm array length float"
                                      "[D" "jvm array length double"
                                      "[C" "jvm array length char"
                                      _ "jvm array length object"))]]
      (wrap (list (` (.|> ((~ g!extension) (~ array))
                          "jvm conversion int-to-long"
                          "jvm object cast"
                          (.: (.primitive (~ (code.text box.long))))
                          (.:coerce .Nat))))))

    _
    (with-gensyms [g!array]
      (wrap (list (` (let [(~ g!array) (~ array)]
                       (..array-length (~ g!array)))))))))

(syntax: #export (array-read idx array)
  {#.doc (doc "Loads an element from an array."
              (array-read 10 my-array))}
  (case array
    [_ (#.Identifier array-name)]
    (do macro.monad
      [array-type (macro.find-type array-name)
       array-jvm-type (type->class-name array-type)
       #let [g!idx (` (.|> (~ idx)
                           (.: .Nat)
                           (.:coerce (.primitive (~ (code.text box.long))))
                           "jvm object cast"
                           "jvm conversion long-to-int"))]]
      (case array-jvm-type
        (^template [<type> <array-op> <box>]
          <type>
          (wrap (list (` (.|> (<array-op> (~ g!idx) (~ array))
                              "jvm object cast"
                              (.: (.primitive (~ (code.text <box>)))))))))
        (["[Z" "jvm array read boolean" box.boolean]
         ["[B" "jvm array read byte" box.byte]
         ["[S" "jvm array read short" box.short]
         ["[I" "jvm array read int" box.int]
         ["[J" "jvm array read long" box.long]
         ["[F" "jvm array read float" box.float]
         ["[D" "jvm array read double" box.double]
         ["[C" "jvm array read char" box.char])

        _
        (wrap (list (` ("jvm array read object" (~ g!idx) (~ array)))))))

    _
    (with-gensyms [g!array]
      (wrap (list (` (let [(~ g!array) (~ array)]
                       (..array-read (~ idx) (~ g!array)))))))))

(syntax: #export (array-write idx value array)
  {#.doc (doc "Stores an element into an array."
              (array-write 10 my-object my-array))}
  (case array
    [_ (#.Identifier array-name)]
    (do macro.monad
      [array-type (macro.find-type array-name)
       array-jvm-type (type->class-name array-type)
       #let [g!idx (` (.|> (~ idx)
                           (.: .Nat)
                           (.:coerce (.primitive (~ (code.text box.long))))
                           "jvm object cast"
                           "jvm conversion long-to-int"))]]
      (case array-jvm-type
        (^template [<type> <array-op> <box>]
          <type>
          (let [g!value (` (.|> (~ value)
                                (.:coerce (.primitive (~ (code.text <box>))))
                                "jvm object cast"))]
            (wrap (list (` (<array-op> (~ g!idx) (~ g!value) (~ array)))))))
        (["[Z" "jvm array write boolean" box.boolean]
         ["[B" "jvm array write byte" box.byte]
         ["[S" "jvm array write short" box.short]
         ["[I" "jvm array write int" box.int]
         ["[J" "jvm array write long" box.long]
         ["[F" "jvm array write float" box.float]
         ["[D" "jvm array write double" box.double]
         ["[C" "jvm array write char" box.char])

        _
        (wrap (list (` ("jvm array write object" (~ g!idx) (~ value) (~ array)))))))

    _
    (with-gensyms [g!array]
      (wrap (list (` (let [(~ g!array) (~ array)]
                       (..array-write (~ idx) (~ value) (~ g!array)))))))))

(syntax: #export (class-for {#let [imports (class-imports *compiler*)]}
                            {type (..type^ imports (list))})
  {#.doc (doc "Loads the class as a java.lang.Class object."
              (class-for java/lang/String))}
  (wrap (list (` ("jvm object class" (~ (code.text (reflection.class type))))))))

(def: get-compiler
  (Meta Lux)
  (function (_ compiler)
    (#.Right [compiler compiler])))

(def: #export (resolve class)
  {#.doc (doc "Given a potentially unqualified class name, qualifies it if necessary."
              (resolve "String")
              =>
              "java.lang.String")}
  (-> Text (Meta Text))
  (do macro.monad
    [*compiler* get-compiler]
    (wrap (qualify (class-imports *compiler*) class))))

(syntax: #export (type {#let [imports (class-imports *compiler*)]}
                       {type (..type^ imports (list))})
  (wrap (list (jvm-type #ManualPrM type))))