[armedbear-cvs] r13849 - trunk/abcl/src/org/armedbear/lisp
ehuelsmann at common-lisp.net
ehuelsmann at common-lisp.net
Sat Feb 4 11:35:40 UTC 2012
Author: ehuelsmann
Date: Sat Feb 4 03:35:39 2012
New Revision: 13849
Log:
Switch compiled closures over to the ArgumentListProcessor completely.
Removes Closure.Parameter class.
Modified:
trunk/abcl/src/org/armedbear/lisp/ArgumentListProcessor.java
trunk/abcl/src/org/armedbear/lisp/Closure.java
trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
Modified: trunk/abcl/src/org/armedbear/lisp/ArgumentListProcessor.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/ArgumentListProcessor.java Fri Feb 3 22:56:01 2012 (r13848)
+++ trunk/abcl/src/org/armedbear/lisp/ArgumentListProcessor.java Sat Feb 4 03:35:39 2012 (r13849)
@@ -102,39 +102,39 @@
* @param moreKeys Indicates whether &allow-other-keys was specified
* @param rest Specifies the &rest variable name, if one was specified, or 'null' if none
*/
- public ArgumentListProcessor(Operator fun, Collection<RequiredParam> required,
- Collection<OptionalParam> optional, Collection<KeywordParam> keyword,
+ public ArgumentListProcessor(Operator fun, int requiredCount,
+ OptionalParam[] optional, KeywordParam[] keyword,
boolean key, boolean moreKeys, Symbol rest) {
function = fun;
- requiredParameters = new RequiredParam[required.size()];
- requiredParameters = required.toArray(requiredParameters);
-
- optionalParameters = new OptionalParam[optional.size()];
- optionalParameters = optional.toArray(optionalParameters);
+ requiredParameters = new RequiredParam[requiredCount];
+ positionalParameters = new Param[requiredCount + optional.length
+ + ((rest != null) ? 1 : 0)];
+
+ // the same anonymous required parameter can be used any number of times
+ RequiredParam r = new RequiredParam();
+ for (int i = 0; i < requiredCount; i++) {
+ requiredParameters[i] = r;
+ positionalParameters[i] = r;
+ }
+
+ optionalParameters = optional;
+ System.arraycopy(optional, 0,
+ positionalParameters, requiredCount, optional.length);
- keywordParameters = new KeywordParam[keyword.size()];
- keywordParameters = keyword.toArray(keywordParameters);
-
restVar = rest;
if (restVar != null)
- restParam = new RestParam(rest, false);
-
+ positionalParameters[requiredCount + optional.length] =
+ restParam = new RestParam(rest, false);
+
andKey = key;
allowOtherKeys = moreKeys;
-
- List<Param> positionalParam = new ArrayList<Param>();
- positionalParam.addAll(required);
- positionalParam.addAll(optional);
- if (restVar != null)
- positionalParam.add(restParam);
+ keywordParameters = keyword;
+
-
- positionalParameters = new Param[positionalParam.size()];
- positionalParameters = positionalParam.toArray(positionalParameters);
-
auxVars = new Param[0];
+
variables = extractVariables();
specials = new boolean[variables.length]; // default values 'false' -- leave that way
@@ -145,7 +145,7 @@
arity = (rest == null && ! allowOtherKeys && ! andKey && optionalParameters.length == 0)
? maxArgs : -1;
- if (optional.isEmpty() && keyword.isEmpty())
+ if (keyword.length == 0)
matcher = new FastMatcher();
else
matcher = new SlowMatcher();
@@ -432,6 +432,10 @@
}
+ public void setFunction(Operator fun) {
+ function = fun;
+ }
+
/** Matches the function call arguments 'args' with the lambda list,
* returning an array with variable values to be used. The array is sorted
* the same way as the variables returned by the 'extractVariables' function.
@@ -865,6 +869,11 @@
Symbol var;
boolean special;
+ // Used above to create anonymous required parameters
+ public RequiredParam() {
+ this(T, false);
+ }
+
public RequiredParam(Symbol var, boolean special) {
this.var = var;
this.special = special;
@@ -894,6 +903,9 @@
boolean suppliedSpecial;
InitForm initForm;
+ public OptionalParam(boolean suppliedVar, LispObject form) {
+ this(T, false, suppliedVar ? T : null, false, form);
+ }
public OptionalParam(Symbol var, boolean special,
Symbol suppliedVar, boolean suppliedSpecial,
@@ -981,6 +993,10 @@
public static class KeywordParam extends OptionalParam {
public Symbol keyword;
+ public KeywordParam(boolean suppliedVar, LispObject form, Symbol keyword) {
+ this(T, false, suppliedVar ? T : null, false, form, keyword);
+ }
+
public KeywordParam(Symbol var, boolean special,
Symbol suppliedVar, boolean suppliedSpecial,
LispObject form, Symbol keyword) {
Modified: trunk/abcl/src/org/armedbear/lisp/Closure.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Closure.java Fri Feb 3 22:56:01 2012 (r13848)
+++ trunk/abcl/src/org/armedbear/lisp/Closure.java Sat Feb 4 03:35:39 2012 (r13849)
@@ -36,8 +36,6 @@
import static org.armedbear.lisp.Lisp.*;
-import java.util.ArrayList;
-
public class Closure extends Function
{
// Parameter types.
@@ -65,37 +63,12 @@
* @param rest the &rest parameter, or NIL if none
* @param moreKeys NIL if &allow-other-keys not present, T otherwise
*/
- public Closure(Parameter[] required,
- Parameter[] optional,
- Parameter[] keyword,
- Symbol keys, Symbol rest, Symbol moreKeys) {
+ public Closure(ArgumentListProcessor arglist) {
// stuff we don't need: we're a compiled function
body = null;
executionBody = null;
environment = null;
-
- ArrayList<ArgumentListProcessor.RequiredParam> reqParams =
- new ArrayList<ArgumentListProcessor.RequiredParam>();
- for (Parameter req : required)
- reqParams.add(new ArgumentListProcessor.RequiredParam(req.var, false));
-
- ArrayList<ArgumentListProcessor.OptionalParam> optParams =
- new ArrayList<ArgumentListProcessor.OptionalParam>();
- for (Parameter opt : optional)
- optParams.add(new ArgumentListProcessor.OptionalParam(opt.var, false,
- (opt.svar == NIL) ? null : (Symbol)opt.svar, false,
- opt.initForm));
-
- ArrayList<ArgumentListProcessor.KeywordParam> keyParams =
- new ArrayList<ArgumentListProcessor.KeywordParam>();
- for (Parameter key : keyword)
- keyParams.add(new ArgumentListProcessor.KeywordParam(key.var, false,
- (key.svar == NIL) ? null : (Symbol)key.svar, false, key.initForm,
- key.keyword));
- arglist = new ArgumentListProcessor(this, reqParams, optParams,
- keyParams, keys != NIL,
- moreKeys != NIL,
- (rest == NIL) ? null : rest);
+ this.arglist = arglist;
freeSpecials = new Symbol[0];
}
@@ -254,99 +227,6 @@
return arglist.match(args, environment, null, null);
}
- public static class Parameter
- {
- final Symbol var;
- final LispObject initForm;
- final LispObject initVal;
- final LispObject svar;
- private final int type;
- final Symbol keyword;
-
- public Parameter(Symbol var)
- {
- this.var = var;
- this.initForm = null;
- this.initVal = null;
- this.svar = NIL;
- this.type = REQUIRED;
- this.keyword = null;
- }
-
- public Parameter(Symbol var, LispObject initForm, int type)
-
- {
- this.var = var;
- this.initForm = initForm;
- this.initVal = processInitForm(initForm);
- this.svar = NIL;
- this.type = type;
- keyword =
- type == KEYWORD ? PACKAGE_KEYWORD.intern(var.name) : null;
- }
-
- public Parameter(Symbol var, LispObject initForm, LispObject svar,
- int type)
-
- {
- this.var = var;
- this.initForm = initForm;
- this.initVal = processInitForm(initForm);
- this.svar = (svar != NIL) ? checkSymbol(svar) : NIL;
- this.type = type;
- keyword =
- type == KEYWORD ? PACKAGE_KEYWORD.intern(var.name) : null;
- }
-
- public Parameter(Symbol keyword, Symbol var, LispObject initForm,
- LispObject svar)
-
- {
- this.var = var;
- this.initForm = initForm;
- this.initVal = processInitForm(initForm);
- this.svar = (svar != NIL) ? checkSymbol(svar) : NIL;
- type = KEYWORD;
- this.keyword = keyword;
- }
-
- @Override
- public String toString()
- {
- if (type == REQUIRED)
- return var.toString();
- StringBuffer sb = new StringBuffer();
- if (keyword != null)
- {
- sb.append(keyword);
- sb.append(' ');
- }
- sb.append(var.toString());
- sb.append(' ');
- sb.append(initForm);
- sb.append(' ');
- sb.append(type);
- return sb.toString();
- }
-
- private static final LispObject processInitForm(LispObject initForm)
-
- {
- if (initForm.constantp())
- {
- if (initForm instanceof Symbol)
- return initForm.getSymbolValue();
- if (initForm instanceof Cons)
- {
- Debug.assertTrue(initForm.car() == Symbol.QUOTE);
- return initForm.cadr();
- }
- return initForm;
- }
- return null;
- }
- }
-
// ### lambda-list-names
private static final Primitive LAMBDA_LIST_NAMES =
new Primitive("lambda-list-names", PACKAGE_SYS, true)
Modified: trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java Fri Feb 3 22:56:01 2012 (r13848)
+++ trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java Sat Feb 4 03:35:39 2012 (r13849)
@@ -41,12 +41,9 @@
public ClosureBinding[] ctx;
- public CompiledClosure(Parameter[] required,
- Parameter[] optional,
- Parameter[] keyword,
- Symbol keys, Symbol rest, Symbol moreKeys)
+ public CompiledClosure(ArgumentListProcessor arglist)
{
- super(required, optional, keyword, keys, rest, moreKeys);
+ super(arglist);
}
Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Fri Feb 3 22:56:01 2012 (r13848)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp Sat Feb 4 03:35:39 2012 (r13849)
@@ -949,12 +949,13 @@
:flags '(:public)))
;; We don't normally need to see debugging output for constructors.
(super (class-file-superclass class))
- req-params-register
opt-params-register
key-params-register
+ req-count
rest-p
keys-p
- more-keys-p)
+ more-keys-p
+ alp-register)
(with-code-to-method (class method)
(allocate-register nil)
(unless (eq super +lisp-compiled-primitive+)
@@ -964,13 +965,14 @@
(parse-lambda-list args)
(setf rest-p rest
more-keys-p allow-other-keys-p
- keys-p key-p)
+ keys-p key-p
+ req-count (length req))
(macrolet
- ((parameters-to-array ((param params register) &body body)
+ ((parameters-to-array ((param params register class) &body body)
(let ((count-sym (gensym)))
`(progn
(emit-push-constant-int (length ,params))
- (emit-anewarray +lisp-closure-parameter+)
+ (emit-anewarray ,class)
(astore (setf ,register *registers-allocated*))
(allocate-register nil)
(do* ((,count-sym 0 (1+ ,count-sym))
@@ -980,28 +982,25 @@
(declare (ignorable ,param))
(aload ,register)
(emit-push-constant-int ,count-sym)
- (emit-new +lisp-closure-parameter+)
+ (emit-new ,class)
(emit 'dup)
, at body
(emit 'aastore))))))
- ;; process required args
- (parameters-to-array (ignore req req-params-register)
- (emit-push-t) ;; we don't need the actual symbol
- (emit-invokespecial-init +lisp-closure-parameter+
- (list +lisp-symbol+)))
-
- (parameters-to-array (param opt opt-params-register)
- (emit-push-t) ;; we don't need the actual variable-symbol
+ (parameters-to-array (param opt opt-params-register
+ +alp-optional-parameter+)
+ (if (null (third param)) ;; supplied-p or not?
+ (emit 'iconst_0)
+ (emit 'iconst_1))
(emit-read-from-string (second param)) ;; initform
- (if (null (third param)) ;; supplied-p
- (emit-push-nil)
- (emit-push-t)) ;; we don't need the actual supplied-p symbol
- (emit-getstatic +lisp-closure+ "OPTIONAL" :int)
- (emit-invokespecial-init +lisp-closure-parameter+
- (list +lisp-symbol+ +lisp-object+
- +lisp-object+ :int)))
+ (emit-invokespecial-init +alp-optional-parameter+
+ (list :boolean +lisp-object+)))
- (parameters-to-array (param key key-params-register)
+ (parameters-to-array (param key key-params-register
+ +alp-keyword-parameter+)
+ (if (null (third param)) ;; supplied-p or not?
+ (emit 'iconst_0)
+ (emit 'iconst_1))
+ (emit-read-from-string (second param)) ;; initform
(let ((keyword (fourth param)))
(if (keywordp keyword)
(progn
@@ -1016,38 +1015,49 @@
(emit-invokestatic +lisp+ "internInPackage"
(list +java-string+ +java-string+)
+lisp-symbol+))))
- (emit-push-t) ;; we don't need the actual variable-symbol
- (emit-read-from-string (second (car key)))
- (if (null (third param))
- (emit-push-nil)
- (emit-push-t)) ;; we don't need the actual supplied-p symbol
- (emit-invokespecial-init +lisp-closure-parameter+
- (list +lisp-symbol+ +lisp-symbol+
- +lisp-object+ +lisp-object+))))))
+ (emit-invokespecial-init +alp-keyword-parameter+
+ (list :boolean +lisp-object+
+ +lisp-symbol+))))))
(aload 0) ;; this
(cond ((eq super +lisp-compiled-primitive+)
(emit-constructor-lambda-name lambda-name)
(emit-constructor-lambda-list args)
(emit-invokespecial-init super (lisp-object-arg-types 2)))
- ((equal super +lisp-compiled-closure+) ;;### only needs EQ when SUPER is guaranteed to be CLASS-NAME
- (aload req-params-register)
+ ((equal super +lisp-compiled-closure+)
+ ;;### only needs EQ when SUPER is guaranteed to be CLASS-NAME
+ (emit-new +argument-list-processor+)
+ (emit 'dup)
+ (emit 'dup)
+ (astore (setf alp-register (allocate-register nil)))
+ (emit 'aconst_null)
+ (emit-push-int req-count)
(aload opt-params-register)
(aload key-params-register)
(if keys-p
- (emit-push-t)
- (emit-push-nil-symbol))
- (if rest-p
- (emit-push-t)
- (emit-push-nil-symbol))
+ (emit 'iconst_1)
+ (emit 'iconst_0))
(if more-keys-p
+ (emit 'iconst_1)
+ (emit 'iconst_0))
+ (if rest-p
(emit-push-t)
- (emit-push-nil-symbol))
+ (emit 'aconst_null))
+ (emit-invokespecial-init +argument-list-processor+
+ (list
+ +lisp-operator+
+ :int
+ (class-array +alp-optional-parameter+)
+ (class-array +alp-keyword-parameter+)
+ :boolean
+ :boolean
+ +lisp-symbol+))
(emit-invokespecial-init super
- (list +lisp-closure-parameter-array+
- +lisp-closure-parameter-array+
- +lisp-closure-parameter-array+
- +lisp-symbol+
- +lisp-symbol+ +lisp-symbol+)))
+ (list +argument-list-processor+))
+ (aload alp-register)
+ (aload 0)
+ (emit-invokevirtual +argument-list-processor+
+ "setFunction"
+ (list +lisp-operator+) nil))
(t
(sys::%format t "unhandled superclass ~A for ~A~%"
super
Modified: trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp Fri Feb 3 22:56:01 2012 (r13848)
+++ trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp Sat Feb 4 03:35:39 2012 (r13849)
@@ -136,6 +136,7 @@
(define-class-name +java-string+ "java.lang.String")
(define-class-name +java-system+ "java.lang.System")
(define-class-name +java-io-input-stream+ "java.io.InputStream")
+(define-class-name +java-util-collection+ "java.util.Collection")
(define-class-name +lisp-object+ "org.armedbear.lisp.LispObject")
(defconstant +lisp-object-array+ (class-array +lisp-object+))
(define-class-name +lisp-simple-string+ "org.armedbear.lisp.SimpleString")
@@ -177,10 +178,17 @@
(define-class-name +lisp-package+ "org.armedbear.lisp.Package")
(define-class-name +lisp-readtable+ "org.armedbear.lisp.Readtable")
(define-class-name +lisp-stream+ "org.armedbear.lisp.Stream")
+(define-class-name +lisp-operator+ "org.armedbear.lisp.Operator")
(define-class-name +lisp-closure+ "org.armedbear.lisp.Closure")
(define-class-name +lisp-compiled-closure+ "org.armedbear.lisp.CompiledClosure")
-(define-class-name +lisp-closure-parameter+
- "org.armedbear.lisp.Closure$Parameter")
+(define-class-name +argument-list-processor+
+ "org.armedbear.lisp.ArgumentListProcessor")
+(define-class-name +alp-required-parameter+
+ "org.armedbear.lisp.ArgumentListProcessor$RequiredParam")
+(define-class-name +alp-optional-parameter+
+ "org.armedbear.lisp.ArgumentListProcessor$OptionalParam")
+(define-class-name +alp-keyword-parameter+
+ "org.armedbear.lisp.ArgumentListProcessor$KeywordParam")
(defconstant +lisp-closure-parameter-array+
(class-array +lisp-closure-parameter+))
More information about the armedbear-cvs
mailing list