Changeset 14349

Timestamp:

01/06/13 07:49:58 (12 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:

• autoloads-gen.lisp (modified) (1 diff)
• clos.lisp (modified) (2 diffs)
• compile-system.lisp (modified) (1 diff)
• documentation.lisp (added)

branches/1.1.x/src/org/armedbear/lisp/autoloads-gen.lisp ¶

@@ -164 +164 @@
 
 (IN-PACKAGE :CL)
-(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))))
+(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))))
 
 ;; MACROS

branches/1.1.x/src/org/armedbear/lisp/clos.lisp ¶

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2003-2007 Peter Graves
-;;; Copyright (C) 2010 Mark Evenson
+;;; Copyright (C) 2010-2013 Mark Evenson
 ;;; $Id$
 ;;;
@@ -3255 +3255 @@
   +the-standard-writer-method-class+)
 
-(atomic-defgeneric documentation (x doc-type)
-    (:method ((x symbol) doc-type)
-        (%documentation x doc-type))
-    (:method ((x function) doc-type)
-        (%documentation x doc-type)))
-
-(atomic-defgeneric (setf documentation) (new-value x doc-type)
-    (:method (new-value (x symbol) doc-type)
-        (%set-documentation x doc-type new-value))
-    (:method (new-value (x function) doc-type)
-        (%set-documentation x doc-type new-value)))
-
-
-;; FIXME This should be a weak hashtable!
-(defvar *list-documentation-hashtable* (make-hash-table :test #'equal))
-
-(defmethod documentation ((x list) (doc-type (eql 'function)))
-  (let ((alist (gethash x *list-documentation-hashtable*)))
-    (and alist (cdr (assoc doc-type alist)))))
-
-(defmethod documentation ((x list) (doc-type (eql 'compiler-macro)))
-  (let ((alist (gethash x *list-documentation-hashtable*)))
-    (and alist (cdr (assoc doc-type alist)))))
-
-(defmethod (setf documentation) (new-value (x list) (doc-type (eql 'function)))
-  (let* ((alist (gethash x *list-documentation-hashtable*))
-         (entry (and alist (assoc doc-type alist))))
-    (cond (entry
-           (setf (cdr entry) new-value))
-          (t
-           (setf (gethash x *list-documentation-hashtable*)
-                 (push (cons doc-type new-value) alist)))))
-  new-value)
-
-(defmethod (setf documentation) (new-value (x list) (doc-type (eql 'compiler-macro)))
-  (let* ((alist (gethash x *list-documentation-hashtable*))
-         (entry (and alist (assoc doc-type alist))))
-    (cond (entry
-           (setf (cdr entry) new-value))
-          (t
-           (setf (gethash x *list-documentation-hashtable*)
-                 (push (cons doc-type new-value) alist)))))
-  new-value)
-
-(defmethod documentation ((x class) (doc-type (eql 't)))
-  (class-documentation x))
-
-(defmethod documentation ((x class) (doc-type (eql 'type)))
-  (class-documentation x))
-
-(defmethod (setf documentation) (new-value (x class) (doc-type (eql 't)))
-  (%set-class-documentation x new-value))
-
-(defmethod (setf documentation) (new-value (x class) (doc-type (eql 'type)))
-  (%set-class-documentation x new-value))
-
-(defmethod documentation ((x structure-class) (doc-type (eql 't)))
-  (%documentation x t))
-
-(defmethod documentation ((x structure-class) (doc-type (eql 'type)))
-  (%documentation x t))
-
-(defmethod (setf documentation) (new-value (x structure-class) (doc-type (eql 't)))
-  (%set-documentation x t new-value))
-
-(defmethod (setf documentation) (new-value (x structure-class) (doc-type (eql 'type)))
-  (%set-documentation x t new-value))
-
-(defmethod documentation ((x standard-generic-function) (doc-type (eql 't)))
-  (generic-function-documentation x))
-
-(defmethod (setf documentation) (new-value (x standard-generic-function) (doc-type (eql 't)))
-  (setf (generic-function-documentation x) new-value))
-
-(defmethod documentation ((x standard-generic-function) (doc-type (eql 'function)))
-  (generic-function-documentation x))
-
-(defmethod (setf documentation) (new-value (x standard-generic-function) (doc-type (eql 'function)))
-  (setf (generic-function-documentation x) new-value))
-
-(defmethod documentation ((x standard-method) (doc-type (eql 't)))
-  (method-documentation x))
-
-(defmethod (setf documentation) (new-value (x standard-method) (doc-type (eql 't)))
-  (setf (method-documentation x) new-value))
-
-(defmethod documentation ((x standard-slot-definition) (doc-type (eql 't)))
-  (slot-definition-documentation x))
-
-(defmethod (setf documentation) (new-value (x standard-slot-definition) (doc-type (eql 't)))
-  (setf (slot-definition-documentation x) new-value))
-
-(defmethod documentation ((x package) (doc-type (eql 't)))
-  (%documentation x doc-type))
-
-(defmethod (setf documentation) (new-value (x package) (doc-type (eql 't)))
-  (%set-documentation x doc-type new-value))
-
-(defmethod documentation ((x symbol) (doc-type (eql 'function)))
-  (if (and (fboundp x) (typep (fdefinition x) 'generic-function))
-      (documentation (fdefinition x) doc-type)
-      (%documentation x doc-type)))
-
-(defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'function)))
-  (if (and (fboundp x) (typep (fdefinition x) 'generic-function))
-      (setf (documentation (fdefinition x) 'function) new-value)
-      (%set-documentation x 'function new-value)))
-
-(defmethod documentation ((x symbol) (doc-type (eql 'type)))
-  (let ((class (find-class x nil)))
-    (if class
-        (documentation class t)
-        (%documentation x 'type))))
-
-(defmethod documentation ((x symbol) (doc-type (eql 'structure)))
-  (%documentation x 'structure))
-
-(defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'type)))
-  (let ((class (find-class x nil)))
-    (if class
-        (setf (documentation class t) new-value)
-        (%set-documentation x 'type new-value))))
-
-(defmethod (setf documentation) (new-value (x symbol)
-                                 (doc-type (eql 'structure)))
-  (%set-documentation x 'structure new-value))
-
 ;;; Applicable methods
 

branches/1.1.x/src/org/armedbear/lisp/compile-system.lisp ¶

@@ -344 +344 @@
                            "do-symbols.lisp"
                            "do.lisp"
+                           "documentation.lisp"
                            "dolist.lisp"
                            "dotimes.lisp"