Changeset 929


Ignore:
Timestamp:
Feb 16, 2005, 9:09:21 PM (16 years ago)
Author:
bryan
Message:

add docstrings to the majority of common-lisp-user symbols starting
with a snapshot of those found in SBCL 0.8.18.

Location:
trunk/ccl
Files:
58 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/compiler/PPC/ppc-disassemble.lisp

    r290 r929  
    362362#+ppc-target
    363363(defun disassemble (thing)
     364  "Disassemble the compiled code associated with OBJECT, which can be a
     365  function, a lambda expression, or a symbol with a function definition. If
     366  it is not already compiled, the compiler is called to produce something to
     367  disassemble."
    364368  (ppc-xdisassemble (require-type (function-for-disassembly thing) 'compiled-function)))
    365369
  • trunk/ccl/compiler/PPC/ppc-lapmacros.lisp

    r389 r929  
    8989; Whatever affected that bit (hopefully) happened earlier in the pipeline.
    9090(defppclapmacro if (test then &optional (else nil else-p))
     91  "If Predicate Then [Else]
     92  If Predicate evaluates to non-null, evaluate Then and returns its values,
     93  otherwise evaluate Else and return its values. Else defaults to NIL."
    9194  (multiple-value-bind (bitform negated) (ppc-lap-parse-test test)
    9295    (let* ((false-label (gensym)))
  • trunk/ccl/compiler/nx-basic.lisp

    r516 r929  
    404404
    405405(defmacro declaim (&environment env &rest decl-specs)
     406  "DECLAIM Declaration*
     407  Do a declaration or declarations for the global environment."
    406408  (let* ((body (mapcar #'(lambda (spec) `(proclaim ',spec)) decl-specs)))
    407409  `(progn
  • trunk/ccl/compiler/nx.lisp

    r128 r929  
    6868; may well have botched it.
    6969(defun compile (spec &optional def &aux (macro-p nil))
     70  "Coerce DEFINITION (by default, the function whose name is NAME)
     71  to a compiled function, returning (VALUES THING WARNINGS-P FAILURE-P),
     72  where if NAME is NIL, THING is the result of compilation, and
     73  otherwise THING is NAME. When NAME is not NIL, the compiled function
     74  is also set into (MACRO-FUNCTION NAME) if NAME names a macro, or into
     75  (FDEFINITION NAME) otherwise."
    7076  (unless def
    7177    (setq def (fboundp spec))
  • trunk/ccl/compiler/nx0.lisp

    r635 r929  
    195195
    196196(defmacro define-compiler-macro  (name arglist &body body &environment env)
     197  "Define a compiler-macro for NAME."
    197198  (unless (symbolp name) (report-bad-arg name 'symbol))
    198199  (let ((body (parse-macro-1 name arglist body env)))
     
    229230
    230231(defun compiler-macro-function (name &optional env)
     232  "If NAME names a compiler-macro in ENV, return the expansion function, else
     233   return NIL. Can be set with SETF when ENV is NIL."
    231234  (unless (nx-lexical-finfo name env)
    232235    (or (cdr (assq name *nx-compile-time-compiler-macros*))
  • trunk/ccl/level-0/PPC/ppc-pred.lisp

    r83 r929  
    2121
    2222(defppclapfunction eql ((x arg_y) (y arg_z))
     23;  "Return T if OBJ1 and OBJ2 represent the same object, otherwise NIL."
    2324  (check-nargs 2)
    2425  @tail
     
    117118
    118119(defppclapfunction equal ((x arg_y) (y arg_z))
     120;  "Return T if X and Y are EQL or if they are structured components
     121;  whose elements are EQUAL. Strings and bit-vectors are EQUAL if they
     122;  are the same length and have identical components. Other arrays must be
     123;  EQ to be EQUAL."
    119124  (check-nargs 2)
    120125  @top
  • trunk/ccl/level-0/l0-aprims.lisp

    r860 r929  
    7373
    7474(defun string (thing)
     75  "Coerces X into a string. If X is a string, X is returned. If X is a
     76   symbol, X's pname is returned. If X is a character then a one element
     77   string containing that character is returned. If X cannot be coerced
     78   into a string, an error occurs."
    7579  (etypecase thing
    7680    (string thing)
  • trunk/ccl/level-0/l0-array.lisp

    r582 r929  
    2323; compiler-transforms
    2424(defun make-string (size &key (initial-element () initial-element-p) (element-type 'character element-type-p))
     25  "Given a character count and an optional fill character, makes and returns
     26   a new string COUNT long filled with the fill character."
    2527  (when (and initial-element-p (not (typep initial-element 'character)))
    2628    (report-bad-arg initial-element 'character))
     
    7274
    7375(defun array-element-type (array)
     76  "Return the type of the elements of the array"
    7477  (let* ((subtag (if (%array-is-header array)
    7578                   (%array-header-subtype array)
     
    8487
    8588(defun adjustable-array-p (array)
     89  "Return T if (ADJUST-ARRAY ARRAY...) would return an array identical
     90   to the argument, this happens for complex arrays."
    8691  (let* ((typecode (typecode array)))
    8792    (declare (fixnum typecode))
     
    9398
    9499(defun array-displacement (array)
     100  "Return the values of :DISPLACED-TO and :DISPLACED-INDEX-offset
     101   options to MAKE-ARRAY, or NIL and 0 if not a displaced array."
    95102  (let* ((typecode (typecode array)))
    96103    (declare (fixnum typecode))
     
    133140
    134141(defun array-has-fill-pointer-p (array)
     142  "Return T if the given ARRAY has a fill pointer, or NIL otherwise."
    135143  (let* ((typecode (typecode array)))
    136144    (declare (fixnum typecode))
     
    142150
    143151(defun fill-pointer (array)
     152  "Return the FILL-POINTER of the given VECTOR."
    144153  (let* ((typecode (typecode array)))
    145154    (declare (fixnum typecode))
     
    169178
    170179(defun array-total-size (array)
     180  "Return the total number of elements in the Array."
    171181  (let* ((typecode (typecode array)))
    172182    (declare (fixnum typecode))
     
    179189
    180190(defun array-dimension (array axis-number)
     191  "Return the length of dimension AXIS-NUMBER of ARRAY."
    181192  (unless (typep axis-number 'fixnum) (report-bad-arg axis-number 'fixnum))
    182193  (locally
     
    200211
    201212(defun array-dimensions (array)
     213  "Return a list whose elements are the dimensions of the array"
    202214  (let* ((typecode (typecode array)))
    203215    (declare (fixnum typecode))
     
    218230
    219231(defun array-rank (array)
     232  "Return the number of dimensions of ARRAY."
    220233  (let* ((typecode (typecode array)))
    221234    (declare (fixnum typecode))
     
    227240
    228241(defun vector-push (elt vector)
     242  "Attempt to set the element of ARRAY designated by its fill pointer
     243   to NEW-EL, and increment the fill pointer by one. If the fill pointer is
     244   too large, NIL is returned, otherwise the index of the pushed element is
     245   returned."
    229246  (let* ((fill (fill-pointer vector))
    230247         (len (%svref vector ppc32::vectorH.physsize-cell)))
     
    264281; Could avoid potential memoization somehow
    265282(defun vector (&lexpr vals)
     283  "Construct a SIMPLE-VECTOR from the given objects."
    266284  (let* ((n (%lexpr-count vals))
    267285         (v (%alloc-misc n ppc32::subtag-simple-vector)))
     
    330348
    331349(defun aref (a &lexpr subs)
     350  "Return the element of the ARRAY specified by the SUBSCRIPTS."
    332351  (let* ((n (%lexpr-count subs)))
    333352    (declare (fixnum n))
     
    421440
    422441(defun schar (s i)
     442  "SCHAR returns the character object at an indexed position in a string
     443   just as CHAR does, except the string must be a simple-string."
    423444  (let* ((typecode (typecode s)))
    424445    (declare (fixnum typecode))
  • trunk/ccl/level-0/l0-def.lisp

    r78 r929  
    2424
    2525(defun functionp (arg)
     26  "Return true if OBJECT is a FUNCTION, and NIL otherwise."
    2627  (functionp arg))
    2728
     
    144145; than %unbound-function%; we expect FBOUNDP to return that something.
    145146(defun fboundp (name)
     147  "Return true if name has a global function definition."
    146148  (let* ((fname (validate-function-name name))
    147149         (def (%svref (%symbol->symptr fname) ppc32::symbol.fcell-cell)))
     
    218220
    219221
    220 (defun special-operator-p (symbol)
    221   "CL. Given a symbol returns non-nil if the symbol defines one of the forms
    222    designated special by CLtL or by this implementation.
    223    The non-nil value returned is not functionp."
     222(defun special-operator-p (symbol)
     223  "If the symbol globally names a special form, return T, otherwise NIL."
    224224  (let ((def (fboundp symbol)))
    225225    (and (typep def 'simple-vector)
  • trunk/ccl/level-0/l0-float.lisp

    r547 r929  
    4040
    4141(defun float-sign (n1 &optional n2) ; second arg silly
     42  "Return a floating-point number that has the same sign as
     43   FLOAT1 and, if FLOAT2 is given, has the same absolute value
     44   as FLOAT2."
    4245  (if (and n2 (not (typep n2 'float)))
    4346    (setq n2 (require-type n2 'float)))
     
    151154
    152155(defun decode-float (n)
     156  "Return three values:
     157   1) a floating-point number representing the significand. This is always
     158      between 0.5 (inclusive) and 1.0 (exclusive).
     159   2) an integer representing the exponent.
     160   3) -1.0 or 1.0 (i.e. the sign of the argument.)"
    153161  (number-case n
    154162    (double-float
     
    191199
    192200; (* float (expt 2 int))
    193 (defun scale-float (float int) 
     201(defun scale-float (float int)
     202  "Return the value (* f (expt (float 2 f) ex)), but with no unnecessary loss
     203  of precision or overflow."
    194204  (unless (fixnump int)(setq int (require-type int 'fixnum)))
    195205  (number-case float
     
    254264        (t (error "Ilegal arg ~s to %copy-float" f))))
    255265
    256 (defun float-precision (float)     ; not used - not in cltl2 index ?
     266(defun float-precision (float)     ; not used - not in cltl2 index ?
     267  "Return a non-negative number of significant digits in its float argument.
     268  Will be less than FLOAT-DIGITS if denormalized or zero."
    257269  (number-case float
    258270     (double-float
     
    510522;;; Transcendental functions.
    511523(defun sin (x)
     524  "Return the sine of NUMBER."
    512525  (if (complexp x)
    513526    (let* ((r (realpart x))
     
    521534
    522535(defun cos (x)
     536  "Return the cosine of NUMBER."
    523537  (if (complexp x)
    524538    (let* ((r (realpart x))
     
    532546
    533547(defun tan (x)
     548  "Return the tangent of NUMBER."
    534549  (if (complexp x)
    535550    (/ (sin x) (cos x))
     
    543558
    544559(defun atan (y &optional (x nil x-p))
     560  "Return the arc tangent of Y if X is omitted or Y/X if X is supplied."
    545561  (if x-p
    546562    (if (or (typep x 'double-float)
     
    564580
    565581(defun log (x &optional (b nil b-p))
     582  "Return the logarithm of NUMBER in the base BASE, which defaults to e."
    566583  (if b-p
    567584    (if (zerop b)
     
    603620
    604621(defun exp (x)
     622  "Return e raised to the power NUMBER."
    605623  (typecase x
    606624    (complex (* (exp (realpart x)) (cis (imagpart x))))
     
    612630
    613631(defun expt (b e)
     632  "Return BASE raised to the POWER."
    614633  (cond ((zerop e) (1+ (* b e)))
    615634        ((integerp e)
     
    630649
    631650
    632 (defun sqrt (x &aux a b) 
     651(defun sqrt (x &aux a b)
     652  "Return the square root of NUMBER."
    633653  (cond ((zerop x) x)
    634654        ((complexp x) (* (sqrt (abs x)) (cis (/ (phase x) 2))))         
     
    650670
    651671(defun asin (x)
     672  "Return the arc sine of NUMBER."
    652673  (number-case x
    653674    (complex
     
    687708
    688709(defun acos (x)
     710  "Return the arc cosine of NUMBER."
    689711  (number-case x
    690712    (complex
  • trunk/ccl/level-0/l0-hash.lisp

    r900 r929  
    509509                             (finalizeable nil)
    510510                             (address-based t))
     511  "Create and return a new hash table. The keywords are as follows:
     512     :TEST -- Indicates what kind of test to use.
     513     :SIZE -- A hint as to how many elements will be put in this hash
     514       table.
     515     :REHASH-SIZE -- Indicates how to expand the table when it fills up.
     516       If an integer, add space for that many elements. If a floating
     517       point number (which must be greater than 1.0), multiply the size
     518       by that amount.
     519     :REHASH-THRESHOLD -- Indicates how dense the table can become before
     520       forcing a rehash. Can be any positive number <=1, with density
     521       approaching zero as the threshold approaches 0. Density 1 means an
     522       average of one entry per bucket."
    511523  (unless (and test (or (functionp test) (symbolp test)))
    512524    (report-bad-arg test '(and (not null) (or symbol function))))
     
    589601; what if somebody is mapping, growing, rehashing?
    590602(defun clrhash (hash)
     603  "This removes all the entries from HASH-TABLE and returns the hash table
     604   itself."
    591605  (unless (hash-table-p hash)
    592606    (report-bad-arg hash 'hash-table))
     
    626640
    627641(defun hash-table-count (hash)
     642  "Return the number of entries in the given HASH-TABLE."
    628643  (if (nhash.locked-additions (require-type hash 'hash-table))
    629644    (add-locked-additions hash))
     
    633648
    634649(defun hash-table-rehash-size (hash)
     650  "Return the rehash-size HASH-TABLE was created with."
    635651  (nhash.rehash-size (require-type hash 'hash-table)))
    636652
    637653(defun hash-table-rehash-threshold (hash)
     654  "Return the rehash-threshold HASH-TABLE was created with."
    638655  (/ 1.0 (nhash.rehash-ratio (require-type hash 'hash-table))))
    639656
    640657(defun hash-table-size (hash)
     658  "Return a size that can be used with MAKE-HASH-TABLE to create a hash
     659   table that can hold however many entries HASH-TABLE can hold without
     660   having to be grown."
    641661  (%i+ (the fixnum (hash-table-count hash))
    642662       (the fixnum (nhash.grow-threshold hash))
     
    644664
    645665(defun hash-table-test (hash)
     666  "Return the test HASH-TABLE was created with."
    646667  (let ((f (nhash.compareF (require-type hash 'hash-table))))
    647668    (if (fixnump f)
     
    819840
    820841(defun gethash (key hash &optional default)
     842  "Finds the entry in HASH-TABLE whose key is KEY and returns the associated
     843   value and T as multiple values, or returns DEFAULT and NIL if there is no
     844   such entry. Entries can be added using SETF."
    821845  (unless (hash-table-p hash)
    822846    (setq hash (require-type hash 'hash-table))) 
     
    861885
    862886(defun remhash (key hash)
     887  "Remove the entry in HASH-TABLE associated with KEY. Return T if there
     888   was such an entry, or NIL if not."
    863889  (unless (hash-table-p hash)
    864890    (setq hash (require-type hash 'hash-table)))
  • trunk/ccl/level-0/l0-init.lisp

    r100 r929  
    1616
    1717(defconstant array-total-size-limit
    18   #.(expt 2 (- ppc32::nbits-in-word ppc32::num-subtag-bits)))
     18  #.(expt 2 (- ppc32::nbits-in-word ppc32::num-subtag-bits))
     19  "the exclusive upper bound on the total number of elements in an array")
    1920
    2021
     
    4950    #+darwinppp-target :darwin-target
    5051    #+darwinppc-target :poweropen-target
    51    
    52 ))
    53 (defparameter *load-verbose* nil)
     52    )
     53  "a list of symbols that describe features provided by the
     54   implementation")
     55(defparameter *load-verbose* nil
     56  "the default for the :VERBOSE argument to LOAD")
    5457
    5558;All Lisp package variables... Dunno if this still matters, but it
  • trunk/ccl/level-0/l0-misc.lisp

    r812 r929  
    188188
    189189(defun room (&optional (verbose :default))
     190  "Print to *STANDARD-OUTPUT* information about the state of internal
     191  storage and its management. The optional argument controls the
     192  verbosity of output. If it is T, ROOM prints out a maximal amount of
     193  information. If it is NIL, ROOM prints out a minimal amount of
     194  information. If it is :DEFAULT or it is not supplied, ROOM prints out
     195  an intermediate amount of information."
    190196  (let* ((freebytes nil)
    191197         (usedbytes nil)
     
    255261
    256262(defun list-length (l)
     263  "Return the length of the given LIST, or NIL if the LIST is circular."
    257264  (do* ((n 0 (+ n 2))
    258265        (fast l (cddr fast))
     
    275282
    276283(defun length (seq)
     284  "Return an integer that is the length of SEQUENCE."
    277285  (seq-dispatch
    278286   seq
  • trunk/ccl/level-0/l0-numbers.lisp

    r392 r929  
    193193
    194194(defun zerop (number)
     195  "Is this number zero?"
    195196  (number-case number
    196197    (integer (eq number 0))
     
    207208
    208209(defun plusp (number)
     210  "Is this real number strictly positive?"
    209211  (number-case number
    210212    (fixnum (%i> number 0))
     
    216218
    217219(defun minusp (number)
     220  "Is this real number strictly negative?"
    218221  (number-case number
    219222    (fixnum (%i< number 0))
     
    225228
    226229(defun oddp (n)
     230  "Is this integer odd?"
    227231  (case (typecode n)
    228232    (#.ppc32::tag-fixnum (logbitp 0 (the fixnum n)))
     
    231235
    232236(defun evenp (n)
     237  "Is this integer even?"
    233238  (case (typecode n)
    234239    (#.ppc32::tag-fixnum (not (logbitp 0 (the fixnum n))))
     
    731736
    732737(defun conjugate (number)
     738  "Return the complex conjugate of NUMBER. For non-complex numbers, this is
     739  an identity."
    733740  (number-case number
    734741    (complex (complex (%realpart number) (- (%imagpart number))))
     
    736743
    737744(defun numerator (rational)
     745  "Return the numerator of NUMBER, which must be rational."
    738746  (number-case rational
    739747    (ratio (%numerator rational))
     
    741749
    742750(defun denominator (rational)
     751  "Return the denominator of NUMBER, which must be rational."
    743752  (number-case rational
    744753    (ratio (%denominator rational))
     
    748757
    749758(defun abs (number)
    750   "Returns the absolute value of the number."
     759  "Return the absolute value of the number."
    751760  (number-case number
    752761   (fixnum
     
    776785
    777786(defun phase (number)
    778   "Returns the angle part of the polar representation of a complex number.
     787  "Return the angle part of the polar representation of a complex number.
    779788  For complex numbers, this is (atan (imagpart number) (realpart number)).
    780   For non-complex positive numbers, this is 0.  For non-complex negative
     789  For non-complex positive numbers, this is 0. For non-complex negative
    781790  numbers this is PI."
    782791  (number-case number
     
    800809; from Lib;numbers.lisp, sort of
    801810(defun float (number &optional other)
     811  "Converts any REAL to a float. If OTHER is not provided, it returns a
     812  SINGLE-FLOAT if NUMBER is not already a FLOAT. If OTHER is provided, the
     813  result is the same float format as OTHER."
    802814  (if (null other)
    803815    (if (typep number 'float)
     
    819831;;;
    820832(defun floor (number &optional divisor)
    821   "Returns the greatest integer not greater than number, or number/divisor.
     833  "Return the greatest integer not greater than number, or number/divisor.
    822834  The second returned value is (mod number divisor)."
    823835  (if (null divisor)(setq divisor 1))
     
    856868;;;
    857869(defun ceiling (number &optional divisor)
    858   "Returns the smallest integer not less than number, or number/divisor.
     870  "Return the smallest integer not less than number, or number/divisor.
    859871  The second returned value is the remainder."
    860872  (if (null divisor)(setq divisor 1))
     
    13741386
    13751387(defun cis (theta)
    1376   "Return cos(Theta) + i sin(Theta), AKA exp(i Theta)."
     1388  "Return cos(Theta) + i sin(Theta), i.e. exp(i Theta)."
    13771389  (if (complexp theta)
    13781390    (error "Argument to CIS is complex: ~S" theta)
     
    13811393
    13821394(defun complex (realpart &optional (imagpart 0))
    1383   "builds a complex number from the specified components."
     1395  "Return a complex number with the specified real and imaginary components."
    13841396  (number-case realpart
    13851397    (short-float
     
    14061418;; #-PPC IN L1-NUMBERS.LISP
    14071419(defun realpart (number)
     1420  "Extract the real part of a number."
    14081421  (number-case number
    14091422    (complex (%realpart number))
     
    14121425;; #-PPC IN L1-NUMBERS.LISP
    14131426(defun imagpart (number)
     1427  "Extract the imaginary part of a number."
    14141428  (number-case number
    14151429    (complex (%imagpart number))
     
    14561470
    14571471(defun lognand (integer1 integer2)
    1458   "Returns the complement of the logical AND of integer1 and integer2."
     1472  "Complement the logical AND of INTEGER1 and INTEGER2."
    14591473  (lognot (logand integer1 integer2)))
    14601474
    14611475(defun lognor (integer1 integer2)
    1462   "Returns the complement of the logical OR of integer1 and integer2."
     1476  "Complement the logical AND of INTEGER1 and INTEGER2."
    14631477  (lognot (logior integer1 integer2)))
    14641478
    14651479(defun logandc1 (x y)
    1466   "Returns the logical AND of (LOGNOT integer1) and integer2." 
     1480  "Return the logical AND of (LOGNOT integer1) and integer2."
    14671481  (number-case x
    14681482    (fixnum (number-case y               
     
    14811495
    14821496(defun logorc1 (integer1 integer2)
    1483   "Returns the logical OR of (LOGNOT integer1) and integer2."
     1497  "Return the logical OR of (LOGNOT integer1) and integer2."
    14841498  (logior (lognot integer1) integer2))
    14851499
     
    15291543
    15301544(defun lognot (number)
    1531   "Returns the bit-wise logical not of integer."
     1545  "Return the bit-wise logical not of integer."
    15321546  (number-case number
    15331547    (fixnum (%ilognot number))
     
    15481562
    15491563(defun ash (integer count)
    1550   "Shifts integer left by count places preserving sign.  - count shifts right."
     1564  "Shifts integer left by count places preserving sign. - count shifts right."
    15511565  (etypecase integer
    15521566    (fixnum
     
    15851599
    15861600(defun integer-length (integer)
    1587   "Returns the number of significant bits in the absolute value of integer."
     1601  "Return the number of significant bits in the absolute value of integer."
    15881602  (number-case integer
    15891603    (fixnum
     
    15981612
    15991613(defun byte-position (bytespec)
     1614  "Return the position part of the byte specifier bytespec."
    16001615  (if (> bytespec 0)
    16011616    (- (integer-length bytespec) (logcount bytespec))
     
    16051620; CMU CL returns T.
    16061621(defun upgraded-complex-part-type (type)
     1622  "Return the element type of the most specialized COMPLEX number type that
     1623   can hold parts of type SPEC."
    16071624  (declare (ignore type))
    16081625  'real)
  • trunk/ccl/level-0/l0-pred.lisp

    r309 r929  
    5858
    5959(defun compiled-function-p (form)
     60  "Return true if OBJECT is a COMPILED-FUNCTION, and NIL otherwise."
    6061  (and (functionp form)
    6162       (not (logbitp $lfbits-trampoline-bit (the fixnum (lfun-bits form))))))
     
    7576
    7677(defun integerp (x)
     78  "Return true if OBJECT is an INTEGER, and NIL otherwise."
    7779  (let* ((typecode (typecode x)))
    7880    (declare (fixnum typecode))
     
    8587
    8688(defun rationalp (x)
     89  "Return true if OBJECT is a RATIONAL, and NIL otherwise."
    8790  (or (fixnump x)
    8891      (let* ((typecode (typecode x)))
     
    101104
    102105(defun floatp (x)
     106  "Return true if OBJECT is a FLOAT, and NIL otherwise."
    103107  (let* ((typecode (typecode x)))
    104108    (declare (fixnum typecode))
     
    107111
    108112(defun realp (x)
     113  "Return true if OBJECT is a REAL, and NIL otherwise."
    109114  (let* ((typecode (typecode x)))
    110115    (declare (fixnum typecode))
     
    114119
    115120(defun complexp (x)
     121  "Return true if OBJECT is a COMPLEX, and NIL otherwise."
    116122  (= (the fixnum (typecode x)) ppc32::subtag-complex))
    117123
    118124(defun numberp (x)
     125  "Return true if OBJECT is a NUMBER, and NIL otherwise."
    119126  (let* ((typecode (typecode x)))
    120127    (declare (fixnum typecode))
     
    124131
    125132(defun arrayp (x)
     133  "Return true if OBJECT is an ARRAY, and NIL otherwise."
    126134  (>= (the fixnum (typecode x)) ppc32::min-array-subtag))
    127135
    128136(defun vectorp (x)
     137  "Return true if OBJECT is a VECTOR, and NIL otherwise."
    129138  (>= (the fixnum (typecode x)) ppc32::min-vector-subtag))
    130139
    131140
    132141(defun stringp (x)
     142  "Return true if OBJECT is a STRING, and NIL otherwise."
    133143  (let* ((typecode (typecode x)))
    134144    (declare (fixnum typecode))
     
    142152
    143153(defun simple-string-p (x)
     154  "Return true if OBJECT is a SIMPLE-STRING, and NIL otherwise."
    144155  (= (the fixnum (typecode x)) ppc32::subtag-simple-base-string))
    145156
     
    178189
    179190(defun simple-vector-p (x)
     191  "Return true if OBJECT is a SIMPLE-VECTOR, and NIL otherwise."
    180192  (= (the fixnum (typecode x)) ppc32::subtag-simple-vector))
    181193
     
    190202
    191203(defun simple-bit-vector-p (form)
     204  "Return true if OBJECT is a SIMPLE-BIT-VECTOR, and NIL otherwise."
    192205  (= (the fixnum (typecode form)) ppc32::subtag-bit-vector))
    193206
    194207(defun bit-vector-p (thing)
     208  "Return true if OBJECT is a BIT-VECTOR, and NIL otherwise."
    195209  (let* ((typecode (typecode thing)))
    196210    (declare (fixnum typecode))
     
    213227
    214228
    215 (defun eq (x y) (eq x y))
     229(defun eq (x y)
     230  "Return T if OBJ1 and OBJ2 are the same object, otherwise NIL."
     231  (eq x y))
    216232
    217233
     
    426442
    427443; real machine specific huh
    428 (defun consp (x) (consp x))
     444(defun consp (x)
     445  "Return true if OBJECT is a CONS, and NIL otherwise."
     446  (consp x))
    429447
    430448(defun characterp (arg)
     449  "Return true if OBJECT is a CHARACTER, and NIL otherwise."
    431450  (characterp arg))
    432451
     
    455474
    456475(defun symbolp (thing)
     476  "Return true if OBJECT is a SYMBOL, and NIL otherwise."
    457477  (if thing
    458478    (= (the fixnum (typecode thing)) ppc32::subtag-symbol)
  • trunk/ccl/level-0/l0-symbol.lisp

    r916 r929  
    8181
    8282(defun symbol-plist (sym)
     83  "Return SYMBOL's property list."
    8384  (let* ((pp (%symbol-package-plist sym)))
    8485    (if (consp pp)
     
    9192
    9293(defun get (sym key &optional default)
     94  "Look on the property list of SYMBOL for the specified INDICATOR. If this
     95  is found, return the associated value, else return DEFAULT."
    9396  (let* ((tail (%pl-search (symbol-plist sym) key)))
    9497    (if tail (%cadr tail) default)))
     
    125128
    126129(defun symbol-value (sym)
     130  "Return SYMBOL's current bound value."
    127131  (let* ((val (%sym-value sym)))
    128132    (if (eq val (%unbound-marker))
     
    131135
    132136(defun set (sym value)
     137  "Set SYMBOL's value cell to NEW-VALUE."
    133138  (let* ((bits (%symbol-bits sym)))
    134139    (declare (fixnum bits))
     
    143148; This leaves the SPECIAL and INDIRECT bits alone, clears the others.
    144149(defun makunbound (sym)
     150  "Make SYMBOL unbound, removing any value it may currently have."
    145151  (if (and *warn-if-redefine-kernel*
    146152           (constant-symbol-p sym))
     
    157163
    158164(defun symbol-package (sym)
     165  "Return the package SYMBOL was interned in, or NIL if none."
    159166  (let* ((pp (%symbol-package-plist sym)))
    160167    (if (consp pp) (car pp) pp)))
    161168
    162169(defun boundp (sym)
     170  "Return non-NIL if SYMBOL is bound to a value."
    163171  (not (eq (%sym-value sym) (%unbound-marker))))
    164172
    165173(defun make-symbol (name)
     174  "Make and return a new symbol with the NAME as its print name."
    166175  (%gvector ppc32::subtag-symbol
    167176                (ensure-simple-string name) ; pname
     
    199208
    200209(defun symbol-name (sym)
     210  "Return SYMBOL's name as a string."
    201211  (%svref (%symbol->symptr sym) ppc32::symbol.pname-cell))
    202212
  • trunk/ccl/level-1/l1-aprims.lisp

    r812 r929  
    4747
    4848(defun atom (arg)
     49  "Return true if OBJECT is an ATOM, and NIL otherwise."
    4950  (not (consp arg)))
    5051
    51 (defun list (&rest args) args)
     52(defun list (&rest args)
     53  "Return constructs and returns a list of its arguments."
     54  args)
    5255
    5356(%fhave '%temp-list #'list)
    5457
    5558(defun list* (arg &rest others)
    56   "Returns a list of the arguments with last cons a dotted pair"
     59  "Return a list of the arguments with last cons a dotted pair"
    5760  (cond ((null others) arg)
    5861        ((null (cdr others)) (cons arg (car others)))
     
    6467
    6568(defun funcall (fn &rest args)
     69  "Call FUNCTION with the given ARGUMENTS."
    6670  (declare (dynamic-extent args))
    6771  (apply fn args))
     
    6973
    7074(defun apply (function arg &rest args)
    71   "Applies FUNCTION to a list of arguments produced by evaluating ARGS in
    72   the manner of LIST*.  That is, a list is made of the values of all but the
     75  "Apply FUNCTION to a list of arguments produced by evaluating ARGUMENTS in
     76  the manner of LIST*. That is, a list is made of the values of all but the
    7377  last argument, appended to the value of the last argument, which must be a
    7478  list."
     
    112116
    113117(defun values-list (arg)
     118  "Return all of the elements of LIST, in order, as values."
    114119  (apply #'values arg))
    115120
     
    117122
    118123(defun make-list (size &key initial-element)
     124  "Constructs a list with size elements each set to value"
    119125  (unless (and (typep size 'fixnum)
    120126               (>= (the fixnum size) 0))
     
    129135
    130136(defun copy-list (list)
     137  "Return a new list which is EQUAL to LIST."
    131138  (if list
    132139    (let ((result (cons (car list) '()) ))
     
    152159
    153160(defun last (list &optional (n 1))
     161  "Return the last N conses (not the last element!) of a list."
    154162  (if (and (typep n 'fixnum)
    155163           (>= (the fixnum n) 0))
     
    172180
    173181(defun nthcdr (index list)
     182  "Performs the cdr function n times on a list."
    174183  (if (and (typep index 'fixnum)
    175184           (>= (the fixnum index) 0))
     
    186195
    187196
    188 (defun nth (index list) (car (nthcdr index list)))
     197(defun nth (index list)
     198  "Return the nth object in a list where the car is the zero-th element."
     199  (car (nthcdr index list)))
    189200
    190201
     
    305316   
    306317(defun nreverse (seq)
     318  "Return a sequence of the same elements in reverse order; the argument
     319   is destroyed."
    307320  (seq-dispatch seq
    308321   (list-nreverse seq)
     
    311324
    312325(defun nreconc (x y)
    313   "Returns (nconc (nreverse x) y)"
     326  "Return (NCONC (NREVERSE X) Y)."
    314327  (do ((1st (cdr x) (if (endp 1st) 1st (cdr 1st)))
    315328       (2nd x 1st)              ;2nd follows first down the list.
     
    319332
    320333(defun append (&lexpr lists)
     334  "Construct a new list by concatenating the list arguments"
    321335  (let* ((n (%lexpr-count lists)))
    322336    (declare (fixnum n))
     
    354368
    355369(defun reverse (seq)
     370  "Return a new sequence containing the same elements but in reverse order."
    356371  (seq-dispatch seq (list-reverse seq) (vector-reverse seq)))
    357372)
     
    490505; appears to be unused
    491506(defun upgraded-array-element-type (type &optional env)
     507  "Return the element type that will actually be used to implement an array
     508   with the specifier :ELEMENT-TYPE Spec."
    492509  (declare (ignore env))
    493510  (element-subtype-type (element-type-subtype type)))
     
    647664
    648665(defun vector-pop (vector)
     666  "Decrease the fill pointer by 1 and return the element pointed to by the
     667  new fill pointer."
    649668  (let* ((fill (fill-pointer vector)))
    650669    (declare (fixnum fill))
     
    660679
    661680(defun elt (sequence idx)
     681  "Return the element of SEQUENCE specified by INDEX."
    662682  (seq-dispatch
    663683   sequence
     
    700720
    701721(defun copy-tree (tree)
     722  "Recursively copy trees of conses."
    702723  (if (atom tree)
    703724    tree
     
    732753
    733754(defun char-downcase (c)
     755  "Return CHAR converted to lower-case if that is possible."
    734756  (let* ((code (char-code c)))
    735757    (if (and (%i>= code (char-code #\A))(%i<= code (char-code #\Z)))
     
    740762
    741763(defun digit-char-p (char &optional radix)
     764  "If char is a digit in the specified radix, returns the fixnum for
     765  which that digit stands, else returns NIL."
    742766  (let* ((code (char-code char))
    743767         (r (if radix (if (and (typep radix 'fixnum)
     
    763787
    764788(defun char-upcase (c)
     789  "Return CHAR converted to upper-case if that is possible.  Don't convert
     790   lowercase eszet (U+DF)."
    765791  (let* ((code (char-code c)))
    766792    (if (and (%i>= code (char-code #\a))(%i<= code (char-code #\z)))
     
    789815
    790816(defun get-properties (place indicator-list)
    791   "Like GETF, except that Indicator-List is a list of indicators which will
    792   be looked for in the property list stored in Place. Three values are
     817  "Like GETF, except that INDICATOR-LIST is a list of indicators which will
     818  be looked for in the property list stored in PLACE. Three values are
    793819  returned, see manual for details."
    794820  (do ((plist place (cddr plist)))
     
    800826
    801827(defun string= (string1 string2 &key start1 end1 start2 end2)
     828  "Given two strings (string1 and string2), and optional integers start1,
     829  start2, end1 and end2, compares characters in string1 to characters in
     830  string2 (using char=)."
    802831    (locally (declare (optimize (speed 3)(safety 0)))
    803832      (if (and (simple-string-p string1)(null start1)(null end1))
     
    822851
    823852(defun function-lambda-expression (fn)
     853  "Return (VALUES DEFINING-LAMBDA-EXPRESSION CLOSURE-P NAME), where
     854  DEFINING-LAMBDA-EXPRESSION is NIL if unknown, or a suitable argument
     855  to COMPILE otherwise, CLOSURE-P is non-NIL if the function's definition
     856  might have been enclosed in some non-null lexical environment, and
     857  NAME is some name (for debugging only) or NIL if there is no name."
    824858  ;(declare (values def env-p name))
    825859  (let* ((bits (lfun-bits (setq fn (require-type fn 'function)))))
     
    955989;True for a-z.
    956990(defun lower-case-p (c)
     991  "The argument must be a character object; LOWER-CASE-P returns T if the
     992   argument is a lower-case character, NIL otherwise."
    957993  (let ((code (char-code c)))
    958994    (and (>= code (char-code #\a))
     
    963999
    9641000(defun alpha-char-p (c)
     1001  "The argument must be a character object. ALPHA-CHAR-P returns T if the
     1002   argument is an alphabetic character, A-Z or a-z; otherwise NIL."
    9651003  (let* ((code (char-code c)))
    9661004    (declare (fixnum code))
  • trunk/ccl/level-1/l1-boot-1.lisp

    r182 r929  
    1919
    2020
    21 (defparameter *gensym-counter* 0)
     21(defparameter *gensym-counter* 0 "counter for generating unique GENSYM symbols")
    2222
    2323(defparameter *inhibit-greeting* nil)
  • trunk/ccl/level-1/l1-clos-boot.lisp

    r887 r929  
    18371837
    18381838(defun constantly (x)
     1839  "Return a function that always returns VALUE."
    18391840  #'(lambda (&rest ignore)
    18401841      (declare (dynamic-extent ignore)
  • trunk/ccl/level-1/l1-error-signal.lisp

    r332 r929  
    9595
    9696(defun error (condition &rest args)
     97  "Invoke the signal facility on a condition formed from DATUM and ARGUMENTS.
     98  If the condition is not handled, the debugger is invoked."
    9799  #|
    98100  #+ppc-target
  • trunk/ccl/level-1/l1-error-system.lisp

    r832 r929  
    456456
    457457(defun restart-name (restart)
     458  "Return the name of the given restart object."
    458459  (%restart-name (require-type restart 'restart)))
    459460
     
    465466
    466467(defun compute-restarts (&optional condition &aux restarts)
     468  "Return a list of all the currently active restarts ordered from most
     469   recently established to less recently established. If CONDITION is
     470   specified, then only restarts associated with CONDITION (or with no
     471   condition) will be returned."
    467472  (dolist (cluster %restarts% (nreverse restarts))
    468473    (if (null condition)
     
    473478
    474479(defun find-restart (name &optional condition)
     480  "Return the first restart named NAME. If NAME names a restart, the restart
     481   is returned if it is currently active. If no such restart is found, NIL is
     482   returned. It is an error to supply NIL as a name. If CONDITION is specified
     483   and not NIL, then only restarts associated with that condition (or with no
     484   condition) will be returned."
    475485  (dolist (cluster %restarts%)
    476486    (dolist (restart cluster)
     
    491501
    492502(defun invoke-restart (restart &rest values)
     503  "Calls the function associated with the given restart, passing any given
     504   arguments. If the argument restart is not a restart or a currently active
     505   non-nil restart name, then a CONTROL-ERROR is signalled."
    493506  (multiple-value-bind (restart tag) (%active-restart restart)
    494507    (let ((fn (%restart-action restart)))
     
    508521
    509522(defun invoke-restart-interactively (restart)
     523  "Calls the function associated with the given restart, prompting for any
     524   necessary arguments. If the argument restart is not a restart or a
     525   currently active non-NIL restart name, then a CONTROL-ERROR is signalled."
    510526  (multiple-value-bind (restart tag) (%active-restart restart)
    511527    (format *error-output* "~&Invoking restart: ~a~&" restart)
     
    529545
    530546(defun use-value (value &optional condition)
     547  "Transfer control and VALUE to a restart named USE-VALUE, or return NIL if
     548   none exists."
    531549  (maybe-invoke-restart 'use-value value condition))
    532550
    533551(defun store-value (value &optional condition)
     552  "Transfer control and VALUE to a restart named STORE-VALUE, or return NIL if
     553   none exists."
    534554  (maybe-invoke-restart 'store-value value condition))
    535555
     
    540560
    541561(defun make-condition (name &rest init-list &aux class)
     562  "Make an instance of a condition object using the specified initargs."
    542563  (declare (dynamic-extent init-list))
    543564  (if (and (setq class (find-class name nil))
  • trunk/ccl/level-1/l1-files.lisp

    r845 r929  
    3838
    3939(defvar %logical-host-translations% '())
    40 (defvar *load-pathname* nil)
    41 (defvar *load-truename* nil)
     40(defvar *load-pathname* nil
     41  "the defaulted pathname that LOAD is currently loading")
     42(defvar *load-truename* nil
     43  "the TRUENAME of the file that LOAD is currently loading")
    4244
    4345
     
    126128
    127129(defun truename (path)
     130  "Return the pathname for the actual file described by PATHNAME.
     131  An error of type FILE-ERROR is signalled if no such file exists,
     132  or the pathname is wild.
     133
     134  Under Unix, the TRUENAME of a broken symlink is considered to be
     135  the name of the broken symlink itself."
    128136  (or (probe-file path)
    129137      (signal-file-error $err-no-file path)))
    130138
    131139(defun probe-file (path)
     140  "Return a pathname which is the truename of the file if it exists, or NIL
     141  otherwise. An error of type FILE-ERROR is signaled if pathname is wild."
    132142  (when (wild-pathname-p path)
    133143    (error 'file-error :error-type "Inappropriate use of wild pathname ~s"
     
    268278
    269279(defun namestring (path)
     280  "Construct the full (name)string form of the pathname."
    270281  (%str-cat (host-namestring path)
    271282            (directory-namestring path)
     
    273284
    274285(defun host-namestring (path)
     286  "Return a string representation of the name of the host in the pathname."
    275287  (let ((host (pathname-host path)))
    276288    (if (and host (neq host :unspecific)) (%str-cat host ":") "")))
    277289
    278290(defun directory-namestring (path)
     291  "Return a string representation of the directories used in the pathname."
    279292  (%directory-list-namestring (pathname-directory path)
    280293                              (neq (pathname-host path) :unspecific)))
     
    322335
    323336(defun file-namestring (path)
     337  "Return a string representation of the name used in the pathname."
    324338  (let* ((name (pathname-name path))
    325339         (type (pathname-type path))
     
    349363
    350364(defun enough-namestring (path &optional (defaults *default-pathname-defaults*))
     365  "Return an abbreviated pathname sufficent to identify the pathname relative
     366   to the defaults."
    351367  (if (null defaults)
    352368    (namestring path)
     
    392408
    393409(defun pathname (path)
     410  "Convert thing (a pathname, string or stream) into a pathname."
    394411  (etypecase path
    395412    (pathname path)
     
    461478                           (defaults nil defaults-p) case
    462479                           &aux path)
     480  "Makes a new pathname from the component arguments. Note that host is
     481a host-structure or string."
    463482  (declare (ignore device))
    464483  (when case (setq case (require-type case pathname-case-type)))
     
    556575(defun merge-pathnames (path &optional (defaults *default-pathname-defaults*)
    557576                                       (default-version :newest))
     577  "Construct a filled in pathname by completing the unspecified components
     578   from the defaults."
    558579  ;(declare (ignore default-version))
    559580  (when (not (pathnamep path))(setq path (pathname path)))
     
    606627;In CCL, a pathname is logical if and only if pathname-host is not :unspecific.
    607628(defun pathname-host (thing &key case)
     629  "Return PATHNAME's host."
    608630  (when (streamp thing)(setq thing (%path-from-stream thing)))
    609631  (when case (setq case (require-type case pathname-case-type)))
     
    641663
    642664(defun pathname-device (thing &key case)
     665  "Return PATHNAME's device."
    643666  (declare (ignore case))
    644667  (and (pathname thing)                 ;type-checking
     
    650673;filesystem.
    651674(defun pathname-directory (path &key case)
     675  "Return PATHNAME's directory."
    652676  (when (streamp path) (setq path (%path-from-stream path)))
    653677  (when case (setq case (require-type case pathname-case-type)))
     
    720744
    721745(defun pathname-version (path)
     746  "Return PATHNAME's version."
    722747  (when (streamp path) (setq path (%path-from-stream path)))
    723748  (typecase path
     
    752777;filesystem.
    753778(defun pathname-name (path &key case)
     779  "Return PATHNAME's name."
    754780  (when (streamp path) (setq path (%path-from-stream path)))
    755781  (when case (setq case (require-type case pathname-case-type)))
     
    787813;filesystem.
    788814(defun pathname-type (path &key case)
     815  "Return PATHNAME's type."
    789816  (when (streamp path) (setq path (%path-from-stream path)))
    790817  (when case (setq case (require-type case pathname-case-type)))
     
    960987
    961988(defun file-write-date (path)
     989  "Return file's creation date, or NIL if it doesn't exist.
     990  An error of type file-error is signaled if file is a wild pathname"
    962991  (%file-write-date (native-translated-namestring path)))
    963992
    964993(defun file-author (path)
     994  "Return the file author as a string, or NIL if the author cannot be
     995  determined. Signal an error of type FILE-ERROR if FILE doesn't exist,
     996  or FILE is a wild pathname."
    965997  (%file-author (native-translated-namestring path)))
    966998
     
    10561088                       (if-does-not-exist :error)
    10571089                       (external-format :default))
    1058   "Extension: :PRINT :SOURCE means print source as well as value"
     1090  "Load the file given by FILESPEC into the Lisp environment, returning
     1091   T on success.
     1092
     1093   Extension: :PRINT :SOURCE means print source as well as value"
    10591094  (loop
    10601095    (restart-case
     
    11561191
    11571192(defun delete-file (path)
     1193  "Delete the specified FILE."
    11581194  (let* ((namestring (native-translated-namestring path)))
    11591195    (when (%realpath namestring)
     
    11721208
    11731209(defun provide (module)
     1210  "Adds a new module name to *MODULES* indicating that it has been loaded.
     1211   Module-name is a string designator"
    11741212  (pushnew (string module) *modules* :test #'string=)
    11751213  module)
     
    11921230
    11931231(defun require (module &optional pathname)
     1232  "Loads a module, unless it already has been loaded. PATHNAMES, if supplied,
     1233   is a designator for a list of pathnames to be loaded if the module
     1234   needs to be. If PATHNAMES is not supplied, functions from the list
     1235   *MODULE-PROVIDER-FUNCTIONS* are called in order with MODULE-NAME
     1236   as an argument, until one of them returns non-NIL.  User code is
     1237   responsible for calling PROVIDE to indicate a successful load of the
     1238   module."
    11941239  (let* ((str (string module))
    11951240         (original-modules (copy-list *modules*)))
     
    12201265
    12211266(defun wild-pathname-p (pathname &optional field-key)
     1267  "Predicate for determining whether pathname contains any wildcards."
    12221268  (flet ((wild-p (name) (or (eq name :wild)
    12231269                            (eq name :wild-inferiors)
  • trunk/ccl/level-1/l1-init.lisp

    r861 r929  
    8989
    9090
    91 (defconstant boole-clr 0)
    92 (defconstant boole-set 1)
    93 (defconstant boole-1 2)
    94 (defconstant boole-2 3)
    95 (defconstant boole-c1 4)
    96 (defconstant boole-c2 5)
    97 (defconstant boole-and 6)
    98 (defconstant boole-ior 7)
    99 (defconstant boole-xor 8)
    100 (defconstant boole-eqv 9)
    101 (defconstant boole-nand 10)
    102 (defconstant boole-nor 11)
    103 (defconstant boole-andc1 12)
    104 (defconstant boole-andc2 13)
    105 (defconstant boole-orc1 14)
    106 (defconstant boole-orc2 15)
    107 
    108 
    109 
    110 (defconstant internal-time-units-per-second 1000)
    111 
    112 (defconstant char-code-limit #x100)
    113 
    114 (defconstant array-rank-limit #x2000)
    115 (defconstant multiple-values-limit 200)
    116 (defconstant lambda-parameters-limit #x2000)
    117 (defconstant call-arguments-limit #x2000)
     91(defconstant boole-clr 0
     92  "Boole function op, makes BOOLE return 0.")
     93(defconstant boole-set 1
     94  "Boole function op, makes BOOLE return -1.")
     95(defconstant boole-1 2
     96  "Boole function op, makes BOOLE return integer1.")
     97(defconstant boole-2 3
     98  "Boole function op, makes BOOLE return integer2.")
     99(defconstant boole-c1 4
     100  "Boole function op, makes BOOLE return complement of integer1.")
     101(defconstant boole-c2 5
     102  "Boole function op, makes BOOLE return complement of integer2.")
     103(defconstant boole-and 6
     104  "Boole function op, makes BOOLE return logand of integer1 and integer2.")
     105(defconstant boole-ior 7
     106  "Boole function op, makes BOOLE return logior of integer1 and integer2.")
     107(defconstant boole-xor 8
     108  "Boole function op, makes BOOLE return logxor of integer1 and integer2.")
     109(defconstant boole-eqv 9
     110  "Boole function op, makes BOOLE return logeqv of integer1 and integer2.")
     111(defconstant boole-nand 10
     112  "Boole function op, makes BOOLE return log nand of integer1 and integer2.")
     113(defconstant boole-nor 11
     114  "Boole function op, makes BOOLE return lognor of integer1 and integer2.")
     115(defconstant boole-andc1 12
     116  "Boole function op, makes BOOLE return logandc1 of integer1 and integer2.")
     117(defconstant boole-andc2 13
     118  "Boole function op, makes BOOLE return logandc2 of integer1 and integer2.")
     119(defconstant boole-orc1 14
     120  "Boole function op, makes BOOLE return logorc1 of integer1 and integer2.")
     121(defconstant boole-orc2 15
     122  "Boole function op, makes BOOLE return logorc2 of integer1 and integer2.")
     123
     124
     125
     126(defconstant internal-time-units-per-second 1000
     127  "The number of internal time units that fit into a second. See
     128  GET-INTERNAL-REAL-TIME and GET-INTERNAL-RUN-TIME.")
     129
     130(defconstant char-code-limit #x100
     131  "the upper exclusive bound on values produced by CHAR-CODE")
     132
     133(defconstant array-rank-limit #x2000
     134  "the exclusive upper bound on the rank of an array")
     135(defconstant multiple-values-limit 200
     136  "The exclusive upper bound on the number of multiple VALUES that you can
     137  return.")
     138(defconstant lambda-parameters-limit #x2000
     139  "The exclusive upper bound on the number of parameters which may be specifed
     140  in a given lambda list. This is actually the limit on required and &OPTIONAL
     141  parameters. With &KEY and &AUX you can get more.")
     142(defconstant call-arguments-limit #x2000
     143  "The exclusive upper bound on the number of arguments which may be passed
     144  to a function, including &REST args."
     145)
    118146
    119147; Currently, vectors can be at most (expt 2 22) bytes, and
     
    125153|#
    126154
    127 (defconstant array-dimension-limit array-total-size-limit)
     155(defconstant array-dimension-limit array-total-size-limit
     156  "the exclusive upper bound on any given dimension of an array")
    128157
    129158
     
    133162    (lsh a b)))
    134163
    135 (defconstant most-positive-fixnum (load-time-value (hide-lsh -1 -1)))
    136 (defconstant most-negative-fixnum (load-time-value (1- (- (hide-lsh -1 -1)))))
     164(defconstant most-positive-fixnum (load-time-value (hide-lsh -1 -1))
     165  "the fixnum closest in value to positive infinity")
     166(defconstant most-negative-fixnum (load-time-value (1- (- (hide-lsh -1 -1))))
     167  "the fixnum closest in value to negative infinity")
    137168
    138169
     
    145176
    146177(defconstant lambda-list-keywords
    147   '(&OPTIONAL &REST &AUX &KEY &ALLOW-OTHER-KEYS &BODY &ENVIRONMENT &WHOLE))
     178  '(&OPTIONAL &REST &AUX &KEY &ALLOW-OTHER-KEYS &BODY &ENVIRONMENT &WHOLE)
     179  "symbols which are magical in a lambda list")
    148180
    149181
     
    155187(defvar *read-default-float-format* 'single-float)
    156188
    157 (defvar *read-suppress* nil)
    158 
    159 (defvar *read-base* 10.)
     189(defvar *read-suppress* nil
     190  "Suppress most interpreting in the reader when T.")
     191
     192(defvar *read-base* 10.
     193  "the radix that Lisp reads numbers in")
    160194
    161195
     
    237271(defconstant *ccl-package* *ccl-package*)
    238272
    239 (defparameter *load-print* nil)
     273(defparameter *load-print* nil "the default for the :PRINT argument to LOAD")
    240274(defparameter *loading-files* nil)
    241275(defvar *loading-file-source-file* nil)
     
    249283
    250284(defvar *modules* nil
    251   "Holds list of names of modules that have been loaded thus far.
    252    The names are case sensitive strings.")
     285  "This is a list of module names that have been loaded into Lisp so far.
     286   The names are case sensitive strings.  It is used by PROVIDE and REQUIRE.")
     287
    253288
    254289
  • trunk/ccl/level-1/l1-io.lisp

    r913 r929  
    16141614                   (simple-bit-vector *print-simple-bit-vector*)
    16151615                   (string-length *print-string-length*))
     1616  "Output OBJECT to the specified stream, defaulting to *STANDARD-OUTPUT*"
    16161617  (let ((*print-escape* escape)
    16171618        (*print-radix* radix)
     
    16571658                             (simple-bit-vector *print-simple-bit-vector*)
    16581659                             (string-length *print-string-length*))
     1660  "Return the printed representation of OBJECT as a string."
    16591661    (let ((*print-escape* escape)
    16601662          (*print-radix* radix)
     
    16821684
    16831685(defun prin1-to-string (object)
     1686  "Return the printed representation of OBJECT as a string with
     1687   slashification on."
    16841688  (with-output-to-string (s)
    16851689    (prin1 object s)))
    16861690
    16871691(defun princ-to-string (object)
     1692  "Return the printed representation of OBJECT as a string with
     1693  slashification off."
    16881694  (with-output-to-string (s)
    16891695    (princ object s)))
    16901696
    16911697(defun prin1 (object &optional stream)
     1698  "Output a mostly READable printed representation of OBJECT on the specified
     1699  STREAM."
    16921700  (let ((*print-escape* t))
    16931701    (write-1 object stream)))
    16941702
    16951703(defun princ (object &optional stream)
     1704  "Output an aesthetic but not necessarily READable printed representation
     1705  of OBJECT on the specified STREAM."
    16961706  (let ((*print-escape* nil)
    16971707        (*print-readably* nil)
     
    17001710
    17011711(defun print (object &optional stream)
     1712  "Output a newline, the mostly READable printed representation of OBJECT, and
     1713  space to the specified STREAM."
    17021714  (setq stream (real-print-stream stream))
    17031715  (terpri stream)
     
    17141726
    17151727(defun read-sequence (seq stream &key (start 0) end)
     1728  "Destructively modify SEQ by reading elements from STREAM.
     1729  That part of SEQ bounded by START and END is destructively modified by
     1730  copying successive elements into it from STREAM. If the end of file
     1731  for STREAM is reached before copying all elements of the subsequence,
     1732  then the extra elements near the end of sequence are not updated, and
     1733  the index of the next element is returned."
    17161734  (setq end (check-sequence-bounds seq start end))
    17171735  (locally (declare (fixnum start end))
     
    17371755
    17381756(defun write-sequence (seq stream &key (start 0) end)
     1757  "Write the elements of SEQ bounded by START and END to STREAM."
    17391758  (setq end (check-sequence-bounds seq start end))
    17401759  (locally (declare (fixnum start end))
  • trunk/ccl/level-1/l1-numbers.lisp

    r392 r929  
    110110
    111111(defun logand (&lexpr numbers)
     112  "Return the bit-wise and of its arguments. Args must be integers."
    112113  (let* ((count (%lexpr-count numbers)))
    113114    (declare (fixnum count))
     
    125126
    126127(defun logior (&lexpr numbers)
     128  "Return the bit-wise or of its arguments. Args must be integers."
    127129  (let* ((count (%lexpr-count numbers)))
    128130    (declare (fixnum count))
     
    139141
    140142(defun logxor (&lexpr numbers)
     143  "Return the bit-wise exclusive or of its arguments. Args must be integers."
    141144  (let* ((count (%lexpr-count numbers)))
    142145    (declare (fixnum count))
     
    153156
    154157(defun logeqv (&lexpr numbers)
     158  "Return the bit-wise equivalence of its arguments. Args must be integers."
    155159  (let* ((count (%lexpr-count numbers))
    156160         (result (if (zerop count)
     
    173177
    174178(defun = (num &lexpr more)
     179  "Return T if all of its arguments are numerically equal, NIL otherwise."
    175180  (let* ((count (%lexpr-count more)))
    176181    (declare (fixnum count))
     
    183188
    184189(defun /= (num &lexpr more)
     190  "Return T if no two of its arguments are numerically equal, NIL otherwise."
    185191  (let* ((count (%lexpr-count more)))
    186192    (declare (fixnum count))
     
    199205
    200206(defun - (num &lexpr more)
     207  "Subtract the second and all subsequent arguments from the first;
     208  or with one argument, negate the first argument."
    201209  (let* ((count (%lexpr-count more)))
    202210    (declare (fixnum count))
     
    207215
    208216(defun / (num &lexpr more)
     217  "Divide the first argument by each of the following arguments, in turn.
     218  With one argument, return reciprocal."
    209219  (let* ((count (%lexpr-count more)))
    210220    (declare (fixnum count))
     
    215225
    216226(defun + (&lexpr numbers)
     227  "Return the sum of its arguments. With no args, returns 0."
    217228  (let* ((count (%lexpr-count numbers)))
    218229    (declare (fixnum count))
     
    230241
    231242(defun * (&lexpr numbers)
     243  "Return the product of its arguments. With no args, returns 1."
    232244  (let* ((count (%lexpr-count numbers)))
    233245    (declare (fixnum count))
     
    245257
    246258(defun < (num &lexpr more)
     259  "Return T if its arguments are in strictly increasing order, NIL otherwise."
    247260  (let* ((count (%lexpr-count more)))
    248261    (declare (fixnum count))
     
    257270
    258271(defun <= (num &lexpr more)
     272  "Return T if arguments are in strictly non-decreasing order, NIL otherwise."
    259273  (let* ((count (%lexpr-count more)))
    260274    (declare (fixnum count))
     
    270284
    271285(defun > (num &lexpr more)
     286  "Return T if its arguments are in strictly decreasing order, NIL otherwise."
    272287  (let* ((count (%lexpr-count more)))
    273288    (declare (fixnum count))
     
    282297
    283298(defun >= (num &lexpr more)
     299  "Return T if arguments are in strictly non-increasing order, NIL otherwise."
    284300  (let* ((count (%lexpr-count more)))
    285301    (declare (fixnum count))
     
    297313
    298314(defun max (num &lexpr more)
     315  "Return the greatest of its arguments; among EQUALP greatest, return
     316   the first."
    299317  (let* ((count (%lexpr-count more)))
    300318    (declare (fixnum count))
     
    309327
    310328(defun min (num &lexpr more)
     329  "Return the least of its arguments; among EQUALP least, return
     330  the first."
    311331  (let* ((count (%lexpr-count more)))
    312332    (declare (fixnum count))
     
    326346
    327347(defun deposit-field (value bytespec integer)
     348  "Return new integer with newbyte in specified position, newbyte is not right justified."
    328349  (if (> bytespec 0)   
    329350    (logior (logandc1 bytespec integer) (logand bytespec value))
     
    338359;;; else ->  (ash (byte-mask size) position)
    339360(defun byte (size position)
     361  "Return a byte specifier which may be used by other byte functions
     362  (e.g. LDB)."
    340363  (unless (and (typep size 'integer)
    341364               (>= size 0))
     
    353376
    354377(defun byte-size (bytespec)
     378  "Return the size part of the byte specifier bytespec."
    355379  (if (> bytespec 0)
    356380    (logcount bytespec)
     
    358382
    359383(defun ldb (bytespec integer)
     384  "Extract the specified byte from integer, and right justify result."
    360385  (if (and (fixnump bytespec) (> (the fixnum bytespec) 0)  (fixnump integer))
    361386    (%ilsr (byte-position bytespec) (%ilogand bytespec integer))
     
    373398
    374399(defun mask-field (bytespec integer)
     400  "Extract the specified byte from integer, but do not right justify result."
    375401  (if (>= bytespec 0)
    376402    (logand bytespec integer)
     
    378404
    379405(defun dpb (value bytespec integer)
     406  "Return new integer with newbyte in specified position, newbyte is right justified."
    380407  (if (and (fixnump value)
    381408           (fixnump bytespec)
     
    387414
    388415(defun ldb-test (bytespec integer)
     416  "Return T if any of the specified bits in integer are 1's."
    389417  (if (> bytespec 0)
    390418    (logtest bytespec integer)
     
    409437
    410438(defun make-random-state (&optional state &aux (seed-1 0) (seed-2 0))
     439  "Make a random state object. If STATE is not supplied, return a copy
     440  of the default random state. If STATE is a random state, then return a
     441  copy of it. If STATE is T then return a random state generated from
     442  the universal time."
    411443  (if (eq state t)
    412444    (multiple-value-setq (seed-1 seed-2) (init-random-state-seeds))
  • trunk/ccl/level-1/l1-pathnames.lisp

    r507 r929  
    6666
    6767(defun logical-pathname-translations (host)
     68  "Return the (logical) host object argument's list of translations."
    6869  (setq host (verify-logical-host-name host))
    6970  (let ((translations (%str-assoc host %logical-host-translations%)))
     
    307308
    308309(defun translate-pathname (source from-wildname to-wildname &key reversible)
     310  "Use the source pathname to translate the from-wildname's wild and
     311   unspecified elements into a completed to-pathname based on the to-wildname."
    309312  (when (not (pathnamep source)) (setq source (pathname source)))
    310313  (flet ((foo-error (source from)
     
    350353;; This extends CL in that it allows a host-less pathname, like "foo;bar;baz".
    351354(defun logical-pathname (thing &aux (path thing))
     355  "Converts the pathspec argument to a logical-pathname and returns it."
    352356  (when (typep path 'stream) (setq path (%path-from-stream path)))
    353357  (etypecase path
     
    371375
    372376(defun pathname-match-p (pathname wildname)
     377  "Pathname matches the wildname template?"
    373378  (let ((path-host (pathname-host pathname))
    374379        (wild-host (pathname-host wildname)))
     
    624629
    625630(defun user-homedir-pathname (&optional host)
     631  "Return the home directory of the user as a pathname."
    626632  (declare (ignore host)) 
    627633  (let* ((native (get-user-home-dir (getuid))))
     
    634640
    635641(defun translate-logical-pathname (pathname &key)
     642  "Translate PATHNAME to a physical pathname, which is returned."
    636643  (setq pathname (pathname pathname))
    637644  (let ((host (pathname-host pathname)))
  • trunk/ccl/level-1/l1-reader.lisp

    r927 r929  
    5656
    5757(defun name-char (name)
     58  "Given an argument acceptable to STRING, NAME-CHAR returns a character
     59  whose name is that string, if one exists. Otherwise, NIL is returned."
    5860  (if (characterp name)
    5961    name
     
    207209
    208210(defun set-syntax-from-char (to-char from-char &optional to-readtable from-readtable)
     211  "Causes the syntax of TO-CHAR to be the same as FROM-CHAR in the
     212  optional readtable (defaults to the current readtable). The
     213  FROM-TABLE defaults to the standard Lisp readtable when NIL."
    209214  (setq to-char (require-type to-char 'base-char))
    210215  (setq from-char (require-type from-char 'base-char))
     
    224229      t)))
    225230
    226 (defun get-macro-character (char &optional readtable) 
     231(defun get-macro-character (char &optional readtable)
     232  "Return the function associated with the specified CHAR which is a macro
     233  character, or NIL if there is no such function. As a second value, return
     234  T if CHAR is a macro character which is non-terminating, i.e. which can
     235  be embedded in a symbol name."
    227236  (setq readtable (readtable-arg readtable))
    228237  (multiple-value-bind (attr info) (%get-readtable-char char readtable)
     
    233242
    234243(defun set-macro-character (char fn &optional non-terminating-p readtable)
     244  "Causes CHAR to be a macro character which invokes FUNCTION when seen
     245   by the reader. The NON-TERMINATINGP flag can be used to make the macro
     246   character non-terminating, i.e. embeddable in a symbol name."
    235247  (setq char (require-type char 'base-char))
    236248  (setq readtable (readtable-arg readtable))
     
    266278
    267279(defun make-dispatch-macro-character (char &optional non-terminating-p readtable)
     280  "Cause CHAR to become a dispatching macro character in readtable (which
     281   defaults to the current readtable). If NON-TERMINATING-P, the char will
     282   be non-terminating."
    268283  (setq readtable (readtable-arg readtable))
    269284  (setq char (require-type char 'base-char))
     
    279294
    280295(defun get-dispatch-macro-character (disp-ch sub-ch &optional (readtable *readtable*))
     296  "Return the macro character function for SUB-CHAR under DISP-CHAR
     297   or NIL if there is no associated function."
    281298  (setq readtable (readtable-arg (or readtable %initial-readtable%)))
    282299  (setq disp-ch (require-type disp-ch 'base-char))
     
    289306
    290307(defun set-dispatch-macro-character (disp-ch sub-ch fn &optional readtable)
     308  "Cause FUNCTION to be called whenever the reader reads DISP-CHAR
     309   followed by SUB-CHAR."
    291310  (setq readtable (readtable-arg readtable))
    292311  (setq disp-ch (require-type disp-ch 'base-char))
     
    9841003
    9851004(defun read-preserving-whitespace (&optional stream (eof-error-p t) eof-value recursive-p)
     1005  "Read from STREAM and return the value read, preserving any whitespace
     1006   that followed the object."
    9861007  (setq stream (input-stream-arg stream))
    9871008  (if recursive-p
     
    9921013
    9931014(defun read-delimited-list (char &optional stream recursive-p)
     1015  "Read Lisp values from INPUT-STREAM until the next character after a
     1016   value's representation is ENDCHAR, and return the objects as a list."
    9941017  (setq char (require-type char 'character))
    9951018  (setq stream (input-stream-arg stream))
  • trunk/ccl/level-1/l1-readloop-lds.lisp

    r822 r929  
    295295
    296296(defun break (&optional string &rest args &aux (fp (%get-frame-ptr)))
     297  "Print a message and invoke the debugger without allowing any possibility
     298   of condition handling occurring."
    297299  (flet ((do-break-loop ()
    298300           (let ((c (make-condition 'simple-condition
     
    313315
    314316(defun invoke-debugger (condition &aux (fp (%get-frame-ptr)))
     317  "Enter the debugger."
    315318  (let ((c (require-type condition 'condition)))
    316319    (when *debugger-hook*
     
    359362
    360363(defun warn (condition-or-format-string &rest args)
     364  "Warn about a situation by signalling a condition formed by DATUM and
     365   ARGUMENTS. While the condition is being signaled, a MUFFLE-WARNING restart
     366   exists that causes WARN to immediately return NIL."
    361367  (when (typep condition-or-format-string 'condition)
    362368    (unless (typep condition-or-format-string 'warning)
  • trunk/ccl/level-1/l1-readloop.lisp

    r859 r929  
    2020
    2121
    22 (defvar *break-on-signals* nil)
     22(defvar *break-on-signals* nil
     23  "When (TYPEP condition *BREAK-ON-SIGNALS*) is true, then calls to SIGNAL will
     24   enter the debugger prior to signalling that condition.")
    2325(defvar *break-on-warnings* nil)
    2426(defvar *break-on-errors* t "Not CL.")
    25 (defvar *debugger-hook* nil)
     27(defvar *debugger-hook* nil
     28  "This is either NIL or a function of two arguments, a condition and the value
     29   of *DEBUGGER-HOOK*. This function can either handle the condition or return
     30   which causes the standard debugger to execute. The system passes the value
     31   of this variable to the function because it binds *DEBUGGER-HOOK* to NIL
     32   around the invocation.")
    2633(defvar *backtrace-on-break* nil)
    27 (defvar *** nil)
    28 (defvar ** nil)
    29 (defvar * nil)
    30 (defvar /// nil)
    31 (defvar // nil)
    32 (defvar / nil)
    33 (defvar +++ nil)
    34 (defvar ++ nil)
    35 (defvar + nil)
    36 (defvar - nil)
     34(defvar *** nil
     35  "the previous value of **")
     36(defvar ** nil
     37  "the previous value of *")
     38(defvar * nil
     39  "the value of the most recent top level EVAL")
     40(defvar /// nil
     41  "the previous value of //")
     42(defvar // nil
     43  "the previous value of /")
     44(defvar / nil
     45  "a list of all the values returned by the most recent top level EVAL")
     46(defvar +++ nil
     47  "the previous value of ++")
     48(defvar ++ nil
     49  "the previous value of +")
     50(defvar + nil
     51  "the value of the most recent top level READ")
     52(defvar - nil
     53  "the form currently being evaluated")
    3754
    3855(defvar *continuablep* nil)
     
    7592
    7693(defun abort (&optional condition)
     94  "Transfer control to a restart named ABORT, signalling a CONTROL-ERROR if
     95   none exists."
    7796  (invoke-restart-no-return (find-restart 'abort condition)))
    7897
    7998(defun continue (&optional condition)
     99  "Transfer control to a restart named CONTINUE, or return NIL if none exists."
    80100  (let ((r (find-restart 'continue condition)))
    81101    (if r (invoke-restart r))))
    82102
    83103(defun muffle-warning (&optional condition)
     104  "Transfer control to a restart named MUFFLE-WARNING, signalling a
     105   CONTROL-ERROR if none exists."
    84106  (invoke-restart-no-return (find-restart 'muffle-warning condition)))
    85107
     
    147169
    148170(defun signal (condition &rest args)
     171  "Invokes the signal facility on a condition formed from DATUM and
     172   ARGUMENTS. If the condition is not handled, NIL is returned. If
     173   (TYPEP condition *BREAK-ON-SIGNALS*) is true, the debugger is invoked
     174   before any signalling is done."
    149175  (setq condition (condition-arg condition args 'simple-condition))
    150176  (lds
     
    208234  name)
    209235
    210 (defvar *macroexpand-hook* 'funcall) ; Should be #'funcall.
     236(defvar *macroexpand-hook* 'funcall
     237  "The value of this variable must be a designator for a function that can
     238  take three arguments, a macro expander function, the macro form to be
     239  expanded, and the lexical environment to expand in. The function should
     240  return the expanded form. This function is called by MACROEXPAND-1
     241  whenever a runtime expansion is needed. Initially this is set to
     242  FUNCALL.") ; Should be #'funcall.
    211243;(queue-fixup (setq *macroexpand-hook* #'funcall)) ;  No it shouldn't.
    212244
     
    241273
    242274(defun macroexpand-1 (form &optional env &aux fn)
     275  "If form is a macro (or symbol macro), expand it once. Return two values,
     276   the expanded form and a T-or-NIL flag indicating whether the form was, in
     277   fact, a macro. ENV is the lexical environment to expand in, which defaults
     278   to the null environment."
    243279  (declare (resident))
    244280  (if (and (consp form)
     
    252288
    253289(defun macroexpand (form &optional env)
     290  "Repetitively call MACROEXPAND-1 until the form can no longer be expanded.
     291   Returns the final resultant form, and T if it was expanded. ENV is the
     292   lexical environment to expand in, or NIL (the default) for the null
     293   environment."
    254294  (declare (resident))
    255295  (multiple-value-bind (new win) (macroexpand-1 form env)
  • trunk/ccl/level-1/l1-streams.lisp

    r917 r929  
    12551255
    12561256(defun make-two-way-stream (in out)
     1257  "Return a bidirectional stream which gets its input from INPUT-STREAM and
     1258   sends its output to OUTPUT-STREAM."
    12571259  (unless (input-stream-p in)
    12581260    (require-type in 'input-stream))
     
    13351337
    13361338(defun make-echo-stream (input-stream output-stream)
     1339  "Return a bidirectional stream which gets its input from INPUT-STREAM and
     1340   sends its output to OUTPUT-STREAM. In addition, all input is echoed to
     1341   the output stream."
    13371342  (make-instance 'echo-stream
    13381343                 :input-stream input-stream
     
    14281433
    14291434(defun make-concatenated-stream (&rest streams)
     1435  "Return a stream which takes its input from each of the streams in turn,
     1436   going on to the next at EOF."
    14301437  (dolist (s streams (make-instance 'concatenated-stream :streams streams))
    14311438    (unless (input-stream-p s)
     
    15611568
    15621569(defun make-string-output-stream (&key (element-type 'character element-type-p))
     1570  "Return an output stream which will accumulate all output given it for
     1571   the benefit of the function GET-OUTPUT-STREAM-STRING."
    15631572  (when (and element-type-p
    15641573             (not (member element-type '(base-character character
     
    17201729(defun make-string-input-stream (string &optional (start 0)
    17211730                                        (end nil))
     1731  "Return an input stream which will supply the characters of STRING between
     1732  START and END in order."
    17221733  (setq end (check-sequence-bounds string start end))
    17231734  (make-instance 'string-input-stream
     
    24142425                      (class *default-file-stream-class*)
    24152426                      (elements-per-buffer *elements-per-buffer*))
     2427  "Return a stream which reads from or writes to FILENAME.
     2428  Defined keywords:
     2429   :DIRECTION - one of :INPUT, :OUTPUT, :IO, or :PROBE
     2430   :ELEMENT-TYPE - the type of object to read or write, default BASE-CHAR
     2431   :IF-EXISTS - one of :ERROR, :NEW-VERSION, :RENAME, :RENAME-AND-DELETE,
     2432                       :OVERWRITE, :APPEND, :SUPERSEDE or NIL
     2433   :IF-DOES-NOT-EXIST - one of :ERROR, :CREATE or NIL
     2434  See the manual for details."
    24162435  (loop
    24172436    (restart-case
     
    24992518; while bootstrapping.
    25002519
    2501 (defparameter *terminal-io* nil)
    2502 (defparameter *debug-io* nil)
    2503 (defparameter *query-io* nil)
    2504 (defparameter *error-output* nil)
    2505 (defparameter *standard-input* nil)
    2506 (defparameter *standard-output* nil)
    2507 (defparameter *trace-output* nil)
     2520(defparameter *terminal-io* nil "terminal I/O stream")
     2521(defparameter *debug-io* nil "interactive debugging stream")
     2522(defparameter *query-io* nil "query I/O stream")
     2523(defparameter *error-output* nil "error output stream")
     2524(defparameter *standard-input* nil "default input stream")
     2525(defparameter *standard-output* nil "default output stream")
     2526(defparameter *trace-output* nil "trace output stream")
    25082527
    25092528(proclaim '(stream
  • trunk/ccl/level-1/l1-symhash.lisp

    r916 r929  
    5858
    5959(defun export (sym-or-syms &optional (package *package*))
     60  "Exports SYMBOLS from PACKAGE, checking that no name conflicts result."
    6061  (setq package (pkg-arg package))
    6162  (if (atom sym-or-syms)
     
    115116
    116117(defun keywordp (x)
     118  "Return true if Object is a symbol in the \"KEYWORD\" package."
    117119  (and (symbolp x) (eq (symbol-package x) *keyword-package*)))
    118120
     
    125127
    126128(defun find-all-symbols (name)
     129  "Return a list of all symbols in the system having the specified name."
    127130  (let* ((syms ())
    128131         (pname (ensure-simple-string (string name)))
     
    135138     
    136139
    137 (defun list-all-packages () (with-package-list-read-lock (copy-list %all-packages%)))
     140(defun list-all-packages ()
     141  "Return a list of all existing packages."
     142  (with-package-list-read-lock (copy-list %all-packages%)))
    138143
    139144(defun rename-package (package new-name &optional new-nicknames)
     145  "Changes the name and nicknames for a package."
    140146  (setq package (pkg-arg package)
    141147        new-name (ensure-simple-string (string new-name)))
     
    179185                          (internal-size 60)
    180186                          (external-size 10))
     187  "Make a new package having the specified NAME, NICKNAMES, and
     188  USE list. :INTERNAL-SYMBOLS and :EXTERNAL-SYMBOLS are
     189  estimates for the number of internal and external symbols which
     190  will ultimately be present in the package. The default value of
     191  USE is implementation-dependent, and in this implementation
     192  it is NIL."
    181193  (setq internal-size (require-type internal-size 'fixnum)
    182194        external-size (require-type external-size 'fixnum))
     
    253265
    254266(defun find-symbol (string &optional package)
     267  "Return the symbol named STRING in PACKAGE. If such a symbol is found
     268  then the second value is :INTERNAL, :EXTERNAL or :INHERITED to indicate
     269  how the symbol is accessible. If no symbol is found then both values
     270  are NIL."
    255271  (multiple-value-bind (sym flag)
    256272                       (%findsym (ensure-simple-string string) (pkg-arg (or package *package*)))
     
    262278
    263279(defun intern (str &optional (package *package*))
     280  "Return a symbol in PACKAGE having the specified NAME, creating it
     281  if necessary."
    264282  (setq package (pkg-arg package))
    265283  (setq str (ensure-simple-string str))
     
    272290
    273291(defun unintern (symbol &optional (package *package*))
     292  "Makes SYMBOL no longer present in PACKAGE. If SYMBOL was present
     293  then T is returned, otherwise NIL. If PACKAGE is SYMBOL's home
     294  package, then it is made uninterned."
    274295  (setq package (pkg-arg package))
    275296  (setq symbol (require-type symbol 'symbol))
     
    350371
    351372(defun import (sym-or-syms &optional package)
     373  "Make SYMBOLS accessible as internal symbols in PACKAGE. If a symbol
     374  is already accessible then it has no effect. If a name conflict
     375  would result from the importation, then a correctable error is signalled."
    352376  (setq package (pkg-arg (or package *package*)))
    353377  (if (listp sym-or-syms)
     
    368392
    369393(defun shadow (sym-or-symbols-or-string-or-strings &optional package)
     394  "Make an internal symbol in PACKAGE with the same name as each of
     395  the specified SYMBOLS. If a symbol with the given name is already
     396  present in PACKAGE, then the existing symbol is placed in the
     397  shadowing symbols list if it is not already present."
    370398  (setq package (pkg-arg (or package *package*)))
    371399  (if (listp sym-or-symbols-or-string-or-strings)
     
    376404
    377405(defun unexport (sym-or-symbols &optional package)
     406  "Makes SYMBOLS no longer exported from PACKAGE."
    378407  (setq package (pkg-arg (or package *package*)))
    379408  (if (listp sym-or-symbols)
     
    513542
    514543(defun use-package (packages-to-use &optional package)
     544  "Add all the PACKAGES-TO-USE to the use list for PACKAGE so that
     545  the external symbols of the used packages are accessible as internal
     546  symbols in PACKAGE."
    515547  (setq package (pkg-arg (or package *package*)))
    516548  (if (listp packages-to-use)
     
    543575
    544576(defun shadowing-import (sym-or-syms &optional (package *package*))
     577  "Import SYMBOLS into package, disregarding any name conflict. If
     578  a symbol of the same name is present, then it is uninterned."
    545579  (setq package (pkg-arg package))
    546580  (if (listp sym-or-syms)
     
    551585
    552586(defun unuse-package (packages-to-unuse &optional package)
     587  "Remove PACKAGES-TO-UNUSE from the USE list for PACKAGE."
    553588  (let ((p (pkg-arg (or package *package*))))
    554589    (flet ((unuse-one-package (unuse)
     
    563598
    564599(defun delete-package (package)
     600  "Delete the package designated by PACKAGE-DESIGNATOR from the package
     601  system data structures."
    565602  (unless (packagep package)
    566603    (setq package (or (find-package package)
  • trunk/ccl/level-1/l1-sysio.lisp

    r585 r929  
    617617
    618618(defun stream-external-format (stream)
     619  "Return the actual external format for file-streams, otherwise :DEFAULT."
    619620  (etypecase stream
    620621    (file-stream (file-stream-external-format stream))
     
    627628;;; "we don't support EXTENDED-CHARs".
    628629(defun file-string-length (stream object)
     630  "Return the delta in STREAM's FILE-POSITION that would be caused by writing
     631   OBJECT to STREAM. Non-trivial only in implementations that support
     632   international character sets."
    629633  (if (typep stream 'broadcast-stream)
    630634    (let* ((last (last-broadcast-stream stream)))
  • trunk/ccl/level-1/l1-typesys.lisp

    r589 r929  
    147147
    148148(defmacro deftype (name arglist &body body &environment env)
    149   "Syntax like DEFMACRO, but defines a new type."
     149  "Define a new type, with syntax like DEFMACRO."
    150150  (expand-type-macro '%deftype name arglist body env))
    151151
     
    37983798;;; As empty a type as you're likely to find ...
    37993799(deftype extended-char ()
     3800  "Type of CHARACTERs that aren't BASE-CHARs."
    38003801  nil)
    38013802)
  • trunk/ccl/level-1/l1-utils.lisp

    r910 r929  
    391391
    392392;Needed early for member etc.
    393 (defun identity (x) x)
     393(defun identity (x)
     394  "This function simply returns what was passed to it."
     395  x)
    394396
    395397(%fhave 'find-unencapsulated-definition #'identity)
     
    471473
    472474(defun assoc (item list &key test test-not key)
     475  "Return the cons in ALIST whose car is equal (by a given test or EQL) to
     476   the ITEM."
    473477  (multiple-value-bind (test test-not key) (%key-conflict test test-not key)
    474478    (if (null key)
     
    533537
    534538(defun member (item list &key test test-not key)
     539  "Return the tail of LIST beginning with first element satisfying EQLity,
     540   :TEST, or :TEST-NOT with the given ITEM."
    535541  (multiple-value-bind (test test-not key) (%key-conflict test test-not key)
    536542    (if (null key)
     
    553559
    554560(defun adjoin (item list &key test test-not key)
     561  "Add ITEM to LIST unless it is already a member"
    555562  (if (and (not test)(not test-not)(not key))
    556563    (if (not (memeql item list))(cons item list) list)
     
    832839
    833840(defun constantp (form &optional env)
     841  "True of any Lisp object that has a constant value: types that eval to
     842  themselves, keywords, constants, and list whose car is QUOTE."
    834843   (or (self-evaluating-p form)
    835844       (quoted-form-p form)
     
    988997
    989998(defun macro-function (form &optional env)
     999  "If SYMBOL names a macro in ENV, returns the expansion function,
     1000   else returns NIL. If ENV is unspecified or NIL, use the global
     1001   environment only."
    9901002  (setq form (require-type form 'symbol))
    9911003  (when env
     
    10061018
    10071019(defun symbol-function (name)
    1008   "Returns the definition of name, even if it is a macro or a special form.
    1009    Errors if name doesn't have a definition."
     1020  "Return the definition of NAME, even if it is a macro or a special form.
     1021   Error if NAME doesn't have a definition."
    10101022  (or (fboundp name) ;Our fboundp returns the binding
    10111023      (prog1 (%err-disp $xfunbnd name))))
     
    10241036
    10251037(defun gensym (&optional (string-or-integer nil string-or-integer-p))
    1026   "Behaves just like Common Lisp. Imagine that."
     1038  "Creates a new uninterned symbol whose name is a prefix string (defaults
     1039   to \"G\"), followed by a decimal number. Thing, when supplied, will
     1040   alter the prefix if it is a string, or be used for the decimal number
     1041   if it is a number, of this symbol. The default value of the number is
     1042   the current value of *gensym-counter* which is incremented each time
     1043   it is used."
    10271044  (let ((prefix "G")
    10281045        (counter nil))
     
    10811098
    10821099(defun caar (x)
     1100  "Return the car of the 1st sublist."
    10831101 (car (car x)))
    10841102
    10851103(defun cadr (x)
     1104  "Return the 2nd object in a list."
    10861105 (car (cdr x)))
    10871106
    10881107(defun cdar (x)
     1108  "Return the cdr of the 1st sublist."
    10891109 (cdr (car x)))
    10901110
    10911111(defun cddr (x)
     1112  "Return all but the 1st two objects of a list."
     1113
    10921114 (cdr (cdr x)))
    10931115
    10941116(defun caaar (x)
     1117  "Return the 1st object in the caar of a list."
    10951118 (car (car (car x))))
    10961119
    10971120(defun caadr (x)
     1121  "Return the 1st object in the cadr of a list."
    10981122 (car (car (cdr x))))
    10991123
    11001124(defun cadar (x)
     1125  "Return the car of the cdar of a list."
    11011126 (car (cdr (car x))))
    11021127
    11031128(defun caddr (x)
     1129  "Return the 1st object in the cddr of a list."
    11041130 (car (cdr (cdr x))))
    11051131
    11061132(defun cdaar (x)
     1133  "Return the cdr of the caar of a list."
    11071134 (cdr (car (car x))))
    11081135
    11091136(defun cdadr (x)
     1137  "Return the cdr of the cadr of a list."
    11101138 (cdr (car (cdr x))))
    11111139
    11121140(defun cddar (x)
     1141  "Return the cdr of the cdar of a list."
    11131142 (cdr (cdr (car x))))
    11141143
    11151144(defun cdddr (x)
     1145  "Return the cdr of the cddr of a list."
    11161146 (cdr (cdr (cdr x))))
    11171147
    11181148(defun cadddr (x)
     1149  "Return the car of the cdddr of a list."
    11191150 (car (cdr (cdr (cdr x)))))
    11201151
     
    12941325
    12951326(defun getf (place key &optional (default ()))
     1327  "Search the property list stored in Place for an indicator EQ to INDICATOR.
     1328  If one is found, return the corresponding value, else return DEFAULT."
    12961329  (let ((p (pl-search place key))) (if p (%cadr p) default)))
    12971330
    12981331(defun remprop (symbol key)
     1332  "Look on property list of SYMBOL for property with specified
     1333  INDICATOR. If found, splice this indicator and its value out of
     1334  the plist, and return the tail of the original list starting with
     1335  INDICATOR. If not found, return () with no side effects.
     1336
     1337  NOTE: The ANSI specification requires REMPROP to return true (not false)
     1338  or false (the symbol NIL). Portable code should not rely on any other value."
    12991339  (do* ((prev nil plist)
    13001340        (plist (symbol-plist symbol) tail)
     
    13511391(defun rassoc (item alist &key (test #'eql test-p) test-not (key #'identity))
    13521392  (declare (list alist))
    1353   "Returns the cons in alist whose cdr is equal (by a given test or EQL) to
    1354    the Item."
     1393  "Return the cons in ALIST whose CDR is equal (by a given test or EQL) to
     1394   the ITEM."
    13551395  (if (or test-p (not test-not))
    13561396    (progn
  • trunk/ccl/level-1/sysutils.lisp

    r401 r929  
    214214
    215215(defun type-of (form)
     216  "Return the type of OBJECT."
    216217  (case form
    217218    ((t) 'boolean)
     
    293294
    294295(defun typep (object type &optional env)
     296  "Is OBJECT of type TYPE?"
    295297  (declare (ignore env))
    296298  (let* ((pred (if (symbolp type) (type-predicate type))))
     
    329331(defun subtypep (type1 type2 &optional env)
    330332  (declare (ignore env))
    331   "Return two values indicating the relationship between type1 and type2:
    332   T and T: type1 definitely is a subtype of type2.
    333   NIL and T: type1 definitely is not a subtype of type2.
    334   NIL and NIL: who knows?"
     333  "Return two values indicating the relationship between type1 and type2.
     334  If values are T and T, type1 definitely is a subtype of type2.
     335  If values are NIL and T, type1 definitely is not a subtype of type2.
     336  If values are NIL and NIL, it couldn't be determined."
    335337  (csubtypep (specifier-type type1) (specifier-type type2)))
    336338
     
    354356(queue-fixup
    355357 (defun fmakunbound (name)
     358   "Make NAME have no global function definition."
    356359   (let* ((fname (validate-function-name name)))
    357360     (remhash fname %structure-refs%)
     
    419422
    420423(defun char (string index)
     424  "Given a string and a non-negative integer index less than the length of
     425  the string, returns the character object representing the character at
     426  that position in the string."
    421427 (if (stringp string)
    422428  (aref string index)
     
    491497
    492498(defun complement (function)
     499  "Return a new function that returns T whenever FUNCTION returns NIL and
     500   NIL whenever FUNCTION returns non-NIL."
    493501  (let ((f (coerce-to-function function))) ; keep poor compiler from consing value cell
    494502  #'(lambda (&rest args)
  • trunk/ccl/lib/apropos.lisp

    r911 r929  
    2525
    2626(defun apropos-list (string &optional package &aux list)
     27  "Like APROPOS, except that it returns a list of the symbols found instead
     28  of describing them."
    2729  (setq string (string-arg string))
    2830  (if package
     
    102104#|
    103105(defun apropos (string &optional package)
     106  "Briefly describe all symbols which contain the specified STRING.
     107  If PACKAGE is supplied then only describe symbols present in
     108  that package. If EXTERNAL-ONLY then only describe
     109  external symbols in the specified package."
    104110  (setq string (string-arg string))
    105111  (if package
  • trunk/ccl/lib/arrays-fry.lisp

    r579 r929  
    1919
    2020(defun bit (bit-array &rest subscripts)
    21   "Returns the bit from the Bit-Array at the specified Subscripts."
     21  "Return the bit from the BIT-ARRAY at the specified SUBSCRIPTS."
    2222  (declare (dynamic-extent subscripts))
    2323  (unless (eq (array-element-type bit-array) 'bit)
     
    3232
    3333(defun sbit (v &optional (sub0 nil sub0-p) &rest others)
     34  "Return the bit from SIMPLE-BIT-ARRAY at the specified SUBSCRIPTS."
    3435  (declare (dynamic-extent others))
    3536  (if sub0-p
     
    5152
    5253(defun bit-and (bit-array1 bit-array2 &optional result-bit-array)
    53   "Performs a bit-wise logical AND on the elements of Bit-Array1 and Bit-Array2
    54   putting the results in the Result-Bit-Array."
     54  "Perform a bit-wise LOGAND on the elements of BIT-ARRAY-1 and BIT-ARRAY-2,
     55  putting the results in RESULT-BIT-ARRAY. If RESULT-BIT-ARRAY is T,
     56  BIT-ARRAY-1 is used. If RESULT-BIT-ARRAY is NIL or omitted, a new array is
     57  created. All the arrays must have the same rank and dimensions."
    5558   (bit-boole boole-and bit-array1 bit-array2 result-bit-array))
    5659
    5760(defun bit-ior (bit-array1 bit-array2 &optional result-bit-array)
    58   "Performs a bit-wise logical IOR on the elements of Bit-Array1 and Bit-Array2
    59   putting the results in the Result-Bit-Array."
     61  "Perform a bit-wise LOGIOR on the elements of BIT-ARRAY-1 and BIT-ARRAY-2,
     62  putting the results in RESULT-BIT-ARRAY. If RESULT-BIT-ARRAY is T,
     63  BIT-ARRAY-1 is used. If RESULT-BIT-ARRAY is NIL or omitted, a new array is
     64  created. All the arrays must have the same rank and dimensions."
    6065  (bit-boole  boole-ior bit-array1 bit-array2 result-bit-array))
    6166
    6267(defun bit-xor (bit-array1 bit-array2 &optional result-bit-array)
    63   "Performs a bit-wise logical XOR on the elements of Bit-Array1 and Bit-Array2
    64   putting the results in the Result-Bit-Array."
     68  "Perform a bit-wise LOGXOR on the elements of BIT-ARRAY-1 and BIT-ARRAY-2,
     69  putting the results in RESULT-BIT-ARRAY. If RESULT-BIT-ARRAY is T,
     70  BIT-ARRAY-1 is used. If RESULT-BIT-ARRAY is NIL or omitted, a new array is
     71  created. All the arrays must have the same rank and dimensions."
    6572   (bit-boole  boole-xor bit-array1 bit-array2 result-bit-array))
    6673
    6774(defun bit-eqv (bit-array1 bit-array2 &optional result-bit-array)
    68   "Performs a bit-wise logical EQV  on the elements of Bit-Array1 and Bit-Array2
    69   putting the results in the Result-Bit-Array."
    70    (bit-boole boole-eqv bit-array1 bit-array2 result-bit-array))
     75  "Perform a bit-wise LOGEQV on the elements of BIT-ARRAY-1 and BIT-ARRAY-2,
     76  putting the results in RESULT-BIT-ARRAY. If RESULT-BIT-ARRAY is T,
     77  BIT-ARRAY-1 is used. If RESULT-BIT-ARRAY is NIL or omitted, a new array is
     78  created. All the arrays must have the same rank and dimensions."
     79  (bit-boole boole-eqv bit-array1 bit-array2 result-bit-array))
    7180
    7281(defun bit-nand (bit-array1 bit-array2 &optional result-bit-array)
    73   "Performs a bit-wise logical NAND  on the elements of Bit-Array1 and Bit-Array2
    74   putting the results in the Result-Bit-Array."
     82  "Perform a bit-wise LOGNAND on the elements of BIT-ARRAY-1 and BIT-ARRAY-2,
     83  putting the results in RESULT-BIT-ARRAY. If RESULT-BIT-ARRAY is T,
     84  BIT-ARRAY-1 is used. If RESULT-BIT-ARRAY is NIL or omitted, a new array is
     85  created. All the arrays must have the same rank and dimensions."
    7586  (bit-boole boole-nand bit-array1 bit-array2 result-bit-array))
    7687
    7788(defun bit-nor (bit-array1 bit-array2 &optional result-bit-array)
    78   "Performs a bit-wise logical NOR  on the elements of Bit-Array1 and Bit-Array2
    79   putting the results in the Result-Bit-Array."
     89  "Perform a bit-wise LOGNOR on the elements of BIT-ARRAY-1 and BIT-ARRAY-2,
     90  putting the results in RESULT-BIT-ARRAY. If RESULT-BIT-ARRAY is T,
     91  BIT-ARRAY-1 is used. If RESULT-BIT-ARRAY is NIL or omitted, a new array is
     92  created. All the arrays must have the same rank and dimensions."
    8093  (bit-boole boole-nor bit-array1 bit-array2 result-bit-array))
    8194
    8295(defun bit-andc1 (bit-array1 bit-array2 &optional result-bit-array)
    83   "Performs a bit-wise logical ANDC1 on the elements of Bit-Array1 and Bit-Array2
    84   putting the results in the Result-Bit-Array."
     96  "Perform a bit-wise LOGANDC1 on the elements of BIT-ARRAY-1 and BIT-ARRAY-2,
     97  putting the results in RESULT-BIT-ARRAY. If RESULT-BIT-ARRAY is T,
     98  BIT-ARRAY-1 is used. If RESULT-BIT-ARRAY is NIL or omitted, a new array is
     99  created. All the arrays must have the same rank and dimensions."
    85100  (bit-boole boole-andc1 bit-array1 bit-array2 result-bit-array))
    86101
    87102(defun bit-andc2 (bit-array1 bit-array2 &optional result-bit-array)
    88   "Performs a bit-wise logical ANDC2 on the elements of Bit-Array1 and Bit-Array2
    89   putting the results in the Result-Bit-Array."
     103  "Perform a bit-wise LOGANDC2 on the elements of BIT-ARRAY-1 and BIT-ARRAY-2,
     104  putting the results in RESULT-BIT-ARRAY. If RESULT-BIT-ARRAY is T,
     105  BIT-ARRAY-1 is used. If RESULT-BIT-ARRAY is NIL or omitted, a new array is
     106  created. All the arrays must have the same rank and dimensions."
    90107  (bit-boole boole-andc2 bit-array1 bit-array2 result-bit-array))
    91108
    92109(defun bit-orc1 (bit-array1 bit-array2 &optional result-bit-array)
    93   "Performs a bit-wise logical ORC1 on the elements of Bit-Array1 and Bit-Array2
    94   putting the results in the Result-Bit-Array."
     110  "Perform a bit-wise LOGORC1 on the elements of BIT-ARRAY-1 and BIT-ARRAY-2,
     111  putting the results in RESULT-BIT-ARRAY. If RESULT-BIT-ARRAY is T,
     112  BIT-ARRAY-1 is used. If RESULT-BIT-ARRAY is NIL or omitted, a new array is
     113  created. All the arrays must have the same rank and dimensions."
    95114  (bit-boole boole-orc1 bit-array1 bit-array2 result-bit-array))
    96115
    97116(defun bit-orc2 (bit-array1 bit-array2 &optional result-bit-array)
    98   "Performs a bit-wise logical ORC2 on the elements of Bit-Array1 and Bit-Array2
    99   putting the results in the Result-Bit-Array."
     117  "Perform a bit-wise LOGORC2 on the elements of BIT-ARRAY-1 and BIT-ARRAY-2,
     118  putting the results in RESULT-BIT-ARRAY. If RESULT-BIT-ARRAY is T,
     119  BIT-ARRAY-1 is used. If RESULT-BIT-ARRAY is NIL or omitted, a new array is
     120  created. All the arrays must have the same rank and dimensions."
    100121  (bit-boole boole-orc2 bit-array1 bit-array2 result-bit-array))
    101122
    102123(defun bit-not (bit-array &optional result-bit-array)
    103   "Performs a bit-wise logical NOT in the elements of the Bit-Array putting
    104   the results into the Result-Bit-Array."
     124  "Performs a bit-wise logical NOT on the elements of BIT-ARRAY,
     125  putting the results in RESULT-BIT-ARRAY. If RESULT-BIT-ARRAY is T,
     126  BIT-ARRAY is used. If RESULT-BIT-ARRAY is NIL or omitted, a new array is
     127  created. Both arrays must have the same rank and dimensions."
    105128  (bit-boole boole-nor bit-array bit-array result-bit-array))
    106129
     
    227250                           displaced-index-offset
    228251                           &aux (subtype (array-element-subtype array)))
     252  "Adjust ARRAY's dimensions to the given DIMENSIONS and stuff."
    229253  (when (and element-type-p
    230254             (neq (element-type-subtype element-type) subtype))
     
    405429
    406430(defun array-in-bounds-p (array &lexpr subscripts)
     431  "Return T if the SUBSCIPTS are in bounds for the ARRAY, NIL otherwise."
    407432  (let ((rank  (array-rank array))
    408433        (nsubs (%lexpr-count subscripts)))
     
    426451
    427452(defun row-major-aref (array index)
     453  "Return the element of array corressponding to the row-major index. This is
     454   SETF'able."
    428455  (multiple-value-bind (displaced-to offset) (displaced-array-p array)
    429456    (aref (or displaced-to array) (+ index offset))))
  • trunk/ccl/lib/chars.lisp

    r6 r929  
    3030
    3131(defun character (arg)
     32  "Coerce OBJECT into a CHARACTER if possible. Legal inputs are
     33  characters, strings and symbols of length 1."
    3234  (if (typep arg 'character)
    3335    arg
     
    4547
    4648(defun digit-char (weight &optional radix)
     49  "All arguments must be integers. Returns a character object that
     50  represents a digit of the given weight in the specified radix. Returns
     51  NIL if no such character exists."
    4752  (let* ((r (if radix (require-type radix 'integer) 10)))
    4853    (if (and (typep (require-type weight 'integer) 'fixnum)
     
    6166; and for guys >= 128. Its really a function of the font of the moment.
    6267(defun graphic-char-p (c)
     68  "The argument must be a character object. GRAPHIC-CHAR-P returns T if the
     69  argument is a printing character (space through ~ in ASCII), otherwise
     70  returns NIL."
    6371  (let* ((code (char-code c)))
    6472    (unless (eq c #\rubout)
     
    6876;True for ascii codes 13 and 32-126 inclusive.
    6977(defun standard-char-p (c)
     78  "The argument must be a character object. STANDARD-CHAR-P returns T if the
     79   argument is a standard character -- one of the 95 ASCII printing characters
     80   or <return>."
    7081  (let* ((code (char-code c)))
    7182    (or (eq c #\newline)
     
    7990; if no table - then what?
    8091(defun upper-case-p (c)
     92  "The argument must be a character object; UPPER-CASE-P returns T if the
     93   argument is an upper-case character, NIL otherwise."
    8194  (let* ((code (char-code c)))
    8295    (declare (optimize (speed 3)(safety 0)))
     
    89102; I assume nobody cares that this be blindingly fast
    90103(defun both-case-p (c)
     104  "The argument must be a character object. BOTH-CASE-P returns T if the
     105  argument is an alphabetic character and if the character exists in
     106  both upper and lower case. For ASCII, this is the same as ALPHA-CHAR-P."
    91107  (let* ((code (char-code c)))
    92108    (declare (optimize (speed 3)(safety 0)))
     
    98114 
    99115(defun alphanumericp (c)
     116  "Given a character-object argument, ALPHANUMERICP returns T if the
     117   argument is either numeric or alphabetic."
    100118  (let ((code (char-code c)))
    101119    (declare (fixnum code))
     
    109127
    110128(defun char= (ch &rest others)
     129  "Return T if all of the arguments are the same character."
    111130  (declare (dynamic-extent others))
    112131  (unless (typep ch 'character)
     
    119138
    120139(defun char/= (ch &rest others)
     140  "Return T if no two of the arguments are the same character."
    121141  (declare (dynamic-extent others))
    122142  (unless (typep ch 'character)
     
    133153
    134154(defun char-equal (char &rest others)
     155  "Return T if all of the arguments are the same character.
     156  Font, bits, and case are ignored."
    135157  (declare (dynamic-extent others))
    136158  (locally (declare (optimize (speed 3)(safety 0)))
     
    143165; to be fast for one or two args.
    144166(defun char-not-equal (char &rest others)
     167  "Return T if no two of the arguments are the same character.
     168   Font, bits, and case are ignored."
    145169  (declare (dynamic-extent others))
    146170  (locally (declare (optimize (speed 3) (safety 0)))
     
    165189
    166190(defun char-lessp (char &rest others)
     191  "Return T if the arguments are in strictly increasing alphabetic order.
     192   Font, bits, and case are ignored."
    167193  (declare (dynamic-extent others))
    168194  (locally (declare (optimize (speed 3)(safety 0)))
     
    173199
    174200(defun char-not-lessp (char &rest others)
     201  "Return T if the arguments are in strictly non-increasing alphabetic order.
     202   Font, bits, and case are ignored."
    175203  (declare (dynamic-extent others))
    176204  (locally (declare (optimize (speed 3)(safety 0)))
     
    181209
    182210(defun char-greaterp (char &rest others)
     211  "Return T if the arguments are in strictly decreasing alphabetic order.
     212   Font, bits, and case are ignored."
    183213  (declare (dynamic-extent others))
    184214  (locally (declare (optimize (speed 3)(safety 0)))
     
    189219
    190220(defun char-not-greaterp (char &rest others)
     221  "Return T if the arguments are in strictly non-decreasing alphabetic order.
     222   Font, bits, and case are ignored."
    191223  (declare (dynamic-extent others))
    192224  (locally (declare (optimize (speed 3)(safety 0)))
     
    198230
    199231(defun char> (char &rest others)
     232  "Return T if the arguments are in strictly decreasing alphabetic order."
    200233  (declare (dynamic-extent others))
    201234  (locally (declare (optimize (speed 3)(safety 0)))
     
    208241
    209242(defun char>= (char &rest others)
     243  "Return T if the arguments are in strictly non-increasing alphabetic order."
    210244  (declare (dynamic-extent others))
    211245  (locally (declare (optimize (speed 3)(safety 0)))
     
    219253
    220254(defun char< (char &rest others)
     255  "Return T if the arguments are in strictly increasing alphabetic order."
    221256  (declare (dynamic-extent others))
    222257  (locally (declare (optimize (speed 3)(safety 0)))
     
    229264
    230265(defun char<= (char &rest others)
     266  "Return T if the arguments are in strictly non-decreasing alphabetic order."
    231267  (declare (dynamic-extent others))
    232268  (locally (declare (optimize (speed 3)(safety 0)))
     
    240276; This is Common Lisp
    241277(defun char-int (c)
     278  "Return the integer code of CHAR."
    242279  (char-code c))
    243280
     
    247284;Otherwise, if char code is < 128, return "^C", otherwise "1nn"
    248285
    249 (defun char-name (c) 
     286(defun char-name (c)
     287  "Return the name (a STRING) for a CHARACTER object."
    250288  (dolist (e *name-char-alist*)
    251289    (declare (list e))   
     
    412450
    413451(defun string-greaterp (string1 string2 &key start1 end1 start2 end2)
     452  "Given two strings, if the first string is lexicographically greater than
     453  the second string, returns the longest common prefix (using char-equal)
     454  of the two strings. Otherwise, returns ()."
    414455  (multiple-value-bind (result pos) (string-compare string1 start1 end1 string2 start2 end2)
    415456    (if (eq result 1) pos nil)))
    416457
    417458(defun string-not-greaterp (string1 string2 &key start1 end1 start2 end2)
     459  "Given two strings, if the first string is lexicographically less than
     460  or equal to the second string, returns the longest common prefix
     461  (using char-equal) of the two strings. Otherwise, returns ()."
    418462  (multiple-value-bind (result pos) (string-compare string1 start1 end1 string2 start2 end2)
    419463    (if (eq result 1) nil pos)))
    420464
    421465(defun string-not-equal (string1 string2 &key start1 end1 start2 end2)
     466  "Given two strings, if the first string is not lexicographically equal
     467  to the second string, returns the longest common prefix (using char-equal)
     468  of the two strings. Otherwise, returns ()."
    422469  (multiple-value-bind (result pos) (string-compare string1 start1 end1 string2 start2 end2)
    423470    (if (eq result t) nil pos)))
    424471
    425472(defun string-not-lessp (string1 string2 &key start1 end1 start2 end2)
     473  "Given two strings, if the first string is lexicographically greater
     474  than or equal to the second string, returns the longest common prefix
     475  (using char-equal) of the two strings. Otherwise, returns ()."
    426476  (multiple-value-bind (result pos) (string-compare string1 start1 end1 string2 start2 end2)
    427477    (if (eq result -1) nil pos)))
    428478
    429479(defun string-equal (string1 string2 &key start1 end1 start2 end2)
     480  "Given two strings (string1 and string2), and optional integers start1,
     481  start2, end1 and end2, compares characters in string1 to characters in
     482  string2 (using char-equal)."
    430483  (eq t (string-compare string1 start1 end1 string2 start2 end2)))
    431484
    432485
    433486(defun string-lessp (string1 string2 &key start1 end1 start2 end2)
     487  "Given two strings, if the first string is lexicographically less than
     488  the second string, returns the longest common prefix (using char-equal)
     489  of the two strings. Otherwise, returns ()."
    434490  (multiple-value-bind (result pos)(string-compare string1 start1 end1 string2 start2 end2)
    435491    (if (eq result -1) pos nil)))
     
    466522
    467523(defun string> (string1 string2 &key start1 end1 start2 end2)
     524  "Given two strings, if the first string is lexicographically greater than
     525  the second string, returns the longest common prefix (using char=)
     526  of the two strings. Otherwise, returns ()."
    468527  (multiple-value-bind (result pos) (string-cmp string1 start1 end1 string2 start2 end2)
    469528    (if (eq result 1) pos nil)))
    470529
    471530(defun string>= (string1 string2 &key start1 end1 start2 end2)
     531  "Given two strings, if the first string is lexicographically greater
     532  than or equal to the second string, returns the longest common prefix
     533  (using char=) of the two strings. Otherwise, returns ()."
    472534  (multiple-value-bind (result pos) (string-cmp string1 start1 end1 string2 start2 end2)
    473535    (if (eq result -1) nil pos)))
    474536
    475537(defun string< (string1 string2 &key start1 end1 start2 end2)
     538  "Given two strings, if the first string is lexicographically less than
     539  the second string, returns the longest common prefix (using char=)
     540  of the two strings. Otherwise, returns ()."
    476541  (multiple-value-bind (result pos) (string-cmp string1 start1 end1 string2 start2 end2)
    477542    (if (eq result -1) pos nil)))
    478543
    479544(defun string<= (string1 string2 &key start1 end1 start2 end2)
     545  "Given two strings, if the first string is lexicographically less than
     546  or equal to the second string, returns the longest common prefix
     547  (using char=) of the two strings. Otherwise, returns ()."
    480548  (multiple-value-bind (result pos) (string-cmp string1 start1 end1 string2 start2 end2)
    481549    (if (eq result 1) nil pos)))
     
    483551; this need not be so fancy?
    484552(defun string/= (string1 string2 &key start1 end1 start2 end2)
     553  "Given two strings, if the first string is not lexicographically equal
     554  to the second string, returns the longest common prefix (using char=)
     555  of the two strings. Otherwise, returns ()."
    485556  (multiple-value-bind (result pos) (string-cmp string1 start1 end1 string2 start2 end2)
    486557    (if (eq result t) nil pos)))
  • trunk/ccl/lib/defstruct-lds.lisp

    r78 r929  
    4242;--> To do: compiler transform for copier, possibly constructor.
    4343(defmacro defstruct (options &rest slots &environment env)
     44  "DEFSTRUCT {Name | (Name Option*)} {Slot | (Slot [Default] {Key Value}*)}
     45   Define the structure type Name. Instances are created by MAKE-<name>,
     46   which takes &KEY arguments allowing initial slot values to the specified.
     47   A SETF'able function <name>-<slot> is defined for each slot to read and
     48   write slot values. <name>-p is a type predicate.
     49
     50   Popular DEFSTRUCT options (see manual for others):
     51
     52   (:CONSTRUCTOR Name)
     53   (:PREDICATE Name)
     54       Specify the name for the constructor or predicate.
     55
     56   (:CONSTRUCTOR Name Lambda-List)
     57       Specify the name and arguments for a BOA constructor
     58       (which is more efficient when keyword syntax isn't necessary.)
     59
     60   (:INCLUDE Supertype Slot-Spec*)
     61       Make this type a subtype of the structure type Supertype. The optional
     62       Slot-Specs override inherited slot options.
     63
     64   Slot options:
     65
     66   :TYPE Type-Spec
     67       Asserts that the value of this slot is always of the specified type.
     68
     69   :READ-ONLY {T | NIL}
     70       If true, no setter function is defined for this slot."
    4471  ;There's too much state to keep around here to break it up into little
    4572  ;functions, so what the hell, let's do it all inline...
  • trunk/ccl/lib/defstruct.lisp

    r276 r929  
    279279
    280280(defun copy-structure (source)
     281  "Return a copy of STRUCTURE with the same (EQL) slot values."
    281282  (copy-uvector (require-type source 'structure-object)))
    282283
  • trunk/ccl/lib/describe.lisp

    r821 r929  
    208208
    209209(defun describe (object &optional stream)
     210  "Print a description of the object X."
    210211  (cond ((null stream) (setq stream *standard-output*))
    211212        ((eq stream t) (setq stream *terminal-io*)))
  • trunk/ccl/lib/encapsulate.lisp

    r812 r929  
    402402
    403403(defmacro untrace (&rest syms)
     404  "Remove tracing from the specified functions. With no args, untrace all
     405   functions."
    404406  (if syms
    405407    `(%untrace-0 ',syms)
     
    453455
    454456(defmacro trace (&rest syms)
     457  "TRACE {Option Global-Value}* {Name {Option Value}*}*
     458
     459TRACE is a debugging tool that provides information when specified
     460functions are called. In its simplest form:
     461
     462       (TRACE NAME-1 NAME-2 ...)
     463
     464The NAMEs are not evaluated. Each may be a symbol, denoting an
     465individual function, or a string, denoting all functions fbound to
     466symbols whose home package is the package with the given name.
     467
     468Options allow modification of the default behavior. Each option is a
     469pair of an option keyword and a value form. Global options are
     470specified before the first name, and affect all functions traced by a
     471given use of TRACE. Options may also be interspersed with function
     472names, in which case they act as local options, only affecting tracing
     473of the immediately preceding function name. Local options override
     474global options.
     475
     476By default, TRACE causes a printout on *TRACE-OUTPUT* each time that
     477one of the named functions is entered or returns.
     478
     479The following options are defined:
     480
     481   :REPORT Report-Type
     482       If Report-Type is TRACE (the default) then information is reported
     483       by printing immediately.  If Report-Type is NIL, then the only effect
     484       of the trace is to execute other options (e.g. PRINT or BREAK).
     485
     486   :CONDITION Form
     487   :CONDITION-AFTER Form
     488   :CONDITION-ALL Form
     489       If :CONDITION is specified, then TRACE does nothing unless Form
     490       evaluates to true at the time of the call. :CONDITION-AFTER is
     491       similar, but suppresses the initial printout, and is tested when the
     492       function returns. :CONDITION-ALL tries both before and after.
     493       This option is not supported with :REPORT PROFILE.
     494
     495   :BREAK Form
     496   :BREAK-AFTER Form
     497   :BREAK-ALL Form
     498       If specified, and Form evaluates to true, then the debugger is invoked
     499       at the start of the function, at the end of the function, or both,
     500       according to the respective option.
     501
     502   :PRINT Form
     503   :PRINT-AFTER Form
     504   :PRINT-ALL Form
     505       In addition to the usual printout, the result of evaluating Form is
     506       printed at the start of the function, at the end of the function, or
     507       both, according to the respective option. Multiple print options cause
     508       multiple values to be printed.
     509
     510   :WHEREIN Names
     511       If specified, Names is a function name or list of names. TRACE does
     512       nothing unless a call to one of those functions encloses the call to
     513       this function (i.e. it would appear in a backtrace.)  Anonymous
     514       functions have string names like \"DEFUN FOO\". This option is not
     515       supported with :REPORT PROFILE.
     516
     517   :ENCAPSULATE {:DEFAULT | T | NIL}
     518       If T, the tracing is done via encapsulation (redefining the function
     519       name) rather than by modifying the function. :DEFAULT is the default,
     520       and means to use encapsulation for interpreted functions and funcallable
     521       instances, breakpoints otherwise. When encapsulation is used, forms are
     522       *not* evaluated in the function's lexical environment.
     523
     524   :FUNCTION Function-Form
     525       This is a not really an option, but rather another way of specifying
     526       what function to trace. The Function-Form is evaluated immediately,
     527       and the resulting function is instrumented, i.e. traced or profiled
     528       as specified in REPORT.
     529
     530:CONDITION, :BREAK and :PRINT forms are evaluated in a context which
     531mocks up the lexical environment of the called function.  The -AFTER
     532and -ALL forms are evaluated in the null environment."
    455533  (if syms
    456534    `(%trace-0 ',syms)
  • trunk/ccl/lib/format.lisp

    r907 r929  
    23722372
    23732373(defun y-or-n-p (&optional format-string &rest arguments &aux response)
     2374  "Y-OR-N-P prints the message, if any, and reads characters from
     2375   *QUERY-IO* until the user enters y or Y as an affirmative, or either
     2376   n or N as a negative answer. It asks again if you enter any other
     2377   characters."
    23742378  (declare (dynamic-extent arguments))
    23752379  (with-terminal-input
     
    23852389
    23862390(defun yes-or-no-p (&optional format-string &rest arguments &aux response)
     2391  "YES-OR-NO-P is similar to Y-OR-N-P, except that it clears the
     2392   input buffer, beeps, and uses READ-LINE to get the strings
     2393   YES or NO."
    23872394  (declare (dynamic-extent arguments))
    23882395  (with-terminal-input
  • trunk/ccl/lib/hash.lisp

    r6 r929  
    413413
    414414(defun maphash (function hash-table)
     415  "For each entry in HASH-TABLE, call the designated two-argument function
     416   on the key and value of the entry. Return NIL."
    415417  (with-hash-table-iterator (m hash-table)
    416418    (loop
  • trunk/ccl/lib/lists.lisp

    r275 r929  
    4242
    4343
    44 (defun caaaar (list) (car (caaar list)))
    45 (defun caaadr (list) (car (caadr list)))
    46 (defun caadar (list) (car (cadar list)))
    47 (defun caaddr (list) (car (caddr list)))
    48 (defun cadaar (list) (car (cdaar list)))
    49 (defun cadadr (list) (car (cdadr list)))
    50 (defun caddar (list) (car (cddar list)))
    51 (defun cdaaar (list) (cdr (caaar list)))
    52 (defun cdaadr (list) (cdr (caadr list)))
    53 (defun cdadar (list) (cdr (cadar list)))
    54 (defun cdaddr (list) (cdr (caddr list)))
    55 (defun cddaar (list) (cdr (cdaar list)))
    56 (defun cddadr (list) (cdr (cdadr list)))
    57 (defun cdddar (list) (cdr (cddar list)))
    58 (defun cddddr (list) (cdr (cdddr list)))
     44(defun caaaar (list)
     45  "Return the car of the caaar of a list."
     46  (car (caaar list)))
     47
     48(defun caaadr (list)
     49  "Return the car of the caadr of a list."
     50  (car (caadr list)))
     51
     52(defun caadar (list)
     53  "Return the car of the cadar of a list."
     54  (car (cadar list)))
     55
     56(defun caaddr (list)
     57  "Return the car of the caddr of a list."
     58  (car (caddr list)))
     59
     60(defun cadaar (list)
     61  "Return the car of the cdaar of a list."
     62  (car (cdaar list)))
     63
     64(defun cadadr (list)
     65  "Return the car of the cdadr of a list."
     66  (car (cdadr list)))
     67
     68(defun caddar (list)
     69  "Return the car of the cddar of a list."
     70  (car (cddar list)))
     71
     72(defun cdaaar (list)
     73  "Return the cdr of the caaar of a list."
     74  (cdr (caaar list)))
     75
     76(defun cdaadr (list)
     77  "Return the cdr of the caadr of a list."
     78  (cdr (caadr list)))
     79
     80(defun cdadar (list)
     81  "Return the cdr of the cadar of a list."
     82  (cdr (cadar list)))
     83
     84(defun cdaddr (list)
     85  "Return the cdr of the caddr of a list."
     86  (cdr (caddr list)))
     87
     88(defun cddaar (list)
     89  "Return the cdr of the cdaar of a list."
     90  (cdr (cdaar list)))
     91
     92(defun cddadr (list)
     93  "Return the cdr of the cdadr of a list."
     94  (cdr (cdadr list)))
     95
     96(defun cdddar (list)
     97  "Return the cdr of the cddar of a list."
     98  (cdr (cddar list)))
     99
     100(defun cddddr (list)
     101  "Return the cdr of the cdddr of a list."
     102  (cdr (cdddr list)))
    59103
    60104(defun tree-equal (x y &key (test (function eql)) test-not)
     
    84128
    85129(defun first (list)
     130  "Return the 1st object in a list or NIL if the list is empty."
    86131  (car list))
    87132
    88133(defun second (list)
     134  "Return the 2nd object in a list or NIL if there is no 2nd object."
    89135  (cadr list))
    90136
    91137(defun third (list)
     138  "Return the 3rd object in a list or NIL if there is no 3rd object."
    92139  (caddr list))
    93140
    94141(defun fourth (list)
     142  "Return the 4th object in a list or NIL if there is no 4th object."
    95143  (cadddr list))
    96144
    97145(defun fifth (list)
     146  "Return the 5th object in a list or NIL if there is no 5th object."
    98147  (car (cddddr list)))
    99148
    100149(defun sixth (list)
     150  "Return the 6th object in a list or NIL if there is no 6th object."
    101151  (cadr (cddddr list)))
    102152
    103153(defun seventh (list)
     154  "Return the 7th object in a list or NIL if there is no 7th object."
    104155  (caddr (cddddr list)))
    105156
    106157(defun eighth (list)
     158  "Return the 8th object in a list or NIL if there is no 8th object."
    107159  (cadddr (cddddr list)))
    108160
    109161(defun ninth (list)
     162  "Return the 9th object in a list or NIL if there is no 9th object."
    110163  (car (cddddr (cddddr list))))
    111164
    112165(defun tenth (list)
     166  "Return the 10th object in a list or NIL if there is no 10th object."
    113167  (cadr (cddddr (cddddr list))))
    114168
    115169(defun rest (list)
     170  "Means the same as the cdr of a list."
    116171  (cdr list))
    117172;;; List* is done the same as list, except that the last cons is made a
     
    127182
    128183(defun copy-alist (alist)
    129   "Returns a new association list equal to alist, constructed in space"
     184  "Return a new association list which is EQUAL to ALIST."
    130185  (unless (endp alist)
    131186    (let ((result
     
    147202
    148203(defun revappend (x y)
    149   "Returns (append (reverse x) y)"
     204  "Return (append (reverse x) y)."
    150205  (dolist (a x y) (push a y)))
    151206
     
    192247     
    193248
    194 (defun ldiff (list object)
    195   "Returns a new list, whose elements are those of List that appear before
    196    Sublist.  If Sublist is not a tail of List, a copy of List is returned."
     249(defun ldiff (list object)
     250  "Return a new list, whose elements are those of LIST that appear before
     251   OBJECT. If OBJECT is not a tail of LIST, a copy of LIST is returned.
     252   LIST must be a proper list or a dotted list."
    197253  (do* ((list (require-type list 'list) (cdr list))
    198254        (result (cons nil nil))
     
    252308;subst that doesn't call labels
    253309(defun subst (new old tree &key key
    254                            (test #'eql testp) (test-not nil notp))   
     310                           (test #'eql testp) (test-not nil notp))
    255311  "Substitutes new for subtrees matching old."
    256312  (if (and testp notp)
     
    308364(defun nsubst (new old tree &key key
    309365                   (test #'eql testp) (test-not nil notp))
    310   "Substitutes new for subtrees matching old."
     366  "Substitute NEW for subtrees matching OLD."
    311367  "replace with above def when labels works"
    312368  (if (and testp notp)
     
    336392
    337393(defun nsubst-if (new test tree &key key)
    338   "Substitutes new for subtrees of tree for which test is true."
     394  "Substitute NEW for subtrees of TREE for which TEST is true."
    339395  "replace with above def when labels works."
    340396  (unless key (setq key #'identity))
     
    353409
    354410(defun nsubst-if-not (new test tree &key key)
    355   "Substitutes new for subtrees of tree for which test is false."
     411  "Substitute NEW for subtrees of TREE for which TEST is false."
    356412  "Replace with above def when labels works."
    357413  (unless key (setq key #'identity))
     
    371427(defun sublis (alist tree &key key
    372428                     (test #'eql testp) (test-not nil notp))
    373   "Substitutes from alist into tree nondestructively."
     429  "Substitute from ALIST into TREE nondestructively."
    374430  (if (and testp notp)
    375431    (test-not-error test test-not))
     
    400456(defun nsublis (alist tree &key key
    401457                      (test #'eql testp) (test-not nil notp))
    402   "Substitutes new for subtrees matching old."
     458  "Substitute from ALIST into TRUE destructively."
    403459  (if (and testp notp)
    404460    (test-not-error test test-not))
     
    425481
    426482(defun member-if (test list &key key )
    427   "Returns tail of list beginning with first element satisfying test(element)"
     483  "Return tail of LIST beginning with first element satisfying TEST."
    428484  (unless key (setq key #'identity))
    429485  (do ((list list (Cdr list)))
     
    433489
    434490(defun member-if-not (test list &key key)
    435   "Returns tail of list beginning with first element not satisfying test(el)"
     491  "Return tail of LIST beginning with first element not satisfying TEST."
    436492  (unless key (setq key #'identity))
    437493  (do ((list list (cdr list)))
     
    441497
    442498(defun tailp (sublist list)                  ;Definition "B"
     499  "Return true if OBJECT is the same as some tail of LIST, otherwise
     500   returns false. LIST must be a proper list or a dotted list."
    443501  (do ((list list (%cdr list)))
    444502      ((atom list) (eql list sublist))
     
    452510                    (test #'eql testp)
    453511                    (test-not nil notp))
    454   "Returns the union of List1 and List2."
     512  "Returns the union of LIST1 and LIST2."
    455513  (if (and testp notp)
    456514    (test-not-error test test-not))
     
    480538(defun nunion (list1 list2 &key key
    481539                     (test #'eql testp) (test-not nil notp))
     540  "Destructively return the union of LIST1 and LIST2."
    482541  (if (and testp notp)
    483542    (test-not-error test test-not))
     
    496555(defun intersection (list1 list2  &key key
    497556                           (test #'eql testp) (test-not nil notp))
    498   "Returns the intersection of List1 and List2."
     557  "Return the intersection of LIST1 and LIST2."
    499558  (if (and testp notp)
    500559    (test-not-error test test-not))
     
    508567(defun nintersection (list1 list2 &key key
    509568                            (test #'eql testp) (test-not nil notp))
     569  "Destructively return the intersection of LIST1 and LIST2."
    510570  (if (and testp notp)
    511571    (test-not-error test test-not))
     
    520580(defun set-difference (list1 list2 &key key
    521581                             (test #'eql testp) (test-not nil notp))
    522   "Returns a lsit of the elements in LIST1 which are not in LIST2."
     582  "Return the elements of LIST1 which are not in LIST2."
    523583  (if (and testp notp)
    524584    (test-not-error test test-not))
     
    532592(defun nset-difference (list1 list2 &key key
    533593                              (test #'eql testp) (test-not nil notp))
     594  "Destructively return the elements of LIST1 which are not in LIST2."
    534595  (if (and testp notp)
    535596    (test-not-error test test-not))
     
    561622                               (test #'eql testp) (test-not nil notp)
    562623                               &aux result elt1-compare elt2-compare)
     624  "Return new list of elements appearing exactly once in LIST1 and LIST2."
    563625  (if (and testp notp)
    564626    (test-not-error test test-not))
     
    628690(defun nset-exclusive-or (list1 list2 &key key
    629691                               (test #'eql testp) (test-not nil notp))
     692  "Destructively return a list with elements which appear but once in LIST1
     693   and LIST2."
    630694   (if (and testp notp)
    631695     (test-not-error test test-not))
     
    635699     (set-exclusive-or list1 list2 :key key :test test)
    636700     ))
    637  
     701
    638702(defun subsetp (list1 list2 &key key
    639703                      (test #'eql testp) (test-not nil notp))
     704  "Return T if every element in LIST1 is also in LIST2."
    640705  (if (and testp notp)
    641706    (test-not-error test test-not))
     
    645710      (return-from subsetp nil)))
    646711  T)
    647    
     712
    648713
    649714;;; Functions that operate on association lists
    650715
    651716(defun acons (key datum a-list)
     717  "Construct a new alist by adding the pair (KEY . DATUM) to ALIST."
    652718  (cons (cons key datum) a-list))
    653719
    654720(defun pairlis (keys data &optional (alist '()))
    655   "Construct an association list from keys and data (adding to alist)"
     721  "Construct an association list from KEYS and DATA (adding to ALIST)."
    656722  (do ((x keys (cdr x))
    657723       (y data (cdr y)))
     
    665731
    666732(defun assoc-if (predicate alist &key key)
    667   "Returns the first cons in alist whose car satisfies the Predicate."
     733  "Return the first cons in ALIST whose CAR satisfies PREDICATE. If
     734   KEY is supplied, apply it to the CAR of each cons before testing."
    668735  (setq key (default-identity-key key))
    669736  (dolist (pair alist)
     
    675742
    676743(defun assoc-if-not (predicate alist &key key)
    677   "Returns the first cons in alist whose car does not satisfy the Predicate."
     744  "Return the first cons in ALIST whose CAR does not satisfy PREDICATE.
     745  If KEY is supplied, apply it to the CAR of each cons before testing."
    678746  (setq key (default-identity-key key))
    679747  (dolist (pair alist)
     
    685753
    686754(defun rassoc-if (predicate alist &key key)
    687   "Returns the first cons in alist whose cdr satisfies the Predicate."
     755  "Return the first cons in ALIST whose CDR satisfies PREDICATE. If KEY
     756  is supplied, apply it to the CDR of each cons before testing."
    688757  (setq key (default-identity-key key))
    689758  (dolist (pair alist)
     
    695764
    696765(defun rassoc-if-not (predicate alist &key key)
    697   "Returns the first cons in alist whose cdr does not satisfy the Predicate."
     766  "Return the first cons in ALIST whose CDR does not satisfy PREDICATE.
     767  If KEY is supplied, apply it to the CDR of each cons before testing."
    698768  (setq key (default-identity-key key))
    699769  (dolist (pair alist)
     
    741811
    742812(defun mapc (function list &rest more-lists)
    743   "Applies fn to successive elements of lists, returns LIST,
    744   ie the 2nd arg to mapc."
     813  "Apply FUNCTION to successive elements of lists. Return the second argument."
    745814  (declare (dynamic-extent more-lists))
    746815  (let ((arglists (cons list more-lists)))
     
    749818
    750819(defun mapcar (function list &rest more-lists)
    751   "Applies fn to successive elements of list, returns list of results."
     820  "Apply FUNCTION to successive elements of LIST. Return list of FUNCTION
     821   return values."
    752822  (declare (dynamic-extent more-lists))
    753823  (let ((arglists (cons list more-lists)))
     
    756826
    757827(defun mapcan (function list &rest more-lists)
    758   "Applies fn to successive elements of list, returns NCONC of results."
     828  "Apply FUNCTION to successive elements of LIST. Return NCONC of FUNCTION
     829   results."
    759830  (declare (dynamic-extent more-lists))
    760831  (let ((arglists (cons list more-lists)))
     
    763834
    764835(defun mapl (function list &rest more-lists)
    765   "Applies fn to successive CDRs of list, returns LIST."
     836  "Apply FUNCTION to successive CDRs of list. Return NIL."
    766837  (declare (dynamic-extent more-lists))
    767838  (let ((arglists (cons list more-lists)))
     
    770841
    771842(defun maplist (function list &rest more-lists)
    772   "Applies fn to successive CDRs of list, returns list of results."
     843  "Apply FUNCTION to successive CDRs of list. Return list of results."
    773844  (declare (dynamic-extent more-lists))
    774845  (let ((arglists (cons list more-lists)))
     
    777848
    778849(defun mapcon (function list &rest more-lists)
    779   "Applies fn to successive CDRs of lists, returns NCONC of results."
     850  "Apply FUNCTION to successive CDRs of lists. Return NCONC of results."
    780851  (declare (dynamic-extent more-lists))
    781852  (let ((arglists (cons list more-lists)))
  • trunk/ccl/lib/macros.lisp

    r909 r929  
    2727
    2828(defmacro defconstant (sym val &optional (doc () doc-p) &environment env)
     29  "Define a global constant, saying that the value is constant and may be
     30  compiled into code. If the variable already has a value, and this is not
     31  EQL to the new value, the code is not portable (undefined behavior). The
     32  third argument is an optional documentation string for the variable."
    2933  (setq sym (require-type sym 'symbol)
    3034        doc (if doc-p (require-type doc 'string)))
     
    223227
    224228(defmacro restart-bind (clauses &body body)
     229  "Executes forms in a dynamic context where the given restart bindings are
     230   in effect. Users probably want to use RESTART-CASE. When clauses contain
     231   the same restart name, FIND-RESTART will find the first such clause."
    225232  (let* ((restarts (mapcar #'(lambda (clause)
    226233                               (list (make-symbol (symbol-name (require-type (car clause) 'symbol)))
     
    241248
    242249(defmacro handler-bind (clauses &body body)
     250  "(HANDLER-BIND ( {(type handler)}* )  body)
     251   Executes body in a dynamic context where the given handler bindings are
     252   in effect. Each handler must take the condition being signalled as an
     253   argument. The bindings are searched first to last in the event of a
     254   signalled condition."
    243255  (let* ((fns)
    244256         (decls)         
     
    264276
    265277(defmacro restart-case (&environment env form &rest clauses)
     278  "(RESTART-CASE form
     279   {(case-name arg-list {keyword value}* body)}*)
     280   The form is evaluated in a dynamic context where the clauses have special
     281   meanings as points to which control may be transferred (see INVOKE-RESTART).
     282   When clauses contain the same case-name, FIND-RESTART will find the first
     283   such clause. If Expression is a call to SIGNAL, ERROR, CERROR or WARN (or
     284   macroexpands into such) then the signalled condition will be associated with
     285   the new restarts."
    266286  (let ((cluster nil))
    267287    (when clauses (setq cluster (gensym) form (restart-case-form form env cluster)))
     
    355375
    356376(defmacro handler-case (form &rest clauses &aux last)
     377  "(HANDLER-CASE form
     378   { (type ([var]) body) }* )
     379   Execute FORM in a context with handlers established for the condition
     380   types. A peculiar property allows type to be :NO-ERROR. If such a clause
     381   occurs, and form returns normally, all its values are passed to this clause
     382   as if by MULTIPLE-VALUE-CALL.  The :NO-ERROR clause accepts more than one
     383   var specification."
    357384  (flet ((handler-case (type var &rest body)
    358385           (when (eq type :no-error)
     
    418445                               &body body
    419446                               &aux (cluster (gensym)) (temp (make-symbol (symbol-name restart-name))))
     447  "(WITH-SIMPLE-RESTART (restart-name format-string format-arguments)
     448   body)
     449   If restart-name is not invoked, then all values returned by forms are
     450   returned. If control is transferred to this restart, it immediately
     451   returns the values NIL and T."
    420452  (unless (and (stringp format-string)
    421453               (null format-args)
     
    441473
    442474(defmacro ignore-errors (&rest forms)
     475  "Execute FORMS handling ERROR conditions, returning the result of the last
     476  form, or (VALUES NIL the-ERROR-that-was-caught) if an ERROR was handled."
    443477  `(handler-case (progn ,@forms)
    444478     (error (condition) (values nil condition))))
     
    460494;  in get-setf-method.
    461495(defmacro setf (&rest args &environment env)
    462   "Takes pairs of arguments like SETQ.  The first is a place and the second
    463   is the value that is supposed to go into that place.  Returns the last
    464   value.  The place argument may be any of the access forms for which SETF
     496  "Takes pairs of arguments like SETQ. The first is a place and the second
     497  is the value that is supposed to go into that place. Returns the last
     498  value. The place argument may be any of the access forms for which SETF
    465499  knows a corresponding setting form."
    466500  (let ((temp (length args))
     
    592626;; ---- allow inlining setf functions
    593627(defmacro defun (spec args &body body &environment env &aux global-name inline-spec)
     628  "Define a function at top level."
    594629  (validate-function-name spec)
    595630  (setq args (require-type args 'list))
     
    627662
    628663(defmacro defvar (&environment env var &optional (value () value-p) doc)
     664  "Define a global variable at top level. Declare the variable
     665  SPECIAL and, optionally, initialize it. If the variable already has a
     666  value, the old value is not clobbered. The third argument is an optional
     667  documentation string for the variable."
    629668  (if (and doc (not (stringp doc))) (report-bad-arg doc 'string))
    630669  (if (and (compile-file-environment-p env) (not *fasl-save-doc-strings*))
     
    646685
    647686(defmacro defparameter (&environment env var value &optional doc)
     687  "Define a parameter that is not normally changed by the program,
     688  but that may be changed without causing an error. Declare the
     689  variable special and sets its value to VAL, overwriting any
     690  previous value. The third argument is an optional documentation
     691  string for the parameter."
    648692  (if (and doc (not (stringp doc))) (signal-program-error "~S is not a string." doc))
    649693  (if (and (compile-file-environment-p env) (not *fasl-save-doc-strings*))
     
    718762      (%car args))))
    719763
    720 (defmacro case (key &body forms)
     764(defmacro case (key &body forms)
     765  "CASE Keyform {({(Key*) | Key} Form*)}*
     766  Evaluates the Forms in the first clause with a Key EQL to the value of
     767  Keyform. If a singleton key is T then the clause is a default clause."
    721768   (let ((key-var (gensym)))
    722769     `(let ((,key-var ,key))
     
    725772
    726773(defmacro ccase (keyplace &body forms)
     774  "CCASE Keyform {({(Key*) | Key} Form*)}*
     775  Evaluates the Forms in the first clause with a Key EQL to the value of
     776  Keyform. If none of the keys matches then a correctable error is
     777  signalled."
    727778  (let* ((key-var (gensym))
    728779         (tag (gensym)))
     
    733784
    734785(defmacro ecase (key &body forms)
     786  "ECASE Keyform {({(Key*) | Key} Form*)}*
     787  Evaluates the Forms in the first clause with a Key EQL to the value of
     788  Keyform. If none of the keys matches then an error is signalled."
    735789  (let* ((key-var (gensym)))
    736790    `(let ((,key-var ,key))
     
    817871
    818872(defmacro typecase (keyform &body clauses)
     873  "TYPECASE Keyform {(Type Form*)}*
     874  Evaluates the Forms in the first clause for which TYPEP of Keyform and Type
     875  is true."
    819876  (let ((key-var (gensym)))
    820877    `(let ((,key-var ,keyform))
     
    823880
    824881(defmacro etypecase (keyform &body clauses)
     882  "ETYPECASE Keyform {(Type Form*)}*
     883  Evaluates the Forms in the first clause for which TYPEP of Keyform and Type
     884  is true. If no form is satisfied then an error is signalled."
    825885  (let ((key-var (gensym)))
    826886    `(let ((,key-var ,keyform))
     
    829889
    830890(defmacro ctypecase (keyform &body clauses)
     891  "CTYPECASE Keyform {(Type Form*)}*
     892  Evaluates the Forms in the first clause for which TYPEP of Keyform and Type
     893  is true. If no form is satisfied then a correctable error is signalled."
    831894  (let ((key-var (gensym))
    832895        (tag (gensym)))
     
    837900
    838901(defmacro destructuring-bind (lambda-list expression &body body)
     902  "Bind the variables in LAMBDA-LIST to the contents of ARG-LIST."
    839903  (multiple-value-bind (bindings decls)
    840904      (%destructure-lambda-list  lambda-list expression nil nil)
     
    855919
    856920(defmacro when (test &body body)
     921  "If the first argument is true, the rest of the forms are
     922  evaluated as a PROGN."
    857923 `(if ,test
    858924   (progn ,@body)))
    859925
    860926(defmacro unless (test &body body)
     927  "If the first argument is not true, the rest of the forms are
     928  evaluated as a PROGN."
    861929 `(if (not ,test)
    862930   (progn ,@body)))
     
    888956
    889957(defmacro psetq (&whole call &body pairs &environment env)
     958  "PSETQ {var value}*
     959   Set the variables to the values, like SETQ, except that assignments
     960   happen in parallel, i.e. no assignments take place until all the
     961   forms have been evaluated."
    890962  (when pairs
    891963   (if (evenp (length pairs))
     
    9431015
    9441016(defmacro do (&environment env var-init-steps (&optional end-test &rest result) &body body)
     1017  "DO ({(Var [Init] [Step])}*) (Test Exit-Form*) Declaration* Form*
     1018  Iteration construct. Each Var is initialized in parallel to the value of the
     1019  specified Init form. On subsequent iterations, the Vars are assigned the
     1020  value of the Step form (if any) in parallel. The Test is evaluated before
     1021  each evaluation of the body Forms. When the Test is true, the Exit-Forms
     1022  are evaluated as a PROGN, with the result being the value of the DO. A block
     1023  named NIL is established around the entire expansion, allowing RETURN to be
     1024  used as an alternate exit mechanism."
    9451025  (do-loop 'let 'psetq env var-init-steps end-test result body))
    9461026
    9471027(defmacro do* (&environment env var-init-steps (&optional end-test &rest result) &body body)
     1028  "DO* ({(Var [Init] [Step])}*) (Test Exit-Form*) Declaration* Form*
     1029  Iteration construct. Each Var is initialized sequentially (like LET*) to the
     1030  value of the specified Init form. On subsequent iterations, the Vars are
     1031  sequentially assigned the value of the Step form (if any). The Test is
     1032  evaluated before each evaluation of the body Forms. When the Test is true,
     1033  the Exit-Forms are evaluated as a PROGN, with the result being the value
     1034  of the DO. A block named NIL is established around the entire expansion,
     1035  allowing RETURN to be used as an laternate exit mechanism."
    9481036  (do-loop 'let* 'setq env var-init-steps end-test result body))
    9491037
     
    10221110
    10231111(defmacro do-symbols ((var &optional pkg result) &body body &environment env)
     1112  "DO-SYMBOLS (VAR [PACKAGE [RESULT-FORM]]) {DECLARATION}* {TAG | FORM}*
     1113   Executes the FORMs at least once for each symbol accessible in the given
     1114   PACKAGE with VAR bound to the current symbol."
    10241115  (expand-package-iteration-macro 'iterate-over-accessable-symbols var pkg result body env))
    10251116
     
    10281119
    10291120(defmacro do-external-symbols ((var &optional pkg result) &body body &environment env)
     1121  "DO-EXTERNAL-SYMBOLS (VAR [PACKAGE [RESULT-FORM]]) {DECL}* {TAG | FORM}*
     1122   Executes the FORMs once for each external symbol in the given PACKAGE with
     1123   VAR bound to the current symbol."
    10301124  (expand-package-iteration-macro 'iterate-over-external-symbols var pkg result body env))
    10311125
    1032 (defmacro do-all-symbols ((var &optional resultform) 
     1126(defmacro do-all-symbols ((var &optional resultform)
    10331127                          &body body &environment env)
     1128  "DO-ALL-SYMBOLS (VAR [RESULT-FORM]) {DECLARATION}* {TAG | FORM}*
     1129   Executes the FORMs once for each symbol in every package with VAR bound
     1130   to the current symbol."
    10341131  (multiple-value-bind (body decls) (parse-body body env nil)
    10351132    (let* ((ftemp (gensym))
     
    10631160
    10641161(defmacro nth-value (n form)
     1162  "Evaluate FORM and return the Nth value (zero based). This involves no
     1163  consing when N is a trivial constant integer."
    10651164  `(car (nthcdr ,n (multiple-value-list ,form))))
    10661165
     
    12861385
    12871386(defmacro with-compilation-unit ((&key override) &body body)
     1387  "WITH-COMPILATION-UNIT ({Key Value}*) Form*
     1388  This form affects compilations that take place within its dynamic extent. It
     1389  is intended to be wrapped around the compilation of all files in the same
     1390  system. These keywords are defined:
     1391    :OVERRIDE Boolean-Form
     1392        One of the effects of this form is to delay undefined warnings
     1393        until the end of the form, instead of giving them at the end of each
     1394        compilation. If OVERRIDE is NIL (the default), then the outermost
     1395        WITH-COMPILATION-UNIT form grabs the undefined warnings. Specifying
     1396        OVERRIDE true causes that form to grab any enclosed warnings, even if
     1397        it is enclosed by another WITH-COMPILATION-UNIT."
    12881398  `(let* ((*outstanding-deferred-warnings* (%defer-warnings ,override)))
    12891399     (multiple-value-prog1 (progn ,@body) (report-deferred-warnings))))
     
    12911401; Yow! Another Done Fun.
    12921402(defmacro with-standard-io-syntax (&body body &environment env)
     1403  "Bind the reader and printer control variables to values that enable READ
     1404   to reliably read the results of PRINT. These values are:
     1405       *PACKAGE*                        the COMMON-LISP-USER package
     1406       *PRINT-ARRAY*                    T
     1407       *PRINT-BASE*                     10
     1408       *PRINT-CASE*                     :UPCASE
     1409       *PRINT-CIRCLE*                   NIL
     1410       *PRINT-ESCAPE*                   T
     1411       *PRINT-GENSYM*                   T
     1412       *PRINT-LENGTH*                   NIL
     1413       *PRINT-LEVEL*                    NIL
     1414       *PRINT-LINES*                    NIL
     1415       *PRINT-MISER-WIDTH*              NIL
     1416       *PRINT-PRETTY*                   NIL
     1417       *PRINT-RADIX*                    NIL
     1418       *PRINT-READABLY*                 T
     1419       *PRINT-RIGHT-MARGIN*             NIL
     1420       *READ-BASE*                      10
     1421       *READ-DEFAULT-FLOAT-FORMAT*      SINGLE-FLOAT
     1422       *READ-EVAL*                      T
     1423       *READ-SUPPRESS*                  NIL
     1424       *READTABLE*                      the standard readtable"
    12931425  (multiple-value-bind (decls body) (parse-body body env)
    12941426    `(let ((*package* (find-package "CL-USER"))
     
    13151447       ,@decls
    13161448       ,@body)))
    1317            
     1449
    13181450(defmacro print-unreadable-object (&environment env (object stream &key type identity) &body forms)
     1451  "Output OBJECT to STREAM with \"#<\" prefix, \">\" suffix, optionally
     1452  with object-type prefix and object-identity suffix, and executing the
     1453  code in BODY to provide possible further output."
    13191454  (multiple-value-bind (body decls) (parse-body forms env)
    13201455    (if body
     
    17691904
    17701905(defmacro define-condition (name (&rest supers) &optional ((&rest slots)) &body options)
     1906  "DEFINE-CONDITION Name (Parent-Type*) (Slot-Spec*) Option*
     1907   Define NAME as a condition type. This new type inherits slots and its
     1908   report function from the specified PARENT-TYPEs. A slot spec is a list of:
     1909     (slot-name :reader <rname> :initarg <iname> {Option Value}*
     1910
     1911   The DEFINE-CLASS slot options :ALLOCATION, :INITFORM, [slot] :DOCUMENTATION
     1912   and :TYPE and the overall options :DEFAULT-INITARGS and
     1913   [type] :DOCUMENTATION are also allowed.
     1914
     1915   The :REPORT option is peculiar to DEFINE-CONDITION. Its argument is either
     1916   a string or a two-argument lambda or function name. If a function, the
     1917   function is called with the condition and stream to report the condition.
     1918   If a string, the string is printed.
     1919
     1920   Condition types are classes, but (as allowed by ANSI and not as described in
     1921   CLtL2) are neither STANDARD-OBJECTs nor STRUCTURE-OBJECTs. WITH-SLOTS and
     1922   SLOT-VALUE may not be used on condition objects."
    17711923  ; If we could tell what environment we're being expanded in, we'd
    17721924  ; probably want to check to ensure that all supers name conditions
     
    18151967
    18161968(defmacro with-condition-restarts (&environment env condition restarts &body body)
     1969  "Evaluates the BODY in a dynamic environment where the restarts in the list
     1970   RESTARTS-FORM are associated with the condition returned by CONDITION-FORM.
     1971   This allows FIND-RESTART, etc., to recognize restarts that are not related
     1972   to the error currently being debugged. See also RESTART-CASE."
    18171973  (multiple-value-bind (body decls)
    18181974                       (parse-body body env)
     
    19002056
    19012057(defmacro defpackage (name &rest options)
     2058  "Defines a new package called PACKAGE. Each of OPTIONS should be one of the
     2059   following:
     2060    (NICKNAMES {package-name}*)
     2061
     2062    (SIZE <integer>)
     2063    (SHADOW {symbol-name}*)
     2064    (SHADOWING-IMPORT-FROM <package-name> {symbol-name}*)
     2065    (USE {package-name}*)
     2066    (IMPORT-FROM <package-name> {symbol-name}*)
     2067    (INTERN {symbol-name}*)
     2068    (EXPORT {symbol-name}*)
     2069    (IMPLEMENT {package-name}*)
     2070    (LOCK boolean)
     2071    (DOCUMENTATION doc-string)
     2072   All options except SIZE, LOCK, and :DOCUMENTATION can be used multiple
     2073   times."
    19022074  (let* ((size nil)
    19032075         (all-names-size 0)
     
    20142186(defmacro with-package-iterator ((mname package-list first-type &rest other-types)
    20152187                                 &body body)
     2188  "Within the lexical scope of the body forms, MNAME is defined via macrolet
     2189   such that successive invocations of (MNAME) will return the symbols,
     2190   one by one, from the packages in PACKAGE-LIST. SYMBOL-TYPES may be
     2191   any of :INHERITED :EXTERNAL :INTERNAL."
    20162192  (setq mname (require-type mname 'symbol))
    20172193  (let ((state (make-symbol "WITH-PACKAGE-ITERATOR_STATE"))
     
    23172493(defmacro check-type (place typespec &optional string)
    23182494  "CHECK-TYPE Place Typespec [String]
    2319   Signal a correctable error if Place does not hold an object of the type
    2320   specified by Typespec."
     2495  Signal a restartable error of type TYPE-ERROR if the value of PLACE is
     2496  not of the specified type. If an error is signalled and the restart is
     2497  used to return, this can only return if the STORE-VALUE restart is
     2498  invoked. In that case it will store into PLACE and start over."
    23212499  `(progn
    23222500     (setf ,place
     
    23292507
    23302508(defmacro with-hash-table-iterator ((mname hash-table) &body body &environment env)
     2509  "WITH-HASH-TABLE-ITERATOR ((function hash-table) &body body)
     2510   provides a method of manually looping over the elements of a hash-table.
     2511   FUNCTION is bound to a generator-macro that, within the scope of the
     2512   invocation, returns one or three values. The first value tells whether
     2513   any objects remain in the hash table. When the first value is non-NIL,
     2514   the second and third values are the key and the value of the next object."
    23312515  (let ((state (gensym)))
    23322516    (multiple-value-bind (body decls) (parse-body body env)
     
    23692553(defmacro pprint-logical-block+ ((var args prefix suffix per-line? circle-check? atsign?)
    23702554                                 &body body)
     2555  "Group some output into a logical block. STREAM-SYMBOL should be either a
     2556   stream, T (for *TERMINAL-IO*), or NIL (for *STANDARD-OUTPUT*). The printer
     2557   control variable *PRINT-LEVEL* is automatically handled."
    23712558  (when (and circle-check? atsign?)
    23722559    (setq circle-check? 'not-first-p))
     
    24532640
    24542641(defmacro time (form)
     2642  "Execute FORM and print timing information on *TRACE-OUTPUT*."
    24552643  `(report-time ',form #'(lambda () (progn ,form))))
    24562644
     
    29213109
    29223110(defmacro step (form)
     3111  "The form is evaluated with single stepping enabled. Function calls
     3112outside the lexical scope of the form can be stepped into only if the
     3113functions in question have been compiled with sufficient DEBUG policy
     3114to be at least partially steppable."
    29233115  form)
  • trunk/ccl/lib/misc.lisp

    r6 r929  
    1919  (require 'defstruct-macros))
    2020
    21 (defun short-site-name  () (or *short-site-name* "unspecified"))
    22 (defun long-site-name   () (or *long-site-name* "unspecified"))
     21(defun short-site-name  ()
     22  "Return a string with the abbreviated site name, or NIL if not known."
     23  (or *short-site-name* "unspecified"))
     24
     25(defun long-site-name   ()
     26  "Return a string with the long form of the site name, or NIL if not known."
     27  (or *long-site-name* "unspecified"))
    2328
    2429(defun machine-instance ()
     30  "Return a string giving the name of the local machine."
    2531  (%uname 1))
    2632
    2733
    2834(defun machine-type ()
     35  "Returns a string describing the type of the local machine."
    2936  (%uname 4))
    3037
     
    3239
    3340(defun machine-version ()
     41  "Return a string describing the version of the computer hardware we
     42are running on, or NIL if we can't find any useful information."
    3443  #+darwinppc-target
    3544  (%stack-block ((mib 8))
     
    5160
    5261(defun software-type ()
     62  "Return a string describing the supporting software."
    5363  (%uname 0))
    5464
    5565
    5666(defun software-version ()
     67  "Return a string describing version of the supporting software, or NIL
     68   if not available."
    5769  (%uname 2))
    5870
     
    415427(defun copy-symbol (symbol &optional (copy-props nil) &aux new-symbol def)
    416428  "Make and return a new uninterned symbol with the same print name
    417   as SYMBOL.  If COPY-PROPS is null, the new symbol has no properties.
    418   Else, it has a copy of SYMBOL's property list."
     429  as SYMBOL. If COPY-PROPS is false, the new symbol is neither bound
     430  nor fbound and has no properties, else it has a copy of SYMBOL's
     431  function, value and property list."
    419432  (setq new-symbol (make-symbol (symbol-name symbol)))
    420433  (when copy-props
     
    432445
    433446(defun gentemp (&optional (prefix "T") (package *package*))
    434   "Creates a new symbol interned in package Package with the given Prefix."
     447  "Creates a new symbol interned in package PACKAGE with the given PREFIX."
    435448  (loop
    436449    (let* ((new-pname (%str-cat (ensure-simple-string prefix)
  • trunk/ccl/lib/nfcomp.lisp

    r846 r929  
    4747(defvar *fasl-non-style-warnings-signalled-p* nil)
    4848(defvar *fasl-warnings-signalled-p* nil)
    49 (defvar *compile-verbose* nil) ; Might wind up getting called *compile-FILE-verbose*
     49(defvar *compile-verbose* nil ; Might wind up getting called *compile-FILE-verbose*
     50  "The default for the :VERBOSE argument to COMPILE-FILE.")
    5051(defvar *fasl-save-doc-strings*  t)
    5152(defvar *fasl-save-definitions* nil)
    52 (defvar *compile-file-pathname* nil) ; pathname of src arg to COMPILE-FILE
    53 (defvar *compile-file-truename* nil) ; truename ...
     53(defvar *compile-file-pathname* nil
     54  "The defaulted pathname of the file currently being compiled, or NIL if not
     55  compiling.") ; pathname of src arg to COMPILE-FILE
     56(defvar *compile-file-truename* nil
     57  "The TRUENAME of the file currently being compiled, or NIL if not
     58  compiling.") ; truename ...
    5459(defvar *fasl-target* (backend-name *host-backend*))
    5560(defvar *fasl-backend* *host-backend*)
    5661(defvar *fcomp-external-format* :default)
    5762
    58 (defvar *compile-print* nil) ; Might wind up getting called *compile-FILE-print*
     63(defvar *compile-print* nil ; Might wind up getting called *compile-FILE-print*
     64  "The default for the :PRINT argument to COMPILE-FILE.")
    5965
    6066;Note: errors need to rebind this to NIL if they do any reading without
     
    8086
    8187(defun compile-file-pathname (pathname &rest ignore &key output-file &allow-other-keys)
     88  "Return a pathname describing what file COMPILE-FILE would write to given
     89   these arguments."
    8290  (declare (ignore ignore))
    8391  (setq pathname (merge-pathnames pathname))
     
    98106                         (external-format :default)
    99107                         force)
     108  "Compile INPUT-FILE, producing a corresponding fasl file and returning
     109   its filename."
    100110  (let* ((backend *host-backend*))
    101111    (when (and target-p (not (setq backend (find-backend target))))
  • trunk/ccl/lib/numbers.lisp

    r392 r929  
    298298
    299299(defun float-radix (float)
     300  "Return (as an integer) the radix b of its floating-point argument."
    300301  (require-type float 'float)
    301302  2)
     
    314315
    315316;==> Needs a transform...
    316 (defun logandc2 (integer1 integer2) (logandc1 integer2 integer1))
    317 
    318 (defun logorc2 (integer1 integer2) (logorc1 integer2 integer1))
     317(defun logandc2 (integer1 integer2)
     318  "Bitwise AND INTEGER1 with (LOGNOT INTEGER2)."
     319  (logandc1 integer2 integer1))
     320
     321(defun logorc2 (integer1 integer2)
     322  "Bitwise OR INTEGER1 with (LOGNOT INTEGER2)."
     323  (logorc1 integer2 integer1))
    319324
    320325
     
    322327; Figure that the common (2-arg) case is caught by a compiler transform anyway.
    323328(defun gcd (&lexpr numbers)
     329  "Return the greatest common divisor of the arguments, which must be
     330  integers. Gcd with no arguments is defined to be 0."
    324331  (let* ((count (%lexpr-count numbers)))
    325332    (declare (fixnum count))   
     
    347354
    348355(defun lcm (&lexpr numbers)
     356  "Return the least common multiple of one or more integers. LCM of no
     357  arguments is defined to be 1."
    349358  (let* ((count (%lexpr-count numbers)))
    350359    (declare (fixnum count))   
     
    390399
    391400(defun rationalize (number)
     401  "Converts any REAL to a RATIONAL.  Floats are converted to a simple rational
     402  representation exploiting the assumption that floats are only accurate to
     403  their precision.  RATIONALIZE (and also RATIONAL) preserve the invariant:
     404      (= x (float (rationalize x) x))"
    392405  (if (floatp number)
    393406    (labels ((simpler-rational (less-predicate lonum loden hinum hiden
     
    529542;===> Change these constants to match maclisp!!
    530543(defun boole (op integer1 integer2)
     544  "Bit-wise boolean function on two integers. Function chosen by OP:
     545        0       BOOLE-CLR
     546        1       BOOLE-SET
     547        2       BOOLE-1
     548        3       BOOLE-2
     549        4       BOOLE-C1
     550        5       BOOLE-C2
     551        6       BOOLE-AND
     552        7       BOOLE-IOR
     553        8       BOOLE-XOR
     554        9       BOOLE-EQV
     555        10      BOOLE-NAND
     556        11      BOOLE-NOR
     557        12      BOOLE-ANDC1
     558        13      BOOLE-ANDC2
     559        14      BOOLE-ORC1
     560        15      BOOLE-ORC2"
    531561  (unless (and (typep op 'fixnum)
    532562               (locally (declare (fixnum op))
     
    553583
    554584(defun signum (x)
     585  "If NUMBER is zero, return NUMBER, else return (/ NUMBER (ABS NUMBER))."
    555586  (cond ((complexp x) (if (zerop x) x (/ x (abs x))))
    556587        ((rationalp x) (if (plusp x) 1 (if (zerop x) 0 -1)))
     
    563594(defun isqrt (n &aux n-len-quarter n-half n-half-isqrt
    564595                init-value iterated-value)
    565   "argument n must be a non-negative integer"
     596  "Return the root of the nearest integer less than n which is a perfect
     597   square.  Argument n must be a non-negative integer"
    566598  (cond
    567599   ((eql n 0) 0)
     
    587619
    588620(defun sinh (x)
     621  "Return the hyperbolic sine of NUMBER."
    589622  (if (complexp x)
    590623    (/ (- (exp x) (exp (- x))) 2)
     
    596629
    597630(defun cosh (x)
     631  "Return the hyperbolic cosine of NUMBER."
    598632  (if (complexp x)
    599633    (/ (+ (exp x) (exp (- x))) 2)
     
    604638
    605639(defun tanh (x)
     640  "Return the hyperbolic tangent of NUMBER."
    606641  (if (complexp x)
    607642    (/ (sinh x) (cosh x))
     
    612647
    613648(defun asinh (x)
     649  "Return the hyperbolic arc sine of NUMBER."
    614650  (if (complexp x)
    615651    (log (+ x (sqrt (+ 1 (* x x)))))
     
    620656
    621657(defun acosh (x)
     658  "Return the hyperbolic arc cosine of NUMBER."
    622659  (if (and (realp x) (<= 1.0 x))
    623660    (if (typep x 'double-float)
     
    628665
    629666(defun atanh (x)
     667  "Return the hyperbolic arc tangent of NUMBER."
    630668  (if (and (realp x) (<= -1.0 (setq x (float x)) 1.0))
    631669    (if (typep x 'double-float)
     
    636674
    637675(defun ffloor (number &optional divisor)
     676  "Same as FLOOR, but returns first value as a float."
    638677  (multiple-value-bind (q r) (floor number divisor)
    639678    (values (float q (if (floatp r) r 0.0)) r)))
    640679
    641680(defun fceiling (number &optional divisor)
     681  "Same as CEILING, but returns first value as a float."
    642682  (multiple-value-bind (q r) (ceiling number divisor)
    643683    (values (float q (if (floatp r) r 0.0)) r)))
    644684
    645685(defun ftruncate (number &optional divisor)
     686  "Same as TRUNCATE, but returns first value as a float."
    646687  (multiple-value-bind (q r) (truncate number divisor)
    647688    (values (float q (if (floatp r) r 0.0)) r)))
    648689
    649690(defun fround (number &optional divisor)
     691  "Same as ROUND, but returns first value as a float."
    650692  (multiple-value-bind (q r) (round number divisor)
    651693    (values (float q (if (floatp r) r 0.0)) r)))
    652694
    653695(defun rational (number)
     696  "RATIONAL produces a rational number for any real numeric argument. This is
     697  more efficient than RATIONALIZE, but it assumes that floating-point is
     698  completely accurate, giving a result that isn't as pretty."
    654699  (if (floatp number)
    655700      (multiple-value-bind (s e sign) (integer-decode-float number)
  • trunk/ccl/lib/pathnames.lisp

    r436 r929  
    9292
    9393(defun rename-file (file new-name &key (if-exists :error))
    94   "Rename File to have the specified New-Name.  If file is a stream open to a
     94  "Rename FILE to have the specified NEW-NAME. If FILE is a stream open to a
    9595  file, then the associated file is renamed."
    9696  (let* ((original (truename file))
     
    185185
    186186(defun ensure-directories-exist (pathspec &key verbose (mode #o777))
    187   "Tests whether the directories containing the specified file
    188   actually exist, and attempts to create them if they do not.
    189   Portable programs should avoid using the :MODE keyword argument."
     187  "Test whether the directories containing the specified file
     188  actually exist, and attempt to create them if they do not.
     189  The MODE argument is an extension to control the Unix permission
     190  bits.  Portable programs should avoid using the :MODE keyword
     191  argument."
    190192  (let* ((pathname (make-directory-pathname :directory (pathname-directory (translate-logical-pathname (merge-pathnames pathspec)))))
    191193         (created-p nil))
     
    271273                            test              ;; Only return pathnames matching test
    272274                            (follow-links t)) ;; return truename's of matching files.
     275  "Return a list of PATHNAMEs, each the TRUENAME of a file that matched the
     276   given pathname. Note that the interaction between this ANSI-specified
     277   TRUENAMEing and the semantics of the Unix filesystem (symbolic links..)
     278   means this function can sometimes return files which don't have the same
     279   directory as PATHNAME."
    273280  (let* ((keys (list :directories directories ;list defaulted key values
    274281                     :files files
  • trunk/ccl/lib/pprint.lisp

    r912 r929  
    13241324
    13251325
    1326 (defun pprint-newline+ (kind xp) 
     1326(defun pprint-newline+ (kind xp)
    13271327  (enqueue xp :newline kind)
    13281328  (let ((queue (xp-queue xp))
     
    18781878
    18791879(defun pprint (object &optional (stream *standard-output*))
     1880  "Prettily output OBJECT preceded by a newline."
    18801881  (setq stream (decode-stream-arg stream))
    18811882  (terpri stream)
     
    20902091
    20912092(defun pprint-newline (kind &optional (stream *standard-output*))
     2093    "Output a conditional newline to STREAM (which defaults to
     2094   *STANDARD-OUTPUT*) if it is a pretty-printing stream, and do
     2095   nothing if not. KIND can be one of:
     2096     :LINEAR - A line break is inserted if and only if the immediatly
     2097        containing section cannot be printed on one line.
     2098     :MISER - Same as LINEAR, but only if ``miser-style'' is in effect.
     2099        (See *PRINT-MISER-WIDTH*.)
     2100     :FILL - A line break is inserted if and only if either:
     2101       (a) the following section cannot be printed on the end of the
     2102           current line,
     2103       (b) the preceding section was not printed on a single line, or
     2104       (c) the immediately containing section cannot be printed on one
     2105           line and miser-style is in effect.
     2106     :MANDATORY - A line break is always inserted.
     2107   When a line break is inserted by any type of conditional newline, any
     2108   blanks that immediately precede the conditional newline are ommitted
     2109   from the output and indentation is introduced at the beginning of the
     2110   next line. (See PPRINT-INDENT.)"
    20922111  (setq stream (decode-stream-arg stream))
    20932112  (when (not (memq kind '(:linear :miser :fill :mandatory)))
     
    21012120
    21022121(defun pprint-indent (relative-to n &optional (stream *standard-output*))
     2122  "Specify the indentation to use in the current logical block if STREAM
     2123   (which defaults to *STANDARD-OUTPUT*) is it is a pretty-printing stream
     2124   and do nothing if not. (See PPRINT-LOGICAL-BLOCK.)  N is the indentation
     2125   to use (in ems, the width of an ``m'') and RELATIVE-TO can be either:
     2126     :BLOCK - Indent relative to the column the current logical block
     2127        started on.
     2128     :CURRENT - Indent relative to the current column.
     2129   The new indentation value does not take effect until the following line
     2130   break."
    21032131  (setq stream (decode-stream-arg stream))
    21042132  (when (not (memq relative-to '(:block :current)))
     
    21122140
    21132141(defun pprint-tab (kind colnum colinc &optional (stream *standard-output*))
     2142  "If STREAM (which defaults to *STANDARD-OUTPUT*) is a pretty-printing
     2143   stream, perform tabbing based on KIND, otherwise do nothing. KIND can
     2144   be one of:
     2145     :LINE - Tab to column COLNUM. If already past COLNUM tab to the next
     2146       multiple of COLINC.
     2147     :SECTION - Same as :LINE, but count from the start of the current
     2148       section, not the start of the line.
     2149     :LINE-RELATIVE - Output COLNUM spaces, then tab to the next multiple of
     2150       COLINC.
     2151     :SECTION-RELATIVE - Same as :LINE-RELATIVE, but count from the start
     2152       of the current section, not the start of the line."
    21142153  (setq stream (decode-stream-arg stream))
    21152154  (when (not (memq kind '(:line :section :line-relative :section-relative)))
     
    30623101
    30633102(defun pprint-linear (s list &optional (colon? T) atsign?)
     3103  "Output LIST to STREAM putting :LINEAR conditional newlines between each
     3104   element. If COLON? is NIL (defaults to T), then no parens are printed
     3105   around the output. ATSIGN? is ignored (but allowed so that PPRINT-LINEAR
     3106   can be used with the ~/.../ format directive."
    30643107  (declare (ignore atsign?))
    30653108  (pprint-logical-block (s list :prefix (if colon? "(" "")
     
    30723115
    30733116(defun pprint-fill (s list &optional (colon? T) atsign?)
     3117  "Output LIST to STREAM putting :FILL conditional newlines between each
     3118   element. If COLON? is NIL (defaults to T), then no parens are printed
     3119   around the output. ATSIGN? is ignored (but allowed so that PPRINT-FILL
     3120   can be used with the ~/.../ format directive."
    30743121  (declare (ignore atsign?))
    30753122  (pprint-logical-block (s list :prefix (if colon? "(" "")
     
    30823129
    30833130(defun pprint-tabular (s list &optional (colon? T) atsign? (tabsize nil))
     3131  "Output LIST to STREAM tabbing to the next column that is an even multiple
     3132   of TABSIZE (which defaults to 16) between each element. :FILL style
     3133   conditional newlines are also output between each element. If COLON? is
     3134   NIL (defaults to T), then no parens are printed around the output.
     3135   ATSIGN? is ignored (but allowed so that PPRINT-TABULAR can be used with
     3136   the ~/.../ format directive."
    30843137  (declare (ignore atsign?))
    30853138  (when (null tabsize) (setq tabsize 16))
  • trunk/ccl/lib/read.lisp

    r922 r929  
    134134(defun parse-integer (string &key (start 0) end
    135135                      (radix 10) junk-allowed)
     136  "Examine the substring of string delimited by start and end
     137  (default to the beginning and end of the string)  It skips over
     138  whitespace characters and then tries to parse an integer. The
     139  radix parameter must be between 2 and 36."
    136140  (flet ((parse-integer-not-integer-string (s)
    137141           (error 'parse-integer-not-integer-string :string s)))
  • trunk/ccl/lib/sequences.lisp

    r908 r929  
    6868
    6969(defun make-sequence (type length &key (initial-element nil initial-element-p))
    70   "Returns a sequence of the given Type and Length, with elements initialized
    71   to :Initial-Element."
     70  "Return a sequence of the given TYPE and LENGTH, with elements initialized
     71  to INITIAL-ELEMENT."
    7272  (setq length (require-type length 'fixnum))
    7373  (let* ((ctype (specifier-type type)))
     
    230230
    231231(defun subseq (sequence start &optional end)
     232  "Return a copy of a subsequence of SEQUENCE starting with element number
     233   START and continuing to the end of SEQUENCE or the optional END."
    232234  (setq end (check-sequence-bounds sequence start end))
    233235  (locally
     
    251253
    252254(defun copy-seq (sequence)
     255  "Return a copy of SEQUENCE which is EQUAL to SEQUENCE but not EQ."
    253256  (seq-dispatch
    254257   sequence
     
    365368
    366369(defun concatenate (output-type-spec &rest sequences)
    367   "Returns a new sequence of all the argument sequences concatenated together
    368    which shares no structure with the original argument sequences of the
    369    specified OUTPUT-TYPE-SPEC."
     370  "Return a new sequence of all the argument sequences concatenated together
     371  which shares no structure with the original argument sequences of the
     372  specified OUTPUT-TYPE-SPEC."
    370373  (declare (dynamic-extent sequences))
    371374  (if (memq output-type-spec '(string simple-string))
     
    489492   
    490493(defun some (predicate one-seq &rest sequences)
     494  "Apply PREDICATE to the 0-indexed elements of the sequences, then
     495   possibly to those with index 1, and so on. Return the first
     496   non-NIL value encountered, or NIL if the end of any sequence is reached."
    491497  (declare (dynamic-extent sequences))
    492498  (if sequences
     
    495501
    496502(defun notany (predicate one-seq &rest sequences)
     503  "Apply PREDICATE to the 0-indexed elements of the sequences, then
     504   possibly to those with index 1, and so on. Return NIL as soon
     505   as any invocation of PREDICATE returns a non-NIL value, or T if the end
     506   of any sequence is reached."
    497507  (declare (dynamic-extent sequences))
    498508  (if sequences
     
    501511
    502512(defun every (predicate one-seq &rest sequences)
     513  "Apply PREDICATE to the 0-indexed elements of the sequences, then
     514   possibly to those with index 1, and so on. Return NIL as soon
     515   as any invocation of PREDICATE returns NIL, or T if every invocation
     516   is non-NIL."
    503517  (declare (dynamic-extent sequences))
    504518  (if sequences
     
    507521
    508522(defun notevery (predicate one-seq &rest sequences)
     523  "Apply PREDICATE to 0-indexed elements of the sequences, then
     524   possibly to those with index 1, and so on. Return T as soon
     525   as any invocation of PREDICATE returns NIL, or NIL if every invocation
     526   is non-NIL."
    509527  (declare (dynamic-extent sequences))
    510528  (if sequences
     
    754772;If you change this, remember to change the transform.
    755773(defun coerce (object output-type-spec)
    756   "Coerces the Object to an object of type Output-Type-Spec."
     774  "Coerce the Object to an object of type Output-Type-Spec."
    757775  (let* ((type (specifier-type output-type-spec)))
    758776    (if (%typep object type)
     
    10891107(defun delete (item sequence &key from-end test test-not (start 0)
    10901108                    end count key)
     1109  "Return a sequence formed by destructively removing the specified ITEM from
     1110  the given SEQUENCE."
    10911111  (setq count (check-count count))
    10921112  (if sequence
     
    11101130(defun delete-if (test sequence &key from-end (start 0)                       
    11111131                       end count key)
     1132  "Return a sequence formed by destructively removing the elements satisfying
     1133  the specified PREDICATE from the given SEQUENCE."
    11121134  (delete test sequence
    11131135          :test #'funcall
     
    11191141
    11201142(defun delete-if-not (test sequence &key from-end (start 0) end count key)
     1143  "Return a sequence formed by destructively removing the elements not
     1144  satisfying the specified PREDICATE from the given SEQUENCE."
    11211145  (delete test sequence
    11221146          :test-not #'funcall
     
    11351159(defun remove (item sequence &key from-end test test-not (start 0)
    11361160                    end count key)
     1161  "Return a copy of SEQUENCE with elements satisfying the test (default is
     1162   EQL) with ITEM removed."
    11371163  (setq count (check-count count))
    11381164  (seq-dispatch
     
    11621188(defun remove-if (test sequence &key from-end (start 0)
    11631189                         end count key)
     1190  "Return a copy of sequence with elements such that predicate(element)
     1191   is non-null removed"
    11641192  (setq count (check-count count))
    11651193  (remove test sequence
     
    11731201(defun remove-if-not (test sequence &key from-end (start 0)
    11741202                         end count key)
     1203  "Return a copy of sequence with elements such that predicate(element)
     1204   is null removed"
    11751205  (setq count (check-count count))
    11761206  (remove test sequence
     
    11951225(defun remove-duplicates (sequence &key (test #'eql) test-not (start 0)
    11961226      from-end (end (length sequence)) key)
     1227  "The elements of SEQUENCE are compared pairwise, and if any two match,
     1228   the one occurring earlier is discarded, unless FROM-END is true, in
     1229   which case the one later in the sequence is discarded. The resulting
     1230   sequence is returned.
     1231
     1232   The :TEST-NOT argument is deprecated."
    11971233  (delete-duplicates (copy-seq sequence) :from-end from-end :test test
    11981234                     :test-not test-not :start start :end end :key key))
     
    12871323
    12881324(defun delete-duplicates (sequence &key (test #'eql) test-not (start 0) from-end end key)
    1289   "The elements of Sequence are examined, and if any two match, one is
     1325  "The elements of SEQUENCE are examined, and if any two match, one is
    12901326   discarded.  The resulting sequence, which may be formed by destroying the
    12911327   given sequence, is returned.
     
    13721408                       (start 0) count
    13731409                       end (key #'identity))
    1374   "Returns a sequence of the same kind as Sequence with the same elements
    1375   except that all elements equal to Old are replaced with New. See manual
     1410  "Return a sequence of the same kind as SEQUENCE with the same elements,
     1411  except that all elements equal to OLD are replaced with NEW. See manual
    13761412  for details."
    13771413  (setq count (check-count count))
     
    13951431                          (end (length sequence))
    13961432                          count (key #'identity))
     1433  "Return a sequence of the same kind as SEQUENCE with the same elements
     1434  except that all elements satisfying the PRED are replaced with NEW. See
     1435  manual for details."
    13971436  (substitute new test sequence
    13981437              :from-end from-end
     
    14071446                              (end (length sequence))
    14081447                              count (key #'identity))
     1448  "Return a sequence of the same kind as SEQUENCE with the same elements
     1449  except that all elements not satisfying the PRED are replaced with NEW.
     1450  See manual for details."
    14091451  (substitute new test sequence
    14101452              :from-end from-end
     
    14211463                        end
    14221464                        (count most-positive-fixnum) (key #'identity) (start 0))
    1423   "Returns a sequence of the same kind as Sequence with the same elements
    1424   except that all elements equal to Old are replaced with New.  The Sequence
    1425   may be destroyed.  See manual for details."
     1465  "Return a sequence of the same kind as SEQUENCE with the same elements
     1466  except that all elements equal to OLD are replaced with NEW. The SEQUENCE
     1467  may be destructively modified. See manual for details."
    14261468  (setq count (check-count count))
    14271469  (let ((incrementer 1)
     
    14741516                           end 
    14751517                           (count most-positive-fixnum) (key #'identity))
     1518  "Return a sequence of the same kind as SEQUENCE with the same elements
     1519   except that all elements satisfying the PRED are replaced with NEW.
     1520   SEQUENCE may be destructively modified. See manual for details."
    14761521  (nsubstitute new test sequence
    14771522               :from-end from-end
     
    14871532(defun nsubstitute-if-not (new test sequence &key from-end (start 0)
    14881533                               end (count most-positive-fixnum) (key #'identity))
     1534  "Return a sequence of the same kind as SEQUENCE with the same elements
     1535   except that all elements not satisfying the TEST are replaced with NEW.
     1536   SEQUENCE may be destructively modified. See manual for details."
    14891537  (nsubstitute new test sequence
    14901538                 :from-end from-end
     
    17211769(defun count (item sequence &key from-end (test #'eql testp)
    17221770                   (test-not nil notp) (start 0) end key)
     1771  "Return the number of elements in SEQUENCE satisfying a test with ITEM,
     1772   which defaults to EQL."
    17231773  (if (and testp notp)
    17241774    (test-not-error test test-not))
     
    17491799
    17501800(defun count-if (test sequence &key from-end (start 0) end key)
     1801  "Return the number of elements in SEQUENCE satisfying PRED(el)."
    17511802  (count test sequence
    17521803         :test #'funcall
     
    17591810
    17601811(defun count-if-not (test sequence &key from-end (start 0) end key)
     1812  "Return the number of elements in SEQUENCE not satisfying TEST(el)."
    17611813  (count test sequence
    17621814         :test-not #'funcall
     
    18081860                                  (vectorp1 (vectorp seq1))
    18091861                                  (vectorp2 (vectorp seq2)))
     1862  "The specified subsequences of SEQUENCE1 and SEQUENCE2 are compared
     1863   element-wise. If they are of equal length and match in every element, the
     1864   result is NIL. Otherwise, the result is a non-negative integer, the index
     1865   within SEQUENCE1 of the leftmost position at which they fail to match; or,
     1866   if one is shorter than and a matching prefix of the other, the index within
     1867   SEQUENCE1 beyond the last position tested is returned. If a non-NIL
     1868   :FROM-END argument is given, then one plus the index of the rightmost
     1869   position in which the sequences differ is returned."
    18101870  ;seq type-checking is done by length
    18111871  ;start/end type-cheking is done by <= (below)
  • trunk/ccl/lib/setf.lisp

    r902 r929  
    5353
    5454(defun get-setf-expansion (form &optional env)
    55   "Returns five values needed by the SETF machinery: a list of temporary
    56   variables, a list of values with which to fill them, the temporary for the
    57   new value in a list, the setting function, and the accessing function."
     55  "Return five values needed by the SETF machinery: a list of temporary
     56   variables, a list of values with which to fill them, a list of temporaries
     57   for the new values, the setting function, and the accessing function."
    5858  ;This isn't actually used by setf, but it has to be compatible.
    5959  (get-setf-expansion-aux form env t))
     
    172172; does this wrap a named block around the body yet ?
    173173(defmacro define-setf-expander (access-fn lambda-list &body body)
    174   "Syntax like DEFMACRO, but creates a Setf-Expansion generator. The body
    175   must be a form that returns the five magical values."
     174  "Syntax like DEFMACRO, but creates a setf expander function. The body
     175  of the definition must be a form that returns five appropriate values."
    176176  (unless (symbolp access-fn)
    177177    (signal-program-error $xnotsym access-fn))
     
    211211
    212212(defmacro defsetf (access-fn &rest rest &environment env)
     213  "Associates a SETF update function or macro with the specified access
     214  function or macro. The format is complex. See the manual for details."
    213215  (unless (symbolp access-fn) (signal-program-error $xnotsym access-fn))
    214216  (if (non-nil-symbol-p (%car rest))
     
    316318 
    317319(defmacro psetf (&whole call &rest pairs &environment env)  ;same structure as psetq
     320  "This is to SETF as PSETQ is to SETQ. Args are alternating place
     321  expressions and values to go into those places. All of the subforms and
     322  values are determined, left to right, and only then are the locations
     323  updated. Returns NIL."
    318324  (when pairs
    319325    (if (evenp (length pairs))
     
    542548
    543549(define-setf-method ldb (bytespec place &environment env)
     550  "The first argument is a byte specifier. The second is any place form
     551  acceptable to SETF. Replace the specified byte of the number in this
     552  place with bits from the low-order end of the new value."
    544553  (multiple-value-bind (dummies vals newval setter getter)
    545554                       (get-setf-method place env)
     
    556565
    557566(define-setf-method mask-field (bytespec place &environment env)
     567  "The first argument is a byte specifier. The second is any place form
     568  acceptable to SETF. Replaces the specified byte of the number in this place
     569  with bits from the corresponding position in the new value."
    558570  (multiple-value-bind (dummies vals newval setter getter)
    559571                       (get-setf-method place env)
     
    569581
    570582(defmacro shiftf (arg1 arg2 &rest places-&-nuval &environment env)
     583  "One or more SETF-style place expressions, followed by a single
     584   value expression. Evaluates all of the expressions in turn, then
     585   assigns the value of each expression to the place on its left,
     586   returning the value of the leftmost."
    571587  (setq places-&-nuval (list* arg1 arg2 places-&-nuval))
    572588  (let* ((nuval (car (last places-&-nuval)))
     
    635651
    636652(defmacro rotatef (&rest args &environment env)
     653  "Takes any number of SETF-style place expressions. Evaluates all of the
     654   expressions in turn, then assigns to each place the value of the form to
     655   its right. The rightmost form gets the value of the leftmost.
     656   Returns NIL."
    637657  (when args
    638658    (let* ((places (reverse args))  ; not nreverse, since &rest arg shares structure with &whole.
     
    674694
    675695(defmacro push (value place &environment env)
     696  "Takes an object and a location holding a list. Conses the object onto
     697  the list, returning the modified list. OBJ is evaluated before PLACE."
    676698  (if (not (consp place))
    677699    `(setq ,place (cons ,value ,place))
     
    686708           ,setter)))))
    687709
    688 (defmacro pushnew (value place &rest keys &environment env)                               
     710(defmacro pushnew (value place &rest keys &environment env)
     711  "Takes an object and a location holding a list. If the object is
     712  already in the list, does nothing; otherwise, conses the object onto
     713  the list. Returns the modified list. If there is a :TEST keyword, this
     714  is used for the comparison."
    689715  (if (not (consp place))
    690716    `(setq ,place (adjoin ,value ,place ,@keys))
     
    700726
    701727(defmacro pop (place &environment env &aux win)
     728  "The argument is a location holding a list. Pops one item off the front
     729  of the list and returns it."
    702730  (while (atom place)
    703731    (multiple-value-setq (place win) (macroexpand-1 place env))
     
    756784(defmacro remf (place indicator &environment env)
    757785  "Place may be any place expression acceptable to SETF, and is expected
    758   to hold a property list or ().  This list is destructively altered to
    759   remove the property specified by the indicator.  Returns T if such a
     786  to hold a property list or (). This list is destructively altered to
     787  remove the property specified by the indicator. Returns T if such a
    760788  property was present, NIL if not."
    761789  (multiple-value-bind (dummies vals newval setter getter)
  • trunk/ccl/lib/sort.lisp

    r6 r929  
    417417;; Only difficulty here is parsing the result-type for vectors.
    418418(defun merge (result-type sequence1 sequence2 predicate &key key)
    419   "The sequences Sequence1 and Sequence2 are destructively merged into
    420   a sequence of type Result-Type using the Predicate to order the elements.
    421   If result-type specifies an array, the returned array will not be
     419  "Merge the sequences SEQUENCE1 and SEQUENCE2 destructively into a
     420   sequence of type RESULT-TYPE using PREDICATE to order the elements.
     421   If result-type specifies an array, the returned array will not be
    422422   a complex array. Usually, result-type is either LIST, ARRAY or STRING."
    423423  (let* ((result-len (+ (length sequence1) (length sequence2)))
  • trunk/ccl/lib/streams.lisp

    r6 r929  
    136136                                &key (start 0) end preserve-whitespace
    137137                                &aux idx)
     138  "The characters of string are successively given to the lisp reader
     139   and the lisp object built by the reader is returned. Macro chars
     140   will take effect."
    138141  (values
    139142   (with-input-from-string (stream string :index idx :start start :end end)
     
    161164            old-error-output nil)))
    162165  (defun dribble (&optional filename)
     166    "With a file name as an argument, dribble opens the file and sends a
     167     record of further I/O to that file. Without an argument, it closes
     168     the dribble file, and quits logging."
    163169    (undribble)
    164170    (when filename
  • trunk/ccl/lib/time.lisp

    r406 r929  
    4040
    4141(defun get-universal-time ()
     42  "Return a single integer for the current time of
     43   day in universal time format."
    4244  (rlet ((tv :timeval))
    4345    (#_gettimeofday tv (%null-ptr))
     
    117119
    118120(defun get-decoded-time ()
     121  "Return nine values specifying the current time as follows:
     122   second, minute, hour, date, month, year, day of week (0 = Monday), T
     123   (daylight savings times) or NIL (standard time), and timezone."
    119124  (decode-universal-time (get-universal-time)))
    120125
     
    135140(defun encode-universal-time (second minute hour date month year
    136141                                     &optional time-zone)
    137   "The time values specified in decoded format are converted to 
     142  "The time values specified in decoded format are converted to
    138143   universal time, which is returned."
    139144  (declare (type (mod 60) second)
     
    165170
    166171(defun sleep (seconds)
     172  "This function causes execution to be suspended for N seconds. N may
     173  be any non-negative, non-complex number."
    167174  (when (minusp seconds) (report-bad-arg seconds '(real 0 *)))
    168175  (let* ((tps *ticks-per-second*)
     
    172179
    173180(defun get-internal-run-time ()
     181  "Return the run time in the internal time format. (See
     182  INTERNAL-TIME-UNITS-PER-SECOND.) This is useful for finding CPU usage."
    174183  (rlet ((usage :rusage)
    175184         (total :timeval))
     
    179188                                          (pref usage :rusage.ru_stime)))))
    180189(defun get-internal-real-time ()
     190  "Return the real time in the internal time format. (See
     191  INTERNAL-TIME-UNITS-PER-SECOND.) This is useful for finding elapsed time."
    181192  (rlet ((tv :timeval))
    182193    (#_gettimeofday tv (%null-ptr))
  • trunk/ccl/library/loop.lisp

    r340 r929  
    991991
    992992;;;INTERFACE: Traditional, ANSI, Lucid.
    993 (defmacro loop-finish () 
    994   "Causes the iteration to terminate \"normally\", the same as implicit
     993(defmacro loop-finish ()
     994  "Cause the iteration to terminate \"normally\", the same as implicit
    995995termination by an iteration driving clause, or by use of WHILE or
    996996UNTIL -- the epilogue code (if any) will be run, and any implicitly
Note: See TracChangeset for help on using the changeset viewer.