mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 21:59:17 +02:00
59 lines
1.7 KiB
Scheme
59 lines
1.7 KiB
Scheme
;; selectors.scm -- extended list selectors
|
|
;; Copyright (c) 2009 Alex Shinn. All rights reserved.
|
|
;; BSD-style license: http://synthcode.com/license.txt
|
|
|
|
(define first car)
|
|
(define second cadr)
|
|
(define (third ls) (car (cdr (cdr ls))))
|
|
(define (fourth ls) (car (cdr (cdr (cdr ls)))))
|
|
(define (fifth ls) (car (cdr (cdr (cdr (cdr ls))))))
|
|
(define (sixth ls) (car (cdr (cdr (cdr (cdr (cdr ls)))))))
|
|
(define (seventh ls) (car (cdr (cdr (cdr (cdr (cdr (cdr ls))))))))
|
|
(define (eighth ls) (car (cdr (cdr (cdr (cdr (cdr (cdr ls))))))))
|
|
(define (ninth ls) (car (cdr (cdr (cdr (cdr (cdr (cdr (cdr ls)))))))))
|
|
(define (tenth ls) (car (cdr (cdr (cdr (cdr (cdr (cdr (cdr (cdr ls))))))))))
|
|
|
|
(define (car+cdr x) (values (car x) (cdr x)))
|
|
|
|
(define (take ls i)
|
|
(let lp ((i i) (ls ls) (res '()))
|
|
(if (<= i 0)
|
|
(reverse! res)
|
|
(lp (- i 1) (cdr ls) (cons (car ls) res)))))
|
|
|
|
(define (take! ls i)
|
|
(if (<= i 0)
|
|
'()
|
|
(let ((tail (list-tail ls (- i 1))))
|
|
(set-cdr! tail '())
|
|
ls)))
|
|
|
|
(define (drop ls i)
|
|
(if (<= i 0) ls (drop (cdr ls) (- i 1))))
|
|
|
|
(define (take-right ls i)
|
|
(drop ls (- (length+ ls) i)))
|
|
|
|
(define (drop-right ls i)
|
|
(take ls (- (length+ ls) i)))
|
|
|
|
(define (drop-right! ls i)
|
|
(take! ls (- (length+ ls) i)))
|
|
|
|
(define (split-at ls i)
|
|
(let lp ((i i) (ls ls) (res '()))
|
|
(if (<= i 0)
|
|
(values (reverse! res) ls)
|
|
(lp (- i 1) (cdr ls) (cons (car ls) res)))))
|
|
|
|
(define (split-at! ls i)
|
|
(if (<= i 0)
|
|
(values '() ls)
|
|
(let* ((tail (list-tail ls (- i 1)))
|
|
(right (cdr tail)))
|
|
(set-cdr! tail '())
|
|
(values ls right))))
|
|
|
|
(define (last ls) (if (null? (cdr ls)) (car ls) (last (cdr ls))))
|
|
(define (last-pair ls) (if (null? (cdr ls)) ls (last-pair (cdr ls))))
|
|
|