1
#| data.jl -- data type functions
3
$Id: data.jl,v 1.3 2001/08/08 06:00:23 jsh Exp $
5
Copyright (C) 2000 John Harper <john@dcs.warwick.ac.uk>
7
This file is part of librep.
9
librep is free software; you can redistribute it and/or modify it
10
under the terms of the GNU General Public License as published by
11
the Free Software Foundation; either version 2, or (at your option)
14
librep is distributed in the hope that it will be useful, but
15
WITHOUT ANY WARRANTY; without even the implied warranty of
16
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17
GNU General Public License for more details.
19
You should have received a copy of the GNU General Public License
20
along with Jade; see the file COPYING. If not, write to
21
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24
(define-structure unscheme.data
26
(export #f #t not eqv? eq? equal? boolean?
28
pair? cons car cdr set-car! set-cdr!
30
caaar caadr cadar caddr
31
cdaar cdadr cddar cdddr
32
caaaar caaadr caadar caaddr
33
cadaar cadadr caddar cadddr
34
cdaaar cdaadr cdadar cdaddr
35
cddaar cddadr cdddar cddddr
37
null? list? list length append reverse
38
list-tail list-ref memq memv member
41
symbol? symbol->string string->symbol
43
number? complex? real? rational? integer?
44
exact? inexact? = < > <= >= zero? positive?
45
negative? odd? even? max min + * - /
46
abs quotient remainder modulo gcd lcm
47
numerator denominator floor ceiling
48
truncate round rationalize exp log sin cos
49
tan asin acos atan sqrt expt exact->inexact
50
inexact->exact string->number number->string
52
char? char=? char<? char>? char<=? char>=?
53
char-ci=? char-ci<? char-ci>? char-ci<=?
54
char-ci>=? char-alphabetic? char-numeric?
55
char-whitespace? char-upper-case?
56
char-lower-case? char->integer integer->char
57
char-upcase char-downcase
59
string? make-string string string-length
60
string-ref string-set! string=? string-ci=?
61
string<? string>? string<=? string>=?
62
string-ci<? string-ci>? string-ci<=?
63
string-ci>=? substring string-append
64
string->list list->string string-copy
67
vector? make-vector vector vector-length
68
vector-ref vector-set! vector->list
69
list->vector vector-fill!)
83
(define (boolean? obj) (and (memq obj '(() t #f #t)) #t))
85
;;; pairs (cons cells)
89
(define set-car! rplaca)
90
(define set-cdr! rplacd)
99
(cond ((null slow) #t)
100
((not (consp slow)) #f)
102
(t (loop (cdr slow) (cddr fast))))))
104
;; XXX return nil if I > (length LST)
105
(define (list-tail lst i) (nthcdr i lst))
106
(define (list-ref lst i) (nth i lst))
110
(define (assv obj alist)
111
(let loop ((rest alist))
112
(cond ((null rest) #f)
113
((eql (caar rest) obj) (car rest))
114
(t (loop (cdr rest))))))
118
(define (symbol? arg)
119
(cond ((memq arg '(#f #t)) #f)
123
(define symbol->string symbol-name)
125
(define (string->symbol name)
126
(if (string= name "nil")
128
(or (find-symbol name)
129
;; The copying is needed to pass test.scm..
130
(intern (copy-sequence name)))))
134
(define number? numberp)
135
(define (complex? obj)
136
(declare (unused obj))
139
(define rational? rationalp)
140
(define integer? integerp)
142
(define exact? exactp)
143
(define inexact? inexactp)
146
(define positive? positivep)
147
(define negative? negativep)
151
(define (rationalize x y)
152
(declare (unused x y))
153
(error "rationalize is unimplemented"))
157
(define char? fixnump)
166
(define (char-ci=? . args) (apply char=? (mapcar char-upcase args)))
167
(define (char-ci<? . args) (apply char<? (mapcar char-upcase args)))
168
(define (char-ci>? . args) (apply char>? (mapcar char-upcase args)))
169
(define (char-ci<=? . args) (apply char<=? (mapcar char-upcase args)))
170
(define (char-ci>=? . args) (apply char>=? (mapcar char-upcase args)))
172
(define char-alphabetic? alpha-char-p)
173
(define char-numeric? digit-char-p)
174
(define char-whitespace? space-char-p)
175
(define char-upper-case? upper-case-p)
176
(define char-lower-case? lower-case-p)
178
(define char->integer identity)
179
(define integer->char identity)
183
(define string? stringp)
185
(define string concat)
186
(define string-length length)
187
(define string-ref aref)
188
(define string-set! aset)
193
(define string<=? <=)
194
(define string>=? >=)
196
(define string-ci=? string-equal)
197
(define string-ci<? string-lessp)
198
(define string-ci>? (lambda args
199
(not (or (apply string-equal args)
200
(apply string-lessp args)))))
201
(define string-ci<=? (lambda args
202
(or (apply string-lessp args)
203
(apply string-equal args))))
204
(define string-ci>=? (lambda args
205
(not (apply string-lessp args))))
207
(define string-append concat)
209
(define (string->list string)
210
(let loop ((i (1- (length string)))
213
(loop (1- i) (cons (aref string i) out))
216
(define list->string concat)
218
(define string-copy copy-sequence)
220
(define (string-fill! string char)
221
(let loop ((i (1- (length string))))
228
(define vector? vectorp)
230
(define vector-length length)
231
(define vector-ref aref)
232
(define vector-set! aset)
234
(define (vector->list vect)
235
(let loop ((i (1- (length vect)))
238
(loop (1- i) (cons (aref vect i) out))
241
(define (list->vector lst)
244
(define (vector-fill! vect char)
245
(let loop ((i (1- (length vect))))
added
removed
lisp/unscheme/data.jl
