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