(.module:
  [lux (#- Type type int char)
   ["lux-." type ("#@." equivalence)]
   [abstract
    ["." monad (#+ Monad do)]
    ["." enum]]
   [control
    ["." function]
    ["." io]
    ["." try (#+ Try)]
    ["." exception (#+ Exception exception:)]
    ["<>" parser ("#@." monad)
     ["<t>" text]
     ["<c>" code (#+ Parser)]]]
   [data
    ["." maybe]
    ["." product]
    ["." bit ("#@." codec)]
    number
    ["." text ("#@." equivalence monoid)
     ["%" format (#+ format)]]
    [collection
     ["." array]
     ["." list ("#@." monad fold monoid)]
     ["." dictionary (#+ Dictionary)]]]
   ["." macro (#+ with-gensyms)
    [syntax (#+ syntax:)]
    ["." code]
    ["." template]]
   [target
    [jvm
     [encoding
      ["." name (#+ External)]]
     ["." type (#+ Type Argument Typed)
      ["." category (#+ Void Value' Value Return' Return Method Primitive Object Class Array Var Parameter Declaration)]
      ["." box]
      ["." descriptor]
      ["." signature]
      ["." reflection]
      ["." parser]]]]])

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

(def: signature
  (All [category]
    (-> (Type category) Text))
  (|>> type.signature signature.signature))

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

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

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

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

  ## 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 [type.boolean box.boolean]
            [type.byte    box.byte]
            [type.short   box.short]
            [type.int     box.int]
            [type.long    box.long]
            [type.float   box.float]
            [type.double  box.double]
            [type.char    box.char])
      (dictionary.from-list type.hash)))

(template [<name> <pre> <post>]
  [(def: (<name> unboxed boxed raw)
     (-> (Type Value) Text Code Code)
     (let [unboxed (..reflection 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: Privacy
  #PublicP
  #PrivateP
  #ProtectedP
  #DefaultP)

(type: StateModifier
  #VolatileSM
  #FinalSM
  #DefaultSM)

(type: InheritanceModifier
  #FinalIM
  #AbstractIM
  #DefaultIM)

(type: Class-Kind
  #Class
  #Interface)

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

(type: Annotation-Parameter
  [Text Code])

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

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

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

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

(type: Method-Definition
  (#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
  {#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 (Type Var))
   #import-member-args   (List [Bit (Type Value)])
   #import-member-maybe? Bit
   #import-member-try?   Bit
   #import-member-io?    Bit})

(type: ImportConstructorDecl
  {})

(type: ImportMethodDecl
  {#import-method-name    Text
   #import-method-return  (Type 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 Value)})

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

(type: Context
  (List [Text Text]))

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

    #.Nil
    name))

(def: (primitive-type mode type)
  (-> Primitive-Mode (Type Primitive) Code)
  (case mode
    #ManualPrM
    (cond (:: type.equivalence = type.boolean type) (` ..Boolean)
          (:: type.equivalence = type.byte type) (` ..Byte)
          (:: type.equivalence = type.short type) (` ..Short)
          (:: type.equivalence = type.int type) (` ..Integer)
          (:: type.equivalence = type.long type) (` ..Long)
          (:: type.equivalence = type.float type) (` ..Float)
          (:: type.equivalence = type.double type) (` ..Double)
          (:: type.equivalence = type.char type) (` ..Character)
          ## else
          (undefined))
    
    #AutoPrM
    (cond (:: type.equivalence = type.boolean type)
          (` .Bit)
          
          (or (:: type.equivalence = type.short type)
              (:: type.equivalence = type.byte type)
              (:: type.equivalence = type.int type)
              (:: type.equivalence = type.long type))
          (` .Int)
          
          (or (:: type.equivalence = type.float type)
              (:: type.equivalence = type.double type))
          (` .Frac)

          (:: type.equivalence = type.char type)
          (` .Nat)

          ## else
          (undefined))))

(def: (parameter-type type)
  (-> (Type Parameter) Code)
  (`` (<| (~~ (template [<when> <binding> <then>]
                [(case (<when> type)
                   (#.Some <binding>)
                   <then>

                   #.None)]

                [parser.var? name (code.identifier ["" name])]
                [parser.wildcard? _ (` .Any)]
                [parser.lower? _ (` .Any)]
                [parser.upper? limit (parameter-type limit)]
                [parser.class? [name parameters]
                 (` (.primitive (~ (code.text name))
                                [(~+ (list@map parameter-type parameters))]))]))
          ## else
          (undefined)
          )))

(def: (value-type mode type)
  (-> Primitive-Mode (Type Value) Code)
  (`` (<| (~~ (template [<when> <binding> <then>]
                [(case (<when> type)
                   (#.Some <binding>)
                   <then>

                   #.None)]

                [parser.parameter? type (parameter-type type)]
                [parser.primitive? type (primitive-type mode type)]
                [parser.array? elementT (case (parser.primitive? elementT)
                                          (#.Some elementT)
                                          (` (#.Primitive (~ (code.text (..reflection (type.array elementT)))) #.Nil))
                                          
                                          #.None
                                          (` (#.Primitive (~ (code.text array.type-name))
                                                          (#.Cons (~ (value-type mode elementT)) #.Nil))))]))
          (undefined)
          )))

(def: declaration-type$
  (-> (Type Declaration) Code)
  (|>> ..signature code.text))

(def: fresh
  Context
  (list))

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

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

(def: (context compiler)
  (-> Lux Context)
  (case (macro.run compiler
                   (: (Meta Context)
                      (do macro.monad
                        [current-module macro.current-module-name
                         definitions (macro.definitions current-module)]
                        (wrap (list@fold (: (-> [Text Global] Context Context)
                                            (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))))
                                         ..fresh
                                         definitions)))))
    (#.Left _)        (list)
    (#.Right imports) imports))

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

(def: (make-get-const-parser class-name field-name)
  (-> Text Text (Parser Code))
  (do <>.monad
    [#let [dotted-name (format "::" field-name)]
     _ (<c>.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 <>.monad
    [#let [dotted-name (format "::" field-name)]
     _ (<c>.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 <>.monad
    [#let [dotted-name (format "::" field-name)]
     [_ _ value] (: (Parser [Any Any Code])
                    (<c>.form ($_ <>.and (<c>.this! (' :=)) (<c>.this! (code.identifier ["" dotted-name])) <c>.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 (<>.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 _)
    (<>.either (make-get-var-parser class-name field-name)
               (make-put-var-parser class-name field-name))))

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

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

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

(template [<name> <jvm-op>]
  [(def: (<name> class-name method-name arguments)
     (-> Text Text (List Argument) (Parser Code))
     (do <>.monad
       [#let [dotted-name (format "::" method-name "!")]
        args (: (Parser (List Code))
                (<c>.form (<>.after (<c>.this! (code.identifier ["" dotted-name]))
                                    (<c>.tuple (<>.exactly (list.size arguments) <c>.any)))))]
       (wrap (` (<jvm-op> (~ (code.text class-name)) (~ (code.text method-name))
                          (~' _jvm_this)
                          (~+ (|> args
                                  (list.zip2 (list@map product.right 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)
  (-> Context (Parser Text))
  (do <>.monad
    [name <c>.local-identifier]
    (wrap (qualify imports name))))

(def: privacy-modifier^
  (Parser Privacy)
  (let [(^open ".") <>.monad]
    ($_ <>.or
        (<c>.this! (' #public))
        (<c>.this! (' #private))
        (<c>.this! (' #protected))
        (wrap []))))

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

(exception: #export (class-names-cannot-contain-periods {name Text})
  (exception.report
   ["Name" (%.text name)]))

(exception: #export (class-name-cannot-be-a-type-variable {name Text}
                                                          {type-vars (List (Type Var))})
  (exception.report
   ["Name" (%.text name)]
   ["Type Variables" (exception.enumerate parser.name type-vars)]))

(def: (assert exception payload test)
  (All [e] (-> (Exception e) e Bit (Parser Any)))
  (<>.assert (exception.construct exception payload)
             test))

(def: (assert-valid-class-name type-vars name)
  (-> (List (Type Var)) External (Parser Any))
  (do <>.monad
    [_ (..assert ..class-names-cannot-contain-periods [name]
                 (not (text.contains? name.external-separator name)))]
    (..assert ..class-name-cannot-be-a-type-variable [name type-vars]
              (not (list.member? text.equivalence
                                 (list@map parser.name type-vars)
                                 name)))))

(def: (valid-class-name imports type-vars)
  (-> Context (List (Type Var)) (Parser External))
  (do <>.monad
    [name (full-class-name^ imports)
     _ (assert-valid-class-name type-vars name)]
    (wrap name)))

(def: (class^' parameter^ imports type-vars)
  (-> (-> Context (List (Type Var)) (Parser (Type Parameter)))
      (-> Context (List (Type Var)) (Parser (Type Class))))
  (do <>.monad
    [[name parameters] (: (Parser [External (List (Type Parameter))])
                          ($_ <>.either
                              (<>.and (valid-class-name imports type-vars)
                                      (<>@wrap (list)))
                              (<c>.form (<>.and (full-class-name^ imports)
                                                (<>.some (parameter^ imports type-vars))))))]
    (wrap (type.class (name.sanitize name) parameters))))

(exception: #export (unexpected-type-variable {name Text}
                                              {type-vars (List (Type Var))})
  (exception.report
   ["Unexpected Type Variable" (%.text name)]
   ["Expected Type Variables" (exception.enumerate parser.name type-vars)]))

(def: (variable^ imports type-vars)
  (-> Context (List (Type Var)) (Parser (Type Parameter)))
  (do <>.monad
    [name (full-class-name^ imports)
     _ (..assert ..unexpected-type-variable [name type-vars]
                 (list.member? text.equivalence (list@map parser.name type-vars) name))]
    (wrap (type.var name))))

(def: wildcard^
  (Parser (Type Parameter))
  (do <>.monad
    [_ (<c>.this! (' ?))]
    (wrap type.wildcard)))

(template [<name> <comparison> <constructor>]
  [(def: <name>
     (-> (Parser (Type Class)) (Parser (Type Parameter)))
     (|>> (<>.after (<c>.this! (' <comparison>)))
          (<>.after ..wildcard^)
          <c>.tuple
          (:: <>.monad map <constructor>)))]

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

(def: (parameter^ imports type-vars)
  (-> Context (List (Type Var)) (Parser (Type Parameter)))
  (<>.rec
   (function (_ recur^)
     (let [class^ (..class^' parameter^ imports type-vars)]
       ($_ <>.either
           (..variable^ imports type-vars)
           ..wildcard^
           (upper^ class^)
           (lower^ class^)
           class^
           )))))

(def: (itself^ type)
  (All [category]
    (-> (Type (<| Return' Value' category))
        (Parser (Type (<| Return' Value' category)))))
  (do <>.monad
    [_ (<c>.identifier! ["" (..reflection type)])]
    (wrap type)))

(def: primitive^
  (Parser (Type Primitive))
  ($_ <>.either
      (itself^ type.boolean)
      (itself^ type.byte)
      (itself^ type.short)
      (itself^ type.int)
      (itself^ type.long)
      (itself^ type.float)
      (itself^ type.double)
      (itself^ type.char)
      ))

(def: array^
  (-> (Parser (Type Value)) (Parser (Type Array)))
  (|>> <c>.tuple
       (:: <>.monad map type.array)))

(def: (type^ imports type-vars)
  (-> Context (List (Type Var)) (Parser (Type Value)))
  (<>.rec
   (function (_ type^)
     ($_ <>.either
         ..primitive^
         (..parameter^ imports type-vars)
         (..array^ type^)
         ))))

(def: void^
  (Parser (Type Void))
  (do <>.monad
    [_ (<c>.identifier! ["" (reflection.reflection reflection.void)])]
    (wrap type.void)))

(def: (return^ imports type-vars)
  (-> Context (List (Type Var)) (Parser (Type Return)))
  (<>.either ..void^
             (..type^ imports type-vars)))

(def: var^
  (Parser (Type Var))
  (:: <>.monad map type.var <c>.local-identifier))

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

(def: (declaration^ imports)
  (-> Context (Parser (Type Declaration)))
  (do <>.monad
    [[name variables] (: (Parser [External (List (Type Var))])
                         (<>.either (<>.and (valid-class-name imports (list))
                                            (<>@wrap (list)))
                                    (<c>.form (<>.and (valid-class-name imports (list))
                                                      (<>.some var^)))
                                    ))]
    (wrap (type.declaration name variables))))

(def: (class^ imports type-vars)
  (-> Context (List (Type Var)) (Parser (Type Class)))
  (class^' parameter^ imports type-vars))

(def: annotation-parameters^
  (Parser (List Annotation-Parameter))
  (<c>.record (<>.some (<>.and <c>.local-tag <c>.any))))

(def: (annotation^ imports)
  (-> Context (Parser Annotation))
  (<>.either (do <>.monad
               [ann-name (full-class-name^ imports)]
               (wrap [ann-name (list)]))
             (<c>.form (<>.and (full-class-name^ imports)
                               annotation-parameters^))))

(def: (annotations^' imports)
  (-> Context (Parser (List Annotation)))
  (do <>.monad
    [_ (<c>.this! (' #ann))]
    (<c>.tuple (<>.some (annotation^ imports)))))

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

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

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

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

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

(def: (argument^ imports type-vars)
  (-> Context (List (Type Var)) (Parser Argument))
  (<c>.record (<>.and <c>.local-identifier
                      (..type^ imports type-vars))))

(def: (arguments^ imports type-vars)
  (-> Context (List (Type Var)) (Parser (List Argument)))
  (<>.some (argument^ imports type-vars)))

(def: (constructor-arg^ imports type-vars)
  (-> Context (List (Type Var)) (Parser (Typed Code)))
  (<c>.record (<>.and (..type^ imports type-vars) <c>.any)))

(def: (constructor-args^ imports type-vars)
  (-> Context (List (Type Var)) (Parser (List (Typed Code))))
  (<c>.tuple (<>.some (constructor-arg^ imports type-vars))))

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

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

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

(def: (import-member-args^ imports type-vars)
  (-> Context (List (Type Var)) (Parser (List [Bit (Type Value)])))
  (<c>.tuple (<>.some (<>.and (<>.parses? (<c>.tag! ["" "?"]))
                              (..type^ imports type-vars)))))

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

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

(def: (import-member-decl^ imports owner-vars)
  (-> Context (List (Type Var)) (Parser Import-Member-Declaration))
  ($_ <>.either
      (<c>.form (do <>.monad
                  [_ (<c>.this! (' #enum))
                   enum-members (<>.some <c>.local-identifier)]
                  (wrap (#EnumDecl enum-members))))
      (<c>.form (do <>.monad
                  [tvars (<>.default (list) ..vars^)
                   _ (<c>.identifier! ["" "new"])
                   ?alias import-member-alias^
                   #let [total-vars (list@compose owner-vars tvars)]
                   ?prim-mode (<>.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?}
                                           {}]))
                  ))
      (<c>.form (do <>.monad
                  [kind (: (Parser ImportMethodKind)
                           (<>.or (<c>.tag! ["" "static"])
                                  (wrap [])))
                   tvars (<>.default (list) ..vars^)
                   name <c>.local-identifier
                   ?alias import-member-alias^
                   #let [total-vars (list@compose owner-vars tvars)]
                   ?prim-mode (<>.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}]))))
      (<c>.form (do <>.monad
                  [static? (<>.parses? (<c>.this! (' #static)))
                   name <c>.local-identifier
                   ?prim-mode (<>.maybe primitive-mode^)
                   gtype (..type^ imports owner-vars)
                   maybe? (<>.parses? (<c>.this! (' #?)))
                   setter? (<>.parses? (<c>.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)
  (-> Privacy Code)
  (case pm
    #PublicP    (code.text "public")
    #PrivateP   (code.text "private")
    #ProtectedP (code.text "protected")
    #DefaultP   (code.text "default")))

(def: (inheritance-modifier$ im)
  (-> InheritanceModifier Code)
  (case im
    #FinalIM    (code.text "final")
    #AbstractIM (code.text "abstract")
    #DefaultIM  (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@map annotation-parameter$ params)))))

(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-identifier))

(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 value$ 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))]
        (~ (value$ class))
        (~ value)
        ))

    (#VariableField sm class)
    (` ("variable" (~ (code.text name))
        (~ (privacy-modifier$ pm))
        (~ (state-modifier$ sm))
        [(~+ (list@map 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)]))

(def: (method-def$ replacer super-class [[name pm anns] method-def])
  (-> (-> Code Code) (Type 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 (<c>.form (do <>.monad
                                                       [_ (<c>.this! (' ::super!))
                                                        args (<c>.tuple (<>.exactly (list.size arguments) <c>.any))]
                                                       (wrap (` ("jvm member invoke special"
                                                                 (~ (code.text (product.left (parser.read-class super-class))))
                                                                 (~ (code.text name))
                                                                 (~' _jvm_this)
                                                                 (~+ (|> args
                                                                         (list.zip2 (list@map product.right 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
  (Type Class)
  (type.class "java.lang.Object" (list)))

(syntax: #export (class:
                   {#let [imports (..context *compiler*)]}
                   {im inheritance-modifier^}
                   {[full-class-name class-vars] (:: @ map parser.declaration (declaration^ imports))}
                   {#let [imports (add-import [(short-class-name full-class-name) full-class-name]
                                              (..context *compiler*))]}
                   {super (<>.default $Object
                                      (class^ imports class-vars))}
                   {interfaces (<>.default (list)
                                           (<c>.tuple (<>.some (class^ imports class-vars))))}
                   {annotations (annotations^ imports)}
                   {fields (<>.some (field-decl^ imports class-vars))}
                   {methods (<>.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 @
    [current-module macro.current-module-name
     #let [fully-qualified-class-name (name.qualify current-module 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 <>.either
                                                 (<>.fail "")
                                                 (list@compose field-parsers method-parsers)))]]
    (wrap (list (` ("jvm class"
                    (~ (declaration$ (type.declaration (name.qualify current-module full-class-name) class-vars)))
                    (~ (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 (..context *compiler*)]}
                   {[full-class-name class-vars] (:: @ map parser.declaration (declaration^ imports))}
                   {#let [imports (add-import [(short-class-name full-class-name) full-class-name]
                                              (..context *compiler*))]}
                   {supers (<>.default (list)
                                       (<c>.tuple (<>.some (class^ imports class-vars))))}
                   {annotations (annotations^ imports)}
                   {members (<>.some (method-decl^ imports class-vars))})
  {#.doc (doc "Allows defining JVM interfaces."
              (interface: TestInterface
                ([] foo [boolean String] void #throws [Exception])))}
  (do @
    [current-module macro.current-module-name]
    (wrap (list (` ("jvm class interface"
                    (~ (declaration$ (type.declaration (name.qualify current-module full-class-name) class-vars)))
                    [(~+ (list@map class$ supers))]
                    [(~+ (list@map annotation$ annotations))]
                    (~+ (list@map method-decl$ members))))))))

(syntax: #export (object
                   {#let [imports (..context *compiler*)]}
                   {class-vars ..vars^}
                   {super (<>.default $Object
                                      (class^ imports class-vars))}
                   {interfaces (<>.default (list)
                                           (<c>.tuple (<>.some (class^ imports class-vars))))}
                   {constructor-args (constructor-args^ imports class-vars)}
                   {methods (<>.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 (..context *compiler*)]}
                        {class (..type^ imports (list))}
                        {unchecked (<>.maybe <c>.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-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 (<>.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? declaration)
  (-> Bit (Type Declaration) Code)
  (let [[full-name params] (parser.declaration declaration)
        def-name (..internal (if long-name?
                               full-name
                               (short-class-name full-name)))
        params' (list@map ..var$' params)]
    (` (def: (~ (code.identifier ["" def-name]))
         {#..jvm-class (~ (code.text (..internal full-name)))}
         .Type
         (All [(~+ params')]
           (primitive (~ (code.text full-name))
                      [(~+ params')]))))))

(def: (member-type-vars class-tvars member)
  (-> (List (Type Var)) Import-Member-Declaration (List (Type 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 member)
  (-> (List (Type Var)) Import-Member-Declaration (Meta [(List [Bit Code]) (List (Type Value)) (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 Value)] (Meta [Bit Code]))
                                  (function (_ [maybe? _])
                                    (with-gensyms [arg-name]
                                      (wrap [maybe? arg-name]))))
                               import-member-args)
         #let [input-jvm-types (list@map product.right import-member-args)
               arg-types (list@map (: (-> [Bit (Type Value)] Code)
                                      (function (_ [maybe? arg])
                                        (let [arg-type (value-type (get@ #import-member-mode commons) arg)]
                                          (if maybe?
                                            (` (Maybe (~ arg-type)))
                                            arg-type))))
                                   import-member-args)]]
        (wrap [arg-inputs input-jvm-types arg-types])))

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

(def: (decorate-return-maybe member never-null? unboxed return-term)
  (-> Import-Member-Declaration Bit (Type Value) 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: $String (type.class "java.lang.String" (list)))

(template [<input?> <name> <unbox/box> <special+>]
  [(def: (<name> mode [unboxed raw])
     (-> Primitive-Mode [(Type Value) Code] Code)
     (let [[unboxed refined post] (: [(Type Value) Code (List Code)]
                                     (case mode
                                       #ManualPrM
                                       [unboxed raw (list)]
                                       
                                       #AutoPrM
                                       (with-expansions [<special+>' (template.splice <special+>)
                                                         <cond-cases> (template [<old> <new> <pre> <post>]
                                                                        [(:: type.equivalence = <old> unboxed)
                                                                         (with-expansions [<post>' (template.splice <post>)]
                                                                           [<new>
                                                                            (` (.|> (~ raw) (~+ <pre>)))
                                                                            (list <post>')])]

                                                                        <special+>')]
                                         (cond <cond-cases>
                                               ## else
                                               [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
   [[type.boolean type.boolean (list (` (.: .Bit)) (` (.:coerce (.primitive (~ (code.text box.boolean)))))) []]
    [type.byte type.byte (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long-to-byte)) []]
    [type.short type.short (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long-to-short)) []]
    [type.int type.int (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long))))) (` ..long-to-int)) []]
    [type.long type.long (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long)))))) []]
    [type.float type.float (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text box.double))))) (` ..double-to-float)) []]
    [type.double type.double (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text box.double)))))) []]
    [..$String ..$String (list (` (.: .Text)) (` (.:coerce (.primitive (~ (code.text (..reflection ..$String))))))) []]
    [(type.class box.boolean (list)) (type.class box.boolean (list)) (list (` (.: .Bit)) (` (.:coerce (.primitive (~ (code.text box.boolean)))))) []]
    [(type.class box.long (list)) (type.class box.long (list)) (list (` (.: .Int)) (` (.:coerce (.primitive (~ (code.text box.long)))))) []]
    [(type.class box.double (list)) (type.class box.double (list)) (list (` (.: .Frac)) (` (.:coerce (.primitive (~ (code.text box.double)))))) []]]]
  [#0 auto-convert-output ..box
   [[type.boolean type.boolean (list) [(` (.: (.primitive (~ (code.text box.boolean))))) (` (.:coerce .Bit))]]
    [type.byte type.long (list (` "jvm conversion byte-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]]
    [type.short type.long (list (` "jvm conversion short-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]]
    [type.int type.long (list (` "jvm conversion int-to-long")) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]]
    [type.long type.long (list) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]]
    [type.float type.double (list (` "jvm conversion float-to-double")) [(` (.: (.primitive (~ (code.text box.double))))) (` (.:coerce .Frac))]]
    [type.double type.double (list) [(` (.: (.primitive (~ (code.text box.double))))) (` (.:coerce .Frac))]]
    [..$String ..$String (list) [(` (.: (.primitive (~ (code.text (..reflection ..$String)))))) (` (.:coerce .Text))]]
    [(type.class box.boolean (list)) (type.class box.boolean (list)) (list) [(` (.: (.primitive (~ (code.text box.boolean))))) (` (.:coerce .Bit))]]
    [(type.class box.long (list)) (type.class box.long (list)) (list) [(` (.: (.primitive (~ (code.text box.long))))) (` (.:coerce .Int))]]
    [(type.class box.double (list)) (type.class box.double (list)) (list) [(` (.: (.primitive (~ (code.text box.double))))) (` (.:coerce .Frac))]]]]
  )

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

(def: (jvm-invoke-inputs mode classes inputs)
  (-> Primitive-Mode (List (Type Value)) (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: (member-def-interop vars kind class [arg-function-inputs input-jvm-types arg-types] member method-prefix)
  (-> (List (Type Var)) Class-Kind (Type Declaration) [(List [Bit Code]) (List (Type Value)) (List Code)] Import-Member-Declaration Text (Meta (List Code)))
  (let [[full-name class-tvars] (parser.declaration class)]
    (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$' 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 [classT (type.class full-name (list))
               def-name (code.identifier ["" (format method-prefix member-separator (get@ #import-member-alias commons))])
               jvm-interop (|> [classT
                                (` ("jvm member invoke constructor"
                                    [(~+ (list@map ..var$ class-tvars))]
                                    (~ (code.text full-name))
                                    [(~+ (list@map ..var$ (get@ #import-member-tvars commons)))]
                                    (~+ (|> (jvm-invoke-inputs (get@ #import-member-mode commons) input-jvm-types arg-function-inputs)
                                            (list.zip2 input-jvm-types)
                                            (list@map ..decorate-input)))))]
                               (auto-convert-output (get@ #import-member-mode commons))
                               (decorate-return-maybe member true classT)
                               (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 (get@ #import-method-return method)
                 callC (: Code
                          (` ((~ (code.text jvm-op))
                              [(~+ (list@map ..var$ class-tvars))]
                              (~ (code.text full-name))
                              (~ (code.text import-method-name))
                              [(~+ (list@map ..var$ (get@ #import-member-tvars commons)))]
                              (~+ (|> object-ast
                                      (list@map ..un-quote)
                                      (list.zip2 (list (type.class full-name (list))))
                                      (list@map (auto-convert-input (get@ #import-member-mode commons)))))
                              (~+ (|> (jvm-invoke-inputs (get@ #import-member-mode commons) input-jvm-types arg-function-inputs)
                                      (list.zip2 input-jvm-types)
                                      (list@map ..decorate-input))))))
                 jvm-interop (: Code
                                (case (type.void? method-return)
                                  (#.Left method-return)
                                  (|> [method-return
                                       callC]
                                      (auto-convert-output (get@ #import-member-mode commons))
                                      (decorate-return-maybe member false method-return)
                                      (decorate-return-try member)
                                      (decorate-return-io member))
                                  
                                  
                                  (#.Right method-return)
                                  (|> callC
                                      (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
               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)
                                                [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 (|> [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 (Type Var)) Bit Class-Kind (Type Declaration) Import-Member-Declaration (Meta (List Code)))
  (let [[full-name _] (parser.declaration class)
        method-prefix (..internal (if long-name?
                                    full-name
                                    (short-class-name full-name)))]
    (do macro.monad
      [=args (member-def-arg-bindings vars 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
  (-> External (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 declaration)
  (-> (Type Declaration) (Meta Class-Kind))
  (let [[class-name _] (parser.declaration declaration)]
    (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 (..context *compiler*)]}
                   {long-name? (<>.parses? (<c>.this! (' #long)))}
                   {declaration (declaration^ imports)}
                   {#let [[full-class-name class-type-vars] (parser.declaration declaration)
                          full-class-name (..internal full-class-name)
                          imports (add-import [(short-class-name full-class-name) full-class-name]
                                              (..context *compiler*))]}
                   {members (<>.some (import-member-decl^ imports class-type-vars))})
  {#.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$ class-type-vars long-name? kind declaration) members)]
    (wrap (list& (class-import$ long-name? declaration) (list@join =members)))))

(syntax: #export (array {#let [imports (..context *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"))]
    (`` (cond (~~ (template [<primitive> <array-op>]
                    [(:: type.equivalence = <primitive> type)
                     (wrap (list (` (<array-op> (~ g!size)))))]

                    [type.boolean "jvm array new boolean"]
                    [type.byte    "jvm array new byte"]
                    [type.short   "jvm array new short"]
                    [type.int     "jvm array new int"]
                    [type.long    "jvm array new long"]
                    [type.float   "jvm array new float"]
                    [type.double  "jvm array new double"]
                    [type.char    "jvm array new char"]))
              ## else
              (wrap (list (` (: (~ (value-type #ManualPrM (type.array type)))
                                ("jvm array new object" (~ g!size))))))))))

(exception: #export (cannot-convert-to-jvm-type {type .Type})
  (exception.report
   ["Lux Type" (%.type type)]))

(with-expansions [<failure> (as-is (macro.fail (exception.construct ..cannot-convert-to-jvm-type [type])))]
  (def: (lux-type->jvm-type type)
    (-> .Type (Meta (Type Value)))
    (if (lux-type@= Any type)
      (:: macro.monad wrap $Object)
      (case type
        (#.Primitive name params)
        (`` (cond (~~ (template [<type>]
                        [(text@= (..reflection <type>) name)
                         (case params
                           #.Nil
                           (:: macro.monad wrap <type>)

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

                  (~~ (template [<type>]
                        [(text@= (..reflection (type.array <type>)) name)
                         (case params
                           #.Nil
                           (:: macro.monad wrap (type.array <type>))

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

                  (text@= array.type-name name)
                  (case params
                    (#.Cons elementLT #.Nil)
                    (:: macro.monad map type.array
                        (lux-type->jvm-type elementLT))

                    _
                    <failure>)

                  (text.starts-with? descriptor.array-prefix name)
                  (case params
                    #.Nil
                    (let [[_ unprefixed] (maybe.assume (text.split-with descriptor.array-prefix name))]
                      (:: macro.monad map type.array
                          (lux-type->jvm-type (#.Primitive unprefixed (list)))))

                    _
                    <failure>)

                  ## else
                  (:: macro.monad map (type.class name)
                      (: (Meta (List (Type Parameter)))
                         (monad.map macro.monad
                                    (function (_ paramLT)
                                      (do macro.monad
                                        [paramJT (lux-type->jvm-type paramLT)]
                                        (case (parser.parameter? paramJT)
                                          (#.Some paramJT)
                                          (wrap paramJT)

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

        (#.Apply A F)
        (case (lux-type.apply (list A) F)
          #.None
          <failure>

          (#.Some type')
          (lux-type->jvm-type type'))
        
        (#.Named _ type')
        (lux-type->jvm-type type')

        _
        <failure>))))

(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 (lux-type->jvm-type array-type)
       #let [g!extension (code.text (`` (cond (~~ (template [<primitive> <extension>]
                                                    [(:: type.equivalence =
                                                         (type.array <primitive>)
                                                         array-jvm-type)
                                                     <extension>]

                                                    [type.boolean "jvm array length boolean"]
                                                    [type.byte "jvm array length byte"]
                                                    [type.short "jvm array length short"]
                                                    [type.int "jvm array length int"]
                                                    [type.long "jvm array length long"]
                                                    [type.float "jvm array length float"]
                                                    [type.double "jvm array length double"]
                                                    [type.char "jvm array length char"]))
                                              
                                              ## else
                                              "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 (lux-type->jvm-type array-type)
       #let [g!idx (` (.|> (~ idx)
                           (.: .Nat)
                           (.:coerce (.primitive (~ (code.text box.long))))
                           "jvm object cast"
                           "jvm conversion long-to-int"))]]
      (`` (cond (~~ (template [<primitive> <extension> <box>]
                      [(:: type.equivalence =
                           (type.array <primitive>)
                           array-jvm-type)
                       (wrap (list (` (.|> (<extension> (~ g!idx) (~ array))
                                           "jvm object cast"
                                           (.: (.primitive (~ (code.text <box>))))))))]

                      [type.boolean "jvm array read boolean" box.boolean]
                      [type.byte "jvm array read byte" box.byte]
                      [type.short "jvm array read short" box.short]
                      [type.int "jvm array read int" box.int]
                      [type.long "jvm array read long" box.long]
                      [type.float "jvm array read float" box.float]
                      [type.double "jvm array read double" box.double]
                      [type.char "jvm array read char" box.char]))
                
                ## else
                (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 (lux-type->jvm-type array-type)
       #let [g!idx (` (.|> (~ idx)
                           (.: .Nat)
                           (.:coerce (.primitive (~ (code.text box.long))))
                           "jvm object cast"
                           "jvm conversion long-to-int"))]]
      (`` (cond (~~ (template [<primitive> <extension> <box>]
                      [(:: type.equivalence =
                           (type.array <primitive>)
                           array-jvm-type)
                       (let [g!value (` (.|> (~ value)
                                             (.:coerce (.primitive (~ (code.text <box>))))
                                             "jvm object cast"))]
                         (wrap (list (` (<extension> (~ g!idx) (~ g!value) (~ array))))))]

                      [type.boolean "jvm array write boolean" box.boolean]
                      [type.byte "jvm array write byte" box.byte]
                      [type.short "jvm array write short" box.short]
                      [type.int "jvm array write int" box.int]
                      [type.long "jvm array write long" box.long]
                      [type.float "jvm array write float" box.float]
                      [type.double "jvm array write double" box.double]
                      [type.char "jvm array write char" box.char]))
                
                ## else
                (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 {type (..type^ (..context *compiler*) (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 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")}
  (-> External (Meta External))
  (do macro.monad
    [*compiler* get-compiler]
    (wrap (qualify (..context *compiler*) class))))

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