Changeset 14349


Ignore:
Timestamp:
01/06/13 07:49:58 (8 years ago)
Author:
Mark Evenson
Message:

Backport r14346 | rschlatte | 2013-01-01 23:25:37 +0100 (Tue, 01 Jan 2013) | 1 line.

Location:
branches/1.1.x/src/org/armedbear/lisp
Files:
1 added
3 edited

Legend:

Unmodified
Added
Removed
  • branches/1.1.x/src/org/armedbear/lisp/autoloads-gen.lisp

    r14133 r14349  
    164164
    165165(IN-PACKAGE :CL)
    166 (DOLIST (SYSTEM::FS (QUOTE ((("adjoin") ADJOIN) (("apropos") APROPOS-LIST APROPOS) (("arrays") MAKE-ARRAY ADJUST-ARRAY ARRAY-ROW-MAJOR-INDEX BIT SBIT) (("assoc") ASSOC ASSOC-IF ASSOC-IF-NOT RASSOC RASSOC-IF RASSOC-IF-NOT ACONS PAIRLIS COPY-ALIST) (("bit-array-ops") BIT-AND BIT-IOR BIT-XOR BIT-EQV BIT-NAND BIT-NOR BIT-ANDC1 BIT-ANDC2 BIT-ORC1 BIT-ORC2 BIT-NOT) (("boole") BOOLE) (("butlast") BUTLAST NBUTLAST) (("byte-io") WRITE-BYTE READ-BYTE) (("chars") CHAR/= CHAR> CHAR>= CHAR-NOT-EQUAL) (("clos") CLASS-NAME NO-APPLICABLE-METHOD FUNCTION-KEYWORDS SLOT-VALUE SLOT-BOUNDP SLOT-MAKUNBOUND SLOT-EXISTS-P METHOD-QUALIFIERS ENSURE-GENERIC-FUNCTION COMPUTE-APPLICABLE-METHODS DOCUMENTATION SLOT-MISSING SLOT-UNBOUND ALLOCATE-INSTANCE INITIALIZE-INSTANCE REINITIALIZE-INSTANCE CHANGE-CLASS UPDATE-INSTANCE-FOR-DIFFERENT-CLASS MAKE-INSTANCES-OBSOLETE UPDATE-INSTANCE-FOR-REDEFINED-CLASS MAKE-CONDITION INVALID-METHOD-ERROR METHOD-COMBINATION-ERROR FIND-METHOD ADD-METHOD REMOVE-METHOD NO-NEXT-METHOD) (("coerce") COERCE) (("compile-file-pathname") COMPILE-FILE-PATHNAME) (("compile-file") COMPILE-FILE) (("compiler-macro") COMPILER-MACRO-FUNCTION) (("compiler-pass2") COMPILE) (("concatenate") CONCATENATE) (("copy-seq") COPY-SEQ) (("copy-symbol") COPY-SYMBOL) (("count") COUNT COUNT-IF COUNT-IF-NOT) (("debug") INVOKE-DEBUGGER BREAK) (("delete-duplicates") DELETE-DUPLICATES) (("delete") DELETE DELETE-IF DELETE-IF-NOT) (("deposit-field") DEPOSIT-FIELD) (("describe") DESCRIBE) (("directory") DIRECTORY) (("disassemble") DISASSEMBLE) (("dribble") DRIBBLE) (("ed") ED) (("enough-namestring") ENOUGH-NAMESTRING) (("ensure-directories-exist") ENSURE-DIRECTORIES-EXIST) (("fill") FILL) (("find-all-symbols") FIND-ALL-SYMBOLS) (("find") POSITION POSITION-IF POSITION-IF-NOT FIND FIND-IF FIND-IF-NOT) (("format") FORMAT) (("gentemp") GENTEMP) (("inspect") INSPECT) (("lcm") LCM) (("ldb") BYTE BYTE-SIZE BYTE-POSITION LDB LDB-TEST DPB) (("ldiff") LDIFF) (("list-length") LIST-LENGTH) (("list") FIFTH SIXTH SEVENTH EIGHTH NINTH TENTH MAKE-LIST COMPLEMENT CONSTANTLY MEMBER) (("load") LOAD) (("make-hash-table") MAKE-HASH-TABLE) (("make-load-form-saving-slots") MAKE-LOAD-FORM-SAVING-SLOTS) (("make-sequence") MAKE-SEQUENCE) (("make-string-output-stream") MAKE-STRING-OUTPUT-STREAM) (("make-string") MAKE-STRING) (("map-into") MAP-INTO) (("map") MAP) (("map1") MAPCAN MAPL MAPLIST MAPCON) (("mask-field") MASK-FIELD) (("member-if") MEMBER-IF MEMBER-IF-NOT) (("mismatch") BAD-SEQ-LIMIT THE-END THE-START CALL-TEST TEST-ERROR MISMATCH) (("nsubstitute") NSUBSTITUTE NSUBSTITUTE-IF NSUBSTITUTE-IF-NOT) (("numbers") SIGNUM ROUND FFLOOR FCEILING FROUND RATIONALIZE GCD ISQRT FLOAT-PRECISION DECODE-FLOAT CONJUGATE PHASE) (("open") OPEN) (("package") MAKE-PACKAGE IMPORT DELETE-PACKAGE) (("parse-integer") PARSE-INTEGER) (("pathnames") PATHNAME-HOST PATHNAME-DEVICE PATHNAME-DIRECTORY PATHNAME-NAME PATHNAME-TYPE WILD-PATHNAME-P PATHNAME-MATCH-P TRANSLATE-PATHNAME LOGICAL-PATHNAME-TRANSLATIONS TRANSLATE-LOGICAL-PATHNAME LOAD-LOGICAL-PATHNAME-TRANSLATIONS LOGICAL-PATHNAME PARSE-NAMESTRING) (("pprint-dispatch") COPY-PPRINT-DISPATCH SET-PPRINT-DISPATCH PPRINT-DISPATCH) (("pprint") WRITE PRINT PRIN1 PRINC PPRINT WRITE-TO-STRING PRIN1-TO-STRING PRINC-TO-STRING WRITE-CHAR WRITE-STRING WRITE-LINE TERPRI FRESH-LINE FINISH-OUTPUT FORCE-OUTPUT CLEAR-OUTPUT PPRINT-NEWLINE PPRINT-INDENT PPRINT-TAB PPRINT-LINEAR PPRINT-FILL PPRINT-TABULAR) (("proclaim") PROCLAIM) (("query") Y-OR-N-P YES-OR-NO-P) (("read-from-string") READ-FROM-STRING) (("read-sequence") READ-SEQUENCE) (("reduce") REDUCE) (("remove-duplicates") REMOVE-DUPLICATES) (("remove") REMOVE REMOVE-IF REMOVE-IF-NOT) (("replace") REPLACE) (("revappend") REVAPPEND) (("search") SEARCH) (("setf") GET-SETF-EXPANSION) (("sets") UNION NUNION INTERSECTION NINTERSECTION SET-DIFFERENCE NSET-DIFFERENCE SET-EXCLUSIVE-OR NSET-EXCLUSIVE-OR SUBSETP) (("sort") MERGE SORT STABLE-SORT) (("strings") STRING-UPCASE STRING-DOWNCASE STRING-CAPITALIZE NSTRING-UPCASE NSTRING-DOWNCASE NSTRING-CAPITALIZE STRING= STRING/= STRING-EQUAL STRING-NOT-EQUAL STRING< STRING> STRING<= STRING>= STRING-LESSP STRING-GREATERP STRING-NOT-LESSP STRING-NOT-GREATERP STRING-LEFT-TRIM STRING-RIGHT-TRIM STRING-TRIM) (("sublis") SUBLIS NSUBLIS) (("subst") SUBST SUBST-IF SUBST-IF-NOT NSUBST NSUBST-IF NSUBST-IF-NOT) (("substitute") LIST-SUBSTITUTE* VECTOR-SUBSTITUTE* SUBSTITUTE SUBSTITUTE-IF SUBSTITUTE-IF-NOT) (("subtypep") SUBTYPEP) (("tailp") TAILP) (("time") DECODE-UNIVERSAL-TIME GET-DECODED-TIME ENCODE-UNIVERSAL-TIME) (("tree-equal") TREE-EQUAL) (("typep") TYPEP) (("upgraded-complex-part-type") UPGRADED-COMPLEX-PART-TYPE) (("write-sequence") WRITE-SEQUENCE)))) (FUNCALL (FUNCTION EXTENSIONS:AUTOLOAD) (CDR SYSTEM::FS) (CAR (CAR SYSTEM::FS))))
     166(DOLIST (SYSTEM::FS (QUOTE ((("adjoin") ADJOIN) (("apropos") APROPOS-LIST APROPOS) (("arrays") MAKE-ARRAY ADJUST-ARRAY ARRAY-ROW-MAJOR-INDEX BIT SBIT) (("assoc") ASSOC ASSOC-IF ASSOC-IF-NOT RASSOC RASSOC-IF RASSOC-IF-NOT ACONS PAIRLIS COPY-ALIST) (("bit-array-ops") BIT-AND BIT-IOR BIT-XOR BIT-EQV BIT-NAND BIT-NOR BIT-ANDC1 BIT-ANDC2 BIT-ORC1 BIT-ORC2 BIT-NOT) (("boole") BOOLE) (("butlast") BUTLAST NBUTLAST) (("byte-io") WRITE-BYTE READ-BYTE) (("chars") CHAR/= CHAR> CHAR>= CHAR-NOT-EQUAL) (("clos") CLASS-NAME NO-APPLICABLE-METHOD FUNCTION-KEYWORDS SLOT-VALUE SLOT-BOUNDP SLOT-MAKUNBOUND SLOT-EXISTS-P METHOD-QUALIFIERS ENSURE-GENERIC-FUNCTION COMPUTE-APPLICABLE-METHODS SLOT-MISSING SLOT-UNBOUND ALLOCATE-INSTANCE INITIALIZE-INSTANCE REINITIALIZE-INSTANCE CHANGE-CLASS UPDATE-INSTANCE-FOR-DIFFERENT-CLASS MAKE-INSTANCES-OBSOLETE UPDATE-INSTANCE-FOR-REDEFINED-CLASS MAKE-CONDITION INVALID-METHOD-ERROR METHOD-COMBINATION-ERROR FIND-METHOD ADD-METHOD REMOVE-METHOD NO-NEXT-METHOD) (("coerce") COERCE) (("compile-file-pathname") COMPILE-FILE-PATHNAME) (("compile-file") COMPILE-FILE) (("compiler-macro") COMPILER-MACRO-FUNCTION) (("compiler-pass2") COMPILE) (("concatenate") CONCATENATE) (("copy-seq") COPY-SEQ) (("copy-symbol") COPY-SYMBOL) (("count") COUNT COUNT-IF COUNT-IF-NOT) (("debug") INVOKE-DEBUGGER BREAK) (("delete-duplicates") DELETE-DUPLICATES) (("delete") DELETE DELETE-IF DELETE-IF-NOT) (("deposit-field") DEPOSIT-FIELD) (("describe") DESCRIBE) (("directory") DIRECTORY) (("disassemble") DISASSEMBLE) (("documentation") DOCUMENTATION) (("dribble") DRIBBLE) (("ed") ED) (("enough-namestring") ENOUGH-NAMESTRING) (("ensure-directories-exist") ENSURE-DIRECTORIES-EXIST) (("fill") FILL) (("find-all-symbols") FIND-ALL-SYMBOLS) (("find") POSITION POSITION-IF POSITION-IF-NOT FIND FIND-IF FIND-IF-NOT) (("format") FORMAT) (("gentemp") GENTEMP) (("inspect") INSPECT) (("lcm") LCM) (("ldb") BYTE BYTE-SIZE BYTE-POSITION LDB LDB-TEST DPB) (("ldiff") LDIFF) (("list-length") LIST-LENGTH) (("list") FIFTH SIXTH SEVENTH EIGHTH NINTH TENTH MAKE-LIST COMPLEMENT CONSTANTLY MEMBER) (("load") LOAD) (("make-hash-table") MAKE-HASH-TABLE) (("make-load-form-saving-slots") MAKE-LOAD-FORM-SAVING-SLOTS) (("make-sequence") MAKE-SEQUENCE) (("make-string-output-stream") MAKE-STRING-OUTPUT-STREAM) (("make-string") MAKE-STRING) (("map-into") MAP-INTO) (("map") MAP) (("map1") MAPCAN MAPL MAPLIST MAPCON) (("mask-field") MASK-FIELD) (("member-if") MEMBER-IF MEMBER-IF-NOT) (("mismatch") BAD-SEQ-LIMIT THE-END THE-START CALL-TEST TEST-ERROR MISMATCH) (("nsubstitute") NSUBSTITUTE NSUBSTITUTE-IF NSUBSTITUTE-IF-NOT) (("numbers") SIGNUM ROUND FFLOOR FCEILING FROUND RATIONALIZE GCD ISQRT FLOAT-PRECISION DECODE-FLOAT CONJUGATE PHASE) (("open") OPEN) (("package") MAKE-PACKAGE IMPORT DELETE-PACKAGE) (("parse-integer") PARSE-INTEGER) (("pathnames") PATHNAME-HOST PATHNAME-DEVICE PATHNAME-DIRECTORY PATHNAME-NAME PATHNAME-TYPE WILD-PATHNAME-P PATHNAME-MATCH-P TRANSLATE-PATHNAME LOGICAL-PATHNAME-TRANSLATIONS TRANSLATE-LOGICAL-PATHNAME LOAD-LOGICAL-PATHNAME-TRANSLATIONS LOGICAL-PATHNAME PARSE-NAMESTRING) (("pprint-dispatch") COPY-PPRINT-DISPATCH SET-PPRINT-DISPATCH PPRINT-DISPATCH) (("pprint") WRITE PRINT PRIN1 PRINC PPRINT WRITE-TO-STRING PRIN1-TO-STRING PRINC-TO-STRING WRITE-CHAR WRITE-STRING WRITE-LINE TERPRI FRESH-LINE FINISH-OUTPUT FORCE-OUTPUT CLEAR-OUTPUT PPRINT-NEWLINE PPRINT-INDENT PPRINT-TAB PPRINT-LINEAR PPRINT-FILL PPRINT-TABULAR) (("proclaim") PROCLAIM) (("query") Y-OR-N-P YES-OR-NO-P) (("read-from-string") READ-FROM-STRING) (("read-sequence") READ-SEQUENCE) (("reduce") REDUCE) (("remove-duplicates") REMOVE-DUPLICATES) (("remove") REMOVE REMOVE-IF REMOVE-IF-NOT) (("replace") REPLACE) (("revappend") REVAPPEND) (("search") SEARCH) (("setf") GET-SETF-EXPANSION) (("sets") UNION NUNION INTERSECTION NINTERSECTION SET-DIFFERENCE NSET-DIFFERENCE SET-EXCLUSIVE-OR NSET-EXCLUSIVE-OR SUBSETP) (("sort") MERGE SORT STABLE-SORT) (("strings") STRING-UPCASE STRING-DOWNCASE STRING-CAPITALIZE NSTRING-UPCASE NSTRING-DOWNCASE NSTRING-CAPITALIZE STRING= STRING/= STRING-EQUAL STRING-NOT-EQUAL STRING< STRING> STRING<= STRING>= STRING-LESSP STRING-GREATERP STRING-NOT-LESSP STRING-NOT-GREATERP STRING-LEFT-TRIM STRING-RIGHT-TRIM STRING-TRIM) (("sublis") SUBLIS NSUBLIS) (("subst") SUBST SUBST-IF SUBST-IF-NOT NSUBST NSUBST-IF NSUBST-IF-NOT) (("substitute") LIST-SUBSTITUTE* VECTOR-SUBSTITUTE* SUBSTITUTE SUBSTITUTE-IF SUBSTITUTE-IF-NOT) (("subtypep") SUBTYPEP) (("tailp") TAILP) (("time") DECODE-UNIVERSAL-TIME GET-DECODED-TIME ENCODE-UNIVERSAL-TIME) (("tree-equal") TREE-EQUAL) (("typep") TYPEP) (("upgraded-complex-part-type") UPGRADED-COMPLEX-PART-TYPE) (("write-sequence") WRITE-SEQUENCE)))) (FUNCALL (FUNCTION EXTENSIONS:AUTOLOAD) (CDR SYSTEM::FS) (CAR (CAR SYSTEM::FS))))
    167167
    168168;; MACROS
  • branches/1.1.x/src/org/armedbear/lisp/clos.lisp

    r14348 r14349  
    22;;;
    33;;; Copyright (C) 2003-2007 Peter Graves
    4 ;;; Copyright (C) 2010 Mark Evenson
     4;;; Copyright (C) 2010-2013 Mark Evenson
    55;;; $Id$
    66;;;
     
    32553255  +the-standard-writer-method-class+)
    32563256
    3257 (atomic-defgeneric documentation (x doc-type)
    3258     (:method ((x symbol) doc-type)
    3259         (%documentation x doc-type))
    3260     (:method ((x function) doc-type)
    3261         (%documentation x doc-type)))
    3262 
    3263 (atomic-defgeneric (setf documentation) (new-value x doc-type)
    3264     (:method (new-value (x symbol) doc-type)
    3265         (%set-documentation x doc-type new-value))
    3266     (:method (new-value (x function) doc-type)
    3267         (%set-documentation x doc-type new-value)))
    3268 
    3269 
    3270 ;; FIXME This should be a weak hashtable!
    3271 (defvar *list-documentation-hashtable* (make-hash-table :test #'equal))
    3272 
    3273 (defmethod documentation ((x list) (doc-type (eql 'function)))
    3274   (let ((alist (gethash x *list-documentation-hashtable*)))
    3275     (and alist (cdr (assoc doc-type alist)))))
    3276 
    3277 (defmethod documentation ((x list) (doc-type (eql 'compiler-macro)))
    3278   (let ((alist (gethash x *list-documentation-hashtable*)))
    3279     (and alist (cdr (assoc doc-type alist)))))
    3280 
    3281 (defmethod (setf documentation) (new-value (x list) (doc-type (eql 'function)))
    3282   (let* ((alist (gethash x *list-documentation-hashtable*))
    3283          (entry (and alist (assoc doc-type alist))))
    3284     (cond (entry
    3285            (setf (cdr entry) new-value))
    3286           (t
    3287            (setf (gethash x *list-documentation-hashtable*)
    3288                  (push (cons doc-type new-value) alist)))))
    3289   new-value)
    3290 
    3291 (defmethod (setf documentation) (new-value (x list) (doc-type (eql 'compiler-macro)))
    3292   (let* ((alist (gethash x *list-documentation-hashtable*))
    3293          (entry (and alist (assoc doc-type alist))))
    3294     (cond (entry
    3295            (setf (cdr entry) new-value))
    3296           (t
    3297            (setf (gethash x *list-documentation-hashtable*)
    3298                  (push (cons doc-type new-value) alist)))))
    3299   new-value)
    3300 
    3301 (defmethod documentation ((x class) (doc-type (eql 't)))
    3302   (class-documentation x))
    3303 
    3304 (defmethod documentation ((x class) (doc-type (eql 'type)))
    3305   (class-documentation x))
    3306 
    3307 (defmethod (setf documentation) (new-value (x class) (doc-type (eql 't)))
    3308   (%set-class-documentation x new-value))
    3309 
    3310 (defmethod (setf documentation) (new-value (x class) (doc-type (eql 'type)))
    3311   (%set-class-documentation x new-value))
    3312 
    3313 (defmethod documentation ((x structure-class) (doc-type (eql 't)))
    3314   (%documentation x t))
    3315 
    3316 (defmethod documentation ((x structure-class) (doc-type (eql 'type)))
    3317   (%documentation x t))
    3318 
    3319 (defmethod (setf documentation) (new-value (x structure-class) (doc-type (eql 't)))
    3320   (%set-documentation x t new-value))
    3321 
    3322 (defmethod (setf documentation) (new-value (x structure-class) (doc-type (eql 'type)))
    3323   (%set-documentation x t new-value))
    3324 
    3325 (defmethod documentation ((x standard-generic-function) (doc-type (eql 't)))
    3326   (generic-function-documentation x))
    3327 
    3328 (defmethod (setf documentation) (new-value (x standard-generic-function) (doc-type (eql 't)))
    3329   (setf (generic-function-documentation x) new-value))
    3330 
    3331 (defmethod documentation ((x standard-generic-function) (doc-type (eql 'function)))
    3332   (generic-function-documentation x))
    3333 
    3334 (defmethod (setf documentation) (new-value (x standard-generic-function) (doc-type (eql 'function)))
    3335   (setf (generic-function-documentation x) new-value))
    3336 
    3337 (defmethod documentation ((x standard-method) (doc-type (eql 't)))
    3338   (method-documentation x))
    3339 
    3340 (defmethod (setf documentation) (new-value (x standard-method) (doc-type (eql 't)))
    3341   (setf (method-documentation x) new-value))
    3342 
    3343 (defmethod documentation ((x standard-slot-definition) (doc-type (eql 't)))
    3344   (slot-definition-documentation x))
    3345 
    3346 (defmethod (setf documentation) (new-value (x standard-slot-definition) (doc-type (eql 't)))
    3347   (setf (slot-definition-documentation x) new-value))
    3348 
    3349 (defmethod documentation ((x package) (doc-type (eql 't)))
    3350   (%documentation x doc-type))
    3351 
    3352 (defmethod (setf documentation) (new-value (x package) (doc-type (eql 't)))
    3353   (%set-documentation x doc-type new-value))
    3354 
    3355 (defmethod documentation ((x symbol) (doc-type (eql 'function)))
    3356   (if (and (fboundp x) (typep (fdefinition x) 'generic-function))
    3357       (documentation (fdefinition x) doc-type)
    3358       (%documentation x doc-type)))
    3359 
    3360 (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'function)))
    3361   (if (and (fboundp x) (typep (fdefinition x) 'generic-function))
    3362       (setf (documentation (fdefinition x) 'function) new-value)
    3363       (%set-documentation x 'function new-value)))
    3364 
    3365 (defmethod documentation ((x symbol) (doc-type (eql 'type)))
    3366   (let ((class (find-class x nil)))
    3367     (if class
    3368         (documentation class t)
    3369         (%documentation x 'type))))
    3370 
    3371 (defmethod documentation ((x symbol) (doc-type (eql 'structure)))
    3372   (%documentation x 'structure))
    3373 
    3374 (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'type)))
    3375   (let ((class (find-class x nil)))
    3376     (if class
    3377         (setf (documentation class t) new-value)
    3378         (%set-documentation x 'type new-value))))
    3379 
    3380 (defmethod (setf documentation) (new-value (x symbol)
    3381                                  (doc-type (eql 'structure)))
    3382   (%set-documentation x 'structure new-value))
    3383 
    33843257;;; Applicable methods
    33853258
  • branches/1.1.x/src/org/armedbear/lisp/compile-system.lisp

    r14196 r14349  
    344344                           "do-symbols.lisp"
    345345                           "do.lisp"
     346                           "documentation.lisp"
    346347                           "dolist.lisp"
    347348                           "dotimes.lisp"
Note: See TracChangeset for help on using the changeset viewer.