MEM, DEL, & Co.

[James R. Meehan <Meehan at YALE>]

This is an attempt to "clean up" some of the T code that processes
lists, including MEM, DEL, ASS, MAP, REVERSE, LENGTH, etc.  Some of
the definitions below might be useful for the manual, others for the
actual implementation, others for nothing.  In any case, I think it
will make the LISTS chapter easier to organize; for example, it should
be clearer why ANY and MAP are in the same place as MEMQ and LENGTH.

                                Part I.
Search through the tails of a list L, and stop when some predicate
PRED is true of some selector SEL of the tail.  Return:

- the tail:                             (FIND->TAIL PRED SEL L)
- the value of the predicate:           (FIND->PRED PRED SEL L)
- the position where you stopped:       (FIND->POS  PRED SEL L)
- the selected value:                   (FIND->SEL  PRED SEL L)

(The code is in Part III.  These all generalize to N lists.)

                            -- membership --
(DEFINE (MEM PRED OBJ L)   (FIND->TAIL (LAMBDA (X) (PRED OBJ X)) CAR L))
(DEFINE (MEMQ OBJ L)       (MEM EQ? OBJ L))
(DEFINE (MEMBER OBJ L)     (MEM ALIKEV? OBJ L))
(DEFINE MEM?               (COMPOSE TRUE? MEM))
(DEFINE MEMQ?              (COMPOSE TRUE? MEMQ))
(DEFINE MEMBER?            (COMPOSE TRUE? MEMBER))

                           -- association --
(DEFINE (MEMASS PRED OBJ L) (FIND->TAIL PRED CAAR L)) [Unreleased; poor name]
(DEFINE ASS                 (COMPOSE CAR MEMASS))
(DEFINE (ASSQ OBJ L)        (ASS EQ? OBJ L))
(DEFINE (ASSOC OBJ L)       (ASS ALIKEV? OBJ L))
(DEFINE MEMASS?             (COMPOSE TRUE? MEMASS))
(DEFINE ASS?                (COMPOSE TRUE? CAR MEMASS))
[Etc. Do we need MEMASS?, ASS?, etc.?]

                      -- "reverse" association --
(DEFINE (RASS PRED OBJ L)   (CAR (FIND->TAIL PRED CDAR L)))
        [Unreleased. Do we need RASSQ, RASSOC, RASSQ, etc.? Probably not.]

                           -- ANY & EVERY --
(DEFINE (ANY PRED L)       (FIND->PRED PRED CAR L))
(DEFINE (ANYCDR PRED L)    (FIND->TAIL PRED ID L))
(DEFINE (SOME PRED L)      (FIND->TAIL PRED CAR L))
        [UCI LISP function, just for comparison]
(DEFINE (EVERY PRED L)     (FIND->SEL NOT (COMPOSE PRED CAR) L))
(DEFINE (EVERYCDR PRED L)  (FIND->SEL NOT PRED L))
        [These use the selector as a predicate. Hack.]

                         -- position [New?] --
(DEFINE (POS PRED OBJ L)   (FIND->POS (LAMBDA (X) (PRED OBJ X)) CAR L))
(DEFINE (POSQ OBJ L)       (POS EQ? OBJ L))
(DEFINE (POSITION OBJ L)   (POS ALIKEV? OBJ L))

                           -- NTHCDR & NTH --
(DEFINE (NTHCDR L INDEX)   (FIND->TAIL
                              (LAMBDA (TAIL)
                                      (IGNORE TAIL)
                                      (NEGATIVE? (DECREMENT INDEX)))
                              L))
        [How about the name NTH-TAIL instead?]
(DEFINE NTH                (COMPOSE CAR NTHCDR))

                                Part II.
Go through all the tails of a list L, applying a selector to each tail,
and collecting the results.

(DEFINE (TRAVERSE INITIAL COLLECTOR SELECTOR)
  (LAMBDA (L)
          (DO ((L L (CDR L))
               (RESULT INITIAL (COLLECTOR (SELECTOR L) RESULT)))
              ((NULL? L) RESULT))))

(DEFINE REVERSE         (TRAVERSE '() CONS CAR))
(DEFINE LENGTH          (TRAVERSE 0 + (ALWAYS 1)))
(DEFINE LASTCDR         (TRAVERSE '() PROJ0 ID))
        [How about the name LAST-PAIR instead?]
(DEFINE LAST            (COMPOSE CAR LASTCDR))   [or (TRAVERSE '() PROJ0 CAR)]
(DEFINE (APPEND X Y)    ((TRAVERSE Y CONS CAR) X))
(DEFINE (WALK FN L)     ((TRAVERSE '() IGNORE (COMPOSE FN CAR)) L)
                        '*VALUE-OF-WALK*)        [IGNORE? COMMENT?]
(DEFINE (WALKCDR FN L)  ((TRAVERSE '() IGNORE FN) L)
                        '*VALUE-OF-WALKCDR*)
(DEFINE (MAP FN L)      (REVERSE! ((TRAVERSE '() CONS (COMPOSE FN CAR)) L)))
(DEFINE (MAPCDR FN L)   (REVERSE! ((TRAVERSE '() CONS FN)) L)))
(DEFINE (SUBSET PRED L) (REVERSE!
                           ((TRAVERSE
                                 '()
                                 (LAMBDA (NEW OLD)
                                     (IF (PRED OBJ NEW) (CONS NEW OLD) OLD))
                                 CAR)
                            L)))
(DEFINE (DEL PRED OBJ L)  (SUBSET (LAMBDA (X) (NOT (PRED OBJ X))) L)
(DEFINE (DELQ OBJ L)      (DEL EQ? OBJ L)
(DEFINE (DELETE OBJ L)    (DEL ALIKEV? OBJ L)


                               Part III.
Code for procedures in Part I.

(DEFINE (FIND->TAIL PRED SEL L)
  (COND ((NULL? L) NIL)
        ((PRED (SEL L)) L)
        (ELSE (FIND->TAIL PRED SEL (CDR L)))))

(DEFINE (FIND->PRED PRED SEL L)
  (COND ((NULL? L) NIL)
        ((PRED (SEL L)))
        (ELSE (FIND->PRED PRED SEL (CDR L)))))

(DEFINE (FIND->SEL PRED SEL L)
  (IF L (LET ((X (SEL L)))
             (COND ((PRED X) X)
                   (ELSE (FIND->SEL PRED SEL (CDR L)))))))

(DEFINE (FIND->POS PRED SEL L)
  (DO ((L L (CDR L))
       (N 0 (1+ N)))
      ((OR (NULL? L) (PRED (SEL L))) (IF L N))))
-------