Changeset 13849
- Timestamp:
- 02/04/12 11:35:39 (11 years ago)
- Location:
- trunk/abcl/src/org/armedbear/lisp
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/ArgumentListProcessor.java
r13843 r13849 103 103 * @param rest Specifies the &rest variable name, if one was specified, or 'null' if none 104 104 */ 105 public ArgumentListProcessor(Operator fun, Collection<RequiredParam> required,106 Collection<OptionalParam> optional, Collection<KeywordParam>keyword,105 public ArgumentListProcessor(Operator fun, int requiredCount, 106 OptionalParam[] optional, KeywordParam[] keyword, 107 107 boolean key, boolean moreKeys, Symbol rest) { 108 108 109 109 function = fun; 110 110 111 requiredParameters = new RequiredParam[required.size()]; 112 requiredParameters = required.toArray(requiredParameters); 113 114 optionalParameters = new OptionalParam[optional.size()]; 115 optionalParameters = optional.toArray(optionalParameters); 116 117 keywordParameters = new KeywordParam[keyword.size()]; 118 keywordParameters = keyword.toArray(keywordParameters); 119 111 requiredParameters = new RequiredParam[requiredCount]; 112 positionalParameters = new Param[requiredCount + optional.length 113 + ((rest != null) ? 1 : 0)]; 114 115 // the same anonymous required parameter can be used any number of times 116 RequiredParam r = new RequiredParam(); 117 for (int i = 0; i < requiredCount; i++) { 118 requiredParameters[i] = r; 119 positionalParameters[i] = r; 120 } 121 122 optionalParameters = optional; 123 System.arraycopy(optional, 0, 124 positionalParameters, requiredCount, optional.length); 125 120 126 restVar = rest; 121 127 if (restVar != null) 122 restParam = new RestParam(rest, false); 123 128 positionalParameters[requiredCount + optional.length] = 129 restParam = new RestParam(rest, false); 130 124 131 andKey = key; 125 132 allowOtherKeys = moreKeys; 126 127 List<Param> positionalParam = new ArrayList<Param>(); 128 positionalParam.addAll(required); 129 positionalParam.addAll(optional); 130 if (restVar != null) 131 positionalParam.add(restParam); 132 133 134 positionalParameters = new Param[positionalParam.size()]; 135 positionalParameters = positionalParam.toArray(positionalParameters); 136 133 keywordParameters = keyword; 134 135 137 136 auxVars = new Param[0]; 137 138 138 139 139 variables = extractVariables(); … … 146 146 ? maxArgs : -1; 147 147 148 if ( optional.isEmpty() && keyword.isEmpty())148 if (keyword.length == 0) 149 149 matcher = new FastMatcher(); 150 150 else … … 433 433 } 434 434 435 public void setFunction(Operator fun) { 436 function = fun; 437 } 438 435 439 /** Matches the function call arguments 'args' with the lambda list, 436 440 * returning an array with variable values to be used. The array is sorted … … 866 870 boolean special; 867 871 872 // Used above to create anonymous required parameters 873 public RequiredParam() { 874 this(T, false); 875 } 876 868 877 public RequiredParam(Symbol var, boolean special) { 869 878 this.var = var; … … 895 904 InitForm initForm; 896 905 906 public OptionalParam(boolean suppliedVar, LispObject form) { 907 this(T, false, suppliedVar ? T : null, false, form); 908 } 897 909 898 910 public OptionalParam(Symbol var, boolean special, … … 982 994 public Symbol keyword; 983 995 996 public KeywordParam(boolean suppliedVar, LispObject form, Symbol keyword) { 997 this(T, false, suppliedVar ? T : null, false, form, keyword); 998 } 999 984 1000 public KeywordParam(Symbol var, boolean special, 985 1001 Symbol suppliedVar, boolean suppliedSpecial, -
trunk/abcl/src/org/armedbear/lisp/Closure.java
r13835 r13849 37 37 import static org.armedbear.lisp.Lisp.*; 38 38 39 import java.util.ArrayList;40 41 39 public class Closure extends Function 42 40 { … … 66 64 * @param moreKeys NIL if &allow-other-keys not present, T otherwise 67 65 */ 68 public Closure(Parameter[] required, 69 Parameter[] optional, 70 Parameter[] keyword, 71 Symbol keys, Symbol rest, Symbol moreKeys) { 66 public Closure(ArgumentListProcessor arglist) { 72 67 // stuff we don't need: we're a compiled function 73 68 body = null; 74 69 executionBody = null; 75 70 environment = null; 76 77 ArrayList<ArgumentListProcessor.RequiredParam> reqParams = 78 new ArrayList<ArgumentListProcessor.RequiredParam>(); 79 for (Parameter req : required) 80 reqParams.add(new ArgumentListProcessor.RequiredParam(req.var, false)); 81 82 ArrayList<ArgumentListProcessor.OptionalParam> optParams = 83 new ArrayList<ArgumentListProcessor.OptionalParam>(); 84 for (Parameter opt : optional) 85 optParams.add(new ArgumentListProcessor.OptionalParam(opt.var, false, 86 (opt.svar == NIL) ? null : (Symbol)opt.svar, false, 87 opt.initForm)); 88 89 ArrayList<ArgumentListProcessor.KeywordParam> keyParams = 90 new ArrayList<ArgumentListProcessor.KeywordParam>(); 91 for (Parameter key : keyword) 92 keyParams.add(new ArgumentListProcessor.KeywordParam(key.var, false, 93 (key.svar == NIL) ? null : (Symbol)key.svar, false, key.initForm, 94 key.keyword)); 95 arglist = new ArgumentListProcessor(this, reqParams, optParams, 96 keyParams, keys != NIL, 97 moreKeys != NIL, 98 (rest == NIL) ? null : rest); 71 this.arglist = arglist; 99 72 freeSpecials = new Symbol[0]; 100 73 } … … 255 228 } 256 229 257 public static class Parameter258 {259 final Symbol var;260 final LispObject initForm;261 final LispObject initVal;262 final LispObject svar;263 private final int type;264 final Symbol keyword;265 266 public Parameter(Symbol var)267 {268 this.var = var;269 this.initForm = null;270 this.initVal = null;271 this.svar = NIL;272 this.type = REQUIRED;273 this.keyword = null;274 }275 276 public Parameter(Symbol var, LispObject initForm, int type)277 278 {279 this.var = var;280 this.initForm = initForm;281 this.initVal = processInitForm(initForm);282 this.svar = NIL;283 this.type = type;284 keyword =285 type == KEYWORD ? PACKAGE_KEYWORD.intern(var.name) : null;286 }287 288 public Parameter(Symbol var, LispObject initForm, LispObject svar,289 int type)290 291 {292 this.var = var;293 this.initForm = initForm;294 this.initVal = processInitForm(initForm);295 this.svar = (svar != NIL) ? checkSymbol(svar) : NIL;296 this.type = type;297 keyword =298 type == KEYWORD ? PACKAGE_KEYWORD.intern(var.name) : null;299 }300 301 public Parameter(Symbol keyword, Symbol var, LispObject initForm,302 LispObject svar)303 304 {305 this.var = var;306 this.initForm = initForm;307 this.initVal = processInitForm(initForm);308 this.svar = (svar != NIL) ? checkSymbol(svar) : NIL;309 type = KEYWORD;310 this.keyword = keyword;311 }312 313 @Override314 public String toString()315 {316 if (type == REQUIRED)317 return var.toString();318 StringBuffer sb = new StringBuffer();319 if (keyword != null)320 {321 sb.append(keyword);322 sb.append(' ');323 }324 sb.append(var.toString());325 sb.append(' ');326 sb.append(initForm);327 sb.append(' ');328 sb.append(type);329 return sb.toString();330 }331 332 private static final LispObject processInitForm(LispObject initForm)333 334 {335 if (initForm.constantp())336 {337 if (initForm instanceof Symbol)338 return initForm.getSymbolValue();339 if (initForm instanceof Cons)340 {341 Debug.assertTrue(initForm.car() == Symbol.QUOTE);342 return initForm.cadr();343 }344 return initForm;345 }346 return null;347 }348 }349 350 230 // ### lambda-list-names 351 231 private static final Primitive LAMBDA_LIST_NAMES = -
trunk/abcl/src/org/armedbear/lisp/CompiledClosure.java
r13440 r13849 42 42 public ClosureBinding[] ctx; 43 43 44 public CompiledClosure(Parameter[] required, 45 Parameter[] optional, 46 Parameter[] keyword, 47 Symbol keys, Symbol rest, Symbol moreKeys) 48 { 49 super(required, optional, keyword, keys, rest, moreKeys); 44 public CompiledClosure(ArgumentListProcessor arglist) 45 { 46 super(arglist); 50 47 } 51 48 -
trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
r13822 r13849 950 950 ;; We don't normally need to see debugging output for constructors. 951 951 (super (class-file-superclass class)) 952 req-params-register953 952 opt-params-register 954 953 key-params-register 954 req-count 955 955 rest-p 956 956 keys-p 957 more-keys-p) 957 more-keys-p 958 alp-register) 958 959 (with-code-to-method (class method) 959 960 (allocate-register nil) … … 965 966 (setf rest-p rest 966 967 more-keys-p allow-other-keys-p 967 keys-p key-p) 968 keys-p key-p 969 req-count (length req)) 968 970 (macrolet 969 ((parameters-to-array ((param params register ) &body body)971 ((parameters-to-array ((param params register class) &body body) 970 972 (let ((count-sym (gensym))) 971 973 `(progn 972 974 (emit-push-constant-int (length ,params)) 973 (emit-anewarray +lisp-closure-parameter+)975 (emit-anewarray ,class) 974 976 (astore (setf ,register *registers-allocated*)) 975 977 (allocate-register nil) … … 981 983 (aload ,register) 982 984 (emit-push-constant-int ,count-sym) 983 (emit-new +lisp-closure-parameter+)985 (emit-new ,class) 984 986 (emit 'dup) 985 987 ,@body 986 988 (emit 'aastore)))))) 987 ;; process required args 988 (parameters-to-array (ignore req req-params-register) 989 (emit-push-t) ;; we don't need the actual symbol 990 (emit-invokespecial-init +lisp-closure-parameter+ 991 (list +lisp-symbol+))) 992 993 (parameters-to-array (param opt opt-params-register) 994 (emit-push-t) ;; we don't need the actual variable-symbol 989 (parameters-to-array (param opt opt-params-register 990 +alp-optional-parameter+) 991 (if (null (third param)) ;; supplied-p or not? 992 (emit 'iconst_0) 993 (emit 'iconst_1)) 995 994 (emit-read-from-string (second param)) ;; initform 996 ( if (null (third param)) ;; supplied-p997 (emit-push-nil)998 (emit-push-t)) ;; we don't need the actual supplied-p symbol 999 (emit-getstatic +lisp-closure+ "OPTIONAL" :int)1000 (emit-invokespecial-init +lisp-closure-parameter+1001 (list +lisp-symbol+ +lisp-object+1002 +lisp-object+ :int)))1003 1004 (parameters-to-array (param key key-params-register)995 (emit-invokespecial-init +alp-optional-parameter+ 996 (list :boolean +lisp-object+))) 997 998 (parameters-to-array (param key key-params-register 999 +alp-keyword-parameter+) 1000 (if (null (third param)) ;; supplied-p or not? 1001 (emit 'iconst_0) 1002 (emit 'iconst_1)) 1003 (emit-read-from-string (second param)) ;; initform 1005 1004 (let ((keyword (fourth param))) 1006 1005 (if (keywordp keyword) … … 1017 1016 (list +java-string+ +java-string+) 1018 1017 +lisp-symbol+)))) 1019 (emit-push-t) ;; we don't need the actual variable-symbol 1020 (emit-read-from-string (second (car key))) 1021 (if (null (third param)) 1022 (emit-push-nil) 1023 (emit-push-t)) ;; we don't need the actual supplied-p symbol 1024 (emit-invokespecial-init +lisp-closure-parameter+ 1025 (list +lisp-symbol+ +lisp-symbol+ 1026 +lisp-object+ +lisp-object+)))))) 1018 (emit-invokespecial-init +alp-keyword-parameter+ 1019 (list :boolean +lisp-object+ 1020 +lisp-symbol+)))))) 1027 1021 (aload 0) ;; this 1028 1022 (cond ((eq super +lisp-compiled-primitive+) … … 1030 1024 (emit-constructor-lambda-list args) 1031 1025 (emit-invokespecial-init super (lisp-object-arg-types 2))) 1032 ((equal super +lisp-compiled-closure+) ;;### only needs EQ when SUPER is guaranteed to be CLASS-NAME 1033 (aload req-params-register) 1026 ((equal super +lisp-compiled-closure+) 1027 ;;### only needs EQ when SUPER is guaranteed to be CLASS-NAME 1028 (emit-new +argument-list-processor+) 1029 (emit 'dup) 1030 (emit 'dup) 1031 (astore (setf alp-register (allocate-register nil))) 1032 (emit 'aconst_null) 1033 (emit-push-int req-count) 1034 1034 (aload opt-params-register) 1035 1035 (aload key-params-register) 1036 1036 (if keys-p 1037 (emit-push-t) 1038 (emit-push-nil-symbol)) 1037 (emit 'iconst_1) 1038 (emit 'iconst_0)) 1039 (if more-keys-p 1040 (emit 'iconst_1) 1041 (emit 'iconst_0)) 1039 1042 (if rest-p 1040 1043 (emit-push-t) 1041 (emit-push-nil-symbol)) 1042 (if more-keys-p 1043 (emit-push-t) 1044 (emit-push-nil-symbol)) 1044 (emit 'aconst_null)) 1045 (emit-invokespecial-init +argument-list-processor+ 1046 (list 1047 +lisp-operator+ 1048 :int 1049 (class-array +alp-optional-parameter+) 1050 (class-array +alp-keyword-parameter+) 1051 :boolean 1052 :boolean 1053 +lisp-symbol+)) 1045 1054 (emit-invokespecial-init super 1046 (list +lisp-closure-parameter-array+ 1047 +lisp-closure-parameter-array+ 1048 +lisp-closure-parameter-array+ 1049 +lisp-symbol+ 1050 +lisp-symbol+ +lisp-symbol+))) 1055 (list +argument-list-processor+)) 1056 (aload alp-register) 1057 (aload 0) 1058 (emit-invokevirtual +argument-list-processor+ 1059 "setFunction" 1060 (list +lisp-operator+) nil)) 1051 1061 (t 1052 1062 (sys::%format t "unhandled superclass ~A for ~A~%" -
trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
r13792 r13849 137 137 (define-class-name +java-system+ "java.lang.System") 138 138 (define-class-name +java-io-input-stream+ "java.io.InputStream") 139 (define-class-name +java-util-collection+ "java.util.Collection") 139 140 (define-class-name +lisp-object+ "org.armedbear.lisp.LispObject") 140 141 (defconstant +lisp-object-array+ (class-array +lisp-object+)) … … 178 179 (define-class-name +lisp-readtable+ "org.armedbear.lisp.Readtable") 179 180 (define-class-name +lisp-stream+ "org.armedbear.lisp.Stream") 181 (define-class-name +lisp-operator+ "org.armedbear.lisp.Operator") 180 182 (define-class-name +lisp-closure+ "org.armedbear.lisp.Closure") 181 183 (define-class-name +lisp-compiled-closure+ "org.armedbear.lisp.CompiledClosure") 182 (define-class-name +lisp-closure-parameter+ 183 "org.armedbear.lisp.Closure$Parameter") 184 (define-class-name +argument-list-processor+ 185 "org.armedbear.lisp.ArgumentListProcessor") 186 (define-class-name +alp-required-parameter+ 187 "org.armedbear.lisp.ArgumentListProcessor$RequiredParam") 188 (define-class-name +alp-optional-parameter+ 189 "org.armedbear.lisp.ArgumentListProcessor$OptionalParam") 190 (define-class-name +alp-keyword-parameter+ 191 "org.armedbear.lisp.ArgumentListProcessor$KeywordParam") 184 192 (defconstant +lisp-closure-parameter-array+ 185 193 (class-array +lisp-closure-parameter+))
Note: See TracChangeset
for help on using the changeset viewer.