Add Clojure lexer.

4 files changed, 650 insertions, 2 deletions

diff --git a/CHANGES b/CHANGES
index f2d984aa..785a1612 100644
--- a/CHANGES
+++ b/CHANGES
@@ -14,6 +14,7 @@ Version 0.11
   * Lighttpd config files
   * Nginix config files
   * Gnuplot plotting scripts
+  * Clojure
 
 - Added "Visual Studio" style.
 
diff --git a/pygments/lexers/_mapping.py b/pygments/lexers/_mapping.py
index ec195588..c6aa1518 100644
--- a/pygments/lexers/_mapping.py
+++ b/pygments/lexers/_mapping.py
@@ -31,6 +31,7 @@ LEXERS = {
     'CheetahJavascriptLexer': ('pygments.lexers.templates', 'JavaScript+Cheetah', ('js+cheetah', 'javascript+cheetah', 'js+spitfire', 'javascript+spitfire'), (), ('application/x-javascript+cheetah', 'text/x-javascript+cheetah', 'text/javascript+cheetah', 'application/x-javascript+spitfire', 'text/x-javascript+spitfire', 'text/javascript+spitfire')),
     'CheetahLexer': ('pygments.lexers.templates', 'Cheetah', ('cheetah', 'spitfire'), ('*.tmpl', '*.spt'), ('application/x-cheetah', 'application/x-spitfire')),
     'CheetahXmlLexer': ('pygments.lexers.templates', 'XML+Cheetah', ('xml+cheetah', 'xml+spitfire'), (), ('application/xml+cheetah', 'application/xml+spitfire')),
+    'ClojureLexer': ('pygments.lexers.agile', 'Clojure', ('clojure', 'clj'), ('*.clj',), ('text/x-clojure', 'application/x-clojure')),
     'CommonLispLexer': ('pygments.lexers.functional', 'Common Lisp', ('common-lisp', 'cl'), ('*.cl', '*.lisp', '*.el'), ('text/x-common-lisp',)),
     'CppLexer': ('pygments.lexers.compiled', 'C++', ('cpp', 'c++'), ('*.cpp', '*.hpp', '*.c++', '*.h++', '*.cc', '*.hh', '*.cxx', '*.hxx'), ('text/x-c++hdr', 'text/x-c++src')),
     'CppObjdumpLexer': ('pygments.lexers.asm', 'cpp-objdump', ('cpp-objdump', 'c++-objdumb', 'cxx-objdump'), ('*.cpp-objdump', '*.c++-objdump', '*.cxx-objdump'), ('text/x-cpp-objdump',)),
diff --git a/pygments/lexers/agile.py b/pygments/lexers/agile.py
index 109bffcc..59c91037 100644
--- a/pygments/lexers/agile.py
+++ b/pygments/lexers/agile.py
@@ -7,7 +7,8 @@
 
     :copyright: 2006-2008 by Georg Brandl, Armin Ronacher,
                 Lukas Meuser, Tim Hatch, Jarrett Billingsley,
-                Tassilo Schweyer, Steven Hazel, Nick Efford.
+                Tassilo Schweyer, Steven Hazel, Nick Efford,
+                Davy Wybiral.
     :license: BSD, see LICENSE for more details.
 """
 
@@ -27,7 +28,7 @@ from pygments import unistring as uni
 
 __all__ = ['PythonLexer', 'PythonConsoleLexer', 'PythonTracebackLexer',
            'RubyLexer', 'RubyConsoleLexer', 'PerlLexer', 'LuaLexer',
-           'MiniDLexer', 'IoLexer', 'TclLexer', 'Python3Lexer']
+           'MiniDLexer', 'IoLexer', 'TclLexer', 'Python3Lexer', 'ClojureLexer']
 
 # b/w compatibility
 from pygments.lexers.functional import SchemeLexer
@@ -1251,3 +1252,138 @@ class TclLexer(RegexLexer):
 
     def analyse_text(text):
         return shebang_matches(text, r'(tcl)')
+
+
+class ClojureLexer(RegexLexer):
+    """
+    Lexer for `Clojure <http://clojure.org/>`_ source code.
+
+    *New in Pygments 0.11.*
+    """
+    name = 'Clojure'
+    aliases = ['clojure', 'clj']
+    filenames = ['*.clj']
+    mimetypes = ['text/x-clojure', 'application/x-clojure']
+
+    keywords = [
+        'fn', 'def', 'defn', 'defmacro', 'defmethod', 'defmulti', 'defn-',
+        'defstruct',
+        'if', 'cond',
+        'let', 'for'
+    ]
+    builtins = [
+        '.', '..',
+        '*', '+', '-', '->', '..', '/', '<', '<=', '=', '==', '>', '>=',
+        'accessor', 'agent', 'agent-errors', 'aget', 'alength', 'all-ns',
+        'alter', 'and', 'append-child', 'apply', 'array-map', 'aset',
+        'aset-boolean', 'aset-byte', 'aset-char', 'aset-double', 'aset-float',
+        'aset-int', 'aset-long', 'aset-short', 'assert', 'assoc', 'await',
+        'await-for', 'bean', 'binding', 'bit-and', 'bit-not', 'bit-or',
+        'bit-shift-left', 'bit-shift-right', 'bit-xor', 'boolean', 'branch?',
+        'butlast', 'byte', 'cast', 'char', 'children', 'class',
+        'clear-agent-errors', 'comment', 'commute', 'comp', 'comparator',
+        'complement', 'concat', 'conj', 'cons', 'constantly',
+        'construct-proxy', 'contains?', 'count', 'create-ns', 'create-struct',
+        'cycle', 'dec',  'deref', 'difference', 'disj', 'dissoc', 'distinct',
+        'doall', 'doc', 'dorun', 'doseq', 'dosync', 'dotimes', 'doto',
+        'double', 'down', 'drop', 'drop-while', 'edit', 'end?', 'ensure',
+        'eval', 'every?', 'false?', 'ffirst', 'file-seq', 'filter', 'find',
+        'find-doc', 'find-ns', 'find-var', 'first', 'float', 'flush',
+        'fnseq', 'frest', 'gensym', 'get', 'get-proxy-class',
+        'hash-map', 'hash-set', 'identical?', 'identity', 'if-let', 'import',
+        'in-ns', 'inc', 'index', 'insert-child', 'insert-left', 'insert-right',
+        'inspect-table', 'inspect-tree', 'instance?', 'int', 'interleave',
+        'intersection', 'into', 'into-array', 'iterate', 'join', 'key', 'keys',
+        'keyword', 'keyword?', 'last', 'lazy-cat', 'lazy-cons', 'left',
+        'lefts', 'line-seq', 'list', 'list*', 'load', 'load-file',
+        'locking', 'long', 'loop', 'macroexpand', 'macroexpand-1',
+        'make-array', 'make-node', 'map', 'map-invert', 'map?', 'mapcat',
+        'max', 'max-key', 'memfn', 'merge', 'merge-with', 'meta', 'min',
+        'min-key', 'name', 'namespace', 'neg?', 'new', 'newline', 'next',
+        'nil?', 'node', 'not', 'not-any?', 'not-every?', 'not=', 'ns-imports',
+        'ns-interns', 'ns-map', 'ns-name', 'ns-publics', 'ns-refers',
+        'ns-resolve', 'ns-unmap', 'nth', 'nthrest', 'or', 'parse', 'partial',
+        'path', 'peek', 'pop', 'pos?', 'pr', 'pr-str', 'print', 'print-str',
+        'println', 'println-str', 'prn', 'prn-str', 'project', 'proxy',
+        'proxy-mappings', 'quot', 'rand', 'rand-int', 'range', 're-find',
+        're-groups', 're-matcher', 're-matches', 're-pattern', 're-seq',
+        'read', 'read-line', 'reduce', 'ref', 'ref-set', 'refer', 'rem',
+        'remove', 'remove-method', 'remove-ns', 'rename', 'rename-keys',
+        'repeat', 'replace', 'replicate', 'resolve', 'rest', 'resultset-seq',
+        'reverse', 'rfirst', 'right', 'rights', 'root', 'rrest', 'rseq',
+        'second', 'select', 'select-keys', 'send', 'send-off', 'seq',
+        'seq-zip', 'seq?', 'set', 'short', 'slurp', 'some', 'sort',
+        'sort-by', 'sorted-map', 'sorted-map-by', 'sorted-set',
+        'special-symbol?', 'split-at', 'split-with', 'str', 'string?',
+        'struct', 'struct-map', 'subs', 'subvec', 'symbol', 'symbol?',
+        'sync', 'take', 'take-nth', 'take-while', 'test', 'time', 'to-array',
+        'to-array-2d', 'tree-seq', 'true?', 'union', 'up', 'update-proxy',
+        'val', 'vals', 'var-get', 'var-set', 'var?', 'vector', 'vector-zip',
+        'vector?', 'when', 'when-first', 'when-let', 'when-not',
+        'with-local-vars', 'with-meta', 'with-open', 'with-out-str',
+        'xml-seq', 'xml-zip', 'zero?', 'zipmap', 'zipper']
+
+    # valid names for identifiers
+    # well, names can only not consist fully of numbers
+    # but this should be good enough for now
+    valid_name = r'[a-zA-Z0-9!$%&*+,/:<=>?@^_~-]+'
+
+    tokens = {
+        'root' : [
+            # the comments - always starting with semicolon
+            # and going to the end of the line
+            (r';.*$', Comment.Single),
+
+            # whitespaces - usually not relevant
+            (r'\s+', Text),
+
+            # numbers
+            (r'-?\d+\.\d+', Number.Float),
+            (r'-?\d+', Number.Integer),
+            # support for uncommon kinds of numbers -
+            # have to figure out what the characters mean
+            #(r'(#e|#i|#b|#o|#d|#x)[\d.]+', Number),
+
+            # strings, symbols and characters
+            (r'"(\\\\|\\"|[^"])*"', String),
+            (r"'" + valid_name, String.Symbol),
+            (r"\\([()/'\".'_!§$%& ?=+-]{1}|[a-zA-Z0-9]+)", String.Char),
+
+            # constants
+            (r'(#t|#f)', Name.Constant),
+
+            # special operators
+            (r"('|#|`|,@|,|\.)", Operator),
+
+            # highlight the keywords
+            ('(%s)' % '|'.join([
+                re.escape(entry) + ' ' for entry in keywords]),
+                Keyword
+            ),
+
+            # first variable in a quoted string like
+            # '(this is syntactic sugar)
+            (r"(?<='\()" + valid_name, Name.Variable),
+            (r"(?<=#\()" + valid_name, Name.Variable),
+
+            # highlight the builtins
+            ("(?<=\()(%s)" % '|'.join([
+                re.escape(entry) + ' ' for entry in builtins]),
+                Name.Builtin
+            ),
+
+            # the remaining functions
+            (r'(?<=\()' + valid_name, Name.Function),
+            # find the remaining variables
+            (valid_name, Name.Variable),
+
+            # Clojure accepts vector notation
+            (r'(\[|\])', Punctuation),
+
+            # Clojure accepts map notation
+            (r'(\{|\})', Punctuation),
+
+            # the famous parentheses!
+            (r'(\(|\))', Punctuation),
+        ],
+    }
diff --git a/tests/examplefiles/genclass.clj b/tests/examplefiles/genclass.clj
new file mode 100644
index 00000000..c63da8fd
--- /dev/null
+++ b/tests/examplefiles/genclass.clj
@@ -0,0 +1,510 @@
+;   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)
+
+)