1;;; 2;;; <cons.rkt> ---- List constructors 3;;; Time-stamp: <02/02/27 12:19:59 noel> 4;;; 5;;; Copyright (C) 2002 by Noel Welsh. 6;;; 7;;; This file is part of SRFI-1. 8 9;;; This SRFI-1 implementation is distributed under the same terms as 10;;; Racket. 11 12;;; Author: Noel Welsh <noelwelsh@yahoo.com> 13 14;; Commentary: 15 16;; Based on the reference implementation by Olin Shiver and hence: 17 18;; Copyright (c) 1998, 1999 by Olin Shivers. You may do as you please with 19;; this code as long as you do not remove this copyright notice or 20;; hold me liable for its use. Please send bug reports to shivers@ai.mit.edu. 21;; -Olin 22 23;; Olin Shivers verified that he is fine with redistributing this code 24;; under the LGPL. (Verified personally by Eli Barzilay.) 25 26#lang racket/base 27 28(require srfi/optional "selector.rkt" 29 (only-in racket/list [make-list make-list*])) 30 31(provide xcons 32 make-list 33 list-tabulate 34 (rename-out [list* cons*]) 35 list-copy 36 circular-list 37 iota) 38 39;; Occasionally useful as a value to be passed to a fold or other 40;; higher-order procedure. 41(define (xcons d a) (cons a d)) 42 43;; Make a list of length LEN. 44 45(define (make-list len [elt #f]) (make-list* len elt)) 46 47;; Make a list of length LEN. Elt i is (PROC i) for 0 <= i < LEN. 48 49(define (list-tabulate len proc) 50 (check-arg (lambda (n) (and (integer? n) (>= n 0))) len 'list-tabulate) 51 (check-arg procedure? proc 'list-tabulate) 52 (for/list ([i (in-range len)]) (proc i))) 53 54;; (cons* a1 a2 ... an) = (cons a1 (cons a2 (cons ... an))) 55;; (cons* a1) = a1; (cons* a1 a2 ...) = (cons a1 (cons* a2 ...)) 56;; 57;; (cons first (unfold not-pair? car cdr rest values)) 58 59;; reprovided as racket's list* 60;; (define (cons* first . rest) 61;; (let recur ((x first) (rest rest)) 62;; (if (pair? rest) 63;; (cons x (recur (car rest) (cdr rest))) 64;; x))) 65 66(define (list-copy lis) 67 (let recur ((lis lis)) 68 (if (pair? lis) 69 (cons (car lis) (recur (cdr lis))) 70 lis))) 71 72(define (circular-list val1 . vals) 73 (let ([ph (make-placeholder #f)]) 74 (placeholder-set! ph 75 (cons val1 (let loop ([vals vals]) 76 (if (null? vals) 77 ph 78 (cons (car vals) (loop (cdr vals))))))) 79 (make-reader-graph ph))) 80 81;; IOTA count [start step] (start start+step ... start+(count-1)*step) 82 83(define (iota count [start 0] [step 1]) 84 (check-arg integer? count 'iota) 85 (check-arg number? start 'iota) 86 (check-arg number? step 'iota) 87 (unless (or (zero? count) (positive? count)) 88 (error 'iota "count expected to be non-negative, got: ~a" count)) 89 (let loop ([n 0]) 90 (if (= n count) '() 91 (cons (+ start (* n step)) (loop (add1 n)))))) 92 93;;; cons.rkt ends here 94