Added AOT-based genclass

!!!Note - breaking change to gen-class!!!
Do not move to this version if you use gen-and-xxx-class until you are ready to port to new system.
Adds :gen-class clause to ns, which can be used to configure the class generated for the namespace

5 files changed, 122 insertions, 49 deletions

diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj
index a6d7ca2e..1122798f 100644
--- a/src/clj/clojure/core.clj
+++ b/src/clj/clojure/core.clj
@@ -3083,11 +3083,13 @@
 (defmacro ns
   "Sets *ns* to the namespace named by name (unevaluated), creating it
   if needed.  references can be zero or more of: (:refer-clojure ...)
-  (:require ...) (:use ...) (:import ...) (:load ...) with the syntax
-  of refer-clojure/require/use/import/load respectively, except the
-  arguments are unevaluated and need not be quoted.  If :refer-clojure
-  is not used, a default (refer 'clojure) is used. Use of ns is preferred
-  to individual calls to in-ns/require/use/import:
+  (:require ...) (:use ...) (:import ...) (:load ...) (:gen-class)
+  with the syntax of refer-clojure/require/use/import/load/gen-class
+  respectively, except the arguments are unevaluated and need not be
+  quoted, and the :gen-class clause does not take a name (since the
+  class name corresponds to the ns name).  If :refer-clojure is not
+  used, a default (refer 'clojure) is used. Use of ns is preferred to
+  individual calls to in-ns/require/use/import:
 
   (ns foo
     (:refer-clojure :exclude [ancestors printf])
diff --git a/src/clj/clojure/genclass.clj b/src/clj/clojure/genclass.clj
index 39370d9d..e85f9a94 100644
--- a/src/clj/clojure/genclass.clj
+++ b/src/clj/clojure/genclass.clj
@@ -59,6 +59,17 @@
 
 ;(distinct (map first(keys (mapcat non-private-methods [Object IPersistentMap]))))
 
+(def #^{:private true} prim->class
+     {'int Integer/TYPE
+      'long Long/TYPE
+      'float Float/TYPE
+      'double Double/TYPE
+      'void Void/TYPE
+      'short Short/TYPE
+      'boolean Boolean/TYPE
+      'byte Byte/TYPE
+      'char Character/TYPE})
+
 (defn gen-class 
   "Generates compiled bytecode for a class with the given
   package-qualified cname (which, as all names in these parameters, can
@@ -67,13 +78,13 @@
   the generated class in functions in a corresponding Clojure
   namespace. Given a generated class org.mydomain.MyClass with a
   method named mymethod, gen-class will generate an implementation
-  that looks for a function named MyClass-mymethod in a Clojure
-  namespace called org.mydomain. All inherited methods, generated
+  that looks for a function named -mymethod in a Clojure
+  namespace called org.mydomain.MyClass . All inherited methods, generated
   methods, and init and main functions (see :methods, :init, and :main
   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 classpath, e.g. in the example
-  case, org/mydomain/MyClass.clj
+  case, org/mydomain/MyClass__init.class
 
   Note that methods with a maximum of 18 parameters are supported.
 
@@ -107,7 +118,8 @@
   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.
+  specifier. In this and all subsequent sections taking types, the primitive
+  types can be referred to by their Java names (int, float etc)
 
   :methods [ [name [param-types] return-type], ...]
 
@@ -147,15 +159,24 @@
   for use in the implementation."
 
   [cname & options]
-  (let [name (str cname)
+  (let [the-class (fn [x] 
+                    (cond 
+                     (class? x) x
+                     (contains? prim->class x) (prim->class x)
+                     :else (let [strx (str x)]
+                             (clojure.lang.RT/classForName 
+                              (if (some #{\.} strx)
+                                strx
+                                (str "java.lang." strx))))))
+        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))
+        super (if extends (the-class extends) Object)
+        interfaces (map the-class implements)
+        supers (cons super interfaces)
         ctor-sig-map (or constructors (zipmap (ctor-sigs super) (ctor-sigs super)))
         cv (new ClassWriter (. ClassWriter COMPUTE_MAXS))
         cname (. name (replace "." "/"))
-        [pkg-name sname] (.split name "[.](?=[^.]*$)")
+        pkg-name name
         ctype (. Type (getObjectType cname))
         iname (fn [c] (.. Type (getType c) (getInternalName)))
         totype (fn [c] (. Type (getType c)))
@@ -172,6 +193,7 @@
         state-name (str state)
         main-name "main"
         var-name (fn [s] (str s "__var"))
+        class-type  (totype Class)
         rt-type  (totype clojure.lang.RT)
         var-type  (totype clojure.lang.Var)
         ifn-type (totype clojure.lang.IFn)
@@ -201,11 +223,13 @@
                          (. gen mark end-label)))
         emit-unsupported (fn [gen m]
                            (. gen (throwException ex-type (str (. m (getName)) " ("
-                                                               pkg-name "/" sname "-" (.getName m)
+                                                               pkg-name "/" "-" (.getName m)
                                                                " not defined?)"))))
         emit-forwarding-method
         (fn [mname pclasses rclass as-static else-gen]
-          (let [ptypes (to-types pclasses)
+          (let [pclasses (map the-class pclasses)
+                rclass (the-class rclass)
+                ptypes (to-types pclasses)
                 rtype (totype rclass)
                 m (new Method mname rtype ptypes)
                 is-overload (overloads mname)
@@ -278,28 +302,28 @@
                         (. obj-type getDescriptor)
                         nil nil)))
     
-                                        ;static init to set up var fields and load clj
+                                        ;static init to set up var fields and load init
     (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 pkg-name)
-        (. gen push (str sname "-" v))
-        (. gen (invokeStatic rt-type (. Method (getMethod "clojure.lang.Var var(String,String)"))))
+        (. gen push (str "-" v))
+        (. gen (invokeStatic var-type (. Method (getMethod "clojure.lang.Var internPrivate(String,String)"))))
         (. gen putStatic ctype (var-name v) var-type))
       
-      (. gen push ctype)
-      (. gen push (str (. name replace \. \/) ".clj"))
-      (. gen push 0)
-      (. gen (invokeStatic rt-type (. Method (getMethod "void loadResourceScript(Class,String,boolean)"))))
-      
+      (. gen push (str name "__init"))
+      (. gen (invokeStatic class-type (. Method (getMethod "Class forName(String)"))))
+      (. gen pop)
       (. gen (returnValue))
       (. gen (endMethod)))
     
                                         ;ctors
     (doseq [[pclasses super-pclasses] ctor-sig-map]
-      (let [ptypes (to-types pclasses)
+      (let [pclasses (map the-class pclasses)
+            super-pclasses (map the-class super-pclasses)
+            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)
@@ -418,7 +442,7 @@
         (. gen goTo end-label)
                                         ;no main found
         (. gen mark no-main-label)
-        (. gen (throwException ex-type (str pkg-name "/" sname "-" main-name " not defined")))
+        (. gen (throwException ex-type (str pkg-name "/" "-" main-name " not defined")))
         (. gen mark end-label)
         (. gen (returnValue))
         (. gen (endMethod))))
@@ -447,6 +471,8 @@
     (. cv (visitEnd))
     {:name name :bytecode (. cv (toByteArray))}))
 
+(comment
+
 (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
@@ -471,6 +497,7 @@
     (.createNewFile file)
     (with-open [f (java.io.FileOutputStream. file)]
       (.write f bytecode))))
+)
 
 (comment
 ;usage
diff --git a/src/jvm/clojure/lang/Compiler.java b/src/jvm/clojure/lang/Compiler.java
index d83be385..da3f022c 100644
--- a/src/jvm/clojure/lang/Compiler.java
+++ b/src/jvm/clojure/lang/Compiler.java
@@ -4485,8 +4485,44 @@ public static Object compile(Reader rdr, String sourcePath, String sourceName) t
 
 	try
 		{
+		//use genclass for the stub
+		String classname = sourcePath.substring(0, sourcePath.lastIndexOf('.')).replace('/', '.');
+		Object r = LispReader.read(pushbackReader, false, EOF, false);
+		Object genclassArgs = null;
+		if(r instanceof IPersistentList
+		   && (Util.equal(RT.first(r), Symbol.create("ns"))
+		       || Util.equal(RT.first(r), Symbol.create("clojure.core", "ns"))))
+			{
+			Keyword gk = Keyword.intern(null, "gen-class");
+			Symbol nssym = (Symbol) RT.second(r);
+			if(!nssym.toString().equals(classname))
+				throw new Exception(String.format("Namespace name must match file, had: %s and %s",
+				                                  nssym, sourcePath));
+			for(ISeq s = RT.rest(RT.rest(r)); s != null; s = s.rest())
+				{
+				Object entry = s.first();
+				if(RT.first(entry).equals(gk))
+					{
+					genclassArgs = RT.rest(entry);
+					break;
+					}
+				}
+			}
+
+		if(genclassArgs == null)
+			genclassArgs = RT.list(Keyword.intern(null, "main"), RT.T);
+
+		genclassArgs = RT.cons(classname, genclassArgs);
+		Var genclass = RT.var("clojure.core", "gen-class");
+		IPersistentMap gret = (IPersistentMap) genclass.applyTo(RT.seq(genclassArgs));
+		writeClassFile(sourcePath.substring(0, sourcePath.lastIndexOf('.')),
+		               (byte[]) RT.get(gret, Keyword.intern(null, "bytecode")));
+
+		//generate loader class
 		FnExpr fn = new FnExpr(null);
-		fn.internalName = sourcePath.replace(File.separator, "/").substring(0, sourcePath.lastIndexOf('.'));
+		fn.internalName = sourcePath.replace(File.separator, "/").substring(0, sourcePath.lastIndexOf('.'))
+		                  + "__init";
+
 		fn.fntype = Type.getObjectType(fn.internalName);
 		ClassWriter cw = new ClassWriter(ClassWriter.COMPUTE_MAXS);
 		ClassVisitor cv = cw;
@@ -4500,7 +4536,7 @@ public static Object compile(Reader rdr, String sourcePath, String sourceName) t
 		                                            cv);
 		gen.visitCode();
 
-		for(Object r = LispReader.read(pushbackReader, false, EOF, false); r != EOF;
+		for(; r != EOF;
 		    r = LispReader.read(pushbackReader, false, EOF, false))
 			{
 			LINE_AFTER.set(pushbackReader.getLineNumber());
@@ -4558,28 +4594,28 @@ public static Object compile(Reader rdr, String sourcePath, String sourceName) t
 		clinitgen.endMethod();
 
 		//main
-		GeneratorAdapter maingen = new GeneratorAdapter(ACC_PUBLIC + ACC_STATIC,
-		                                            Method.getMethod("void main (String[])"),
-		                                            null,
-		                                            null,
-		                                            cv);
-		maingen.visitCode();
-		maingen.push(fn.internalName.replace('/', '.'));
-		maingen.push("main");
-		maingen.invokeStatic(RT_TYPE, Method.getMethod("clojure.lang.Var var(String,String)"));
-		maingen.loadArgs();
-		maingen.invokeStatic(RT_TYPE,Method.getMethod("clojure.lang.ISeq seq(Object)"));
-        maingen.invokeInterface(IFN_TYPE, new Method("applyTo",OBJECT_TYPE,new Type[]{Type.getType(ISeq.class)}));
-		maingen.pop();
-
-		 //end of main
-		maingen.returnValue();
-		maingen.endMethod();
+//		GeneratorAdapter maingen = new GeneratorAdapter(ACC_PUBLIC + ACC_STATIC,
+//		                                                Method.getMethod("void main (String[])"),
+//		                                                null,
+//		                                                null,
+//		                                                cv);
+//		maingen.visitCode();
+//		maingen.push(fn.internalName.replace('/', '.'));
+//		maingen.push("main");
+//		maingen.invokeStatic(RT_TYPE, Method.getMethod("clojure.lang.Var var(String,String)"));
+//		maingen.loadArgs();
+//		maingen.invokeStatic(RT_TYPE, Method.getMethod("clojure.lang.ISeq seq(Object)"));
+//		maingen.invokeInterface(IFN_TYPE, new Method("applyTo", OBJECT_TYPE, new Type[]{Type.getType(ISeq.class)}));
+//		maingen.pop();
+//
+//		//end of main
+//		maingen.returnValue();
+//		maingen.endMethod();
 
 		//end of class
 		cv.visitEnd();
-		
-		writeClassFile(fn.internalName,cw.toByteArray());
+
+		writeClassFile(fn.internalName, cw.toByteArray());
 		}
 	catch(LispReader.ReaderException e)
 		{
diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java
index e714b80e..1c81e3c8 100644
--- a/src/jvm/clojure/lang/RT.java
+++ b/src/jvm/clojure/lang/RT.java
@@ -1615,11 +1615,11 @@ static public Class classForName(String name) throws ClassNotFoundException{
 	return Class.forName(name, false, baseLoader());
 }
 
-static public boolean loadClassForName(String name) throws ClassNotFoundException{
+static public boolean loadClassForName(String name) throws Exception{
 	try{
 	Class.forName(name, true, baseLoader());
 	}
-	catch(Exception e)
+	catch(ClassNotFoundException e)
 		{
 		return false;
 		}
diff --git a/src/jvm/clojure/lang/Var.java b/src/jvm/clojure/lang/Var.java
index 5fcfd5eb..6b7d1d9e 100644
--- a/src/jvm/clojure/lang/Var.java
+++ b/src/jvm/clojure/lang/Var.java
@@ -45,6 +45,7 @@ static ThreadLocal<Frame> dvals = new ThreadLocal<Frame>(){
 };
 
 static Keyword privateKey = Keyword.intern(null, "private");
+static IPersistentMap privateMeta = new PersistentArrayMap(new Object[]{privateKey, Boolean.TRUE});
 static Keyword macroKey = Keyword.intern(null, "macro");
 static Keyword nameKey = Keyword.intern(null, "name");
 static Keyword nsKey = Keyword.intern(null, "ns");
@@ -90,6 +91,13 @@ public static Var intern(Symbol nsName, Symbol sym){
 	return intern(ns, sym);
 }
 
+public static Var internPrivate(String nsName, String sym){
+	Namespace ns = Namespace.findOrCreate(Symbol.intern(nsName));
+	Var ret = intern(ns, Symbol.intern(sym));
+	ret.setMeta(privateMeta);
+	return ret;
+}
+
 public static Var intern(Namespace ns, Symbol sym){
 	return ns.intern(sym);
 }