9e216da9ef
After go1.16, go will use module mode by default, even when the repository is checked out under GOPATH or in a one-off directory. Add go.mod, go.sum to keep this repo buildable without opting out of the module mode. > go mod init github.com/mmcgrana/gobyexample > go mod tidy > go mod vendor In module mode, the 'vendor' directory is special and its contents will be actively maintained by the go command. pygments aren't the dependency the go will know about, so it will delete the contents from vendor directory. Move it to `third_party` directory now. And, vendor the blackfriday package. Note: the tutorial contents are not affected by the change in go1.16 because all the examples in this tutorial ask users to run the go command with the explicit list of files to be compiled (e.g. `go run hello-world.go` or `go build command-line-arguments.go`). When the source list is provided, the go command does not have to compute the build list and whether it's running in GOPATH mode or module mode becomes irrelevant.
511 lines
21 KiB
Clojure
511 lines
21 KiB
Clojure
; Copyright (c) Rich Hickey. All rights reserved.
|
|
; The use and distribution terms for this software are covered by the
|
|
; Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
|
|
; which can be found in the file CPL.TXT at the root of this distribution.
|
|
; By using this software in any fashion, you are agreeing to be bound by
|
|
; the terms of this license.
|
|
; You must not remove this notice, or any other, from this software.
|
|
|
|
(in-ns 'clojure)
|
|
|
|
(import '(java.lang.reflect Modifier Constructor)
|
|
'(clojure.asm ClassWriter ClassVisitor Opcodes Type)
|
|
'(clojure.asm.commons Method GeneratorAdapter)
|
|
'(clojure.lang IPersistentMap))
|
|
|
|
;(defn method-sig [#^java.lang.reflect.Method meth]
|
|
; [(. meth (getName)) (seq (. meth (getParameterTypes)))])
|
|
|
|
(defn- non-private-methods [#^Class c]
|
|
(loop [mm {}
|
|
considered #{}
|
|
c c]
|
|
(if c
|
|
(let [[mm considered]
|
|
(loop [mm mm
|
|
considered considered
|
|
meths (concat
|
|
(seq (. c (getDeclaredMethods)))
|
|
(seq (. c (getMethods))))]
|
|
(if meths
|
|
(let [#^Method meth (first meths)
|
|
mods (. meth (getModifiers))
|
|
mk (method-sig meth)]
|
|
(if (or (considered mk)
|
|
(. Modifier (isPrivate mods))
|
|
(. Modifier (isStatic mods))
|
|
(. Modifier (isFinal mods)))
|
|
(recur mm (conj considered mk) (rest meths))
|
|
(recur (assoc mm mk meth) (conj considered mk) (rest meths))))
|
|
[mm considered]))]
|
|
(recur mm considered (. c (getSuperclass))))
|
|
mm)))
|
|
|
|
(defn- ctor-sigs [super]
|
|
(for [#^Constructor ctor (. super (getDeclaredConstructors))
|
|
:when (not (. Modifier (isPrivate (. ctor (getModifiers)))))]
|
|
(apply vector (. ctor (getParameterTypes)))))
|
|
|
|
(defn- escape-class-name [c]
|
|
(.. (.getSimpleName c)
|
|
(replace "[]" "<>")))
|
|
|
|
(defn- overload-name [mname pclasses]
|
|
(if (seq pclasses)
|
|
(apply str mname (interleave (repeat \-)
|
|
(map escape-class-name pclasses)))
|
|
(str mname "-void")))
|
|
|
|
;(distinct (map first(keys (mapcat non-private-methods [Object IPersistentMap]))))
|
|
|
|
(defn gen-class
|
|
"Generates compiled bytecode for a class with the given
|
|
package-qualified cname (which, as all names in these parameters, can
|
|
be a string or symbol). The gen-class construct contains no
|
|
implementation, as the implementation will be dynamically sought by
|
|
the generated class in functions in a corresponding Clojure
|
|
namespace. Given a generated class org.mydomain.MyClass, methods
|
|
will be implemented that look for same-named functions in a Clojure
|
|
namespace called org.domain.MyClass. The init and main
|
|
functions (see below) will be found similarly. The static
|
|
initializer for the generated class will attempt to load the Clojure
|
|
support code for the class as a resource from the claspath, e.g. in
|
|
the example case, org/mydomain/MyClass.clj
|
|
|
|
Returns a map containing :name and :bytecode. Most uses will be
|
|
satisfied by the higher-level gen-and-load-class and
|
|
gen-and-store-class functions, which generate and immediately load,
|
|
or generate and store to disk, respectively.
|
|
|
|
Options should be a set of key/value pairs, all of which are optional:
|
|
|
|
:extends aclass
|
|
|
|
Specifies the superclass, the non-private methods of which will be
|
|
overridden by the class. If not provided, defaults to Object.
|
|
|
|
:implements [interface ...]
|
|
|
|
One or more interfaces, the methods of which will be implemented by the class.
|
|
|
|
:init name
|
|
|
|
If supplied, names a function that will be called with the arguments
|
|
to the constructor. Must return [[superclass-constructor-args] state]
|
|
If not supplied, the constructor args are passed directly to
|
|
the superclass constructor and the state will be nil
|
|
|
|
:constructors {[param-types] [super-param-types], ...}
|
|
|
|
By default, constructors are created for the generated class which
|
|
match the signature(s) of the constructors for the superclass. This
|
|
parameter may be used to explicitly specify constructors, each entry
|
|
providing a mapping from a constructor signature to a superclass
|
|
constructor signature. When you supply this, you must supply an :init
|
|
specifier.
|
|
|
|
:methods [[name [param-types] return-type], ...]
|
|
|
|
The generated class automatically defines all of the non-private
|
|
methods of its superclasses/interfaces. This parameter can be used
|
|
to specify the signatures of additional methods of the generated
|
|
class. Do not repeat superclass/interface signatures here.
|
|
|
|
:main boolean
|
|
|
|
If supplied and true, a static public main function will be
|
|
generated. It will pass each string of the String[] argument as a
|
|
separate argument to a function called 'main.
|
|
|
|
:factory name
|
|
|
|
If supplied, a (set of) public static factory function(s) will be
|
|
created with the given name, and the same signature(s) as the
|
|
constructor(s).
|
|
|
|
:state name
|
|
|
|
If supplied, a public final instance field with the given name will be
|
|
created. You must supply an :init function in order to provide a
|
|
value for the state. Note that, though final, the state can be a ref
|
|
or agent, supporting the creation of Java objects with transactional
|
|
or asynchronous mutation semantics.
|
|
|
|
:exposes {protected-field-name {:get name :set name}, ...}
|
|
|
|
Since the implementations of the methods of the generated class
|
|
occur in Clojure functions, they have no access to the inherited
|
|
protected fields of the superclass. This parameter can be used to
|
|
generate public getter/setter methods exposing the protected field(s)
|
|
for use in the implementation."
|
|
|
|
[cname & options]
|
|
(let [name (str cname)
|
|
{:keys [extends implements constructors methods main factory state init exposes]} (apply hash-map options)
|
|
super (or extends Object)
|
|
interfaces implements
|
|
supers (cons super (seq interfaces))
|
|
ctor-sig-map (or constructors (zipmap (ctor-sigs super) (ctor-sigs super)))
|
|
cv (new ClassWriter (. ClassWriter COMPUTE_MAXS))
|
|
cname (. name (replace "." "/"))
|
|
ctype (. Type (getObjectType cname))
|
|
iname (fn [c] (.. Type (getType c) (getInternalName)))
|
|
totype (fn [c] (. Type (getType c)))
|
|
to-types (fn [cs] (if (pos? (count cs))
|
|
(into-array (map totype cs))
|
|
(make-array Type 0)))
|
|
obj-type (totype Object)
|
|
arg-types (fn [n] (if (pos? n)
|
|
(into-array (replicate n obj-type))
|
|
(make-array Type 0)))
|
|
super-type (totype super)
|
|
init-name (str init)
|
|
factory-name (str factory)
|
|
state-name (str state)
|
|
main-name "main"
|
|
var-name (fn [s] (str s "__var"))
|
|
rt-type (totype clojure.lang.RT)
|
|
var-type (totype clojure.lang.Var)
|
|
ifn-type (totype clojure.lang.IFn)
|
|
iseq-type (totype clojure.lang.ISeq)
|
|
ex-type (totype java.lang.UnsupportedOperationException)
|
|
all-sigs (distinct (concat (map #(let[[m p] (key %)] {m [p]}) (mapcat non-private-methods supers))
|
|
(map (fn [[m p]] {(str m) [p]}) methods)))
|
|
sigs-by-name (apply merge-with concat {} all-sigs)
|
|
overloads (into {} (filter (fn [[m s]] (rest s)) sigs-by-name))
|
|
var-fields (concat (and init [init-name])
|
|
(and main [main-name])
|
|
(distinct (concat (keys sigs-by-name)
|
|
(mapcat (fn [[m s]] (map #(overload-name m %) s)) overloads)
|
|
(mapcat (comp (partial map str) vals val) exposes))))
|
|
emit-get-var (fn [gen v]
|
|
(let [false-label (. gen newLabel)
|
|
end-label (. gen newLabel)]
|
|
(. gen getStatic ctype (var-name v) var-type)
|
|
(. gen dup)
|
|
(. gen invokeVirtual var-type (. Method (getMethod "boolean isBound()")))
|
|
(. gen ifZCmp (. GeneratorAdapter EQ) false-label)
|
|
(. gen invokeVirtual var-type (. Method (getMethod "Object get()")))
|
|
(. gen goTo end-label)
|
|
(. gen mark false-label)
|
|
(. gen pop)
|
|
(. gen visitInsn (. Opcodes ACONST_NULL))
|
|
(. gen mark end-label)))
|
|
emit-forwarding-method
|
|
(fn [mname pclasses rclass else-gen]
|
|
(let [ptypes (to-types pclasses)
|
|
rtype (totype rclass)
|
|
m (new Method mname rtype ptypes)
|
|
is-overload (overloads mname)
|
|
gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)
|
|
found-label (. gen (newLabel))
|
|
else-label (. gen (newLabel))
|
|
end-label (. gen (newLabel))]
|
|
(. gen (visitCode))
|
|
(when is-overload
|
|
(emit-get-var gen (overload-name mname pclasses))
|
|
(. gen (dup))
|
|
(. gen (ifNonNull found-label))
|
|
(. gen (pop)))
|
|
(emit-get-var gen mname)
|
|
(. gen (dup))
|
|
(. gen (ifNull else-label))
|
|
(when is-overload
|
|
(. gen (mark found-label)))
|
|
;if found
|
|
(. gen (loadThis))
|
|
;box args
|
|
(dotimes i (count ptypes)
|
|
(. gen (loadArg i))
|
|
(. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i))))
|
|
;call fn
|
|
(. gen (invokeInterface ifn-type (new Method "invoke" obj-type
|
|
(into-array (cons obj-type
|
|
(replicate (count ptypes) obj-type))))))
|
|
;unbox return
|
|
(. gen (unbox rtype))
|
|
(when (= (. rtype (getSort)) (. Type VOID))
|
|
(. gen (pop)))
|
|
(. gen (goTo end-label))
|
|
|
|
;else call supplied alternative generator
|
|
(. gen (mark else-label))
|
|
(. gen (pop))
|
|
|
|
(else-gen gen m)
|
|
|
|
(. gen (mark end-label))
|
|
(. gen (returnValue))
|
|
(. gen (endMethod))))
|
|
]
|
|
;start class definition
|
|
(. cv (visit (. Opcodes V1_5) (. Opcodes ACC_PUBLIC)
|
|
cname nil (iname super)
|
|
(when interfaces
|
|
(into-array (map iname interfaces)))))
|
|
|
|
;static fields for vars
|
|
(doseq v var-fields
|
|
(. cv (visitField (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_FINAL) (. Opcodes ACC_STATIC))
|
|
(var-name v)
|
|
(. var-type getDescriptor)
|
|
nil nil)))
|
|
|
|
;instance field for state
|
|
(when state
|
|
(. cv (visitField (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_FINAL))
|
|
state-name
|
|
(. obj-type getDescriptor)
|
|
nil nil)))
|
|
|
|
;static init to set up var fields and load clj
|
|
(let [gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_STATIC))
|
|
(. Method getMethod "void <clinit> ()")
|
|
nil nil cv)]
|
|
(. gen (visitCode))
|
|
(doseq v var-fields
|
|
(. gen push name)
|
|
(. gen push v)
|
|
(. gen (invokeStatic rt-type (. Method (getMethod "clojure.lang.Var var(String,String)"))))
|
|
(. gen putStatic ctype (var-name v) var-type))
|
|
|
|
(. gen push ctype)
|
|
(. gen push (str (. name replace \. (. java.io.File separatorChar)) ".clj"))
|
|
(. gen (invokeStatic rt-type (. Method (getMethod "void loadResourceScript(Class,String)"))))
|
|
|
|
(. gen (returnValue))
|
|
(. gen (endMethod)))
|
|
|
|
;ctors
|
|
(doseq [pclasses super-pclasses] ctor-sig-map
|
|
(let [ptypes (to-types pclasses)
|
|
super-ptypes (to-types super-pclasses)
|
|
m (new Method "<init>" (. Type VOID_TYPE) ptypes)
|
|
super-m (new Method "<init>" (. Type VOID_TYPE) super-ptypes)
|
|
gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)
|
|
no-init-label (. gen newLabel)
|
|
end-label (. gen newLabel)
|
|
nth-method (. Method (getMethod "Object nth(Object,int)"))
|
|
local (. gen newLocal obj-type)]
|
|
(. gen (visitCode))
|
|
|
|
(if init
|
|
(do
|
|
(emit-get-var gen init-name)
|
|
(. gen dup)
|
|
(. gen ifNull no-init-label)
|
|
;box init args
|
|
(dotimes i (count pclasses)
|
|
(. gen (loadArg i))
|
|
(. clojure.lang.Compiler$HostExpr (emitBoxReturn nil gen (nth pclasses i))))
|
|
;call init fn
|
|
(. gen (invokeInterface ifn-type (new Method "invoke" obj-type
|
|
(arg-types (count ptypes)))))
|
|
;expecting [[super-ctor-args] state] returned
|
|
(. gen dup)
|
|
(. gen push 0)
|
|
(. gen (invokeStatic rt-type nth-method))
|
|
(. gen storeLocal local)
|
|
|
|
(. gen (loadThis))
|
|
(. gen dupX1)
|
|
(dotimes i (count super-pclasses)
|
|
(. gen loadLocal local)
|
|
(. gen push i)
|
|
(. gen (invokeStatic rt-type nth-method))
|
|
(. clojure.lang.Compiler$HostExpr (emitUnboxArg nil gen (nth super-pclasses i))))
|
|
(. gen (invokeConstructor super-type super-m))
|
|
|
|
(if state
|
|
(do
|
|
(. gen push 1)
|
|
(. gen (invokeStatic rt-type nth-method))
|
|
(. gen (putField ctype state-name obj-type)))
|
|
(. gen pop))
|
|
|
|
(. gen goTo end-label)
|
|
;no init found
|
|
(. gen mark no-init-label)
|
|
(. gen (throwException ex-type (str init-name " not defined")))
|
|
(. gen mark end-label))
|
|
(if (= pclasses super-pclasses)
|
|
(do
|
|
(. gen (loadThis))
|
|
(. gen (loadArgs))
|
|
(. gen (invokeConstructor super-type super-m)))
|
|
(throw (new Exception ":init not specified, but ctor and super ctor args differ"))))
|
|
|
|
(. gen (returnValue))
|
|
(. gen (endMethod))
|
|
;factory
|
|
(when factory
|
|
(let [fm (new Method factory-name ctype ptypes)
|
|
gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_STATIC))
|
|
fm nil nil cv)]
|
|
(. gen (visitCode))
|
|
(. gen newInstance ctype)
|
|
(. gen dup)
|
|
(. gen (loadArgs))
|
|
(. gen (invokeConstructor ctype m))
|
|
(. gen (returnValue))
|
|
(. gen (endMethod))))))
|
|
|
|
;add methods matching supers', if no fn -> call super
|
|
(let [mm (non-private-methods super)]
|
|
(doseq #^java.lang.reflect.Method meth (vals mm)
|
|
(emit-forwarding-method (.getName meth) (.getParameterTypes meth) (.getReturnType meth)
|
|
(fn [gen m]
|
|
(. gen (loadThis))
|
|
;push args
|
|
(. gen (loadArgs))
|
|
;call super
|
|
(. gen (visitMethodInsn (. Opcodes INVOKESPECIAL)
|
|
(. super-type (getInternalName))
|
|
(. m (getName))
|
|
(. m (getDescriptor)))))))
|
|
;add methods matching interfaces', if no fn -> throw
|
|
(doseq #^Class iface interfaces
|
|
(doseq #^java.lang.reflect.Method meth (. iface (getMethods))
|
|
(when-not (contains? mm (method-sig meth))
|
|
(emit-forwarding-method (.getName meth) (.getParameterTypes meth) (.getReturnType meth)
|
|
(fn [gen m]
|
|
(. gen (throwException ex-type (. m (getName)))))))))
|
|
;extra methods
|
|
(doseq [mname pclasses rclass :as msig] methods
|
|
(emit-forwarding-method (str mname) pclasses rclass
|
|
(fn [gen m]
|
|
(. gen (throwException ex-type (. m (getName))))))))
|
|
|
|
;main
|
|
(when main
|
|
(let [m (. Method getMethod "void main (String[])")
|
|
gen (new GeneratorAdapter (+ (. Opcodes ACC_PUBLIC) (. Opcodes ACC_STATIC))
|
|
m nil nil cv)
|
|
no-main-label (. gen newLabel)
|
|
end-label (. gen newLabel)]
|
|
(. gen (visitCode))
|
|
|
|
(emit-get-var gen main-name)
|
|
(. gen dup)
|
|
(. gen ifNull no-main-label)
|
|
(. gen loadArgs)
|
|
(. gen (invokeStatic rt-type (. Method (getMethod "clojure.lang.ISeq seq(Object)"))))
|
|
(. gen (invokeInterface ifn-type (new Method "applyTo" obj-type
|
|
(into-array [iseq-type]))))
|
|
(. gen pop)
|
|
(. gen goTo end-label)
|
|
;no main found
|
|
(. gen mark no-main-label)
|
|
(. gen (throwException ex-type (str main-name " not defined")))
|
|
(. gen mark end-label)
|
|
(. gen (returnValue))
|
|
(. gen (endMethod))))
|
|
;field exposers
|
|
(doseq [f {getter :get setter :set}] exposes
|
|
(let [fld (.getField super (str f))
|
|
ftype (totype (.getType fld))]
|
|
(when getter
|
|
(let [m (new Method (str getter) ftype (to-types []))
|
|
gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)]
|
|
(. gen (visitCode))
|
|
(. gen loadThis)
|
|
(. gen getField ctype (str f) ftype)
|
|
(. gen (returnValue))
|
|
(. gen (endMethod))))
|
|
(when setter
|
|
(let [m (new Method (str setter) (. Type VOID_TYPE) (into-array [ftype]))
|
|
gen (new GeneratorAdapter (. Opcodes ACC_PUBLIC) m nil nil cv)]
|
|
(. gen (visitCode))
|
|
(. gen loadThis)
|
|
(. gen loadArgs)
|
|
(. gen putField ctype (str f) ftype)
|
|
(. gen (returnValue))
|
|
(. gen (endMethod))))))
|
|
;finish class def
|
|
(. cv (visitEnd))
|
|
{:name name :bytecode (. cv (toByteArray))}))
|
|
|
|
(defn gen-and-load-class
|
|
"Generates and immediately loads the bytecode for the specified
|
|
class. Note that a class generated this way can be loaded only once
|
|
- the JVM supports only one class with a given name per
|
|
classloader. Subsequent to generation you can import it into any
|
|
desired namespaces just like any other class. See gen-class for a
|
|
description of the options."
|
|
|
|
[name & options]
|
|
(let [{:keys [name bytecode]}
|
|
(apply gen-class (str name) options)]
|
|
(.. clojure.lang.RT ROOT_CLASSLOADER (defineClass (str name) bytecode))))
|
|
|
|
(defn gen-and-save-class
|
|
"Generates the bytecode for the named class and stores in a .class
|
|
file in a subpath of the supplied path, the directories for which
|
|
must already exist. See gen-class for a description of the options"
|
|
|
|
[path name & options]
|
|
(let [{:keys [name bytecode]} (apply gen-class (str name) options)
|
|
file (java.io.File. path (str (. name replace \. (. java.io.File separatorChar)) ".class"))]
|
|
(.createNewFile file)
|
|
(with-open f (java.io.FileOutputStream. file)
|
|
(.write f bytecode))))
|
|
|
|
(comment
|
|
;usage
|
|
(gen-class
|
|
package-qualified-name
|
|
;all below are optional
|
|
:extends aclass
|
|
:implements [interface ...]
|
|
:constructors {[param-types] [super-param-types], }
|
|
:methods [[name [param-types] return-type], ]
|
|
:main boolean
|
|
:factory name
|
|
:state name
|
|
:init name
|
|
:exposes {protected-field {:get name :set name}, })
|
|
|
|
;(gen-and-load-class
|
|
(clojure/gen-and-save-class
|
|
"/Users/rich/Downloads"
|
|
'fred.lucy.Ethel
|
|
:extends clojure.lang.Box ;APersistentMap
|
|
:implements [clojure.lang.IPersistentMap]
|
|
:state 'state
|
|
;:constructors {[Object] [Object]}
|
|
;:init 'init
|
|
:main true
|
|
:factory 'create
|
|
:methods [['foo [Object] Object]
|
|
['foo [] Object]]
|
|
:exposes {'val {:get 'getVal :set 'setVal}})
|
|
|
|
(in-ns 'fred.lucy.Ethel__2276)
|
|
(clojure/refer 'clojure :exclude '(assoc seq count cons))
|
|
(defn init [n] [[] n])
|
|
(defn foo
|
|
([this] :foo)
|
|
([this x] x))
|
|
(defn main [x y] (println x y))
|
|
(in-ns 'user)
|
|
(def ethel (new fred.lucy.Ethel__2276 42))
|
|
(def ethel (fred.lucy.Ethel__2276.create 21))
|
|
(fred.lucy.Ethel__2276.main (into-array ["lucy" "ricky"]))
|
|
(.state ethel)
|
|
(.foo ethel 7)
|
|
(.foo ethel)
|
|
(.getVal ethel)
|
|
(.setVal ethel 12)
|
|
|
|
(gen-class org.clojure.MyComparator :implements [Comparator])
|
|
(in-ns 'org.clojure.MyComparator)
|
|
(defn compare [this x y] ...)
|
|
|
|
(load-file "/Users/rich/dev/clojure/src/genclass.clj")
|
|
|
|
(clojure/gen-and-save-class "/Users/rich/dev/clojure/gen/"
|
|
'org.clojure.ClojureServlet
|
|
:extends javax.servlet.http.HttpServlet)
|
|
|
|
)
|