summaryrefslogtreecommitdiff
path: root/util.lisp
blob: 4c13d19120ada1972d85d4aebe0cb4fd3db2c760 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
(in-package #:def)

(defun take-until (pred list)
  "Returns two values: FRONT BACK.

FRONT contains the first N members X of LIST for which (PRED X) is NIL.
BACK contains everything after the members of FRONT.

(EQUALP LIST
       (MULTIPLE-VALUE-BIND (FRONT BACK) (TAKE-UNTIL PRED LIST)
           (APPEND FRONT BACK))

Is always T."
  (loop :for (x . back) :on list
        :for fx? := (funcall pred x)
        :until fx?
        :collect x :into front
        :finally (return (values front (if fx? (cons x back) nil)))))

(defun partition (pred list)
  "Returns two list values: YES NO.

YES is everything for which PRED is T, NO is everything else."
  (loop :for e :in list
        :when (funcall pred e)
          :collect e :into yes
        :else
          :collect e :into no
        :finally (return (values yes no))))

(defun good-muffed-var-name-p (name &key (muffer "*"))
  (and (symbolp name)
       (string= muffer name :end2 (length muffer))
       (string= muffer name :start2 (- (length (symbol-name name))
                                       (length muffer)))))

(defun lambda-opt-p (x)
  (find x '(cl:&optional cl:&key cl:&aux cl:&allow-other-keys cl:&rest)
        :test #'eq))