(cl:in-package #:sod-utilities)
;;;--------------------------------------------------------------------------
+;;; Common symbols.
+;;;
+;;; Sometimes, logically independent packages will want to use the same
+;;; symbol, and these uses (by careful design) don't conflict with each
+;;; other. If we export the symbols here, then the necessary sharing will
+;;; happen automatically.
+
+(export 'int) ; used by c-types and optparse
+
+;;;--------------------------------------------------------------------------
;;; Macro hacks.
(export 'with-gensyms)
;;; Functions.
(export 'compose)
-(defun compose (function &rest more-functions)
+(defun compose (&rest functions)
"Composition of functions. Functions are applied left-to-right.
This is the reverse order of the usual mathematical notation, but I find
(labels ((compose1 (func-a func-b)
(lambda (&rest args)
(multiple-value-call func-b (apply func-a args)))))
- (reduce #'compose1 more-functions :initial-value function)))
+ (if (null functions) #'values
+ (reduce #'compose1 (cdr functions)
+ :initial-value (car functions)))))
;;;--------------------------------------------------------------------------
;;; Variables.
The loop is surrounded by an anonymous BLOCK and the loop body forms an
implicit TAGBODY, as is usual. There is no result-form, however."
- (once-only (:environment env seq start end)
- (with-gensyms ((ivar "INDEX-") (endvar "END-") (bodyfunc "BODY-"))
+ (once-only (:environment env start end)
+ (with-gensyms ((seqvar "SEQ-") (ivar "INDEX-")
+ (endvar "END-") (bodyfunc "BODY-"))
(multiple-value-bind (docs decls body) (parse-body body :docp nil)
(declare (ignore docs))
(let* ((do-vars nil)
(end-condition (if endvar
`(>= ,ivar ,endvar)
- `(endp ,seq)))
+ `(endp ,seqvar)))
(item (if listp
- `(car ,seq)
- `(aref ,seq ,ivar)))
+ `(car ,seqvar)
+ `(aref ,seqvar ,ivar)))
(body-call `(,bodyfunc ,item)))
(when listp
- (push `(,seq (nthcdr ,start ,seq) (cdr ,seq))
+ (push `(,seqvar (nthcdr ,start ,seqvar) (cdr ,seqvar))
do-vars))
(when indexp
(push `(,ivar ,start (1+ ,ivar)) do-vars))
`(do ,do-vars (,end-condition) ,body-call))))
`(block nil
- (flet ((,bodyfunc (,var ,@(and indexvar `(,indexvar)))
- ,@decls
- (tagbody ,@body)))
- (etypecase ,seq
- (vector
- (let ((,endvar (or ,end (length ,seq))))
- ,(loopguts t nil endvar)))
- (list
- (if ,end
- ,(loopguts t t end)
- ,(loopguts indexvar t nil)))))))))))
+ (let ((,seqvar ,seq))
+ (flet ((,bodyfunc (,var ,@(and indexvar `(,indexvar)))
+ ,@decls
+ (tagbody ,@body)))
+ (etypecase ,seqvar
+ (vector
+ (let ((,endvar (or ,end (length ,seqvar))))
+ ,(loopguts t nil endvar)))
+ (list
+ (if ,end
+ ,(loopguts t t end)
+ ,(loopguts indexvar t nil))))))))))))
;;;--------------------------------------------------------------------------
;;; Structure accessor hacks.