76 lines
1.6 KiB
Scheme
76 lines
1.6 KiB
Scheme
|
; This is a init file for Mini-Scheme.
|
||
|
|
; Modified for UNSLISP.
|
||
|
|
|
||
|
|
(define (caar x) (car (car x)))
|
||
|
|
(define (cadr x) (car (cdr x)))
|
||
|
|
(define (cdar x) (cdr (car x)))
|
||
|
|
(define (cddr x) (cdr (cdr x)))
|
||
|
|
(define (caaar x) (car (car (car x))))
|
||
|
|
(define (caadr x) (car (car (cdr x))))
|
||
|
|
(define (cadar x) (car (cdr (car x))))
|
||
|
|
(define (caddr x) (car (cdr (cdr x))))
|
||
|
|
(define (cdaar x) (cdr (car (car x))))
|
||
|
|
(define (cdadr x) (cdr (car (cdr x))))
|
||
|
|
(define (cddar x) (cdr (cdr (car x))))
|
||
|
|
(define (cdddr x) (cdr (cdr (cdr x))))
|
||
|
|
|
||
|
|
(define (list . x) x)
|
||
|
|
|
||
|
|
(define (map proc list)
|
||
|
|
(if (pair? list)
|
||
|
|
(cons (proc (car list)) (map proc (cdr list)))))
|
||
|
|
|
||
|
|
(define (for-each proc list)
|
||
|
|
(if (pair? list)
|
||
|
|
(begin (proc (car list)) (for-each proc (cdr list)))
|
||
|
|
#t ))
|
||
|
|
|
||
|
|
(define (list-tail x k)
|
||
|
|
(if (zero? k)
|
||
|
|
x
|
||
|
|
(list-tail (cdr x) (- k 1))))
|
||
|
|
|
||
|
|
(define (list-ref x k)
|
||
|
|
(car (list-tail x k)))
|
||
|
|
|
||
|
|
(define list-set!
|
||
|
|
(lambda (lst k obj)
|
||
|
|
(if (= k 0)
|
||
|
|
(set-car! lst obj)
|
||
|
|
(list-set! (cdr lst) (- k 1) obj))))
|
||
|
|
|
||
|
|
(define (last-pair x)
|
||
|
|
(if (pair? (cdr x))
|
||
|
|
(last-pair (cdr x))
|
||
|
|
x))
|
||
|
|
|
||
|
|
(define vector list)
|
||
|
|
(define vector-ref list-ref)
|
||
|
|
(define vector-set! list-set!)
|
||
|
|
|
||
|
|
(define (head stream) (car stream))
|
||
|
|
|
||
|
|
(define (tail stream) (force (cdr stream)))
|
||
|
|
|
||
|
|
;;;;; following part is written by a.k
|
||
|
|
|
||
|
|
;;;; atom?
|
||
|
|
(define (atom? x)
|
||
|
|
(not (pair? x)))
|
||
|
|
|
||
|
|
;;;; memq
|
||
|
|
(define (memq obj lst)
|
||
|
|
(cond
|
||
|
|
((null? lst) #f)
|
||
|
|
((eq? obj (car lst)) lst)
|
||
|
|
(else (memq obj (cdr lst)))))
|
||
|
|
|
||
|
|
;;;; equal?
|
||
|
|
(define (equal? x y)
|
||
|
|
(if (pair? x)
|
||
|
|
(and (pair? y)
|
||
|
|
(equal? (car x) (car y))
|
||
|
|
(equal? (cdr x) (cdr y)))
|
||
|
|
(and (not (pair? y))
|
||
|
|
(eqv? x y))))
|