br-parser-tools/collects/mrspidey/Sba/lib/lib-list.ss

;; library-list.ss
;; ----------------------------------------------------------------------

;; map from left to right
(define mapLR
  (lambda (f l)
    (match l
      [() '()]
      [(x . y) (let ([v (f x)]) (cons v (mapLR f y)))]
      [l (error 'mapLR "Bad list ~s" l)])))

;; map from right to left
(define mapRL
  (lambda (f l)
    (match l
      [() '()]
      [(x . y) (let ([v (mapRL f y)]) (cons (f x) v))])))

(define foldl-with-n
  (lambda (f i l)
    (recur loop ([l l][acc i][n 0])
      (match l
        [() acc]
        [(x . y) (loop y (f x n acc) (add1 n))]))))

;; fold for a 2-argument function
;; right operand of f is accumulator
(define foldr2
  (lambda (f i l1 l2)
    (recur loop ([l1 l1][l2 l2])
      (match (list l1 l2)
        [(() ()) i]
        [((x1 . y1) (x2 . y2)) (f x1 x2 (loop y1 y2))]))))

;; filter elements out of a list by a predicate
(define filter
  (lambda (p l)
    (match l
      [() '()]
      [(x . y) (if (p x) (cons x (filter p y)) (filter p y))])))

;; filter and map left to right
(define filter-map
  (lambda (p l)
    (match l
      [() '()]
      [(x . y)
       (match (p x)
         [#f (filter-map p y)]
         [x (cons x (filter-map p y))])])))

;; filter and map left to right, and return (filtered-list . unfiltered)

(define filter-map-split
  (lambda (p l)
    (recur loop ([done-filtered '()][done-unfiltered '()][l l])
      (match l
        [() (values done-filtered done-unfiltered)]
        [(x . y)
         (match (p x)
           [#f (loop done-filtered (cons x done-unfiltered) y)]
           [x  (loop (cons x done-filtered) done-unfiltered y)])]))))

;; last element of a list
(define rac
  (lambda (l)
    (match l
      [(last) last]
      [(_ . rest) (rac rest)])))

;; all but the last element of a list
(define rdc
  (lambda (l)
    (match l
      [(_) '()]
      [(x . rest) (cons x (rdc rest))])))

;; map left to right over a list, but also pass f a 0-based index
(define map-with-n
  (lambda (f l)
    (recur loop ([l l][n 0])
      (match l
        [() '()]
        [(x . y) (let ([v (f x n)]) (cons v (loop y (+ 1 n))))]
        [l (error 'map-with-n "Bad list ~s" l)]))))

;; for-each, but also pass f a 0-based index
(define for-each-with-n
  (lambda (f l)
    (recur loop ([l l][n 0])
      (match l
        [() '()]
        [(x . y) (f x n) (loop y (+ 1 n))]))))

;; map on a (possibly improper) list
(define map-ilist
  (lambda (f l)
    (recur loop ([l l])
      (match l
        [() '()]
        [(x . y) (cons (f x) (loop y))]
        [x (f x)]))))

;; length on a (possibly improper) list
(define length-ilist
  (match-lambda
    [(x . y) (add1 (length-ilist y))]
    [_ 0]))

(define improper?
  (match-lambda
    [(x . y) (improper? y)]
    [() #f]
    [_ #t]))

(define (flatten-ilist l)
  (cond [(null? l) '()]
        [(pair? l) (cons (car l) (flatten-ilist (cdr l)))]
        [else (list l)]))

;; map a binary function down 2 lists, left to right
(define map2
  (lambda (f a b)
    (match (cons a b)
      [(() . ())
       '()]
      [((ax . ay) . (bx . by))
       (let ([v (f ax bx)]) (cons v (map2 f ay by)))]
      [else (error 'map2 "lists differ in length")])))

; map over a list of lists

(define (mapmap f ll) (map (lambda (l) (map f l)) ll))

;; interate a binary function down 2 lists, left to right
(define for-each2
  (lambda (f a b)
    (match (cons a b)
      [(() . ())
       (void)]
      [((ax . ay) . (bx . by))
       (f ax bx)
       (for-each2 f ay by)]
      [else (error 'for-each2 "lists differ in length")])))

;; andmap for 2 lists
(define andmap2
  (lambda (f a b)
    (match (cons a b)
      [(() . ())
       #t]
      [((ax) . (bx))
       (f ax bx)]
      [((ax . ay) . (bx . by))
       (and (f ax bx) (andmap2 f ay by))]
      [else (error 'andmap2 "lists differ in length")])))

;; andmap for 2 lists, fail on inequal lengths
(define andmap2len
  (lambda (f a b)
    (match (cons a b)
      [(() . ()) 
       #t]
      [((ax) . (bx))
       (f ax bx)]
      [((ax . ay) . (bx . by))
       (and (f ax bx) (andmap2len f ay by))]
      [else #f])))
;(define andmap andmap2)

;; ormap for 2 lists
(define ormap2
  (lambda (f a b)
    (match (cons a b)
      [(() . ())
       #f]
      [((ax) . (bx))
       (f ax bx)]
      [((ax . ay) . (bx . by))
       (or (f ax bx) (ormap2 f ay by))]
      [else (error 'ormap2 "lists differ in length")])))

;; make a list containing n copies of e
(define list-n-copies
  (lambda (n e)
    (if (zero? n)
	'()
	(cons e (list-n-copies (sub1 n) e)))))

(define (count p l)
  (recur loop ([c 0][l l])
    (cond
     [(null? l) c]
     [(p (car l)) (loop (add1 c) (cdr l))]
     [else (loop c (cdr l))])))

(define (index l x)
  (recur loop ([l l][i 0])
    (cond
     [(null? l) #f]
     [(eq? x (car l)) i]
     [else (loop (cdr l) (add1 i))])))

(define (get-prefix l1 l2)
    (if (eq? l1 l2)
        '()
        (cons (car l1) (get-prefix (cdr l1) l2))))

(define (mklist n)
  (if (zero? n)
      '()
      (cons n (mklist (sub1 n)))))

(define (nth l n)
  (if (zero? n)
      (car l)
      (nth (cdr l) (sub1 n))))


; Takes an atom and a list and returns the position of the atom in the list
(define list-pos
  (lambda (a l)
    (recur loop ([l l][i 0])
      (cond                               
       [(null? l) #f]
       [(eqv? a (car l)) i]
       [else (loop (cdr l) (add1 i))]))))

; Takes an atom and a list and returns the position of the atom in the list
; uses equal?, returns #f if no match
(define list-pos-equal
  (lambda (a l)
    (recur loop ([l l][n 0])
      (cond
       [(null? l) #f]
       [(equal? a (car l)) n]
       [else (loop (cdr l) (add1 n))]))))

;; Returns first element in set satisfying a predicate, or #f
(define (find p l)
  (recur loop ([l l])
    (cond
     [(null? l) #f]
     [(p (car l)) (car l)]
     [else (loop (cdr l))])))