Property changes on: . ___________________________________________________________________ Modified: svn:ignore - .cvsignore config.cache config.log config.status autom4te.cache classes.stamp j j.bat abcl abcl.bat j.jar *.zip *.tar.gz Makefile abcl.jar compile-system.bat customizations.lisp make-jar.bat *.patch build dist *.properties ext + *.diff *.log *.patch *.properties *.tar.gz *.zip .cvsignore Makefile abcl abcl.bat abcl.jar autom4te.cache build classes.stamp compile-system.bat config.cache config.log config.status customizations.lisp dist ext j j.bat j.jar make-jar.bat Index: build.xml =================================================================== --- build.xml (revision 12823) +++ build.xml (working copy) @@ -449,6 +449,7 @@ + Index: src/org/armedbear/lisp/ForwardReferencedClass.java =================================================================== --- src/org/armedbear/lisp/ForwardReferencedClass.java (revision 12823) +++ src/org/armedbear/lisp/ForwardReferencedClass.java (working copy) @@ -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) { Index: src/org/armedbear/lisp/Function.java =================================================================== --- src/org/armedbear/lisp/Function.java (revision 12823) +++ src/org/armedbear/lisp/Function.java (working copy) @@ -46,6 +46,11 @@ */ private final LispObject loadedFrom; + /** + * Examine this object's class to determine if there is a DocString annotation, and if so, + * add the documentation. + */ + protected Function() { LispObject loadTruename = Symbol.LOAD_TRUENAME.symbolValueNoThrow(); loadedFrom = loadTruename != null ? loadTruename : NIL; @@ -53,7 +58,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 +74,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,19 +91,13 @@ 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) { this(name, pkg, false); Index: src/org/armedbear/lisp/Java.java =================================================================== --- src/org/armedbear/lisp/Java.java (revision 12823) +++ src/org/armedbear/lisp/Java.java (working copy) @@ -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 Index: src/org/armedbear/lisp/Lisp.java =================================================================== --- src/org/armedbear/lisp/Lisp.java (revision 12823) +++ src/org/armedbear/lisp/Lisp.java (working copy) @@ -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) { Index: src/org/armedbear/lisp/LispObject.java =================================================================== --- src/org/armedbear/lisp/LispObject.java (revision 12823) +++ src/org/armedbear/lisp/LispObject.java (working copy) @@ -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; } Index: src/org/armedbear/lisp/LispThread.java =================================================================== --- src/org/armedbear/lisp/LispThread.java (revision 12823) +++ src/org/armedbear/lisp/LispThread.java (working copy) @@ -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) Index: src/org/armedbear/lisp/logorc2.java =================================================================== --- src/org/armedbear/lisp/logorc2.java (revision 12823) +++ src/org/armedbear/lisp/logorc2.java (working copy) @@ -37,9 +37,9 @@ import java.math.BigInteger; -// ### logorc2 // logorc2 integer-1 integer-2 => result-integer // or integer-1 with complement of integer-2 +@DocString(name="logorc2", args="integer-1 integer-2") public final class logorc2 extends Primitive { private logorc2() Index: src/org/armedbear/lisp/Operator.java =================================================================== --- src/org/armedbear/lisp/Operator.java (revision 12823) +++ src/org/armedbear/lisp/Operator.java (working copy) @@ -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; } Index: src/org/armedbear/lisp/package_error_package.java =================================================================== --- src/org/armedbear/lisp/package_error_package.java (revision 12823) +++ src/org/armedbear/lisp/package_error_package.java (working copy) @@ -35,7 +35,7 @@ import static org.armedbear.lisp.Lisp.*; -// ### package-error-package +@DocString(name="package-error-package") public final class package_error_package extends Primitive { private package_error_package() Index: src/org/armedbear/lisp/Primitive.java =================================================================== --- src/org/armedbear/lisp/Primitive.java (revision 12823) +++ src/org/armedbear/lisp/Primitive.java (working copy) @@ -45,6 +45,11 @@ super(name); } + public Primitive(Symbol symbol) + { + super(symbol); + } + public Primitive(Symbol symbol, String arglist) { super(symbol, arglist);