Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
(ns defwrapper
(:require [clojure.string :as str]))
(set! *warn-on-reflection* true)
(defn class-methods [^Class class]
(seq (.getMethods class)))
(defn constructors [^Class klazz]
(.getDeclaredConstructors klazz))
(defn return-type [^java.lang.reflect.Method method]
(.getReturnType method))
(defn parameter-types [^java.lang.reflect.Method method]
(seq (.getParameterTypes method)))
(defn parameter-count [^java.lang.reflect.Method method]
(.getParameterCount method))
(defn method-name [^java.lang.reflect.Method method]
(.getName method))
(defn class-name [^Class klazz]
(symbol (.getName klazz)))
(defn camel->kebab
(-> string
(clojure.string/replace #"(.)([A-Z][a-z]+)" "$1-$2")
(clojure.string/replace #"([a-z0-9])([A-Z])" "$1-$2")
(defn class->name [^Class class]
(if (.isArray class)
(str (.getName (.getComponentType class)) "-array")
(.getName class))
(str/replace "." "-")))
(defn method-static? [^java.lang.reflect.Method method]
(java.lang.reflect.Modifier/isStatic (.getModifiers method)))
(defn method-public? [^java.lang.reflect.Method method]
(java.lang.reflect.Modifier/isPublic (.getModifiers method)))
(defn primitive-class [sym]
('{byte java.lang.Byte/TYPE
short java.lang.Short/TYPE
int java.lang.Integer/TYPE
long java.lang.Long/TYPE
float java.lang.Float/TYPE
double java.lang.Double/TYPE
char java.lang.Character/TYPE
boolean java.lang.Boolean/TYPE} sym sym))
(defn array-class [klz]
(class (into-array klz [])))
(defn ensure-boxed [t]
(get '{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
boolean java.lang.Boolean
void java.lang.Object}
t t))
(defn ensure-boxed-long-double
"Allow long and double, box everything else."
(let [t (if (instance? Class c)
(class-name c)
(get '{byte java.lang.Byte
short java.lang.Short
int java.lang.Integer
float java.lang.Float
char java.lang.Character
boolean java.lang.Boolean
void java.lang.Object}
t t)))
(defn tagged [value tag]
(let [tag (if (and (instance? Class tag) (.isArray ^Class tag))
`(array-class ~(primitive-class (class-name (.getComponentType ^Class tag))))
(vary-meta value assoc :tag (ensure-boxed-long-double tag))))
(defn tagged-local [value tag]
(let [tag (ensure-boxed-long-double tag)]
(= 'long tag)
`(long ~value)
(= 'double tag)
`(double ~value)
(vary-meta value assoc :tag tag))))
(defn wrapper-multi-tail [klazz methods]
(let [static? (method-static? (first methods))
this (gensym "this")
arg-vec (take (parameter-count (first methods)) (repeatedly gensym))
ret (if (apply = (map return-type methods))
(return-type (first methods))
`(~(tagged `[~@(when-not static? [this]) ~@arg-vec] ret)
(fn [method]
`[(and ~@(map (fn [sym ^Class klz]
`(instance? ~(ensure-boxed (class-name klz)) ~sym))
(parameter-types method)))
(let [~@(mapcat (fn [sym ^Class klz]
[sym (tagged-local sym klz)])
(parameter-types method))]
(~(if static?
(symbol (str klazz) (method-name method))
(symbol (str "." (method-name method))))
~@(when-not static? [(tagged this klazz)])
(defn wrapper-tail [klazz method]
(let [nam (method-name method)
ret (return-type method)
par (parameter-types method)
static? (method-static? method)
arg-vec (into (if static? [] [(tagged (gensym "this") klazz)])
(map #(tagged (gensym (class->name %)) %))
`(~(tagged arg-vec ret)
(~(if static?
(symbol (str klazz) nam)
(symbol (str "." nam))) ~@(map #(vary-meta % dissoc :tag) arg-vec)))))
(defn method-wrapper-form [fname klazz methods]
(let [arities (group-by parameter-count methods)]
`(defn ~fname
{:arglists '~(map (comp (partial into [klazz])
parameter-types) methods)}
~@(map (fn [[cnt meths]]
(if (= 1 (count meths))
(wrapper-tail klazz (first meths))
(wrapper-multi-tail klazz meths)))
(defmacro defwrapper [klazz & [prefix]]
(let [methods (->> klazz
(filter method-public?)
(remove (set (class-methods Object)))
(group-by method-name))]
~@(for [[mname meths] methods
:let [fname (symbol (str prefix (camel->kebab mname)))]]
(method-wrapper-form fname klazz meths)))))
#_(binding [*print-meta* true]
(prn (macroexpand-1 '(defwrapper javax.sound.midi.MidiSystem "midi-sys-"))))
(defwrapper javax.sound.midi.MidiSystem "midi-sys-")
(defwrapper javax.sound.midi.Synthesizer "synth-")
(defwrapper javax.sound.midi.MidiChannel "chan-")
;;; Play some tunes
(def synth (midi-sys-get-synthesizer))
(synth-open synth)
(def chan (first (synth-get-channels synth)))
(meta #'synth-get-channels)
(chan-note-on chan 60 600)
(chan-note-on chan 64 600)
(chan-note-on chan 67 600)
(Thread/sleep 1100)
(chan-note-on chan 60 600)
(chan-note-on chan 64 600)
(chan-note-on chan 67 600)
(chan-note-on chan 71 600)))
;; TODO:
;; - better varargs
;; - test if (long ... ) actually works
;; - prevent unnecessary boxing
;; - constructors

This comment has been minimized.

Copy link

@admay admay commented Aug 26, 2019

Has any more work on this been done? I'm having trouble when trying to wrap classes based on number operations (java.lang.Integer, for instance). I was wondering if you or anyone else has put some time into it or can help out


This comment has been minimized.

Copy link
Owner Author

@plexus plexus commented Aug 27, 2019

@admay would you mind posting your question here: not much has happened since this was posted, but I'm open to improving it and I'm curious what issues you're seeing exactly.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment