(;module:
  [lux #- char]
  (lux (control [monad #+ do]
                ["p" parser]
                ["ex" exception #+ exception:])
       (concurrency ["A" atom])
       (data ["R" result]
             [text "text/" Eq<Text>]
             (text format
                   ["l" lexer])
             (coll [list "list/" Fold<List> Functor<List>]
                   [array #+ Array]
                   ["d" dict]))
       [macro "lux/" Monad<Lux>]
       [type]
       (type ["TC" check])
       [host])
  (luxc ["&" base]
        ["&;" host]
        (lang ["la" analysis #+ Analysis])
        (analyser ["&;" common]))
  ["@" ../common]
  )

(do-template [<name> <class>]
  [(def: #export <name> Type (#;Host <class> (list)))]

  ## Boxes
  [Boolean   "java.lang.Boolean"]
  [Byte      "java.lang.Byte"]
  [Short     "java.lang.Short"]
  [Integer   "java.lang.Integer"]
  [Long      "java.lang.Long"]
  [Float     "java.lang.Float"]
  [Double    "java.lang.Double"]
  [Character "java.lang.Character"]
  [String    "java.lang.String"]

  ## Primitives
  [boolean   "boolean"]
  [byte      "byte"]
  [short     "short"]
  [int       "int"]
  [long      "long"]
  [float     "float"]
  [double    "double"]
  [char      "char"]
  )

(def: conversion-procs
  @;Bundle
  (<| (@;prefix "convert")
      (|> (d;new text;Hash<Text>)
          (@;install "double-to-float" (@;unary Double Float))
          (@;install "double-to-int" (@;unary Double Integer))
          (@;install "double-to-long" (@;unary Double Long))
          (@;install "float-to-double" (@;unary Float Double))
          (@;install "float-to-int" (@;unary Float Integer))
          (@;install "float-to-long" (@;unary Float Long))
          (@;install "int-to-byte" (@;unary Integer Byte))
          (@;install "int-to-char" (@;unary Integer Character))
          (@;install "int-to-double" (@;unary Integer Double))
          (@;install "int-to-float" (@;unary Integer Float))
          (@;install "int-to-long" (@;unary Integer Long))
          (@;install "int-to-short" (@;unary Integer Short))
          (@;install "long-to-double" (@;unary Long Double))
          (@;install "long-to-float" (@;unary Long Float))
          (@;install "long-to-int" (@;unary Long Integer))
          (@;install "long-to-short" (@;unary Long Short))
          (@;install "long-to-byte" (@;unary Long Byte))
          (@;install "char-to-byte" (@;unary Character Byte))
          (@;install "char-to-short" (@;unary Character Short))
          (@;install "char-to-int" (@;unary Character Integer))
          (@;install "char-to-long" (@;unary Character Long))
          (@;install "byte-to-long" (@;unary Byte Long))
          (@;install "short-to-long" (@;unary Short Long))
          )))

(do-template [<name> <prefix> <type>]
  [(def: <name>
     @;Bundle
     (<| (@;prefix <prefix>)
         (|> (d;new text;Hash<Text>)
             (@;install "+" (@;binary <type> <type> <type>))
             (@;install "-" (@;binary <type> <type> <type>))
             (@;install "*" (@;binary <type> <type> <type>))
             (@;install "/" (@;binary <type> <type> <type>))
             (@;install "%" (@;binary <type> <type> <type>))
             (@;install "=" (@;binary <type> <type> Boolean))
             (@;install "<" (@;binary <type> <type> Boolean))
             (@;install ">" (@;binary <type> <type> Boolean))
             (@;install "and" (@;binary <type> <type> <type>))
             (@;install "or" (@;binary <type> <type> <type>))
             (@;install "xor" (@;binary <type> <type> <type>))
             (@;install "shl" (@;binary <type> Integer <type>))
             (@;install "shr" (@;binary <type> Integer <type>))
             (@;install "ushr" (@;binary <type> Integer <type>))
             )))]

  [int-procs  "int"  Integer]
  [long-procs "long" Long]
  )

(do-template [<name> <prefix> <type>]
  [(def: <name>
     @;Bundle
     (<| (@;prefix <prefix>)
         (|> (d;new text;Hash<Text>)
             (@;install "+" (@;binary <type> <type> <type>))
             (@;install "-" (@;binary <type> <type> <type>))
             (@;install "*" (@;binary <type> <type> <type>))
             (@;install "/" (@;binary <type> <type> <type>))
             (@;install "%" (@;binary <type> <type> <type>))
             (@;install "=" (@;binary <type> <type> Boolean))
             (@;install "<" (@;binary <type> <type> Boolean))
             (@;install ">" (@;binary <type> <type> Boolean))
             )))]

  [float-procs  "float"  Float]
  [double-procs "double" Double]
  )

(def: char-procs
  @;Bundle
  (<| (@;prefix "char")
      (|> (d;new text;Hash<Text>)
          (@;install "=" (@;binary Character Character Boolean))
          (@;install "<" (@;binary Character Character Boolean))
          (@;install ">" (@;binary Character Character Boolean))
          )))

(def: #export boxes
  (d;Dict Text Text)
  (|> (list ["boolean" "java.lang.Boolean"]
            ["byte" "java.lang.Byte"]
            ["short" "java.lang.Short"]
            ["int" "java.lang.Integer"]
            ["long" "java.lang.Long"]
            ["float" "java.lang.Float"]
            ["double" "java.lang.Double"]
            ["char" "java.lang.Character"])
      (d;from-list text;Hash<Text>)))

(def: (array-length proc)
  (-> Text @;Proc)
  (function [analyse args]
    (&common;with-var
      (function [[var-id varT]]
        (case args
          (^ (list arrayC))
          (do macro;Monad<Lux>
            [arrayA (&;with-expected-type (type (Array varT))
                      (analyse arrayC))
             _ (&;infer Nat)]
            (wrap (#la;Procedure proc (list arrayA))))

          _
          (&;fail (@;wrong-arity proc +1 (list;size args))))))))

(def: (invalid-array-type arrayT)
  (-> Type Text)
  (format "Invalid type for array: " (%type arrayT)))

(def: (array-new proc)
  (-> Text @;Proc)
  (function [analyse args]
    (case args
      (^ (list lengthC))
      (do macro;Monad<Lux>
        [lengthA (&;with-expected-type Nat
                   (analyse lengthC))
         expectedT macro;expected-type
         [level elem-class] (: (Lux [Nat Text])
                               (loop [analysisT expectedT
                                      level +0]
                                 (case analysisT
                                   (#;Apply inputT funcT)
                                   (case (type;apply (list inputT) funcT)
                                     (#;Some outputT)
                                     (recur outputT level)

                                     #;None
                                     (&;fail (invalid-array-type expectedT)))

                                   (^ (#;Host "#Array" (list elemT)))
                                   (recur elemT (n.inc level))

                                   (#;Host class _)
                                   (wrap [level class])
                                   
                                   _
                                   (&;fail (invalid-array-type expectedT)))))
         _ (&;assert "Must have at least 1 level of nesting in array type."
                     (n.> +0 level))]
        (wrap (#la;Procedure proc (list (#la;Nat level) (#la;Text elem-class) lengthA))))

      _
      (&;fail (@;wrong-arity proc +1 (list;size args))))))

(def: (not-object type)
  (-> Type Text)
  (format "Non-object type: " (%type type)))

(def: (check-object objectT)
  (-> Type (Lux Text))
  (case objectT
    (#;Host name _)
    (if (d;contains? name boxes)
      (&;fail (format "Primitives are not objects: " name))
      (:: macro;Monad<Lux> wrap name))

    (#;Named name unnamed)
    (check-object unnamed)

    (^template [<tag>]
      (<tag> env unquantified)
      (check-object unquantified))
    ([#;UnivQ]
     [#;ExQ])

    (#;Apply inputT funcT)
    (case (type;apply (list inputT) funcT)
      (#;Some outputT)
      (check-object outputT)

      #;None
      (&;fail (not-object objectT)))

    _
    (&;fail (not-object objectT))))

(def: (box-array-element-type elemT)
  (-> Type (Lux [Type Text]))
  (do macro;Monad<Lux>
    []
    (case elemT
      (#;Host name #;Nil)
      (let [boxed-name (|> (d;get name boxes)
                           (default name))]
        (wrap [(#;Host boxed-name #;Nil)
               boxed-name]))

      (#;Host name _)
      (if (d;contains? name boxes)
        (&;fail (format "Primitives cannot be parameterized: " name))
        (:: macro;Monad<Lux> wrap [elemT name]))

      _
      (&;fail (format "Invalid type for array element: " (%type elemT))))))

(def: (array-read proc)
  (-> Text @;Proc)
  (function [analyse args]
    (&common;with-var
      (function [[var-id varT]]
        (case args
          (^ (list arrayC idxC))
          (do macro;Monad<Lux>
            [arrayA (&;with-expected-type (type (Array varT))
                      (analyse arrayC))
             elemT (&;within-type-env
                    (TC;read-var var-id))
             [elemT elem-class] (box-array-element-type elemT)
             idxA (&;with-expected-type Nat
                    (analyse idxC))
             _ (&;infer elemT)]
            (wrap (#la;Procedure proc (list (#la;Text elem-class) arrayA idxA))))

          _
          (&;fail (@;wrong-arity proc +2 (list;size args))))))))

(def: (array-write proc)
  (-> Text @;Proc)
  (function [analyse args]
    (&common;with-var
      (function [[var-id varT]]
        (case args
          (^ (list arrayC idxC valueC))
          (do macro;Monad<Lux>
            [arrayA (&;with-expected-type (type (Array varT))
                      (analyse arrayC))
             elemT (&;within-type-env
                    (TC;read-var var-id))
             [valueT elem-class] (box-array-element-type elemT)
             idxA (&;with-expected-type Nat
                    (analyse idxC))
             valueA (&;with-expected-type valueT
                      (analyse valueC))
             _ (&;infer (type (Array elemT)))]
            (wrap (#la;Procedure proc (list (#la;Text elem-class) arrayA idxA valueA))))

          _
          (&;fail (@;wrong-arity proc +3 (list;size args))))))))

(def: array-procs
  @;Bundle
  (<| (@;prefix "array")
      (|> (d;new text;Hash<Text>)
          (@;install "length" array-length)
          (@;install "new" array-new)
          (@;install "read" array-read)
          (@;install "write" array-write)
          )))

(def: (object-null proc)
  (-> Text @;Proc)
  (function [analyse args]
    (case args
      (^ (list))
      (do macro;Monad<Lux>
        [expectedT macro;expected-type
         _ (check-object expectedT)]
        (wrap (#la;Procedure proc (list))))

      _
      (&;fail (@;wrong-arity proc +0 (list;size args))))))

(def: (object-null? proc)
  (-> Text @;Proc)
  (function [analyse args]
    (&common;with-var
      (function [[var-id varT]]
        (case args
          (^ (list objectC))
          (do macro;Monad<Lux>
            [objectA (&;with-expected-type varT
                       (analyse objectC))
             objectT (&;within-type-env
                      (TC;read-var var-id))
             _ (check-object objectT)
             _ (&;infer Bool)]
            (wrap (#la;Procedure proc (list objectA))))

          _
          (&;fail (@;wrong-arity proc +1 (list;size args))))))))

(def: (object-synchronized proc)
  (-> Text @;Proc)
  (function [analyse args]
    (&common;with-var
      (function [[var-id varT]]
        (case args
          (^ (list monitorC exprC))
          (do macro;Monad<Lux>
            [monitorA (&;with-expected-type varT
                        (analyse monitorC))
             monitorT (&;within-type-env
                       (TC;read-var var-id))
             _ (check-object monitorT)
             exprA (analyse exprC)]
            (wrap (#la;Procedure proc (list monitorA exprA))))

          _
          (&;fail (@;wrong-arity proc +2 (list;size args))))))))

(host;import java.lang.Object)

(host;import java.lang.ClassLoader)

(host;import #long java.lang.reflect.Type
  (getTypeName [] String))

(host;import java.lang.reflect.GenericArrayType
  (getGenericComponentType [] java.lang.reflect.Type))

(host;import java.lang.reflect.ParameterizedType
  (getRawType [] java.lang.reflect.Type)
  (getActualTypeArguments [] (Array java.lang.reflect.Type)))

(host;import (java.lang.reflect.TypeVariable d)
  (getName [] String)
  (getBounds [] (Array java.lang.reflect.Type)))

(host;import (java.lang.reflect.WildcardType d)
  (getLowerBounds [] (Array java.lang.reflect.Type))
  (getUpperBounds [] (Array java.lang.reflect.Type)))

(host;import java.lang.reflect.Modifier
  (#static isStatic [int] boolean)
  (#static isFinal [int] boolean))

(host;import java.lang.reflect.Field
  (getDeclaringClass [] (java.lang.Class Object))
  (getModifiers [] int)
  (getGenericType [] java.lang.reflect.Type))

(host;import (java.lang.Class c)
  (getName [] String)
  (#static forName [String boolean ClassLoader] #try (Class Object))
  (isAssignableFrom [(Class Object)] boolean)
  (getTypeParameters [] (Array (TypeVariable (Class c))))
  (getGenericInterfaces [] (Array java.lang.reflect.Type))
  (getGenericSuperclass [] java.lang.reflect.Type)
  (getDeclaredField [String] #try Field))

(def: (load-class name)
  (-> Text (Lux (Class Object)))
  (do macro;Monad<Lux>
    [class-loader &host;class-loader]
    (case (Class.forName [name false class-loader])
      (#R;Success [class])
      (wrap class)

      (#R;Error error)
      (&;fail (format "Unknown class: " name)))))

(def: (sub-class? super sub)
  (-> Text Text (Lux Bool))
  (do macro;Monad<Lux>
    [super (load-class super)
     sub (load-class sub)]
    (wrap (Class.isAssignableFrom [sub] super))))

(exception: #export Not-Throwable)

(def: (object-throw proc)
  (-> Text @;Proc)
  (function [analyse args]
    (&common;with-var
      (function [[var-id varT]]
        (case args
          (^ (list exceptionC))
          (do macro;Monad<Lux>
            [exceptionA (&;with-expected-type varT
                          (analyse exceptionC))
             exceptionT (&;within-type-env
                         (TC;read-var var-id))
             exception-class (check-object exceptionT)
             ? (sub-class? "java.lang.Throwable" exception-class)
             _ (: (Lux Unit)
                  (if ?
                    (wrap [])
                    (&;throw Not-Throwable exception-class)))
             _ (&;infer Bottom)]
            (wrap (#la;Procedure proc (list exceptionA))))

          _
          (&;fail (@;wrong-arity proc +1 (list;size args))))))))

(def: (object-class proc)
  (-> Text @;Proc)
  (function [analyse args]
    (case args
      (^ (list classC))
      (case classC
        [_ (#;Text class)]
        (do macro;Monad<Lux>
          [_ (load-class class)
           _ (&;infer (#;Host "java.lang.Class" (list (#;Host class (list)))))]
          (wrap (#la;Procedure proc (list (#la;Text class)))))

        _
        (&;fail (format "Wrong syntax for '" proc "'.")))

      _
      (&;fail (@;wrong-arity proc +1 (list;size args))))))

(exception: #export Cannot-Be-Instance)

(def: (object-instance? proc)
  (-> Text @;Proc)
  (function [analyse args]
    (&common;with-var
      (function [[var-id varT]]
        (case args
          (^ (list classC objectC))
          (case classC
            [_ (#;Text class)]
            (do macro;Monad<Lux>
              [objectA (&;with-expected-type varT
                         (analyse objectC))
               objectT (&;within-type-env
                        (TC;read-var var-id))
               object-class (check-object objectT)
               ? (sub-class? class object-class)]
              (if ?
                (do @
                  [_ (&;infer Bool)]
                  (wrap (#la;Procedure proc (list (#la;Text class)))))
                (&;throw Cannot-Be-Instance (format object-class " !<= "  class))))

            _
            (&;fail (format "Wrong syntax for '" proc "'.")))

          _
          (&;fail (@;wrong-arity proc +2 (list;size args))))))))

(def: object-procs
  @;Bundle
  (<| (@;prefix "object")
      (|> (d;new text;Hash<Text>)
          (@;install "null" object-null)
          (@;install "null?" object-null?)
          (@;install "synchronized" object-synchronized)
          (@;install "throw" object-throw)
          (@;install "class" object-class)
          (@;install "instance?" object-instance?)
          )))

(def: type-descriptor
  (-> java.lang.reflect.Type Text)
  (java.lang.reflect.Type.getTypeName []))

(exception: #export Cannot-Convert-To-Class)

(def: (type-to-class type)
  (-> java.lang.reflect.Type (Lux Text))
  (cond (host;instance? Class type)
        (lux/wrap (Class.getName [] (:! Class type)))

        (host;instance? ParameterizedType type)
        (type-to-class (ParameterizedType.getRawType [] (:! ParameterizedType type)))

        ## else
        (&;throw Cannot-Convert-To-Class (type-descriptor type))))

(def: (adjust parent type)
  (-> java.lang.reflect.Type Type (Lux Type))
  (&;fail "UNIMPLEMENTED"))

(exception: #export Cannot-Find-Lineage)

(def: (up-cast super-class sub-class type)
  (-> Text Text Type (Lux Type))
  (if (text/= super-class sub-class)
    (lux/wrap type)
    (do macro;Monad<Lux>
      [super (load-class super-class)
       sub (load-class sub-class)
       parent (case (|> (list& (Class.getGenericSuperclass [] sub)
                               (array;to-list (Class.getGenericInterfaces [] sub)))
                        (list;filter (function check [class]
                                       (cond (host;instance? Class class)
                                             (Class.isAssignableFrom [(:! Class class)] super)

                                             (host;instance? ParameterizedType class)
                                             (check (ParameterizedType.getRawType [] (:! ParameterizedType class)))

                                             ## else
                                             false)))
                        list;head)
                (#;Some parent)
                (wrap parent)
                
                #;None
                (&;throw Cannot-Find-Lineage (format "from: " sub-class "\n"
                                                     "  to: " super-class)))
       parent-class (type-to-class parent)
       upped (adjust parent type)]
      (up-cast super-class parent-class type))))

(def: (with-super-type super-class analysis)
  (All [a] (-> Text (Lux a) (Lux [Type Type a])))
  (&common;with-var
    (function [[var-id varT]]
      (do macro;Monad<Lux>
        [output (&;with-expected-type varT
                  analysis)
         subT (&;within-type-env
               (TC;read-var var-id))
         sub-class (check-object subT)
         ? (sub-class? super-class sub-class)
         _ (&;assert (format "'" sub-class "' is not a sub-class of '" sub-class "'.")
                     ?)
         superT (up-cast super-class sub-class subT)]
        (wrap [superT subT output])))))

(def: (find-field class-name field-name)
  (-> Text Text (Lux [(Class Object) Field]))
  (do macro;Monad<Lux>
    [class (load-class class-name)]
    (case (Class.getDeclaredField [field-name] class)
      (#R;Success field)
      (let [owner (Field.getDeclaringClass [] field)]
        (if (is owner class)
          (wrap [class field])
          (&;fail (format "Field '" field-name "' does not belong to class '" class-name "'.\n"
                          "Belongs to '" (Class.getName [] owner) "'."))))
      
      (#R;Error _)
      (&;fail (format "Unknown field '" field-name "' for class '" class-name "'.")))))

(def: (translate-type java-type)
  (-> java.lang.reflect.Type (Lux Type))
  (cond (host;instance? Class java-type)
        (lux/wrap (#;Host (Class.getName [] (:! Class java-type)) (list)))
        
        (host;instance? GenericArrayType java-type)
        (do macro;Monad<Lux>
          [#let [innerJT (GenericArrayType.getGenericComponentType [] (:! GenericArrayType java-type))]
           innerT (translate-type innerJT)]
          (wrap (#;Host "#Array" (list innerT))))
        
        (host;instance? ParameterizedType java-type)
        (do macro;Monad<Lux>
          [#let [rawJT (ParameterizedType.getRawType [] (:! ParameterizedType java-type))
                 paramsJT+ (array;to-list (ParameterizedType.getActualTypeArguments [] (:! ParameterizedType java-type)))]
           _ (&;assert (format "Expected class, but got something else: " (type-descriptor java-type))
                       (host;instance? Class rawJT))
           paramsT+ (monad;map @ translate-type paramsJT+)]
          (wrap (#;Host (Class.getName [] (:! Class rawJT)) paramsT+)))
        
        ## else
        (&;fail (format "Cannot translate type: " (type-descriptor java-type)))))

(def: (static-field class-name field-name)
  (-> Text Text (Lux [Type Bool]))
  (do macro;Monad<Lux>
    [[class field] (find-field class-name field-name)
     #let [modifiers (Field.getModifiers [] field)]]
    (if (Modifier.isStatic [modifiers])
      (let [fieldJT (Field.getGenericType [] field)]
        (do @
          [fieldT (translate-type fieldJT)]
          (wrap [fieldT (Modifier.isFinal [modifiers])])))
      (&;fail (format "Field '" field-name "' of class '" class-name "' is not static.")))))

(def: (virtual-field class-name field-name objectT)
  (-> Text Text Type (Lux [Type Bool]))
  (do macro;Monad<Lux>
    [[class field] (find-field class-name field-name)
     #let [modifiers (Field.getModifiers [] field)]]
    (if (not (Modifier.isStatic [modifiers]))
      (let [fieldJT (Field.getGenericType [] field)]
        (do @
          [fieldT (translate-type fieldJT)]
          (wrap [fieldT (Modifier.isFinal [modifiers])])))
      (&;fail (format "Field '" field-name "' of class '" class-name "' is static.")))))

(def: (static-get proc)
  (-> Text @;Proc)
  (function [analyse args]
    (case args
      (^ (list classC fieldC))
      (case [classC fieldC]
        [[_ (#;Text class)] [_ (#;Text field)]]
        (do macro;Monad<Lux>
          [[fieldT final?] (static-field class field)
           _ (&;infer fieldT)]
          (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field)))))

        _
        (&;fail (format "Wrong syntax for '" proc "'.")))

      _
      (&;fail (@;wrong-arity proc +2 (list;size args))))))

(exception: #export Final-Field)

(def: (static-put proc)
  (-> Text @;Proc)
  (function [analyse args]
    (case args
      (^ (list classC fieldC valueC))
      (case [classC fieldC]
        [[_ (#;Text class)] [_ (#;Text field)]]
        (do macro;Monad<Lux>
          [[fieldT final?] (static-field class field)
           _ (&;assert (Final-Field (format class "#" field))
                       (not final?))
           valueA (&;with-expected-type fieldT
                    (analyse valueC))
           _ (&;infer Unit)]
          (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) valueA))))

        _
        (&;fail (format "Wrong syntax for '" proc "'.")))

      _
      (&;fail (@;wrong-arity proc +3 (list;size args))))))

(def: (virtual-get proc)
  (-> Text @;Proc)
  (function [analyse args]
    (case args
      (^ (list classC fieldC objectC))
      (case [classC fieldC]
        [[_ (#;Text class)] [_ (#;Text field)]]
        (do macro;Monad<Lux>
          [[superT objectT objectA] (with-super-type class
                                      (analyse objectC))
           [fieldT final?] (virtual-field class field objectT)
           _ (&;infer fieldT)]
          (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) objectA))))

        _
        (&;fail (format "Wrong syntax for '" proc "'.")))

      _
      (&;fail (@;wrong-arity proc +3 (list;size args))))))

(def: (virtual-put proc)
  (-> Text @;Proc)
  (function [analyse args]
    (case args
      (^ (list classC fieldC valueC objectC))
      (case [classC fieldC]
        [[_ (#;Text class)] [_ (#;Text field)]]
        (do macro;Monad<Lux>
          [[superT objectT objectA] (with-super-type class
                                      (analyse objectC))
           [fieldT final?] (virtual-field class field objectT)
           _ (&;assert (Final-Field (format class "#" field))
                       (not final?))
           valueA (&;with-expected-type fieldT
                    (analyse valueC))
           _ (&;infer Unit)]
          (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) valueA objectA))))

        _
        (&;fail (format "Wrong syntax for '" proc "'.")))

      _
      (&;fail (@;wrong-arity proc +4 (list;size args))))))

(def: member-procs
  @;Bundle
  (<| (@;prefix "member")
      (|> (d;new text;Hash<Text>)
          (d;merge (<| (@;prefix "static")
                       (|> (d;new text;Hash<Text>)
                           (@;install "get" static-get)
                           (@;install "put" static-put)
                           )))
          (d;merge (<| (@;prefix "virtual")
                       (|> (d;new text;Hash<Text>)
                           (@;install "get" virtual-get)
                           (@;install "put" virtual-put)
                           )))
          )))

(def: #export procedures
  @;Bundle
  (<| (@;prefix "jvm")
      (|> (d;new text;Hash<Text>)
          (d;merge conversion-procs)
          (d;merge int-procs)
          (d;merge long-procs)
          (d;merge float-procs)
          (d;merge double-procs)
          (d;merge char-procs)
          (d;merge array-procs)
          (d;merge object-procs)
          (d;merge member-procs)
          )))