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.
parent 090b2672
......@@ -449,6 +449,7 @@ will load ASDF-INSTALL.
<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"/>
......
/*
* 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.
*/
@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 "";
}
......@@ -76,7 +76,7 @@ public class ForwardReferencedClass extends LispClass
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)
{
......
......@@ -52,8 +52,15 @@ public abstract class Function extends Operator
}
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 abstract class Function extends Operator
}
}
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 @@ public abstract class Function extends Operator
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 diff is collapsed.
......@@ -89,7 +89,7 @@ public final class Lisp
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 @@ public final class Lisp
return thread.setValues(form, NIL);
}
// ### interactive-eval
@DocString(name="interactive-eval")
private static final Primitive INTERACTIVE_EVAL =
new Primitive("interactive-eval", PACKAGE_SYS, true)
{
......
......@@ -657,6 +657,23 @@ public class LispObject //extends Lisp
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;
}
......
......@@ -860,7 +860,7 @@ public final class LispThread extends LispObject
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 @@ public final class LispThread extends LispObject
}
};
// ### 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 @@ public final class LispThread extends LispObject
}
};
// ### 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 @@ public final class LispThread extends LispObject
}
};
// ### 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 @@ public final class LispThread extends LispObject
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 @@ public final class LispThread extends LispObject
}
};
// ### 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 @@ public final class LispThread extends LispObject
}
};
// ### 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 @@ public final class LispThread extends LispObject
}
};
// ### 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 @@ public final class LispThread extends LispObject
}
};
// ### 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 @@ public final class LispThread extends LispObject
}
};
// ### 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 @@ public final class LispThread extends LispObject
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 @@ public final class LispThread extends LispObject
}
};
// ### 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 @@ public final class LispThread extends LispObject
};
// ### 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 @@ public final class LispThread extends LispObject
}
};
// ### 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 @@ public final class LispThread extends LispObject
}
};
// ### 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 @@ public final class LispThread extends LispObject
}
};
// ### 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 @@ public final class LispThread extends LispObject
}
};
// ### 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)
......
......@@ -53,6 +53,11 @@ public abstract class Operator extends LispObject
public final LispObject getLambdaList()
{
if(lambdaList == null) {
DocString ds = getClass().getAnnotation(DocString.class);
if(ds != null)
lambdaList = new SimpleString(ds.args());
}
return lambdaList;
}
......
......@@ -45,6 +45,11 @@ public class Primitive extends Function
super(name);
}
public Primitive(Symbol symbol)
{
super(symbol);
}
public Primitive(Symbol symbol, String arglist)
{
super(symbol, arglist);
......
......@@ -37,9 +37,9 @@ import static org.armedbear.lisp.Lisp.*;
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()
......
......@@ -35,7 +35,7 @@ package org.armedbear.lisp;
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()
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment