[armedbear-cvs] r12826 - in trunk/abcl: . src/org/armedbear/lisp
Ville Voutilainen
vvoutilainen at common-lisp.net
Sun Jul 25 19:09:14 UTC 2010
Author: vvoutilainen
Date: Sun Jul 25 15:09:13 2010
New Revision: 12826
Log:
DocString annotation support, for generating DOCUMENTATION, and
later Javadoc from the same data. Also includes TAGS support
for the DocString annotations. Patch by Matt Seddon.
Added:
trunk/abcl/src/org/armedbear/lisp/DocString.java
Modified:
trunk/abcl/build.xml
trunk/abcl/src/org/armedbear/lisp/ForwardReferencedClass.java
trunk/abcl/src/org/armedbear/lisp/Function.java
trunk/abcl/src/org/armedbear/lisp/Java.java
trunk/abcl/src/org/armedbear/lisp/Lisp.java
trunk/abcl/src/org/armedbear/lisp/LispObject.java
trunk/abcl/src/org/armedbear/lisp/LispThread.java
trunk/abcl/src/org/armedbear/lisp/Operator.java
trunk/abcl/src/org/armedbear/lisp/Primitive.java
trunk/abcl/src/org/armedbear/lisp/logorc2.java
trunk/abcl/src/org/armedbear/lisp/package_error_package.java
Modified: trunk/abcl/build.xml
==============================================================================
--- trunk/abcl/build.xml (original)
+++ trunk/abcl/build.xml Sun Jul 25 15:09:13 2010
@@ -449,6 +449,7 @@
<apply executable="etags" parallel="true" verbose="true" maxparallel="300">
<arg value="--append"/>
<arg value="--regex=|[ \t]+//[ \t]+###[ \t]+\([^ \t]+\)|\1|"/>
+ <arg value='--regex=|[ \t]*@DocString([ \t]*name=\"\([^\"]*\)|\1|'/>
<fileset dir="${src.dir}">
<patternset refid="abcl.source.java"/>
<patternset refid="abcl.source.lisp"/>
Added: trunk/abcl/src/org/armedbear/lisp/DocString.java
==============================================================================
--- (empty file)
+++ trunk/abcl/src/org/armedbear/lisp/DocString.java Sun Jul 25 15:09:13 2010
@@ -0,0 +1,50 @@
+/*
+ * DocString.java
+ *
+ * Copyright (C) 2010 Matt Seddon
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ *
+ * As a special exception, the copyright holders of this library give you
+ * permission to link this library with independent modules to produce an
+ * executable, regardless of the license terms of these independent
+ * modules, and to copy and distribute the resulting executable under
+ * terms of your choice, provided that you also meet, for each linked
+ * independent module, the terms and conditions of the license of that
+ * module. An independent module is a module which is not derived from
+ * or based on this library. If you modify this library, you may extend
+ * this exception to your version of the library, but you are not
+ * obligated to do so. If you do not wish to do so, delete this
+ * exception statement from your version.
+ */
+package org.armedbear.lisp;
+
+import java.lang.annotation.*;
+
+/**
+ * An annotation type to expose documentation to ABCL.
+ * <i>Note:</i> the TAGS ant target also pulls information from here. It
+ * expects <tt>name</tt> to be the first item in the DocString declaration,
+ * and not broken onto multiple lines.
+ */
+ at Retention(RetentionPolicy.RUNTIME)
+public @interface DocString {
+ /** The lisp name. */
+ public String name() default "";
+ /** The arguments. */
+ public String args() default "";
+ /** The documentation string. */
+ public String doc() default "";
+}
Modified: trunk/abcl/src/org/armedbear/lisp/ForwardReferencedClass.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/ForwardReferencedClass.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/ForwardReferencedClass.java Sun Jul 25 15:09:13 2010
@@ -76,7 +76,7 @@
return unreadableString(sb.toString());
}
- // ### make-forward-referenced-class
+ @DocString(name="make-forward-referenced=class")
private static final Primitive MAKE_FORWARD_REFERENCED_CLASS =
new Primitive("make-forward-referenced-class", PACKAGE_SYS, true)
{
Modified: trunk/abcl/src/org/armedbear/lisp/Function.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Function.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Function.java Sun Jul 25 15:09:13 2010
@@ -53,7 +53,14 @@
public Function(String name)
{
+ this(name, (String)null);
+ }
+
+ public Function(String name, String arglist)
+ {
this();
+ if(arglist != null)
+ setLambdaList(new SimpleString(arglist));
if (name != null) {
Symbol symbol = Symbol.addFunction(name.toUpperCase(), this);
if (cold)
@@ -62,14 +69,14 @@
}
}
+ public Function(Symbol symbol)
+ {
+ this(symbol, null, null);
+ }
+
public Function(Symbol symbol, String arglist)
{
- this();
- symbol.setSymbolFunction(this);
- if (cold)
- symbol.setBuiltInFunction(true);
- setLambdaName(symbol);
- setLambdaList(new SimpleString(arglist));
+ this(symbol, arglist, null);
}
public Function(Symbol symbol, String arglist, String docstring)
@@ -79,17 +86,11 @@
if (cold)
symbol.setBuiltInFunction(true);
setLambdaName(symbol);
- setLambdaList(new SimpleString(arglist));
- if (docstring != null) {
+ if(arglist != null)
+ setLambdaList(new SimpleString(arglist));
+ if (docstring != null)
symbol.setDocumentation(Symbol.FUNCTION,
new SimpleString(docstring));
- }
- }
-
- public Function(String name, String arglist)
- {
- this(name);
- setLambdaList(new SimpleString(arglist));
}
public Function(String name, Package pkg)
Modified: trunk/abcl/src/org/armedbear/lisp/Java.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Java.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Java.java Sun Jul 25 15:09:13 2010
@@ -60,11 +60,13 @@
}
private static final Primitive ENSURE_JAVA_OBJECT = new pf_ensure_java_object();
+ @DocString(name="ensure-java-object", args="obj",
+ doc="Ensures OBJ is wrapped in a JAVA-OBJECT, wrapping it if necessary.")
private static final class pf_ensure_java_object extends Primitive
{
pf_ensure_java_object()
{
- super("ensure-java-object", PACKAGE_JAVA, true, "obj");
+ super("ensure-java-object", PACKAGE_JAVA, true);
}
@Override
@@ -73,14 +75,16 @@
}
};
- // ### register-java-exception exception-name condition-symbol => T
private static final Primitive REGISTER_JAVA_EXCEPTION = new pf_register_java_exception();
+ @DocString(name="register-java-exception", // => T
+ args="exception-name condition-symbol",
+ doc="Registers the Java Throwable named by the symbol EXCEPTION-NAME as the condition " +
+ "designated by CONDITION-SYMBOL. Returns T if successful, NIL if not.")
private static final class pf_register_java_exception extends Primitive
{
pf_register_java_exception()
{
- super("register-java-exception", PACKAGE_JAVA, true,
- "exception-name condition-symbol");
+ super("register-java-exception", PACKAGE_JAVA, true);
}
@Override
@@ -98,14 +102,15 @@
}
};
- // ### unregister-java-exception exception-name => T or NIL
private static final Primitive UNREGISTER_JAVA_EXCEPTION = new pf_unregister_java_exception();
+ @DocString(name="unregister-java-exception", args="exception-name",
+ doc="Unregisters the Java Throwable EXCEPTION-NAME previously registered" +
+ " by REGISTER-JAVA-EXCEPTION.")
private static final class pf_unregister_java_exception extends Primitive
{
pf_unregister_java_exception()
{
- super("unregister-java-exception", PACKAGE_JAVA, true,
- "exception-name");
+ super("unregister-java-exception", PACKAGE_JAVA, true);
}
@Override
@@ -129,15 +134,17 @@
return null;
}
- // ### jclass name-or-class-ref &optional class-loader => class-ref
private static final Primitive JCLASS = new pf_jclass();
+ @DocString(name="jclass", args="name-or-class-ref &optional class-loader",
+ doc="Returns a reference to the Java class designated by" +
+ " NAME-OR-CLASS-REF. If the CLASS-LOADER parameter is passed, the" +
+ " class is resolved with respect to the given ClassLoader.")
private static final class pf_jclass extends Primitive
{
pf_jclass()
{
- super(Symbol.JCLASS, "name-or-class-ref &optional class-loader",
- "Returns a reference to the Java class designated by NAME-OR-CLASS-REF. If the CLASS-LOADER parameter is passed, the class is resolved with respect to the given ClassLoader.");
+ super(Symbol.JCLASS);
}
@Override
@@ -154,35 +161,6 @@
}
};
- // ### jfield - retrieve or modify a field in a Java class or instance.
- //
- // Supported argument patterns:
- //
- // Case 1: class-ref field-name:
- // to retrieve the value of a static field.
- //
- // Case 2: class-ref field-name instance-ref:
- // to retrieve the value of a class field of the instance.
- //
- // Case 3: class-ref field-name primitive-value:
- // to store primitive-value in a static field.
- //
- // Case 4: class-ref field-name instance-ref value:
- // to store value in a class field of the instance.
- //
- // Case 5: class-ref field-name nil value:
- // to store value in a static field (when value may be
- // confused with an instance-ref).
- //
- // Case 6: field-name instance:
- // to retrieve the value of a field of the instance. The
- // class is derived from the instance.
- //
- // Case 7: field-name instance value:
- // to store value in a field of the instance. The class is
- // derived from the instance.
- //
-
static final LispObject jfield(Primitive fun, LispObject[] args, boolean translate)
{
@@ -258,14 +236,35 @@
return NIL;
}
- // ### jfield class-ref-or-field field-or-instance &optional instance value
+
private static final Primitive JFIELD = new pf_jfield();
+ @DocString(name="jfield",
+ args="class-ref-or-field field-or-instance &optional instance value",
+ doc="Retrieves or modifies a field in a Java class or instance.\n\n"+
+ "Supported argument patterns:\n\n"+
+ " Case 1: class-ref field-name:\n"+
+ " Retrieves the value of a static field.\n\n"+
+ " Case 2: class-ref field-name instance-ref:\n"+
+ " Retrieves the value of a class field of the instance.\n\n"+
+ " Case 3: class-ref field-name primitive-value:\n"+
+ " Stores a primitive-value in a static field.\n\n"+
+ " Case 4: class-ref field-name instance-ref value:\n"+
+ " Stores value in a class field of the instance.\n\n"+
+ " Case 5: class-ref field-name nil value:\n"+
+ " Stores value in a static field (when value may be\n"+
+ " confused with an instance-ref).\n\n"+
+ " Case 6: field-name instance:\n"+
+ " Retrieves the value of a field of the instance. The\n"+
+ " class is derived from the instance.\n\n"+
+ " Case 7: field-name instance value:\n"+
+ " Stores value in a field of the instance. The class is\n"+
+ " derived from the instance.\n\n"
+ )
private static final class pf_jfield extends Primitive
{
pf_jfield()
{
- super("jfield", PACKAGE_JAVA, true,
- "class-ref-or-field field-or-instance &optional instance value");
+ super("jfield", PACKAGE_JAVA, true);
}
@Override
@@ -275,14 +274,35 @@
}
};
- // ### jfield-raw - retrieve or modify a field in a Java class or instance.
private static final Primitive JFIELD_RAW = new pf_jfield_raw();
+ @DocString(name="jfield",
+ args="class-ref-or-field field-or-instance &optional instance value",
+ doc="Retrieves or modifies a field in a Java class or instance. Does not\n"+
+ "attempt to coerce its value or the result into a Lisp object.\n\n"+
+ "Supported argument patterns:\n\n"+
+ " Case 1: class-ref field-name:\n"+
+ " Retrieves the value of a static field.\n\n"+
+ " Case 2: class-ref field-name instance-ref:\n"+
+ " Retrieves the value of a class field of the instance.\n\n"+
+ " Case 3: class-ref field-name primitive-value:\n"+
+ " Stores a primitive-value in a static field.\n\n"+
+ " Case 4: class-ref field-name instance-ref value:\n"+
+ " Stores value in a class field of the instance.\n\n"+
+ " Case 5: class-ref field-name nil value:\n"+
+ " Stores value in a static field (when value may be\n"+
+ " confused with an instance-ref).\n\n"+
+ " Case 6: field-name instance:\n"+
+ " Retrieves the value of a field of the instance. The\n"+
+ " class is derived from the instance.\n\n"+
+ " Case 7: field-name instance value:\n"+
+ " Stores value in a field of the instance. The class is\n"+
+ " derived from the instance.\n\n"
+ )
private static final class pf_jfield_raw extends Primitive
{
pf_jfield_raw()
{
- super("jfield-raw", PACKAGE_JAVA, true,
- "class-ref-or-field field-or-instance &optional instance value");
+ super("jfield-raw", PACKAGE_JAVA, true);
}
@Override
@@ -292,14 +312,15 @@
}
};
- // ### jconstructor class-ref &rest parameter-class-refs
private static final Primitive JCONSTRUCTOR = new pf_jconstructor();
+ @DocString(name="jconstructor", args="class-ref &rest parameter-class-refs",
+ doc="Returns a reference to the Java constructor of CLASS-REF with the" +
+ " given PARAMETER-CLASS-REFS.")
private static final class pf_jconstructor extends Primitive
{
pf_jconstructor()
{
- super("jconstructor", PACKAGE_JAVA, true,
- "class-ref &rest parameter-class-refs");
+ super("jconstructor", PACKAGE_JAVA, true);
}
@Override
@@ -342,14 +363,16 @@
}
};
- // ### jmethod class-ref name &rest parameter-class-refs
private static final Primitive JMETHOD = new pf_jmethod();
+
+ @DocString(name="jmethod", args="class-ref method-name &rest parameter-class-refs",
+ doc="Returns a reference to the Java method METHOD-NAME of CLASS-REF with the" +
+ " given PARAMETER-CLASS-REFS.")
private static final class pf_jmethod extends Primitive
{
pf_jmethod()
{
- super("jmethod", PACKAGE_JAVA, true,
- "class-ref name &rest parameter-class-refs");
+ super("jmethod", PACKAGE_JAVA, true);
}
@Override
@@ -470,13 +493,14 @@
return NIL;
}
- // ### jstatic method class &rest args
private static final Primitive JSTATIC = new pf_jstatic();
+ @DocString(name="jstatic", args="method class &rest args",
+ doc="Invokes the static method METHOD on class CLASS with ARGS.")
private static final class pf_jstatic extends Primitive
{
pf_jstatic()
{
- super("jstatic", PACKAGE_JAVA, true, "method class &rest args");
+ super("jstatic", PACKAGE_JAVA, true);
}
@Override
@@ -486,14 +510,15 @@
}
};
- // ### jstatic-raw method class &rest args
private static final Primitive JSTATIC_RAW = new pf_jstatic_raw();
+ @DocString(name="jstatic-raw", args="method class &rest args",
+ doc="Invokes the static method METHOD on class CLASS with ARGS. Does not "+
+ "attempt to coerce the arguments or result into a Lisp object.")
private static final class pf_jstatic_raw extends Primitive
{
pf_jstatic_raw()
{
- super("jstatic-raw", PACKAGE_JAVA, true,
- "method class &rest args");
+ super("jstatic-raw", PACKAGE_JAVA, true);
}
@Override
@@ -503,13 +528,14 @@
}
};
- // ### jnew constructor &rest args
private static final Primitive JNEW = new pf_jnew();
+ @DocString(name="jnew", args="constructor &rest args",
+ doc="Invokes the Java constructor CONSTRUCTOR with the arguments ARGS.")
private static final class pf_jnew extends Primitive
{
pf_jnew()
{
- super("jnew", PACKAGE_JAVA, true, "constructor &rest args");
+ super("jnew", PACKAGE_JAVA, true);
}
@Override
@@ -566,14 +592,15 @@
}
};
- // ### jnew-array element-type &rest dimensions
private static final Primitive JNEW_ARRAY = new pf_jnew_array();
+ @DocString(name="jnew-array", args="element-type &rest dimensions",
+ doc="Creates a new Java array of type ELEMENT-TYPE, with the given" +
+ " DIMENSIONS.")
private static final class pf_jnew_array extends Primitive
{
pf_jnew_array()
{
- super("jnew-array", PACKAGE_JAVA, true,
- "element-type &rest dimensions");
+ super("jnew-array", PACKAGE_JAVA, true);
}
@Override
@@ -624,14 +651,15 @@
return NIL;
}
- // ### jarray-ref java-array &rest indices
private static final Primitive JARRAY_REF = new pf_jarray_ref();
+ @DocString(name="jarray-ref", args="java-array &rest indices",
+ doc="Dereferences the Java array JAVA-ARRAY using the given INDICIES, " +
+ "coercing the result into a Lisp object, if possible.")
private static final class pf_jarray_ref extends Primitive
{
pf_jarray_ref()
{
- super("jarray-ref", PACKAGE_JAVA, true,
- "java-array &rest indices");
+ super("jarray-ref", PACKAGE_JAVA, true);
}
@Override
@@ -641,14 +669,15 @@
}
};
- // ### jarray-ref-raw java-array &rest indices
private static final Primitive JARRAY_REF_RAW = new pf_jarray_ref_raw();
+ @DocString(name="jarray-ref-raw", args="java-array &rest indices",
+ doc="Dereference the Java array JAVA-ARRAY using the given INDICIES. " +
+ "Does not attempt to coerce the result into a Lisp object.")
private static final class pf_jarray_ref_raw extends Primitive
{
pf_jarray_ref_raw()
{
- super("jarray-ref-raw", PACKAGE_JAVA, true,
- "java-array &rest indices");
+ super("jarray-ref-raw", PACKAGE_JAVA, true);
}
@Override
@@ -658,14 +687,14 @@
}
};
- // ### jarray-set java-array new-value &rest indices
private static final Primitive JARRAY_SET = new pf_jarray_set();
+ @DocString(name="jarray-set", args="java-array new-value &rest indices",
+ doc="Stores NEW-VALUE at the given index in JAVA-ARRAY.")
private static final class pf_jarray_set extends Primitive
{
pf_jarray_set()
{
- super("jarray-set", PACKAGE_JAVA, true,
- "java-array new-value &rest indices");
+ super("jarray-set", PACKAGE_JAVA, true);
}
@Override
@@ -698,14 +727,16 @@
}
};
- // ### jcall method instance &rest args
/** Calls makeLispObject() to convert the result to an appropriate Lisp type. */
private static final Primitive JCALL = new pf_jcall();
+ @DocString(name="jcall", args="method-ref instance &rest args",
+ doc="Invokes the Java method METHOD-REF on INSTANCE with arguments ARGS," +
+ " coercing the result into a Lisp object, if possible.")
private static final class pf_jcall extends Primitive
{
pf_jcall()
{
- super(Symbol.JCALL, "method-ref instance &rest args");
+ super(Symbol.JCALL);
}
@Override
@@ -715,17 +746,19 @@
}
};
- // ### jcall-raw method instance &rest args
/**
* Does no type conversion. The result of the call is simply wrapped in a
* JavaObject.
*/
private static final Primitive JCALL_RAW = new pf_jcall_raw();
+ @DocString(name="jcall-raw", args="method-ref instance &rest args",
+ doc="Invokes the Java method METHOD-REF on INSTANCE with arguments ARGS." +
+ " Does not attempt to coerce the result into a Lisp object.")
private static final class pf_jcall_raw extends Primitive
{
pf_jcall_raw()
{
- super(Symbol.JCALL_RAW, "method-ref instance &rest args");
+ super(Symbol.JCALL_RAW);
}
@Override
@@ -983,14 +1016,17 @@
}
}
- // ### make-immediate-object object &optional type
private static final Primitive MAKE_IMMEDIATE_OBJECT = new pf_make_immediate_object();
+ @DocString(name="make-immediate-object", args="object &optional type",
+ doc="Attempts to coerce a given Lisp object into a java-object of the\n"+
+ "given type. If type is not provided, works as jobject-lisp-value.\n"+
+ "Currently, type may be :BOOLEAN, treating the object as a truth value,\n"+
+ "or :REF, which returns Java null if NIL is provided.")
private static final class pf_make_immediate_object extends Primitive
{
pf_make_immediate_object()
{
- super("make-immediate-object", PACKAGE_JAVA, true,
- "object &optional type");
+ super("make-immediate-object", PACKAGE_JAVA, true);
}
@Override
@@ -1019,13 +1055,14 @@
}
};
- // ### java-object-p
private static final Primitive JAVA_OBJECT_P = new pf_java_object_p();
+ @DocString(name="java-object-p", args="object",
+ doc="Returns T if OBJECT is a JAVA-OBJECT.")
private static final class pf_java_object_p extends Primitive
{
pf_java_object_p()
{
- super("java-object-p", PACKAGE_JAVA, true, "object");
+ super("java-object-p", PACKAGE_JAVA, true);
}
@Override
@@ -1035,8 +1072,9 @@
}
};
- // ### jobject-lisp-value java-object
private static final Primitive JOBJECT_LISP_VALUE = new pf_jobject_lisp_value();
+ @DocString(name="jobject-lisp-value", args="java-object",
+ doc="Attempts to coerce JAVA-OBJECT into a Lisp object.")
private static final class pf_jobject_lisp_value extends Primitive
{
pf_jobject_lisp_value()
@@ -1051,13 +1089,15 @@
}
};
- // ### jcoerce java-object intended-class
private static final Primitive JCOERCE = new pf_jcoerce();
+ @DocString(name="jcoerce", args="object intended-class",
+ doc="Attempts to coerce OBJECT into a JavaObject of class INTENDED-CLASS." +
+ " Raises a TYPE-ERROR if no conversion is possible.")
private static final class pf_jcoerce extends Primitive
{
pf_jcoerce()
{
- super("jcoerce", PACKAGE_JAVA, true, "java-object intended-class");
+ super("jcoerce", PACKAGE_JAVA, true);
}
@Override
@@ -1073,8 +1113,10 @@
}
};
- // ### %jget-property-value java-object property-name
private static final Primitive JGET_PROPERTY_VALUE = new pf__jget_property_value();
+ @DocString(name="%jget-propety-value", args="java-object property-name",
+ doc="Gets a JavaBeans property on JAVA-OBJECT.\n" +
+ "SYSTEM-INTERNAL: Use jproperty-value instead.")
private static final class pf__jget_property_value extends Primitive
{
pf__jget_property_value()
@@ -1102,8 +1144,10 @@
}
};
- // ### %jset-property-value java-object property-name value
private static final Primitive JSET_PROPERTY_VALUE = new pf__jset_property_value();
+ @DocString(name="%jset-propety-value", args="java-object property-name value",
+ doc="Sets a JavaBean property on JAVA-OBJECT.\n" +
+ "SYSTEM-INTERNAL: Use (setf jproperty-value) instead.")
private static final class pf__jset_property_value extends Primitive
{
pf__jset_property_value()
@@ -1138,15 +1182,15 @@
}
};
-
- // ### jrun-exception-protected closure
private static final Primitive JRUN_EXCEPTION_PROTECTED = new pf_jrun_exception_protection();
+ @DocString(name="jrun-exception-protected", args="closure",
+ doc="Invokes the function CLOSURE and returns the result. "+
+ "Signals an error if stack or heap exhaustion occurs.")
private static final class pf_jrun_exception_protection extends Primitive
{
pf_jrun_exception_protection()
{
- super("jrun-exception-protected", PACKAGE_JAVA, true,
- "closure");
+ super("jrun-exception-protected", PACKAGE_JAVA, true);
}
@Override
Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Lisp.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Lisp.java Sun Jul 25 15:09:13 2010
@@ -89,7 +89,7 @@
Packages.createPackage("SEQUENCE");
- // ### nil
+ @DocString(name="nil")
public static final LispObject NIL = Nil.NIL;
// We need NIL before we can call usePackage().
@@ -261,7 +261,7 @@
return thread.setValues(form, NIL);
}
- // ### interactive-eval
+ @DocString(name="interactive-eval")
private static final Primitive INTERACTIVE_EVAL =
new Primitive("interactive-eval", PACKAGE_SYS, true)
{
Modified: trunk/abcl/src/org/armedbear/lisp/LispObject.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/LispObject.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/LispObject.java Sun Jul 25 15:09:13 2010
@@ -657,6 +657,23 @@
if (entry instanceof Cons)
return ((Cons)entry).cdr;
}
+ if(docType == Symbol.FUNCTION && this instanceof Symbol) {
+ Object fn = ((Symbol)this).getSymbolFunction();
+ if(fn instanceof Function) {
+ DocString ds = fn.getClass().getAnnotation(DocString.class);
+ if(ds != null) {
+ String arglist = ds.args();
+ String docstring = ds.doc();
+ if(arglist.length() != 0)
+ ((Function)fn).setLambdaList(new SimpleString(arglist));
+ if(docstring.length() != 0) {
+ SimpleString doc = new SimpleString(docstring);
+ ((Symbol)this).setDocumentation(Symbol.FUNCTION, doc);
+ return doc;
+ }
+ }
+ }
+ }
return NIL;
}
Modified: trunk/abcl/src/org/armedbear/lisp/LispThread.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/LispThread.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/LispThread.java Sun Jul 25 15:09:13 2010
@@ -860,7 +860,7 @@
return unreadableString(sb.toString());
}
- // ### make-thread
+ @DocString(name="make-thread", args="function &optional &key name")
private static final Primitive MAKE_THREAD =
new Primitive("make-thread", PACKAGE_THREADS, true, "function &optional &key name")
{
@@ -886,10 +886,10 @@
}
};
- // ### threadp
+ @DocString(name="threadp", args="object",
+ doc="Boolean predicate testing if OBJECT is a thread.")
private static final Primitive THREADP =
- new Primitive("threadp", PACKAGE_THREADS, true, "object",
- "Boolean predicate as whether OBJECT is a thread.")
+ new Primitive("threadp", PACKAGE_THREADS, true)
{
@Override
public LispObject execute(LispObject arg)
@@ -898,7 +898,8 @@
}
};
- // ### thread-alive-p
+ @DocString(name="thread-alive-p", args="thread",
+ doc="Returns T if THREAD is alive.")
private static final Primitive THREAD_ALIVE_P =
new Primitive("thread-alive-p", PACKAGE_THREADS, true, "thread",
"Boolean predicate whether THREAD is alive.")
@@ -917,10 +918,10 @@
}
};
- // ### thread-name
+ @DocString(name="thread-name", args="thread",
+ doc="Return the name of THREAD, if it has one.")
private static final Primitive THREAD_NAME =
- new Primitive("thread-name", PACKAGE_THREADS, true, "thread",
- "Return the name of THREAD if it has one.")
+ new Primitive("thread-name", PACKAGE_THREADS, true)
{
@Override
public LispObject execute(LispObject arg)
@@ -972,9 +973,10 @@
return (d < Long.MAX_VALUE ? (long) d : Long.MAX_VALUE);
}
- // ### sleep
- private static final Primitive SLEEP = new Primitive("sleep", PACKAGE_CL, true, "seconds",
- "Causes the invoking thread to sleep for SECONDS seconds.\nSECONDS may be a value between 0 1and 1.")
+ @DocString(name="sleep", args="seconds",
+ doc="Causes the invoking thread to sleep for SECONDS seconds.\n"+
+ "SECONDS may be a value between 0 1and 1.")
+ private static final Primitive SLEEP = new Primitive("sleep", PACKAGE_CL, true)
{
@Override
public LispObject execute(LispObject arg)
@@ -990,10 +992,10 @@
}
};
- // ### mapcar-threads
+ @DocString(name="mapcar-threads", args= "function",
+ doc="Applies FUNCTION to all existing threads.")
private static final Primitive MAPCAR_THREADS =
- new Primitive("mapcar-threads", PACKAGE_THREADS, true, "function",
- "Applies FUNCTION to all existing threads.")
+ new Primitive("mapcar-threads", PACKAGE_THREADS, true)
{
@Override
public LispObject execute(LispObject arg)
@@ -1011,10 +1013,9 @@
}
};
- // ### destroy-thread
+ @DocString(name="destroy-thread", args="thread", doc="Mark THREAD as destroyed")
private static final Primitive DESTROY_THREAD =
- new Primitive("destroy-thread", PACKAGE_THREADS, true, "thread",
- "Mark THREAD as destroyed.")
+ new Primitive("destroy-thread", PACKAGE_THREADS, true)
{
@Override
public LispObject execute(LispObject arg)
@@ -1031,11 +1032,12 @@
}
};
- // ### interrupt-thread thread function &rest args => T
- // Interrupts thread and forces it to apply function to args. When the
- // function returns, the thread's original computation continues. If
- // multiple interrupts are queued for a thread, they are all run, but the
- // order is not guaranteed.
+ // => T
+ @DocString(name="interrupt-thread", args="thread function &rest args",
+ doc="Interrupts thread and forces it to apply function to args. When the\n"+
+ "function returns, the thread's original computation continues. If\n"+
+ "multiple interrupts are queued for a thread, they are all run, but the\n"+
+ "order is not guaranteed.")
private static final Primitive INTERRUPT_THREAD =
new Primitive("interrupt-thread", PACKAGE_THREADS, true,
"thread function &rest args",
@@ -1062,10 +1064,10 @@
}
};
- // ### current-thread
+ @DocString(name="current-thread",
+ doc="Returns a reference to invoking thread.")
private static final Primitive CURRENT_THREAD =
- new Primitive("current-thread", PACKAGE_THREADS, true, "",
- "Returns a reference to invoking thread.")
+ new Primitive("current-thread", PACKAGE_THREADS, true)
{
@Override
public LispObject execute()
@@ -1074,10 +1076,10 @@
}
};
- // ### backtrace
+ @DocString(name="backtrace",
+ doc="Returns a backtrace of the invoking thread.")
private static final Primitive BACKTRACE =
- new Primitive("backtrace", PACKAGE_SYS, true, "",
- "Returns a backtrace of the invoking thread.")
+ new Primitive("backtrace", PACKAGE_SYS, true)
{
@Override
public LispObject execute(LispObject[] args)
@@ -1089,9 +1091,9 @@
return currentThread().backtrace(limit);
}
};
- // ### frame-to-string
+ @DocString(name="frame-to-string", args="frame")
private static final Primitive FRAME_TO_STRING =
- new Primitive("frame-to-string", PACKAGE_SYS, true, "frame")
+ new Primitive("frame-to-string", PACKAGE_SYS, true)
{
@Override
public LispObject execute(LispObject[] args)
@@ -1104,9 +1106,9 @@
}
};
- // ### frame-to-list
+ @DocString(name="frame-to-list", args="frame")
private static final Primitive FRAME_TO_LIST =
- new Primitive("frame-to-list", PACKAGE_SYS, true, "frame")
+ new Primitive("frame-to-list", PACKAGE_SYS, true)
{
@Override
public LispObject execute(LispObject[] args)
@@ -1120,7 +1122,7 @@
};
- // ### use-fast-calls
+ @DocString(name="use-fast-calls")
private static final Primitive USE_FAST_CALLS =
new Primitive("use-fast-calls", PACKAGE_SYS, true)
{
@@ -1132,7 +1134,7 @@
}
};
- // ### synchronized-on
+ @DocString(name="synchronized-on", args="form &body body")
private static final SpecialOperator SYNCHRONIZED_ON =
new SpecialOperator("synchronized-on", PACKAGE_THREADS, true,
"form &body body")
@@ -1151,10 +1153,9 @@
}
};
- // ### object-wait
+ @DocString(name="object-wait", args="object &optional timeout")
private static final Primitive OBJECT_WAIT =
- new Primitive("object-wait", PACKAGE_THREADS, true,
- "object &optional timeout")
+ new Primitive("object-wait", PACKAGE_THREADS, true)
{
@Override
public LispObject execute(LispObject object)
@@ -1189,7 +1190,7 @@
}
};
- // ### object-notify
+ @DocString(name="object-notify", args="object")
private static final Primitive OBJECT_NOTIFY =
new Primitive("object-notify", PACKAGE_THREADS, true,
"object")
@@ -1208,10 +1209,9 @@
}
};
- // ### object-notify-all
+ @DocString(name="object-notify-all", args="object")
private static final Primitive OBJECT_NOTIFY_ALL =
- new Primitive("object-notify-all", PACKAGE_THREADS, true,
- "object")
+ new Primitive("object-notify-all", PACKAGE_THREADS, true)
{
@Override
public LispObject execute(LispObject object)
Modified: trunk/abcl/src/org/armedbear/lisp/Operator.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Operator.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Operator.java Sun Jul 25 15:09:13 2010
@@ -53,6 +53,11 @@
public final LispObject getLambdaList()
{
+ if(lambdaList == null) {
+ DocString ds = getClass().getAnnotation(DocString.class);
+ if(ds != null)
+ lambdaList = new SimpleString(ds.args());
+ }
return lambdaList;
}
Modified: trunk/abcl/src/org/armedbear/lisp/Primitive.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Primitive.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Primitive.java Sun Jul 25 15:09:13 2010
@@ -45,6 +45,11 @@
super(name);
}
+ public Primitive(Symbol symbol)
+ {
+ super(symbol);
+ }
+
public Primitive(Symbol symbol, String arglist)
{
super(symbol, arglist);
Modified: trunk/abcl/src/org/armedbear/lisp/logorc2.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/logorc2.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/logorc2.java Sun Jul 25 15:09:13 2010
@@ -37,9 +37,9 @@
import java.math.BigInteger;
-// ### logorc2
// logorc2 integer-1 integer-2 => result-integer
// or integer-1 with complement of integer-2
+ at DocString(name="logorc2", args="integer-1 integer-2")
public final class logorc2 extends Primitive
{
private logorc2()
Modified: trunk/abcl/src/org/armedbear/lisp/package_error_package.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/package_error_package.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/package_error_package.java Sun Jul 25 15:09:13 2010
@@ -35,7 +35,7 @@
import static org.armedbear.lisp.Lisp.*;
-// ### package-error-package
+ at DocString(name="package-error-package")
public final class package_error_package extends Primitive
{
private package_error_package()
More information about the armedbear-cvs
mailing list