path: root/luxc/src/lux/analyser/host.clj

;;  Copyright (c) Eduardo Julian. All rights reserved.
;;  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
;;  If a copy of the MPL was not distributed with this file,
;;  You can obtain one at http://mozilla.org/MPL/2.0/.

(ns lux.analyser.host
  (:require (clojure [template :refer [do-template]]
                     [string :as string])
            clojure.core.match
            clojure.core.match.array
            (lux [base :as & :refer [|let |do return* return |case assert!]]
                 [type :as &type]
                 [host :as &host]
                 [lexer :as &lexer]
                 [parser :as &parser]
                 [reader :as &reader])
            [lux.type.host :as &host-type]
            [lux.host.generics :as &host-generics]
            (lux.analyser [base :as &&]
                          [lambda :as &&lambda]
                          [env :as &&env]
                          [parser :as &&a-parser])
            [lux.compiler.base :as &c!base])
  (:import (java.lang.reflect Type TypeVariable)))

;; [Utils]
(defn ^:private ensure-catching [exceptions*]
  "(-> (List Text) (Lux Null))"
  (|do [class-loader &/loader]
    (fn [state]
      (|let [exceptions (&/|map #(Class/forName % true class-loader) exceptions*)
             catching (->> state
                           (&/get$ &/$host)
                           (&/get$ &/$catching)
                           (&/|map #(Class/forName % true class-loader)))]
        (if-let [missing-ex (&/fold (fn [prev ^Class now]
                                      (or prev
                                          (cond (or (.isAssignableFrom java.lang.RuntimeException now)
                                                    (.isAssignableFrom java.lang.Error now))
                                                nil

                                                (&/fold (fn [found? ^Class ex-catch]
                                                          (or found?
                                                              (.isAssignableFrom ex-catch now)))
                                                        false
                                                        catching)
                                                nil

                                                :else
                                                now)))
                                    nil
                                    exceptions)]
          ((&/fail-with-loc (str "[Analyser Error] Unhandled exception: " missing-ex))
           state)
          (&/return* state nil)))
      )))

(defn ^:private with-catches [catches body]
  "(All [a] (-> (List Text) (Lux a) (Lux a)))"
  (fn [state]
    (let [old-catches (->> state (&/get$ &/$host) (&/get$ &/$catching))
          state* (->> state (&/update$ &/$host #(&/update$ &/$catching (partial &/|++ catches) %)))]
      (|case (&/run-state body state*)
        (&/$Left msg)
        (&/$Left msg)

        (&/$Right state** output)
        (&/$Right (&/T [(->> state** (&/update$ &/$host #(&/set$ &/$catching old-catches %)))
                        output]))))
    ))

(defn ^:private ensure-object [type]
  "(-> Type (Lux (, Text (List Type))))"
  (|case type
    (&/$HostT payload)
    (return payload)

    (&/$VarT id)
    (return (&/T ["java.lang.Object" (&/|list)]))

    (&/$ExT id)
    (return (&/T ["java.lang.Object" (&/|list)]))

    (&/$NamedT _ type*)
    (ensure-object type*)

    (&/$UnivQ _ type*)
    (ensure-object type*)

    (&/$ExQ _ type*)
    (ensure-object type*)

    (&/$AppT F A)
    (|do [type* (&type/apply-type F A)]
      (ensure-object type*))

    _
    (&/fail-with-loc (str "[Analyser Error] Expecting object: " (&type/show-type type)))))

(defn ^:private as-object [type]
  "(-> Type Type)"
  (|case type
    (&/$HostT class params)
    (&/$HostT (&host-type/as-obj class) params)

    _
    type))

(defn ^:private as-otype [tname]
  (case tname
    "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"
    ;; else
    tname
    ))

(defn ^:private as-otype+ [type]
  "(-> Type Type)"
  (|case type
    (&/$HostT name params)
    (&/$HostT (as-otype name) params)

    _
    type))

(defn ^:private clean-gtype-var [idx gtype-var]
  (|let [(&/$VarT id) gtype-var]
    (|do [? (&type/bound? id)]
      (if ?
        (|do [real-type (&type/deref id)]
          (return (&/T [idx real-type])))
        (return (&/T [(+ 2 idx) (&/$BoundT idx)]))))))

(defn ^:private clean-gtype-vars [gtype-vars]
  (|do [[_ clean-types] (&/fold% (fn [idx+types gtype-var]
                                   (|do [:let [[idx types] idx+types]
                                         [idx* real-type] (clean-gtype-var idx gtype-var)]
                                     (return (&/T [idx* (&/$Cons real-type types)]))))
                                 (&/T [1 &/$Nil])
                                 gtype-vars)]
    (return clean-types)))

(defn ^:private make-gtype [class-name type-args]
  "(-> Text (List Type) Type)"
  (&/fold (fn [base-type type-arg]
            (|case type-arg
              (&/$BoundT _)
              (&/$UnivQ &type/empty-env base-type)
              
              _
              base-type))
          (&/$HostT class-name type-args)
          type-args))

;; [Resources]
(defn ^:private analyse-field-access-helper [obj-type gvars gtype]
  "(-> Type (List (^ java.lang.reflect.Type)) (^ java.lang.reflect.Type) (Lux Type))"
  (|case obj-type
    (&/$HostT class targs)
    (if (= (&/|length targs) (&/|length gvars))
      (|let [gtype-env (&/fold2 (fn [m ^TypeVariable g t] (&/$Cons (&/T [(.getName g) t]) m))
                                (&/|table)
                                gvars
                                targs)]
        (&host-type/instance-param &type/existential gtype-env gtype))
      (&/fail-with-loc (str "[Type Error] Mismatched number of type-parameters: " (&/|length gvars) " - " (&type/show-type obj-type))))

    _
    (&/fail-with-loc (str "[Type Error] Type is not an object type: " (&type/show-type obj-type)))))

(defn generic-class->simple-class [gclass]
  "(-> GenericClass Text)"
  (|case gclass
    (&/$GenericTypeVar var-name)
    "java.lang.Object"

    (&/$GenericWildcard _)
    "java.lang.Object"
    
    (&/$GenericClass name params)
    name

    (&/$GenericArray param)
    (|case param
      (&/$GenericArray _)
      (str "[" (generic-class->simple-class param))

      (&/$GenericClass "boolean" _)
      "[Z"
      
      (&/$GenericClass "byte" _)
      "[B"
      
      (&/$GenericClass "short" _)
      "[S"
      
      (&/$GenericClass "int" _)
      "[I"
      
      (&/$GenericClass "long" _)
      "[J"
      
      (&/$GenericClass "float" _)
      "[F"
      
      (&/$GenericClass "double" _)
      "[D"
      
      (&/$GenericClass "char" _)
      "[C"

      (&/$GenericClass name params)
      (str "[L" name ";")

      (&/$GenericTypeVar var-name)
      "[Ljava.lang.Object;"

      (&/$GenericWildcard _)
      "[Ljava.lang.Object;")
    ))

(defn generic-class->type [env gclass]
  "(-> (List (, TypeVar Type)) GenericClass (Lux Type))"
  (|case gclass
    (&/$GenericTypeVar var-name)
    (if-let [ex (&/|get var-name env)]
      (return ex)
      (&/fail-with-loc (str "[Analysis Error] Unknown type var: " var-name)))
    
    (&/$GenericClass name params)
    (case name
      "boolean" (return (&/$HostT "java.lang.Boolean" &/$Nil))
      "byte"    (return (&/$HostT "java.lang.Byte" &/$Nil))
      "short"   (return (&/$HostT "java.lang.Short" &/$Nil))
      "int"     (return (&/$HostT "java.lang.Integer" &/$Nil))
      "long"    (return (&/$HostT "java.lang.Long" &/$Nil))
      "float"   (return (&/$HostT "java.lang.Float" &/$Nil))
      "double"  (return (&/$HostT "java.lang.Double" &/$Nil))
      "char"    (return (&/$HostT "java.lang.Character" &/$Nil))
      "void"    (return &/$UnitT)
      ;; else
      (|do [=params (&/map% (partial generic-class->type env) params)]
        (return (&/$HostT name =params))))

    (&/$GenericArray param)
    (|do [=param (generic-class->type env param)]
      (return (&/$HostT &host-type/array-data-tag (&/|list =param))))

    (&/$GenericWildcard _)
    (return (&/$ExQ &/$Nil (&/$BoundT 1)))
    ))

(defn gen-super-env [class-env supers class-decl]
  "(-> (List (, TypeVar Type)) (List SuperClassDecl) ClassDecl (Lux (List (, Text Type))))"
  (|let [[class-name class-vars] class-decl]
    (|case (&/|some (fn [super]
                      (|let [[super-name super-params] super]
                        (if (= class-name super-name)
                          (&/$Some (&/zip2 (&/|map &/|first class-vars) super-params))
                          &/$None)))
                    supers)
      (&/$None)
      (&/fail-with-loc (str "[Analyser Error] Unrecognized super-class: " class-name))

      (&/$Some vars+gtypes)
      (&/map% (fn [var+gtype]
                (|do [:let [[var gtype] var+gtype]
                      =gtype (generic-class->type class-env gtype)]
                  (return (&/T [var =gtype]))))
              vars+gtypes)
      )))

(defn ^:private make-type-env [type-params]
  "(-> (List TypeParam) (Lux (List [Text Type])))"
  (&/map% (fn [gvar]
            (|do [:let [[gvar-name _] gvar]
                  ex &type/existential]
              (return (&/T [gvar-name ex]))))
          type-params))

(defn ^:private double-register-gclass? [gclass]
  (|case gclass
    (&/$GenericClass name _)
    (|case name
      "long"   true
      "double" true
      _        false)

    _
    false))

(defn ^:private method-input-folder [full-env]
  (fn [body* input*]
    (|do [:let [[iname itype*] input*]
          itype (generic-class->type full-env itype*)]
      (if (double-register-gclass? itype*)
        (&&env/with-local iname itype
          (&&env/with-local "" &/$VoidT
            body*))
        (&&env/with-local iname itype
          body*)))))

(defn ^:private analyse-method [analyse class-decl class-env all-supers method]
  "(-> Analyser ClassDecl (List (, TypeVar Type)) (List SuperClassDecl) MethodSyntax (Lux MethodAnalysis))"
  (|let [[?cname ?cparams] class-decl
         class-type (&/$HostT ?cname (&/|map &/|second class-env))]
    (|case method
      (&/$ConstructorMethodSyntax =privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body)
      (|do [method-env (make-type-env ?gvars)
            :let [full-env (&/|++ class-env method-env)]
            :let [output-type &/$UnitT]
            =ctor-args (&/map% (fn [ctor-arg]
                                 (|do [:let [[ca-type ca-term] ctor-arg]
                                       =ca-type (generic-class->type full-env ca-type)
                                       =ca-term (&&/analyse-1 analyse =ca-type ca-term)]
                                   (return (&/T [ca-type =ca-term]))))
                               ?ctor-args)
            =body (&/with-type-env full-env
                    (&&env/with-local &&/jvm-this class-type
                      (&/with-no-catches
                        (with-catches (&/|map &host-generics/gclass->class-name ?exceptions)
                          (&/fold (method-input-folder full-env)
                                  (&&/analyse-1 analyse output-type ?body)
                                  (&/|reverse ?inputs))))))]
        (return (&/$ConstructorMethodAnalysis (&/T [=privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs =ctor-args =body]))))
      
      (&/$VirtualMethodSyntax ?name =privacy-modifier =final? ?strict ?anns ?gvars ?exceptions ?inputs ?output ?body)
      (|do [method-env (make-type-env ?gvars)
            :let [full-env (&/|++ class-env method-env)]
            output-type (generic-class->type full-env ?output)
            =body (&/with-type-env full-env
                    (&&env/with-local &&/jvm-this class-type
                      (&/with-no-catches
                        (with-catches (&/|map &host-generics/gclass->class-name ?exceptions)
                          (&/fold (method-input-folder full-env)
                                  (&&/analyse-1 analyse output-type ?body)
                                  (&/|reverse ?inputs))))))]
        (return (&/$VirtualMethodAnalysis (&/T [?name =privacy-modifier =final? ?strict ?anns ?gvars ?exceptions ?inputs ?output =body]))))
      
      (&/$OverridenMethodSyntax ?class-decl ?name ?strict ?anns ?gvars ?exceptions ?inputs ?output ?body)
      (|do [super-env (gen-super-env class-env all-supers ?class-decl)
            method-env (make-type-env ?gvars)
            :let [full-env (&/|++ super-env method-env)]
            output-type (generic-class->type full-env ?output)
            =body (&/with-type-env full-env
                    (&&env/with-local &&/jvm-this class-type
                      (&/with-no-catches
                        (with-catches (&/|map &host-generics/gclass->class-name ?exceptions)
                          (&/fold (method-input-folder full-env)
                                  (&&/analyse-1 analyse output-type ?body)
                                  (&/|reverse ?inputs))))))]
        (return (&/$OverridenMethodAnalysis (&/T [?class-decl ?name ?strict ?anns ?gvars ?exceptions ?inputs ?output =body]))))

      (&/$StaticMethodSyntax ?name =privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?output ?body)
      (|do [method-env (make-type-env ?gvars)
            :let [full-env method-env]
            output-type (generic-class->type full-env ?output)
            =body (&/with-type-env full-env
                    (&/with-no-catches
                      (with-catches (&/|map &host-generics/gclass->class-name ?exceptions)
                        (&/fold (method-input-folder full-env)
                                (&&/analyse-1 analyse output-type ?body)
                                (&/|reverse ?inputs)))))]
        (return (&/$StaticMethodAnalysis (&/T [?name =privacy-modifier ?strict ?anns ?gvars ?exceptions ?inputs ?output =body]))))

      (&/$AbstractMethodSyntax ?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output)
      (return (&/$AbstractMethodAnalysis (&/T [?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output])))

      (&/$NativeMethodSyntax ?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output)
      (return (&/$NativeMethodAnalysis (&/T [?name =privacy-modifier ?anns ?gvars ?exceptions ?inputs ?output])))
      )))

(defn ^:private mandatory-methods [supers]
  (|do [class-loader &/loader]
    (&/flat-map% (partial &host/abstract-methods class-loader) supers)))

(defn ^:private check-method-completion [supers methods]
  "(-> (List SuperClassDecl) (List (, MethodDecl Analysis)) (Lux Null))"
  (|do [abstract-methods (mandatory-methods supers)
        :let [methods-map (&/fold (fn [mmap mentry]
                                    (|case mentry
                                      (&/$ConstructorMethodAnalysis _)
                                      mmap
                                      
                                      (&/$VirtualMethodAnalysis _)
                                      mmap
                                      
                                      (&/$OverridenMethodAnalysis =class-decl =name ?strict =anns =gvars =exceptions =inputs =output body)
                                      (update-in mmap [=name] (fn [old-inputs] (if old-inputs (conj old-inputs =inputs) [=inputs])))

                                      (&/$StaticMethodAnalysis _)
                                      mmap

                                      (&/$AbstractMethodSyntax _)
                                      mmap

                                      (&/$NativeMethodSyntax _)
                                      mmap
                                      ))
                                  {}
                                  methods)
              missing-method (&/fold (fn [missing abs-meth]
                                       (or missing
                                           (|let [[am-name am-inputs] abs-meth]
                                             (if-let [meth-struct (get methods-map am-name)]
                                               (if (some (fn [=inputs]
                                                           (and (= (&/|length =inputs) (&/|length am-inputs))
                                                                (&/fold2 (fn [prev mi ai]
                                                                           (|let [[iname itype] mi]
                                                                             (and prev (= (generic-class->simple-class itype) ai))))
                                                                         true
                                                                         =inputs am-inputs)))
                                                         meth-struct)
                                                 nil
                                                 abs-meth)
                                               abs-meth))))
                                     nil
                                     abstract-methods)]]
    (if (nil? missing-method)
      (return nil)
      (|let [[am-name am-inputs] missing-method]
        (&/fail-with-loc (str "[Analyser Error] Missing method: " am-name " " "(" (->> am-inputs (&/|interpose " ") (&/fold str "")) ")"))))))

(defn ^:private analyse-field [analyse gtype-env field]
  "(-> Analyser GTypeEnv FieldSyntax (Lux FieldAnalysis))"
  (|case field
    (&/$ConstantFieldSyntax ?name ?anns ?gclass ?value)
    (|do [=gtype (&host-type/instance-gtype &type/existential gtype-env ?gclass)
          =value (&&/analyse-1 analyse =gtype ?value)]
      (return (&/$ConstantFieldAnalysis ?name ?anns ?gclass =value)))
    
    (&/$VariableFieldSyntax ?name ?privacy-modifier ?state-modifier ?anns ?type)
    (return (&/$VariableFieldAnalysis ?name ?privacy-modifier ?state-modifier ?anns ?type))
    ))

(do-template [<name> <proc> <from-class> <to-class>]
  (let [output-type (&/$HostT <to-class> &/$Nil)]
    (defn <name> [analyse exo-type _?value]
      (|do [:let [(&/$Cons ?value (&/$Nil)) _?value]
            =value (&&/analyse-1 analyse (&/$HostT <from-class> &/$Nil) ?value)
            _ (&type/check exo-type output-type)
            _cursor &/cursor]
        (return (&/|list (&&/|meta output-type _cursor (&&/$proc (&/T ["jvm" <proc>]) (&/|list =value) (&/|list))))))))

  ^:private analyse-jvm-d2f "d2f" "java.lang.Double"    "java.lang.Float"
  ^:private analyse-jvm-d2i "d2i" "java.lang.Double"    "java.lang.Integer"
  ^:private analyse-jvm-d2l "d2l" "java.lang.Double"    "java.lang.Long"

  ^:private analyse-jvm-f2d "f2d" "java.lang.Float"     "java.lang.Double"
  ^:private analyse-jvm-f2i "f2i" "java.lang.Float"     "java.lang.Integer"
  ^:private analyse-jvm-f2l "f2l" "java.lang.Float"     "java.lang.Long"

  ^:private analyse-jvm-i2b "i2b" "java.lang.Integer"   "java.lang.Byte"
  ^:private analyse-jvm-i2c "i2c" "java.lang.Integer"   "java.lang.Character"
  ^:private analyse-jvm-i2d "i2d" "java.lang.Integer"   "java.lang.Double"
  ^:private analyse-jvm-i2f "i2f" "java.lang.Integer"   "java.lang.Float"
  ^:private analyse-jvm-i2l "i2l" "java.lang.Integer"   "java.lang.Long"
  ^:private analyse-jvm-i2s "i2s" "java.lang.Integer"   "java.lang.Short"

  ^:private analyse-jvm-l2d "l2d" "java.lang.Long"      "java.lang.Double"
  ^:private analyse-jvm-l2f "l2f" "java.lang.Long"      "java.lang.Float"
  ^:private analyse-jvm-l2i "l2i" "java.lang.Long"      "java.lang.Integer"
  ^:private analyse-jvm-l2s "l2s" "java.lang.Long"      "java.lang.Short"
  ^:private analyse-jvm-l2b "l2b" "java.lang.Long"      "java.lang.Byte"

  ^:private analyse-jvm-c2b "c2b" "java.lang.Character" "java.lang.Byte"
  ^:private analyse-jvm-c2s "c2s" "java.lang.Character" "java.lang.Short"
  ^:private analyse-jvm-c2i "c2i" "java.lang.Character" "java.lang.Integer"
  ^:private analyse-jvm-c2l "c2l" "java.lang.Character" "java.lang.Long"

  ^:private analyse-jvm-s2l "s2l" "java.lang.Short"     "java.lang.Long"

  ^:private analyse-jvm-b2l "b2l" "java.lang.Byte"      "java.lang.Long"
  )

(do-template [<name> <proc> <v1-class> <v2-class> <to-class>]
  (let [output-type (&/$HostT <to-class> &/$Nil)]
    (defn <name> [analyse exo-type ?values]
      (|do [:let [(&/$Cons ?value1 (&/$Cons ?value2 (&/$Nil))) ?values]
            =value1 (&&/analyse-1 analyse (&/$HostT <v1-class> &/$Nil) ?value1)
            =value2 (&&/analyse-1 analyse (&/$HostT <v2-class> &/$Nil) ?value2)
            _ (&type/check exo-type output-type)
            _cursor &/cursor]
        (return (&/|list (&&/|meta output-type _cursor (&&/$proc (&/T ["jvm" <proc>]) (&/|list =value1 =value2) (&/|list))))))))

  ^:private analyse-jvm-iand  "iand"  "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
  ^:private analyse-jvm-ior   "ior"   "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
  ^:private analyse-jvm-ixor  "ixor"  "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
  ^:private analyse-jvm-ishl  "ishl"  "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
  ^:private analyse-jvm-ishr  "ishr"  "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"
  ^:private analyse-jvm-iushr "iushr" "java.lang.Integer" "java.lang.Integer" "java.lang.Integer"

  ^:private analyse-jvm-land  "land"  "java.lang.Long"    "java.lang.Long"    "java.lang.Long"
  ^:private analyse-jvm-lor   "lor"   "java.lang.Long"    "java.lang.Long"    "java.lang.Long"
  ^:private analyse-jvm-lxor  "lxor"  "java.lang.Long"    "java.lang.Long"    "java.lang.Long"
  ^:private analyse-jvm-lshl  "lshl"  "java.lang.Long"    "java.lang.Integer" "java.lang.Long"
  ^:private analyse-jvm-lshr  "lshr"  "java.lang.Long"    "java.lang.Integer" "java.lang.Long"
  ^:private analyse-jvm-lushr "lushr" "java.lang.Long"    "java.lang.Integer" "java.lang.Long"
  )

(do-template [<name> <proc> <input-class> <output-class>]
  (let [input-type (&/$HostT <input-class> &/$Nil)
        output-type (&/$HostT <output-class> &/$Nil)]
    (defn <name> [analyse exo-type ?values]
      (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values]
            =x (&&/analyse-1 analyse input-type x)
            =y (&&/analyse-1 analyse input-type y)
            _ (&type/check exo-type output-type)
            _cursor &/cursor]
        (return (&/|list (&&/|meta output-type _cursor
                                   (&&/$proc (&/T ["jvm" <proc>]) (&/|list =x =y) (&/|list))))))))

  ^:private analyse-jvm-iadd "iadd" "java.lang.Integer" "java.lang.Integer"
  ^:private analyse-jvm-isub "isub" "java.lang.Integer" "java.lang.Integer"
  ^:private analyse-jvm-imul "imul" "java.lang.Integer" "java.lang.Integer"
  ^:private analyse-jvm-idiv "idiv" "java.lang.Integer" "java.lang.Integer"
  ^:private analyse-jvm-irem "irem" "java.lang.Integer" "java.lang.Integer"
  ^:private analyse-jvm-ieq  "ieq"  "java.lang.Integer" "java.lang.Boolean"
  ^:private analyse-jvm-ilt  "ilt"  "java.lang.Integer" "java.lang.Boolean"
  ^:private analyse-jvm-igt  "igt"  "java.lang.Integer" "java.lang.Boolean"

  ^:private analyse-jvm-ceq  "ceq"  "java.lang.Character" "java.lang.Boolean"
  ^:private analyse-jvm-clt  "clt"  "java.lang.Character" "java.lang.Boolean"
  ^:private analyse-jvm-cgt  "cgt"  "java.lang.Character" "java.lang.Boolean"

  ^:private analyse-jvm-ladd "ladd" "java.lang.Long"    "java.lang.Long"
  ^:private analyse-jvm-lsub "lsub" "java.lang.Long"    "java.lang.Long"
  ^:private analyse-jvm-lmul "lmul" "java.lang.Long"    "java.lang.Long"
  ^:private analyse-jvm-ldiv "ldiv" "java.lang.Long"    "java.lang.Long"
  ^:private analyse-jvm-lrem "lrem" "java.lang.Long"    "java.lang.Long"
  ^:private analyse-jvm-leq  "leq"  "java.lang.Long"    "java.lang.Boolean"
  ^:private analyse-jvm-llt  "llt"  "java.lang.Long"    "java.lang.Boolean"
  ^:private analyse-jvm-lgt  "lgt"  "java.lang.Long"    "java.lang.Boolean"

  ^:private analyse-jvm-fadd "fadd" "java.lang.Float"   "java.lang.Float"
  ^:private analyse-jvm-fsub "fsub" "java.lang.Float"   "java.lang.Float"
  ^:private analyse-jvm-fmul "fmul" "java.lang.Float"   "java.lang.Float"
  ^:private analyse-jvm-fdiv "fdiv" "java.lang.Float"   "java.lang.Float"
  ^:private analyse-jvm-frem "frem" "java.lang.Float"   "java.lang.Float"
  ^:private analyse-jvm-feq  "feq"  "java.lang.Float"   "java.lang.Boolean"
  ^:private analyse-jvm-flt  "flt"  "java.lang.Float"   "java.lang.Boolean"
  ^:private analyse-jvm-fgt  "fgt"  "java.lang.Float"   "java.lang.Boolean"

  ^:private analyse-jvm-dadd "dadd" "java.lang.Double"  "java.lang.Double"
  ^:private analyse-jvm-dsub "dsub" "java.lang.Double"  "java.lang.Double"
  ^:private analyse-jvm-dmul "dmul" "java.lang.Double"  "java.lang.Double"
  ^:private analyse-jvm-ddiv "ddiv" "java.lang.Double"  "java.lang.Double"
  ^:private analyse-jvm-drem "drem" "java.lang.Double"  "java.lang.Double"
  ^:private analyse-jvm-deq  "deq"  "java.lang.Double"  "java.lang.Boolean"
  ^:private analyse-jvm-dlt  "dlt"  "java.lang.Double"  "java.lang.Boolean"
  ^:private analyse-jvm-dgt  "dgt"  "java.lang.Double"  "java.lang.Boolean"
  )

(let [length-type &type/Nat
      idx-type &type/Nat]
  (do-template [<elem-class> <array-class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>]
    (let [elem-type (&/$HostT <elem-class> &/$Nil)
          array-type (&/$HostT <array-class> &/$Nil)]
      (defn <new-name> [analyse exo-type ?values]
        (|do [:let [(&/$Cons length (&/$Nil)) ?values]
              =length (&&/analyse-1 analyse length-type length)
              _ (&type/check exo-type array-type)
              _cursor &/cursor]
          (return (&/|list (&&/|meta exo-type _cursor
                                     (&&/$proc (&/T ["jvm" <new-tag>]) (&/|list =length) (&/|list)))))))

      (defn <load-name> [analyse exo-type ?values]
        (|do [:let [(&/$Cons array (&/$Cons idx (&/$Nil))) ?values]
              =array (&&/analyse-1 analyse array-type array)
              =idx (&&/analyse-1 analyse idx-type idx)
              _ (&type/check exo-type elem-type)
              _cursor &/cursor]
          (return (&/|list (&&/|meta exo-type _cursor
                                     (&&/$proc (&/T ["jvm" <load-tag>]) (&/|list =array =idx) (&/|list)))))))

      (defn <store-name> [analyse exo-type ?values]
        (|do [:let [(&/$Cons array (&/$Cons idx (&/$Cons elem (&/$Nil)))) ?values]
              =array (&&/analyse-1 analyse array-type array)
              =idx (&&/analyse-1 analyse idx-type idx)
              =elem (&&/analyse-1 analyse elem-type elem)
              _ (&type/check exo-type array-type)
              _cursor &/cursor]
          (return (&/|list (&&/|meta exo-type _cursor
                                     (&&/$proc (&/T ["jvm" <store-tag>]) (&/|list =array =idx =elem) (&/|list)))))))
      )

    "java.lang.Boolean"   "[Z" ^:private analyse-jvm-znewarray "znewarray" analyse-jvm-zaload "zaload" analyse-jvm-zastore "zastore"
    "java.lang.Byte"      "[B" ^:private analyse-jvm-bnewarray "bnewarray" analyse-jvm-baload "baload" analyse-jvm-bastore "bastore"
    "java.lang.Short"     "[S" ^:private analyse-jvm-snewarray "snewarray" analyse-jvm-saload "saload" analyse-jvm-sastore "sastore"
    "java.lang.Integer"   "[I" ^:private analyse-jvm-inewarray "inewarray" analyse-jvm-iaload "iaload" analyse-jvm-iastore "iastore"
    "java.lang.Long"      "[J" ^:private analyse-jvm-lnewarray "lnewarray" analyse-jvm-laload "laload" analyse-jvm-lastore "lastore"
    "java.lang.Float"     "[F" ^:private analyse-jvm-fnewarray "fnewarray" analyse-jvm-faload "faload" analyse-jvm-fastore "fastore"
    "java.lang.Double"    "[D" ^:private analyse-jvm-dnewarray "dnewarray" analyse-jvm-daload "daload" analyse-jvm-dastore "dastore"
    "java.lang.Character" "[C" ^:private analyse-jvm-cnewarray "cnewarray" analyse-jvm-caload "caload" analyse-jvm-castore "castore"
    ))

(defn ^:private array-class? [class-name]
  (or (= &host-type/array-data-tag class-name)
      (case class-name
        ("[Z" "[B" "[S" "[I" "[J" "[F" "[D" "[C") true
        ;; else
        false)))

(let [length-type &type/Nat
      idx-type &type/Nat]
  (defn ^:private analyse-jvm-anewarray [analyse exo-type ?values]
    (|do [:let [(&/$Cons [_ (&/$TextS _gclass)] (&/$Cons length (&/$Nil))) ?values]
          gclass (&reader/with-source "jvm-anewarray" _gclass
                   &&a-parser/parse-gclass)
          gtype-env &/get-type-env
          =gclass (&host-type/instance-gtype &type/existential gtype-env gclass)
          :let [array-type (&/$HostT &host-type/array-data-tag (&/|list =gclass))]
          =length (&&/analyse-1 analyse length-type length)
          _ (&type/check exo-type array-type)
          _cursor &/cursor]
      (return (&/|list (&&/|meta exo-type _cursor
                                 (&&/$proc (&/T ["jvm" "anewarray"]) (&/|list =length) (&/|list gclass gtype-env)))))))

  (defn ^:private analyse-jvm-aaload [analyse exo-type ?values]
    (|do [:let [(&/$Cons array (&/$Cons idx (&/$Nil))) ?values]
          =array (&&/analyse-1+ analyse array)
          [arr-class arr-params] (ensure-object (&&/expr-type* =array))
          _ (&/assert! (= &host-type/array-data-tag arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class))
          :let [(&/$Cons inner-arr-type (&/$Nil)) arr-params]
          =idx (&&/analyse-1 analyse idx-type idx)
          _ (&type/check exo-type inner-arr-type)
          _cursor &/cursor]
      (return (&/|list (&&/|meta exo-type _cursor
                                 (&&/$proc (&/T ["jvm" "aaload"]) (&/|list =array =idx) (&/|list)))))))

  (defn ^:private analyse-jvm-aastore [analyse exo-type ?values]
    (|do [:let [(&/$Cons array (&/$Cons idx (&/$Cons elem (&/$Nil)))) ?values]
          =array (&&/analyse-1+ analyse array)
          :let [array-type (&&/expr-type* =array)]
          [arr-class arr-params] (ensure-object array-type)
          _ (&/assert! (= &host-type/array-data-tag arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class))
          :let [(&/$Cons inner-arr-type (&/$Nil)) arr-params]
          =idx (&&/analyse-1 analyse idx-type idx)
          =elem (&&/analyse-1 analyse inner-arr-type elem)
          _ (&type/check exo-type array-type)
          _cursor &/cursor]
      (return (&/|list (&&/|meta exo-type _cursor
                                 (&&/$proc (&/T ["jvm" "aastore"]) (&/|list =array =idx =elem) (&/|list))))))))

(defn ^:private analyse-jvm-arraylength [analyse exo-type ?values]
  (|do [:let [(&/$Cons array (&/$Nil)) ?values]
        =array (&&/analyse-1+ analyse array)
        [arr-class arr-params] (ensure-object (&&/expr-type* =array))
        _ (&/assert! (array-class? arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class))
        _ (&type/check exo-type &type/Nat)
        _cursor &/cursor]
    (return (&/|list (&&/|meta exo-type _cursor
                               (&&/$proc (&/T ["jvm" "arraylength"]) (&/|list =array) (&/|list))
                               )))))

(defn ^:private analyse-jvm-null? [analyse exo-type ?values]
  (|do [:let [(&/$Cons object (&/$Nil)) ?values]
        =object (&&/analyse-1+ analyse object)
        _ (ensure-object (&&/expr-type* =object))
        :let [output-type &type/Bool]
        _ (&type/check exo-type output-type)
        _cursor &/cursor]
    (return (&/|list (&&/|meta exo-type _cursor
                               (&&/$proc (&/T ["jvm" "null?"]) (&/|list =object) (&/|list)))))))

(defn ^:private analyse-jvm-null [analyse exo-type ?values]
  (|do [:let [(&/$Nil) ?values]
        :let [output-type (&/$HostT &host-type/null-data-tag &/$Nil)]
        _ (&type/check exo-type output-type)
        _cursor &/cursor]
    (return (&/|list (&&/|meta exo-type _cursor
                               (&&/$proc (&/T ["jvm" "null"]) (&/|list) (&/|list)))))))

(defn analyse-jvm-synchronized [analyse exo-type ?values]
  (|do [:let [(&/$Cons ?monitor (&/$Cons ?expr (&/$Nil))) ?values]
        =monitor (&&/analyse-1+ analyse ?monitor)
        _ (ensure-object (&&/expr-type* =monitor))
        =expr (&&/analyse-1 analyse exo-type ?expr)
        _cursor &/cursor]
    (return (&/|list (&&/|meta exo-type _cursor
                               (&&/$proc (&/T ["jvm" "synchronized"]) (&/|list =monitor =expr) (&/|list)))))))

(defn ^:private analyse-jvm-throw [analyse exo-type ?values]
  (|do [:let [(&/$Cons ?ex (&/$Nil)) ?values]
        =ex (&&/analyse-1+ analyse ?ex)
        _ (&type/check (&/$HostT "java.lang.Throwable" &/$Nil) (&&/expr-type* =ex))
        [throw-class throw-params] (ensure-object (&&/expr-type* =ex))
        _ (ensure-catching (&/|list throw-class))
        _cursor &/cursor
        _ (&type/check exo-type &type/Bottom)]
    (return (&/|list (&&/|meta exo-type _cursor
                               (&&/$proc (&/T ["jvm" "throw"]) (&/|list =ex) (&/|list)))))))

(defn ^:private analyse-jvm-getstatic [analyse exo-type class field ?values]
  (|do [!class! (&/de-alias-class class)
        :let [(&/$Nil) ?values]
        class-loader &/loader
        [gvars gtype] (&host/lookup-static-field class-loader !class! field)
        =type (&host-type/instance-param &type/existential &/$Nil gtype)
        :let [output-type =type]
        _ (&type/check exo-type output-type)
        _cursor &/cursor]
    (return (&/|list (&&/|meta exo-type _cursor
                               (&&/$proc (&/T ["jvm" "getstatic"]) (&/|list) (&/|list class field output-type)))))))

(defn ^:private analyse-jvm-getfield [analyse exo-type class field ?values]
  (|do [!class! (&/de-alias-class class)
        :let [(&/$Cons object (&/$Nil)) ?values]
        class-loader &/loader
        =object (&&/analyse-1+ analyse object)
        _ (ensure-object (&&/expr-type* =object))
        [gvars gtype] (&host/lookup-field class-loader !class! field)
        =type (analyse-field-access-helper (&&/expr-type* =object) gvars gtype)
        :let [output-type =type]
        _ (&type/check exo-type output-type)
        _cursor &/cursor]
    (return (&/|list (&&/|meta exo-type _cursor
                               (&&/$proc (&/T ["jvm" "getfield"]) (&/|list =object) (&/|list class field output-type)))))))

(defn ^:private analyse-jvm-putstatic [analyse exo-type class field ?values]
  (|do [!class! (&/de-alias-class class)
        :let [(&/$Cons value (&/$Nil)) ?values]
        class-loader &/loader
        [gvars gtype] (&host/lookup-static-field class-loader !class! field)
        :let [gclass (&host-type/gtype->gclass gtype)]
        =type (&host-type/instance-param &type/existential &/$Nil gtype)
        =value (&&/analyse-1 analyse =type value)
        :let [output-type &/$UnitT]
        _ (&type/check exo-type output-type)
        _cursor &/cursor]
    (return (&/|list (&&/|meta exo-type _cursor
                               (&&/$proc (&/T ["jvm" "putstatic"]) (&/|list =value) (&/|list class field gclass)))))))

(defn ^:private analyse-jvm-putfield [analyse exo-type class field ?values]
  (|do [!class! (&/de-alias-class class)
        :let [(&/$Cons object (&/$Cons value (&/$Nil))) ?values]
        class-loader &/loader
        =object (&&/analyse-1+ analyse object)
        :let [obj-type (&&/expr-type* =object)]
        _ (ensure-object obj-type)
        [gvars gtype] (&host/lookup-field class-loader !class! field)
        :let [gclass (&host-type/gtype->gclass gtype)]
        =type (analyse-field-access-helper obj-type gvars gtype)
        =value (&&/analyse-1 analyse =type value)
        :let [output-type &/$UnitT]
        _ (&type/check exo-type output-type)
        _cursor &/cursor]
    (return (&/|list (&&/|meta exo-type _cursor
                               (&&/$proc (&/T ["jvm" "putfield"]) (&/|list =object =value) (&/|list class field gclass =type)))))))

(defn ^:private analyse-method-call-helper [analyse exo-type gret gtype-env gtype-vars gtype-args args]
  (|case gtype-vars
    (&/$Nil)
    (|do [arg-types (&/map% (partial &host-type/instance-param &type/existential gtype-env) gtype-args)
          =arg-types (&/map% &type/show-type+ arg-types)
          =args (&/map2% (partial &&/analyse-1 analyse) arg-types args)
          =gret (&host-type/instance-param &type/existential gtype-env gret)
          _ (&type/check exo-type (as-otype+ =gret))]
      (return (&/T [=gret =args])))
    
    (&/$Cons ^TypeVariable gtv gtype-vars*)
    (&type/with-var
      (fn [$var]
        (|do [:let [(&/$VarT _id) $var
                    gtype-env* (&/$Cons (&/T [(.getName gtv) $var]) gtype-env)]
              [=gret =args] (analyse-method-call-helper analyse exo-type gret gtype-env* gtype-vars* gtype-args args)
              ==gret (&type/clean $var =gret)
              ==args (&/map% (partial &&/clean-analysis $var) =args)]
          (return (&/T [==gret ==args])))))
    ))

(let [dummy-type-param (&/$HostT "java.lang.Object" &/$Nil)]
  (do-template [<name> <tag> <only-interface?>]
    (defn <name> [analyse exo-type class method classes ?values]
      (|do [!class! (&/de-alias-class class)
            :let [(&/$Cons object args) ?values]
            class-loader &/loader
            _ (try (assert! (let [=class (Class/forName !class! true class-loader)]
                              (= <only-interface?> (.isInterface =class)))
                            (if <only-interface?>
                              (str "[Analyser Error] Can only invoke method \"" method "\"" " on interface.")
                              (str "[Analyser Error] Can only invoke method \"" method "\"" " on class.")))
                (catch Exception e
                  (&/fail-with-loc (str "[Analyser Error] Unknown class: " class))))
            [gret exceptions parent-gvars gvars gargs] (if (= "<init>" method)
                                                         (return (&/T [Void/TYPE &/$Nil &/$Nil &/$Nil &/$Nil]))
                                                         (&host/lookup-virtual-method class-loader !class! method classes))
            _ (ensure-catching exceptions)
            =object (&&/analyse-1+ analyse object)
            [sub-class sub-params] (ensure-object (&&/expr-type* =object))
            (&/$HostT super-class* super-params*) (&host-type/->super-type &type/existential class-loader !class! (if (= sub-class class)
                                                                                                                    !class!
                                                                                                                    sub-class)
                                                                           sub-params)
            :let [gtype-env (&/fold2 (fn [m ^TypeVariable g t] (&/$Cons (&/T [(.getName g) t]) m))
                                     (&/|table)
                                     parent-gvars
                                     super-params*)]
            [output-type =args] (analyse-method-call-helper analyse exo-type gret gtype-env gvars gargs args)
            _cursor &/cursor]
        (return (&/|list (&&/|meta exo-type _cursor
                                   (&&/$proc (&/T ["jvm" <tag>]) (&/$Cons =object =args) (&/|list class method classes output-type gret)))))))

    ^:private analyse-jvm-invokevirtual   "invokevirtual"   false
    ^:private analyse-jvm-invokespecial   "invokespecial"   false
    ^:private analyse-jvm-invokeinterface "invokeinterface" true
    ))

(defn ^:private analyse-jvm-invokestatic [analyse exo-type class method classes ?values]
  (|do [!class! (&/de-alias-class class)
        :let [args ?values]
        class-loader &/loader
        [gret exceptions parent-gvars gvars gargs] (&host/lookup-static-method class-loader !class! method classes)
        _ (ensure-catching exceptions)
        :let [gtype-env (&/|table)]
        [output-type =args] (analyse-method-call-helper analyse exo-type gret gtype-env gvars gargs args)
        _cursor &/cursor]
    (return (&/|list (&&/|meta exo-type _cursor
                               (&&/$proc (&/T ["jvm" "invokestatic"]) =args (&/|list class method classes output-type gret)))))))

(defn ^:private analyse-jvm-new-helper [analyse gtype gtype-env gtype-vars gtype-args args]
  (|case gtype-vars
    (&/$Nil)
    (|do [arg-types (&/map% (partial &host-type/instance-param &type/existential gtype-env) gtype-args)
          =args (&/map2% (partial &&/analyse-1 analyse) arg-types args)
          gtype-vars* (->> gtype-env (&/|map &/|second) (clean-gtype-vars))]
      (return (&/T [(make-gtype gtype gtype-vars*)
                    =args])))
    
    (&/$Cons ^TypeVariable gtv gtype-vars*)
    (&type/with-var
      (fn [$var]
        (|do [:let [gtype-env* (&/$Cons (&/T [(.getName gtv) $var]) gtype-env)]
              [=gret =args] (analyse-jvm-new-helper analyse gtype gtype-env* gtype-vars* gtype-args args)
              ==gret (&type/clean $var =gret)
              ==args (&/map% (partial &&/clean-analysis $var) =args)]
          (return (&/T [==gret ==args])))))
    ))

(defn ^:private analyse-jvm-new [analyse exo-type class classes ?values]
  (|do [!class! (&/de-alias-class class)
        :let [args ?values]
        class-loader &/loader
        [exceptions gvars gargs] (&host/lookup-constructor class-loader !class! classes)
        _ (ensure-catching exceptions)
        [output-type =args] (analyse-jvm-new-helper analyse class (&/|table) gvars gargs args)
        _ (&type/check exo-type output-type)
        _cursor &/cursor]
    (return (&/|list (&&/|meta exo-type _cursor
                               (&&/$proc (&/T ["jvm" "new"]) =args (&/|list class classes)))))))

(defn ^:private analyse-jvm-try [analyse exo-type ?values]
  (|do [:let [(&/$Cons ?body (&/$Cons ?catch (&/$Nil))) ?values]
        =body (with-catches (&/|list "java.lang.Exception")
                (&&/analyse-1 analyse exo-type ?body))
        =catch (&&/analyse-1 analyse (&/$LambdaT (&/$HostT "java.lang.Exception" &/$Nil) exo-type) ?catch)
        _cursor &/cursor]
    (return (&/|list (&&/|meta exo-type _cursor
                               (&&/$proc (&/T ["jvm" "try"]) (&/|list =body =catch) (&/|list)))))))

(defn ^:private analyse-jvm-instanceof [analyse exo-type class ?values]
  (|do [:let [(&/$Cons object (&/$Nil)) ?values]
        =object (&&/analyse-1+ analyse object)
        _ (ensure-object (&&/expr-type* =object))
        :let [output-type &type/Bool]
        _ (&type/check exo-type output-type)
        _cursor &/cursor]
    (return (&/|list (&&/|meta output-type _cursor
                               (&&/$proc (&/T ["jvm" "instanceof"]) (&/|list =object) (&/|list class)))))))

(defn ^:private analyse-jvm-load-class [analyse exo-type ?values]
  (|do [:let [(&/$Cons [_ (&/$TextS _class-name)] (&/$Nil)) ?values]
        ^ClassLoader class-loader &/loader
        _ (try (do (.loadClass class-loader _class-name)
                 (return nil))
            (catch Exception e
              (&/fail-with-loc (str "[Analyser Error] Unknown class: " _class-name))))
        :let [output-type (&/$HostT "java.lang.Class" (&/|list (&/$HostT _class-name (&/|list))))]
        _ (&type/check exo-type output-type)
        _cursor &/cursor]
    (return (&/|list (&&/|meta output-type _cursor
                               (&&/$proc (&/T ["jvm" "load-class"]) (&/|list) (&/|list _class-name output-type)))))))

(let [length-type &type/Nat
      idx-type &type/Nat]
  (defn ^:private analyse-array-new [analyse exo-type ?values]
    (|do [:let [(&/$Cons length (&/$Nil)) ?values]
          :let [gclass (&/$GenericClass "java.lang.Object" (&/|list))
                array-type (&/$UnivQ (&/|list) (&/$HostT &host-type/array-data-tag (&/|list (&/$BoundT 1))))]
          gtype-env &/get-type-env
          =length (&&/analyse-1 analyse length-type length)
          _ (&type/check exo-type array-type)
          _cursor &/cursor]
      (return (&/|list (&&/|meta exo-type _cursor
                                 (&&/$proc (&/T ["jvm" "anewarray"]) (&/|list =length) (&/|list gclass gtype-env)))))))

  (defn ^:private analyse-array-get [analyse exo-type ?values]
    (|do [:let [(&/$Cons array (&/$Cons idx (&/$Nil))) ?values]
          =array (&&/analyse-1+ analyse array)
          [arr-class arr-params] (ensure-object (&&/expr-type* =array))
          _ (&/assert! (= &host-type/array-data-tag arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class))
          :let [(&/$Cons inner-arr-type (&/$Nil)) arr-params]
          =idx (&&/analyse-1 analyse idx-type idx)
          _ (&type/check exo-type (&/$AppT &type/Maybe inner-arr-type))
          _cursor &/cursor]
      (return (&/|list (&&/|meta exo-type _cursor
                                 (&&/$proc (&/T ["array" "get"]) (&/|list =array =idx) (&/|list)))))))

  (defn ^:private analyse-array-remove [analyse exo-type ?values]
    (|do [:let [(&/$Cons array (&/$Cons idx (&/$Nil))) ?values]
          =array (&&/analyse-1+ analyse array)
          :let [array-type (&&/expr-type* =array)]
          [arr-class arr-params] (ensure-object array-type)
          _ (&/assert! (= &host-type/array-data-tag arr-class) (str "[Analyser Error] Expected array. Instead got: " arr-class))
          :let [(&/$Cons inner-arr-type (&/$Nil)) arr-params]
          =idx (&&/analyse-1 analyse idx-type idx)
          _cursor &/cursor
          :let [=elem (&&/|meta inner-arr-type _cursor
                                (&&/$proc (&/T ["jvm" "null"]) (&/|list) (&/|list)))]
          _ (&type/check exo-type array-type)]
      (return (&/|list (&&/|meta exo-type _cursor
                                 (&&/$proc (&/T ["jvm" "aastore"]) (&/|list =array =idx =elem) (&/|list))))))))

(defn ^:private analyse-jvm-interface [analyse compile-interface interface-decl supers =anns =methods]
  (|do [module &/get-module-name
        _ (compile-interface interface-decl supers =anns =methods)
        :let [_ (println 'INTERFACE (str module "." (&/|first interface-decl)))]
        _cursor &/cursor]
    (return (&/|list (&&/|meta &/$UnitT _cursor
                               (&&/$tuple (&/|list)))))))

(defn ^:private analyse-jvm-class [analyse compile-class class-decl super-class interfaces =inheritance-modifier =anns ?fields methods]
  (&/with-closure
    (|do [module &/get-module-name
          :let [[?name ?params] class-decl
                full-name (str (string/replace module "/" ".") "." ?name)
                class-decl* (&/T [full-name ?params])
                all-supers (&/$Cons super-class interfaces)]
          class-env (make-type-env ?params)
          =fields (&/map% (partial analyse-field analyse class-env) ?fields)
          _ (&host/use-dummy-class class-decl super-class interfaces &/$None =fields methods)
          =methods (&/map% (partial analyse-method analyse class-decl* class-env all-supers) methods)
          _ (check-method-completion all-supers =methods)
          _ (compile-class class-decl super-class interfaces =inheritance-modifier =anns =fields =methods &/$Nil &/$None)
          _ &/pop-dummy-name
          :let [_ (println 'CLASS full-name)]
          _cursor &/cursor]
      (return (&/|list (&&/|meta &/$UnitT _cursor
                                 (&&/$tuple (&/|list))))))))

(defn ^:private captured-source [env-entry]
  (|case env-entry
    [name [_ (&&/$captured _ _ source)]]
    source))

(let [default-<init> (&/$ConstructorMethodSyntax (&/T [&/$PublicPM
                                                       false
                                                       &/$Nil
                                                       &/$Nil
                                                       &/$Nil
                                                       &/$Nil
                                                       &/$Nil
                                                       (&/$TupleS &/$Nil)]))
      captured-slot-class "java.lang.Object"
      captured-slot-type (&/$GenericClass captured-slot-class &/$Nil)]
  (defn ^:private analyse-jvm-anon-class [analyse compile-class exo-type super-class interfaces ctor-args methods]
    (&/with-closure
      (|do [module &/get-module-name
            scope &/get-scope-name
            :let [name (->> scope &/|reverse &/|tail &host/location)
                  class-decl (&/T [name &/$Nil])
                  anon-class (str (string/replace module "/" ".") "." name)
                  anon-class-type (&/$HostT anon-class &/$Nil)]
            =ctor-args (&/map% (fn [ctor-arg]
                                 (|let [[arg-type arg-term] ctor-arg]
                                   (|do [=arg-term (&&/analyse-1+ analyse arg-term)]
                                     (return (&/T [arg-type =arg-term])))))
                               ctor-args)
            _ (->> methods
                   (&/$Cons default-<init>)
                   (&host/use-dummy-class class-decl super-class interfaces (&/$Some =ctor-args) &/$Nil))
            :let [all-supers (&/$Cons super-class interfaces)
                  class-env &/$Nil]
            =methods (&/map% (partial analyse-method analyse class-decl class-env all-supers) methods)
            _ (check-method-completion all-supers =methods)
            =captured &&env/captured-vars
            :let [=fields (&/|map (fn [^objects idx+capt]
                                    (|let [[idx _] idx+capt]
                                      (&/$VariableFieldAnalysis (str &c!base/closure-prefix idx)
                                                                &/$PublicPM
                                                                &/$FinalSM
                                                                &/$Nil
                                                                captured-slot-type)))
                                  (&/enumerate =captured))]
            :let [sources (&/|map captured-source =captured)]
            _ (compile-class class-decl super-class interfaces &/$DefaultIM &/$Nil =fields =methods =captured (&/$Some =ctor-args))
            _ &/pop-dummy-name
            _cursor &/cursor]
        (return (&/|list (&&/|meta anon-class-type _cursor
                                   (&&/$proc (&/T ["jvm" "new"]) sources (&/|list anon-class (&/|repeat (&/|length sources) captured-slot-class)))
                                   )))
        ))))

(do-template [<name> <op>]
  (defn <name> [analyse exo-type ?values]
    (|do [:let [(&/$Cons input (&/$Cons mask (&/$Nil))) ?values]
          =mask (&&/analyse-1 analyse &type/Nat mask)
          =input (&&/analyse-1 analyse &type/Nat input)
          _ (&type/check exo-type &type/Nat)
          _cursor &/cursor]
      (return (&/|list (&&/|meta exo-type _cursor
                                 (&&/$proc (&/T ["bit" <op>]) (&/|list =input =mask) (&/|list)))))))

  ^:private analyse-bit-and "and"
  ^:private analyse-bit-or  "or"
  ^:private analyse-bit-xor "xor"
  )

(defn ^:private analyse-bit-count [analyse exo-type ?values]
  (|do [:let [(&/$Cons input (&/$Nil)) ?values]
        =input (&&/analyse-1 analyse &type/Nat input)
        _ (&type/check exo-type &type/Nat)
        _cursor &/cursor]
    (return (&/|list (&&/|meta exo-type _cursor
                               (&&/$proc (&/T ["bit" "count"]) (&/|list =input) (&/|list)))))))

(do-template [<name> <op> <type>]
  (defn <name> [analyse exo-type ?values]
    (|do [:let [(&/$Cons input (&/$Cons shift (&/$Nil))) ?values]
          =shift (&&/analyse-1 analyse &type/Nat shift)
          =input (&&/analyse-1 analyse <type> input)
          _ (&type/check exo-type <type>)
          _cursor &/cursor]
      (return (&/|list (&&/|meta exo-type _cursor
                                 (&&/$proc (&/T ["bit" <op>]) (&/|list =input =shift) (&/|list)))))))

  ^:private analyse-bit-shift-left           "shift-left"           &type/Nat
  ^:private analyse-bit-shift-right          "shift-right"          &type/Int
  ^:private analyse-bit-unsigned-shift-right "unsigned-shift-right" &type/Nat
  )

(defn ^:private analyse-lux-== [analyse exo-type ?values]
  (&type/with-var
    (fn [$var]
      (|do [:let [(&/$Cons left (&/$Cons right (&/$Nil))) ?values]
            =left (&&/analyse-1 analyse $var left)
            =right (&&/analyse-1 analyse $var right)
            _ (&type/check exo-type &type/Bool)
            _cursor &/cursor]
        (return (&/|list (&&/|meta exo-type _cursor
                                   (&&/$proc (&/T ["lux" "=="]) (&/|list =left =right) (&/|list)))))))))

(do-template [<name> <proc> <input-type> <output-type>]
  (defn <name> [analyse exo-type ?values]
    (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values]
          =x (&&/analyse-1 analyse <input-type> x)
          =y (&&/analyse-1 analyse <input-type> y)
          _ (&type/check exo-type <output-type>)
          _cursor &/cursor]
      (return (&/|list (&&/|meta <output-type> _cursor
                                 (&&/$proc (&/T <proc>) (&/|list =x =y) (&/|list)))))))

  ^:private analyse-nat-add  ["nat" "+"]  &type/Nat  &type/Nat
  ^:private analyse-nat-sub  ["nat" "-"]  &type/Nat  &type/Nat
  ^:private analyse-nat-mul  ["nat" "*"]  &type/Nat  &type/Nat
  ^:private analyse-nat-div  ["nat" "/"]  &type/Nat  &type/Nat
  ^:private analyse-nat-rem  ["nat" "%"]  &type/Nat  &type/Nat
  ^:private analyse-nat-eq   ["nat" "="]  &type/Nat  &type/Bool
  ^:private analyse-nat-lt   ["nat" "<"]  &type/Nat  &type/Bool

  ^:private analyse-deg-add ["deg" "+"] &type/Deg &type/Deg
  ^:private analyse-deg-sub ["deg" "-"] &type/Deg &type/Deg
  ^:private analyse-deg-mul ["deg" "*"] &type/Deg &type/Deg
  ^:private analyse-deg-div ["deg" "/"] &type/Deg &type/Deg
  ^:private analyse-deg-rem ["deg" "%"] &type/Deg &type/Deg
  ^:private analyse-deg-eq  ["deg" "="] &type/Deg &type/Bool
  ^:private analyse-deg-lt  ["deg" "<"] &type/Deg &type/Bool
  )

(defn ^:private analyse-deg-scale [analyse exo-type ?values]
  (|do [:let [(&/$Cons x (&/$Cons y (&/$Nil))) ?values]
        =x (&&/analyse-1 analyse &type/Deg x)
        =y (&&/analyse-1 analyse &type/Nat y)
        _ (&type/check exo-type &type/Deg)
        _cursor &/cursor]
    (return (&/|list (&&/|meta &type/Deg _cursor
                               (&&/$proc (&/T ["deg" "scale"]) (&/|list =x =y) (&/|list)))))))

(do-template [<encode> <encode-op> <decode> <decode-op> <type>]
  (do (defn <encode> [analyse exo-type ?values]
        (|do [:let [(&/$Cons x (&/$Nil)) ?values]
              =x (&&/analyse-1 analyse <type> x)
              _ (&type/check exo-type &type/Text)
              _cursor &/cursor]
          (return (&/|list (&&/|meta &type/Text _cursor
                                     (&&/$proc (&/T <encode-op>) (&/|list =x) (&/|list)))))))

    (let [decode-type (&/$AppT &type/Maybe <type>)]
      (defn <decode> [analyse exo-type ?values]
        (|do [:let [(&/$Cons x (&/$Nil)) ?values]
              =x (&&/analyse-1 analyse &type/Text x)
              _ (&type/check exo-type decode-type)
              _cursor &/cursor]
          (return (&/|list (&&/|meta decode-type _cursor
                                     (&&/$proc (&/T <decode-op>) (&/|list =x) (&/|list)))))))))

  ^:private analyse-nat-encode  ["nat"  "encode"] ^:private analyse-nat-decode  ["nat"  "decode"] &type/Nat
  ^:private analyse-deg-encode ["deg" "encode"] ^:private analyse-deg-decode ["deg" "decode"] &type/Deg
  )

(do-template [<name> <type> <op>]
  (defn <name> [analyse exo-type ?values]
    (|do [:let [(&/$Nil) ?values]
          _ (&type/check exo-type <type>)
          _cursor &/cursor]
      (return (&/|list (&&/|meta <type> _cursor
                                 (&&/$proc (&/T <op>) (&/|list) (&/|list)))))))

  ^:private analyse-nat-min-value  &type/Nat  ["nat"  "min-value"]
  ^:private analyse-nat-max-value  &type/Nat  ["nat"  "max-value"]

  ^:private analyse-deg-min-value &type/Deg ["deg" "min-value"]
  ^:private analyse-deg-max-value &type/Deg ["deg" "max-value"]
  )

(do-template [<name> <from-type> <to-type> <op>]
  (defn <name> [analyse exo-type ?values]
    (|do [:let [(&/$Cons x (&/$Nil)) ?values]
          =x (&&/analyse-1 analyse <from-type> x)
          _ (&type/check exo-type <to-type>)
          _cursor &/cursor]
      (return (&/|list (&&/|meta <to-type> _cursor
                                 (&&/$proc (&/T <op>) (&/|list =x) (&/|list)))))))

  ^:private analyse-nat-to-int   &type/Nat  &type/Int  ["nat" "to-int"]
  ^:private analyse-nat-to-char  &type/Nat  &type/Char ["nat" "to-char"]
  ^:private analyse-int-to-nat   &type/Int  &type/Nat  ["int" "to-nat"]
  ^:private analyse-char-to-nat  &type/Char &type/Nat  ["char" "to-nat"]

  ^:private analyse-deg-to-real &type/Deg &type/Real ["deg" "to-real"]
  ^:private analyse-real-to-deg &type/Real &type/Deg ["real" "to-deg"]
  )

(defn analyse-host [analyse exo-type compilers category proc ?values]
  (|let [[_ _ compile-class compile-interface] compilers]
    (case category
      "lux"
      (case proc
        "=="                   (analyse-lux-== analyse exo-type ?values))

      "bit"
      (case proc
        "count"                (analyse-bit-count analyse exo-type ?values)
        "and"                  (analyse-bit-and analyse exo-type ?values)
        "or"                   (analyse-bit-or analyse exo-type ?values)
        "xor"                  (analyse-bit-xor analyse exo-type ?values)
        "shift-left"           (analyse-bit-shift-left analyse exo-type ?values)
        "shift-right"          (analyse-bit-shift-right analyse exo-type ?values)
        "unsigned-shift-right" (analyse-bit-unsigned-shift-right analyse exo-type ?values))
      
      "array"
      (case proc
        "new"    (analyse-array-new analyse exo-type ?values)
        "get"    (analyse-array-get analyse exo-type ?values)
        "put"    (analyse-jvm-aastore analyse exo-type ?values)
        "remove" (analyse-array-remove analyse exo-type ?values)
        "size"   (analyse-jvm-arraylength analyse exo-type ?values))

      "nat"
      (case proc
        "+" (analyse-nat-add analyse exo-type ?values)
        "-" (analyse-nat-sub analyse exo-type ?values)
        "*" (analyse-nat-mul analyse exo-type ?values)
        "/" (analyse-nat-div analyse exo-type ?values)
        "%" (analyse-nat-rem analyse exo-type ?values)
        "=" (analyse-nat-eq analyse exo-type ?values)
        "<" (analyse-nat-lt analyse exo-type ?values)
        "encode" (analyse-nat-encode analyse exo-type ?values)
        "decode" (analyse-nat-decode analyse exo-type ?values)
        "min-value" (analyse-nat-min-value analyse exo-type ?values)
        "max-value" (analyse-nat-max-value analyse exo-type ?values)
        "to-int" (analyse-nat-to-int analyse exo-type ?values)
        "to-char" (analyse-nat-to-char analyse exo-type ?values)
        )

      "deg"
      (case proc
        "+" (analyse-deg-add analyse exo-type ?values)
        "-" (analyse-deg-sub analyse exo-type ?values)
        "*" (analyse-deg-mul analyse exo-type ?values)
        "/" (analyse-deg-div analyse exo-type ?values)
        "%" (analyse-deg-rem analyse exo-type ?values)
        "=" (analyse-deg-eq analyse exo-type ?values)
        "<" (analyse-deg-lt analyse exo-type ?values)
        "encode" (analyse-deg-encode analyse exo-type ?values)
        "decode" (analyse-deg-decode analyse exo-type ?values)
        "min-value" (analyse-deg-min-value analyse exo-type ?values)
        "max-value" (analyse-deg-max-value analyse exo-type ?values)
        "to-real" (analyse-deg-to-real analyse exo-type ?values)
        "scale" (analyse-deg-scale analyse exo-type ?values)
        )

      "int"
      (case proc
        "to-nat" (analyse-int-to-nat analyse exo-type ?values)
        )

      "real"
      (case proc
        "to-deg" (analyse-real-to-deg analyse exo-type ?values)
        )

      "char"
      (case proc
        "to-nat" (analyse-char-to-nat analyse exo-type ?values)
        )
      
      "jvm"
      (case proc
        "synchronized" (analyse-jvm-synchronized analyse exo-type ?values)
        "load-class"   (analyse-jvm-load-class analyse exo-type ?values)
        "try"          (analyse-jvm-try analyse exo-type ?values)
        "throw"        (analyse-jvm-throw analyse exo-type ?values)
        "null?"        (analyse-jvm-null? analyse exo-type ?values)
        "null"         (analyse-jvm-null analyse exo-type ?values)
        "anewarray"    (analyse-jvm-anewarray analyse exo-type ?values)
        "aaload"       (analyse-jvm-aaload analyse exo-type ?values)
        "aastore"      (analyse-jvm-aastore analyse exo-type ?values)
        "arraylength"  (analyse-jvm-arraylength analyse exo-type ?values)
        "znewarray"    (analyse-jvm-znewarray analyse exo-type ?values)
        "bnewarray"    (analyse-jvm-bnewarray analyse exo-type ?values)
        "snewarray"    (analyse-jvm-snewarray analyse exo-type ?values)
        "inewarray"    (analyse-jvm-inewarray analyse exo-type ?values)
        "lnewarray"    (analyse-jvm-lnewarray analyse exo-type ?values)
        "fnewarray"    (analyse-jvm-fnewarray analyse exo-type ?values)
        "dnewarray"    (analyse-jvm-dnewarray analyse exo-type ?values)
        "cnewarray"    (analyse-jvm-cnewarray analyse exo-type ?values)
        "iadd"         (analyse-jvm-iadd analyse exo-type ?values)
        "isub"         (analyse-jvm-isub analyse exo-type ?values)
        "imul"         (analyse-jvm-imul analyse exo-type ?values)
        "idiv"         (analyse-jvm-idiv analyse exo-type ?values)
        "irem"         (analyse-jvm-irem analyse exo-type ?values)
        "ieq"          (analyse-jvm-ieq analyse exo-type ?values)
        "ilt"          (analyse-jvm-ilt analyse exo-type ?values)
        "igt"          (analyse-jvm-igt analyse exo-type ?values)
        "ceq"          (analyse-jvm-ceq analyse exo-type ?values)
        "clt"          (analyse-jvm-clt analyse exo-type ?values)
        "cgt"          (analyse-jvm-cgt analyse exo-type ?values)
        "ladd"         (analyse-jvm-ladd analyse exo-type ?values)
        "lsub"         (analyse-jvm-lsub analyse exo-type ?values)
        "lmul"         (analyse-jvm-lmul analyse exo-type ?values)
        "ldiv"         (analyse-jvm-ldiv analyse exo-type ?values)
        "lrem"         (analyse-jvm-lrem analyse exo-type ?values)
        "leq"          (analyse-jvm-leq analyse exo-type ?values)
        "llt"          (analyse-jvm-llt analyse exo-type ?values)
        "lgt"          (analyse-jvm-lgt analyse exo-type ?values)
        "fadd"         (analyse-jvm-fadd analyse exo-type ?values)
        "fsub"         (analyse-jvm-fsub analyse exo-type ?values)
        "fmul"         (analyse-jvm-fmul analyse exo-type ?values)
        "fdiv"         (analyse-jvm-fdiv analyse exo-type ?values)
        "frem"         (analyse-jvm-frem analyse exo-type ?values)
        "feq"          (analyse-jvm-feq analyse exo-type ?values)
        "flt"          (analyse-jvm-flt analyse exo-type ?values)
        "fgt"          (analyse-jvm-fgt analyse exo-type ?values)
        "dadd"         (analyse-jvm-dadd analyse exo-type ?values)
        "dsub"         (analyse-jvm-dsub analyse exo-type ?values)
        "dmul"         (analyse-jvm-dmul analyse exo-type ?values)
        "ddiv"         (analyse-jvm-ddiv analyse exo-type ?values)
        "drem"         (analyse-jvm-drem analyse exo-type ?values)
        "deq"          (analyse-jvm-deq analyse exo-type ?values)
        "dlt"          (analyse-jvm-dlt analyse exo-type ?values)
        "dgt"          (analyse-jvm-dgt analyse exo-type ?values)
        "iand"         (analyse-jvm-iand analyse exo-type ?values)
        "ior"          (analyse-jvm-ior analyse exo-type ?values)
        "ixor"         (analyse-jvm-ixor analyse exo-type ?values)
        "ishl"         (analyse-jvm-ishl analyse exo-type ?values)
        "ishr"         (analyse-jvm-ishr analyse exo-type ?values)
        "iushr"        (analyse-jvm-iushr analyse exo-type ?values)
        "land"         (analyse-jvm-land analyse exo-type ?values)
        "lor"          (analyse-jvm-lor analyse exo-type ?values)
        "lxor"         (analyse-jvm-lxor analyse exo-type ?values)
        "lshl"         (analyse-jvm-lshl analyse exo-type ?values)
        "lshr"         (analyse-jvm-lshr analyse exo-type ?values)
        "lushr"        (analyse-jvm-lushr analyse exo-type ?values)
        "d2f"          (analyse-jvm-d2f analyse exo-type ?values)
        "d2i"          (analyse-jvm-d2i analyse exo-type ?values)
        "d2l"          (analyse-jvm-d2l analyse exo-type ?values)
        "f2d"          (analyse-jvm-f2d analyse exo-type ?values)
        "f2i"          (analyse-jvm-f2i analyse exo-type ?values)
        "f2l"          (analyse-jvm-f2l analyse exo-type ?values)
        "i2b"          (analyse-jvm-i2b analyse exo-type ?values)
        "i2c"          (analyse-jvm-i2c analyse exo-type ?values)
        "i2d"          (analyse-jvm-i2d analyse exo-type ?values)
        "i2f"          (analyse-jvm-i2f analyse exo-type ?values)
        "i2l"          (analyse-jvm-i2l analyse exo-type ?values)
        "i2s"          (analyse-jvm-i2s analyse exo-type ?values)
        "l2d"          (analyse-jvm-l2d analyse exo-type ?values)
        "l2f"          (analyse-jvm-l2f analyse exo-type ?values)
        "l2i"          (analyse-jvm-l2i analyse exo-type ?values)
        "l2s"          (analyse-jvm-l2s analyse exo-type ?values)
        "l2b"          (analyse-jvm-l2b analyse exo-type ?values)
        "c2b"          (analyse-jvm-c2b analyse exo-type ?values)
        "c2s"          (analyse-jvm-c2s analyse exo-type ?values)
        "c2i"          (analyse-jvm-c2i analyse exo-type ?values)
        "c2l"          (analyse-jvm-c2l analyse exo-type ?values)
        "b2l"          (analyse-jvm-b2l analyse exo-type ?values)
        "s2l"          (analyse-jvm-s2l analyse exo-type ?values)
        ;; else
        (->> (&/fail-with-loc (str "[Analyser Error] Unknown host procedure: " [category proc]))
             (if-let [[_ _def-code] (re-find #"^interface:(.*)$" proc)]
               (|do [[_module _line _column] &/cursor]
                 (&reader/with-source (str "interface@" "(" _module "," _line "," _column ")") _def-code
                   (|do [[=gclass-decl =supers =anns =methods] &&a-parser/parse-interface-def]
                     (analyse-jvm-interface analyse compile-interface =gclass-decl =supers =anns =methods)))))
             
             (if-let [[_ _def-code] (re-find #"^class:(.*)$" proc)]
               (|do [[_module _line _column] &/cursor]
                 (&reader/with-source (str "class@" "(" _module "," _line "," _column ")") _def-code
                   (|do [[=gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods] &&a-parser/parse-class-def]
                     (analyse-jvm-class analyse compile-class =gclass-decl =super-class =interfaces =inheritance-modifier =anns =fields =methods)))))
             
             (if-let [[_ _def-code] (re-find #"^anon-class:(.*)$" proc)]
               (|do [[_module _line _column] &/cursor]
                 (&reader/with-source (str "anon-class@" "(" _module "," _line "," _column ")") _def-code
                   (|do [[=super-class =interfaces =ctor-args =methods] &&a-parser/parse-anon-class-def]
                     (analyse-jvm-anon-class analyse compile-class exo-type =super-class =interfaces =ctor-args =methods)))))
             
             (if-let [[_ _class] (re-find #"^instanceof:([^:]+)$" proc)]
               (analyse-jvm-instanceof analyse exo-type _class ?values))
             
             (if-let [[_ _class _arg-classes] (re-find #"^new:([^:]+):([^:]*)$" proc)]
               (analyse-jvm-new analyse exo-type _class (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
             
             (if-let [[_ _class _method _arg-classes] (re-find #"^invokestatic:([^:]+):([^:]+):([^:]*)$" proc)]
               (analyse-jvm-invokestatic analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
             
             (if-let [[_ _class _method _arg-classes] (re-find #"^invokeinterface:([^:]+):([^:]+):([^:]*)$" proc)]
               (analyse-jvm-invokeinterface analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
             
             (if-let [[_ _class _method _arg-classes] (re-find #"^invokevirtual:([^:]+):([^:]+):([^:]*)$" proc)]
               (analyse-jvm-invokevirtual analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
             
             (if-let [[_ _class _method _arg-classes] (re-find #"^invokespecial:([^:]+):([^:]+):([^:]*)$" proc)]
               (analyse-jvm-invokespecial analyse exo-type _class _method (if (= "" _arg-classes) (&/|list) (&/->list (string/split _arg-classes #","))) ?values))
             
             (if-let [[_ _class _field] (re-find #"^getstatic:([^:]+):([^:]+)$" proc)]
               (analyse-jvm-getstatic analyse exo-type _class _field ?values))
             
             (if-let [[_ _class _field] (re-find #"^getfield:([^:]+):([^:]+)$" proc)]
               (analyse-jvm-getfield analyse exo-type _class _field ?values))
             
             (if-let [[_ _class _field] (re-find #"^putstatic:([^:]+):([^:]+)$" proc)]
               (analyse-jvm-putstatic analyse exo-type _class _field ?values))
             
             (if-let [[_ _class _field] (re-find #"^putfield:([^:]+):([^:]+)$" proc)]
               (analyse-jvm-putfield analyse exo-type _class _field ?values))))

      ;; else
      (&/fail-with-loc (str "[Analyser Error] Unknown host procedure: " [category proc])))))