[armedbear-cvs] r11772 - trunk/abcl/src/org/armedbear/lisp
Erik Huelsmann
ehuelsmann at common-lisp.net
Mon Apr 20 20:21:38 UTC 2009
Author: ehuelsmann
Date: Mon Apr 20 16:21:37 2009
New Revision: 11772
Log:
Factor out functions to separate declarations, the body and optionally the
documentation as well as to determine which variables have been declared
special.
Modified:
trunk/abcl/src/org/armedbear/lisp/Closure.java
trunk/abcl/src/org/armedbear/lisp/Do.java
trunk/abcl/src/org/armedbear/lisp/Environment.java
trunk/abcl/src/org/armedbear/lisp/Lisp.java
trunk/abcl/src/org/armedbear/lisp/Primitives.java
trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java
trunk/abcl/src/org/armedbear/lisp/dolist.java
trunk/abcl/src/org/armedbear/lisp/dotimes.java
Modified: trunk/abcl/src/org/armedbear/lisp/Closure.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Closure.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Closure.java Mon Apr 20 16:21:37 2009
@@ -62,6 +62,7 @@
private Parameter[] keywordParameters = emptyParameterArray;
private Parameter[] auxVars = emptyParameterArray;
private final LispObject body;
+ private final LispObject executionBody;
private final Environment environment;
private final boolean andKey;
private final boolean allowOtherKeys;
@@ -78,7 +79,7 @@
emptySymbolArray = new Symbol[0];
}
private Symbol[] variables = emptySymbolArray;
- private Symbol[] specials = emptySymbolArray;
+ private LispObject specials = NIL;
private boolean bindInitForms;
@@ -292,6 +293,10 @@
maxArgs = 0;
}
this.body = lambdaExpression.cddr();
+ LispObject bodyAndDecls = parseBody(this.body, false);
+ this.executionBody = bodyAndDecls.car();
+ this.specials = parseSpecials(bodyAndDecls.NTH(1));
+
this.environment = env;
this.andKey = _andKey;
this.allowOtherKeys = _allowOtherKeys;
@@ -299,7 +304,6 @@
if (arity >= 0)
Debug.assertTrue(arity == minArgs);
variables = processVariables();
- specials = processDeclarations();
}
private final void processParameters(ArrayList<Symbol> vars,
@@ -333,45 +337,6 @@
return array;
}
- private final Symbol[] processDeclarations() throws ConditionThrowable
- {
- ArrayList<Symbol> arrayList = null;
- LispObject forms = body;
- while (forms != NIL)
- {
- LispObject obj = forms.car();
- if (obj instanceof Cons && obj.car() == Symbol.DECLARE)
- {
- LispObject decls = obj.cdr();
- while (decls != NIL)
- {
- LispObject decl = decls.car();
- if (decl instanceof Cons && decl.car() == Symbol.SPECIAL)
- {
- LispObject vars = decl.cdr();
- while (vars != NIL)
- {
- Symbol var = checkSymbol(vars.car());
- if (arrayList == null)
- arrayList = new ArrayList<Symbol>();
- arrayList.add(var);
- vars = vars.cdr();
- }
- }
- decls = decls.cdr();
- }
- forms = forms.cdr();
- }
- else
- break;
- }
- if (arrayList == null)
- return emptySymbolArray;
- Symbol[] array = new Symbol[arrayList.size()];
- arrayList.toArray(array);
- return array;
- }
-
private static final void invalidParameter(LispObject obj)
throws ConditionThrowable
{
@@ -411,7 +376,7 @@
{
if (arity == 0)
{
- return progn(body, environment,
+ return progn(executionBody, environment,
LispThread.currentThread());
}
else
@@ -435,7 +400,7 @@
bindAuxVars(ext, thread);
try
{
- return progn(body, ext, thread);
+ return progn(executionBody, ext, thread);
}
finally
{
@@ -614,8 +579,11 @@
bindArg(specials, sym, args[i], ext, thread);
}
bindAuxVars(ext, thread);
+ LispObject s = specials;
special:
- for (Symbol special : specials) {
+ while (s != NIL) {
+ Symbol special = (Symbol)s.car();
+ s = s.cdr();
for (Symbol var : variables)
if (special == var)
continue special;
@@ -626,7 +594,7 @@
}
try
{
- return progn(body, ext, thread);
+ return progn(executionBody, ext, thread);
}
finally
{
Modified: trunk/abcl/src/org/armedbear/lisp/Do.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Do.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Do.java Mon Apr 20 16:21:37 2009
@@ -96,32 +96,11 @@
final LispObject stack = thread.getStack();
final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
// Process declarations.
- LispObject specials = NIL;
- while (body != NIL)
- {
- LispObject obj = body.car();
- if (obj instanceof Cons && obj.car() == Symbol.DECLARE)
- {
- LispObject decls = obj.cdr();
- while (decls != NIL)
- {
- LispObject decl = decls.car();
- if (decl instanceof Cons && decl.car() == Symbol.SPECIAL)
- {
- LispObject names = decl.cdr();
- while (names != NIL)
- {
- specials = new Cons(names.car(), specials);
- names = names.cdr();
- }
- }
- decls = decls.cdr();
- }
- body = body.cdr();
- }
- else
- break;
- }
+
+ final LispObject bodyAndDecls = parseBody(body, false);
+ LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
+ body = bodyAndDecls.car();
+
final Environment ext = new Environment(env);
for (int i = 0; i < numvars; i++)
{
Modified: trunk/abcl/src/org/armedbear/lisp/Environment.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Environment.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Environment.java Mon Apr 20 16:21:37 2009
@@ -203,33 +203,12 @@
public LispObject processDeclarations(LispObject body)
throws ConditionThrowable
{
- while (body != NIL)
- {
- LispObject obj = body.car();
- if (obj instanceof Cons && ((Cons)obj).car == Symbol.DECLARE)
- {
- LispObject decls = ((Cons)obj).cdr;
- while (decls != NIL)
- {
- LispObject decl = decls.car();
- if (decl instanceof Cons && ((Cons)decl).car == Symbol.SPECIAL)
- {
- LispObject names = ((Cons)decl).cdr;
- while (names != NIL)
- {
- Symbol var = checkSymbol(names.car());
- declareSpecial(var);
- names = ((Cons)names).cdr;
- }
- }
- decls = ((Cons)decls).cdr;
- }
- body = ((Cons)body).cdr;
- }
- else
- break;
- }
- return body;
+ LispObject bodyAndDecls = parseBody(body, false);
+ LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
+ for (; specials != NIL; specials = specials.cdr())
+ declareSpecial(checkSymbol(specials.car()));
+
+ return bodyAndDecls.car();
}
public void declareSpecial(Symbol var)
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 Mon Apr 20 16:21:37 2009
@@ -546,6 +546,59 @@
return thread.execute(function, array);
}
+ public static final LispObject parseBody(LispObject body,
+ boolean documentationAllowed)
+ throws ConditionThrowable
+ {
+ LispObject decls = NIL;
+ LispObject doc = NIL;
+
+ while (body != NIL) {
+ LispObject form = body.car();
+ if (documentationAllowed && form instanceof AbstractString
+ && body.cdr() != NIL) {
+ doc = body.car();
+ documentationAllowed = false;
+ } else if (form instanceof Cons && form.car() == Symbol.DECLARE)
+ decls = new Cons(form, decls);
+ else
+ break;
+
+ body = body.cdr();
+ }
+ return list(body, decls.nreverse(), doc);
+ }
+
+ public static final LispObject parseSpecials(LispObject forms)
+ throws ConditionThrowable
+ {
+ LispObject specials = NIL;
+ while (forms != NIL) {
+ LispObject decls = forms.car();
+
+ Debug.assertTrue(decls instanceof Cons);
+ Debug.assertTrue(decls.car() == Symbol.DECLARE);
+ decls = decls.cdr();
+ while (decls != NIL) {
+ LispObject decl = decls.car();
+
+ if (decl instanceof Cons && decl.car() == Symbol.SPECIAL) {
+ decl = decl.cdr();
+ while (decl != NIL) {
+ specials = new Cons(checkSymbol(decl.car()), specials);
+ decl = decl.cdr();
+ }
+ }
+
+ decls = decls.cdr();
+ }
+
+ forms = forms.cdr();
+ }
+
+ return specials;
+ }
+
public static final LispObject progn(LispObject body, Environment env,
LispThread thread)
throws ConditionThrowable
@@ -560,22 +613,24 @@
}
// Environment wrappers.
- private static final boolean isSpecial(Symbol sym, Symbol[] ownSpecials,
+ private static final boolean isSpecial(Symbol sym, LispObject ownSpecials,
Environment env)
+ throws ConditionThrowable
{
if (ownSpecials != null)
{
if (sym.isSpecialVariable())
return true;
- for (Symbol special : ownSpecials)
+ for (; ownSpecials != NIL; ownSpecials = ownSpecials.cdr())
{
- if (sym == special)
+ if (sym == ownSpecials.car())
return true;
}
}
return false;
}
- protected static final void bindArg(Symbol[] ownSpecials,
+
+ protected static final void bindArg(LispObject ownSpecials,
Symbol sym, LispObject value,
Environment env, LispThread thread)
throws ConditionThrowable
Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Primitives.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/Primitives.java Mon Apr 20 16:21:37 2009
@@ -3746,32 +3746,10 @@
values[0] = value;
}
// Process declarations.
- LispObject specials = NIL;
- while (body != NIL)
- {
- LispObject obj = body.car();
- if (obj instanceof Cons && ((Cons)obj).car == Symbol.DECLARE)
- {
- LispObject decls = ((Cons)obj).cdr;
- while (decls != NIL)
- {
- LispObject decl = decls.car();
- if (decl instanceof Cons && ((Cons)decl).car == Symbol.SPECIAL)
- {
- LispObject declvars = ((Cons)decl).cdr;
- while (declvars != NIL)
- {
- specials = new Cons(declvars.car(), specials);
- declvars = ((Cons)declvars).cdr;
- }
- }
- decls = ((Cons)decls).cdr;
- }
- body = ((Cons)body).cdr;
- }
- else
- break;
- }
+ LispObject bodyAndDecls = parseBody(body, false);
+ LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
+ body = bodyAndDecls.car();
+
final SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
final Environment ext = new Environment(env);
int i = 0;
Modified: trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/SpecialOperators.java Mon Apr 20 16:21:37 2009
@@ -118,37 +118,12 @@
try
{
LispObject varList = checkList(args.car());
- LispObject body = args.cdr();
- // Process declarations.
- ArrayList<Symbol> specials = new ArrayList<Symbol>();
- while (body != NIL)
- {
- LispObject obj = body.car();
- if (obj instanceof Cons && ((Cons)obj).car == Symbol.DECLARE)
- {
- LispObject decls = ((Cons)obj).cdr;
- while (decls != NIL)
- {
- LispObject decl = decls.car();
- if (decl instanceof Cons && ((Cons)decl).car == Symbol.SPECIAL)
- {
- LispObject vars = ((Cons)decl).cdr;
- while (vars != NIL)
- {
- specials.add(0, (Symbol) vars.car());
- vars = ((Cons)vars).cdr;
- }
- }
- decls = ((Cons)decls).cdr;
- }
- body = ((Cons)body).cdr;
- }
- else
- break;
- }
+ LispObject bodyAndDecls = parseBody(args.cdr(), false);
+ LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
+ LispObject body = bodyAndDecls.car();
+
Environment ext = new Environment(env);
LinkedList<Cons> nonSequentialVars = new LinkedList<Cons>();
- Symbol[] arrayToUseForSpecials = new Symbol[0];
while (varList != NIL)
{
final Symbol symbol;
@@ -169,28 +144,22 @@
value = NIL;
}
if (sequential)
- bindArg(specials.toArray(arrayToUseForSpecials),
- symbol, value, ext, thread);
+ bindArg(specials, symbol, value, ext, thread);
else
nonSequentialVars.add(new Cons(symbol, value));
varList = ((Cons)varList).cdr;
}
if (!sequential)
- {
- for (Cons x : nonSequentialVars)
- {
- bindArg(specials.toArray(arrayToUseForSpecials),
- (Symbol)x.car(), x.cdr(), ext, thread);
- }
- }
+ for (Cons x : nonSequentialVars)
+ bindArg(specials, (Symbol)x.car(), x.cdr(), ext, thread);
+
// Make sure free special declarations are visible in the body.
// "The scope of free declarations specifically does not include
// initialization forms for bindings established by the form
// containing the declarations." (3.3.4)
- for (Symbol symbol : specials)
- {
- ext.declareSpecial(symbol);
- }
+ for (; specials != NIL; specials = specials.cdr())
+ ext.declareSpecial((Symbol)specials.car());
+
return progn(body, ext, thread);
}
finally
Modified: trunk/abcl/src/org/armedbear/lisp/dolist.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/dolist.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/dolist.java Mon Apr 20 16:21:37 2009
@@ -54,32 +54,10 @@
SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
final LispObject stack = thread.getStack();
// Process declarations.
- LispObject specials = NIL;
- while (bodyForm != NIL)
- {
- LispObject obj = bodyForm.car();
- if (obj instanceof Cons && obj.car() == Symbol.DECLARE)
- {
- LispObject decls = obj.cdr();
- while (decls != NIL)
- {
- LispObject decl = decls.car();
- if (decl instanceof Cons && decl.car() == Symbol.SPECIAL)
- {
- LispObject vars = decl.cdr();
- while (vars != NIL)
- {
- specials = new Cons(vars.car(), specials);
- vars = vars.cdr();
- }
- }
- decls = decls.cdr();
- }
- bodyForm = bodyForm.cdr();
- }
- else
- break;
- }
+ LispObject bodyAndDecls = parseBody(bodyForm, false);
+ LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
+ bodyForm = bodyAndDecls.car();
+
try
{
final Environment ext = new Environment(env);
Modified: trunk/abcl/src/org/armedbear/lisp/dotimes.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/dotimes.java (original)
+++ trunk/abcl/src/org/armedbear/lisp/dotimes.java Mon Apr 20 16:21:37 2009
@@ -52,33 +52,11 @@
LispObject resultForm = args.cdr().cdr().car();
SpecialBinding lastSpecialBinding = thread.lastSpecialBinding;
final LispObject stack = thread.getStack();
- // Process declarations.
- LispObject specials = NIL;
- while (bodyForm != NIL)
- {
- LispObject obj = bodyForm.car();
- if (obj instanceof Cons && obj.car() == Symbol.DECLARE)
- {
- LispObject decls = obj.cdr();
- while (decls != NIL)
- {
- LispObject decl = decls.car();
- if (decl instanceof Cons && decl.car() == Symbol.SPECIAL)
- {
- LispObject vars = decl.cdr();
- while (vars != NIL)
- {
- specials = new Cons(vars.car(), specials);
- vars = vars.cdr();
- }
- }
- decls = decls.cdr();
- }
- bodyForm = bodyForm.cdr();
- }
- else
- break;
- }
+
+ LispObject bodyAndDecls = parseBody(bodyForm, false);
+ LispObject specials = parseSpecials(bodyAndDecls.NTH(1));
+ bodyForm = bodyAndDecls.car();
+
try
{
LispObject limit = eval(countForm, env, thread);
More information about the armedbear-cvs
mailing list