/[gcl]/gcl/ansi-tests/ansi-aux.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/ansi-aux.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.70 by pfdietz, Thu Jun 19 02:25:54 2003 UTC revision 1.71 by pfdietz, Sat Jun 28 21:02:55 2003 UTC
# Line 376  the condition to go uncaught if it canno Line 376  the condition to go uncaught if it canno
376    
377  (defun compose (&rest fns)  (defun compose (&rest fns)
378    (let ((rfns (reverse fns)))    (let ((rfns (reverse fns)))
379      #'(lambda (x) (loop for f in rfns do (setf x (funcall f x))) x)))      #'(lambda (x) (loop for f of-type function
380                            in rfns do (setf x (funcall f x))) x)))
381    
382  (defun evendigitp (c)  (defun evendigitp (c)
383    (notnot (find c "02468")))    (notnot (find c "02468")))
# Line 1443  the condition to go uncaught if it canno Line 1444  the condition to go uncaught if it canno
1444    (not (not (typep element type))))    (not (not (typep element type))))
1445    
1446  (defun applyf (fn &rest args)  (defun applyf (fn &rest args)
1447    #'(lambda (&rest more-args) (apply fn (append args more-args))))    (etypecase fn
1448        (symbol
1449         #'(lambda (&rest more-args) (apply (the symbol fn) (append args more-args))))
1450        (function
1451         #'(lambda (&rest more-args) (apply (the function fn) (append args more-args))))))
1452    
1453  (defun slot-boundp* (object slot)  (defun slot-boundp* (object slot)
1454    (notnot (slot-boundp object slot)))    (notnot (slot-boundp object slot)))

Legend:
Removed from v.1.70  
changed lines
  Added in v.1.71

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26