Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Ported Arnesi's #'PARTITIONX

  • Loading branch information...
commit 848c5242aa5c3dd2804aa45b0fa35bd6b0b96fc1 1 parent fd0ce0a
@adlai authored
Showing with 22 additions and 1 deletion.
  1. +1 −1  src/package.lisp
  2. +21 −0 src/utils.lisp
View
2  src/package.lisp
@@ -2,7 +2,7 @@
(defpackage :Eos
(:use :common-lisp :it.bese.arnesi)
- (:shadow #:ensure-list #:aif #:with-unique-names #:list-match-case)
+ (:shadow #:ensure-list #:aif #:partitionx #:with-unique-names #:list-match-case)
(:export ;; creating tests and test-suites
#:make-suite
#:def-suite
View
21 src/utils.lisp
@@ -14,6 +14,27 @@
`(let ((it ,test))
(if it ,true ,false)))
+;;; This is taken from Arnesi's src/list.lisp, and partitions
+;;; a list into separate parts using predicate lambdas
+
+(defun partitionx (list &rest lambdas)
+ (let ((collectors (mapcar (lambda (l)
+ (cons (if (and (symbolp l)
+ (member l (list :otherwise t)
+ :test #'string=))
+ (constantly t)
+ l)
+ (make-collector)))
+ lambdas)))
+ (dolist (item list)
+ (block item
+ (dolist (collector collectors)
+ (destructuring-bind (test-func . collector-func) collector
+ (when (funcall test-func item)
+ (funcall collector-func item)
+ (return-from item))))))
+ (mapcar #'funcall (mapcar #'cdr collectors))))
+
;;; This is taken from Arnesi's src/one-liners.lisp, and implements a
;;; more sophisticated version of PCL's WITH-GENSYMS.

0 comments on commit 848c524

Please sign in to comment.
Something went wrong with that request. Please try again.