mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 13:49:17 +02:00
8b5eb68238
They can be close()d explicitly with close-file-descriptor, and will close() on gc, but only explicitly closing the last port on them will close the fileno. Notably needed for network sockets where we open separate input and output ports on the same socket.
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))))
|
|
|