Consolidating common SRFI-1 and R7RS bindings into the core.

This commit is contained in:
Alex Shinn 2014-01-26 00:06:08 +09:00
parent c17a30942f
commit e0fc986db8
4 changed files with 8 additions and 24 deletions

View file

@ -23,6 +23,8 @@
(define (list . args) args)
(define (list-copy ls) (reverse! (reverse ls)))
(define (list-tail ls k)
(if (eq? k 0)
ls
@ -444,6 +446,11 @@
;; list utils
(define (make-list n . o)
(let ((default (if (pair? o) (car o))))
(let lp ((n n) (res '()))
(if (<= n 0) res (lp (- n 1) (cons default res))))))
(define (member obj ls . o)
(let ((eq (if (pair? o) (car o) equal?)))
(let lp ((ls ls))

View file

@ -146,17 +146,6 @@
((>= i end))
(write-u8 (bytevector-u8-ref vec i) out))))
(define (make-list n . o)
(let ((init (and (pair? o) (car o))))
(let lp ((i 0) (res '()))
(if (>= i n) res (lp (+ i 1) (cons init res))))))
(define (list-copy ls)
(let lp ((ls ls) (res '()))
(if (pair? ls)
(lp (cdr ls) (cons (car ls) res))
(append (reverse res) ls))))
(define (list-set! ls k x)
(cond ((null? ls) (error "invalid list index"))
((zero? k) (set-car! ls x))

View file

@ -10,17 +10,10 @@
(append-reverse rev x)
(lp (cons x rev) (car ls) (cdr ls)))))
(define (make-list n . o)
(let ((default (if (pair? o) (car o))))
(let lp ((n n) (res '()))
(if (<= n 0) res (lp (- n 1) (cons default res))))))
(define (list-tabulate n proc)
(let lp ((n (- n 1)) (res '()))
(if (< n 0) res (lp (- n 1) (cons (proc n) res)))))
(define (list-copy ls) (reverse! (reverse ls)))
(define (circular-list x . args)
(let ((res (cons x args)))
(set-cdr! (last-pair res) res)

View file

@ -1,6 +1,6 @@
(cond-expand
(chibi (import (chibi) (chibi test) (srfi 38)))
(chibi (import (chibi) (chibi test) (srfi 1) (srfi 38)))
(chicken (use chicken test srfi-38)))
(test-begin "read/write")
@ -29,11 +29,6 @@
(test str (write-to-string value #t))
(test str (write-to-string (read-from-string str) #t))))))
(define (circular-list . args)
(let ((res (map (lambda (x) x) args)))
(set-cdr! (list-tail res (- (length res) 1)) res)
res))
(test-io "(1)" (list 1))
(test-io "(1 2)" (list 1 2))
(test-io "(1 . 2)" (cons 1 2))