-
Notifications
You must be signed in to change notification settings - Fork 4
/
library.scm
30 lines (30 loc) · 2.42 KB
/
library.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
(define nil '())
(define (null? x) (eq? x nil))
(define (not x) (if (eq? x #f) #t #f))
(define if (form (P C A) (list 'cond (list P C) (list 'else A))))
(define (list? x) (cond ((null? x) #t) ((pair? x) #t) (else #f)))
(begin (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 (length x) (cond ((null? x) 0) ((pair? x) (+ 1 (length (cdr x)))) (else (fail! 'length 'improper-list))))
(define (append x y) (cond ((null? x) y) (else (cons (car x) (append (cdr x) y)))))
(define = (lambda (n m) (eq? n m)))
(define (zero? n) (= n 0))
(define let (form (bindings : body) (define (var-list bindings) (cond ((null? bindings) '()) ((= (length (car bindings)) 2) (cons (caar bindings) (var-list (cdr bindings)))) (else (fail! 'let 'syntax-error)) )) (define (init-list bindings) (cond ((null? bindings) '()) ((= (length (car bindings)) 2) (cons (cadar bindings) (init-list (cdr bindings)))) (else (fail! 'let 'syntax-error)) )) (cons (cons 'lambda (cons (var-list bindings) body)) (init-list bindings)) ))
(define (ratio n d) (cond ((zero? d) (fail! 'ratio 'division-by-zero)) (else (list n '/ d))))
(define (factorial n) (if (< n 2) 1 (* n (factorial (- n 1)))))
(define Y (lambda (f) ((lambda (g) (g g)) (lambda (h) (lambda (x) ((f (h h)) x) ))) ))
(define fact (Y (lambda (f) (lambda (x) (cond ((< x 2) 1) (else (* x (f (- x 1)))) ) )) ))
(define (fib n) (cond ((= n 0) 0) ((= n 1) 1) (else (+ (fib (- n 1)) (fib (- n 2)))) ))
(define (A x y) (define (dec n) (- n 1)) (cond ((zero? y) 0) ((zero? x) (* 2 y)) ((= y 1) 2) (else (A (dec x) (A x (dec y)))) ))
(define (mapper sel comb id lst) (cond ((null? list) id) (else (comb (sel lst) (mapper sel comb id (cdr lst))))))
(define (time-diff t0 t1) (define (s t) (cdar t)) (define (us t) (cdadr t)) (list (cons 's (- (s t1) (s t0))) (cons 'us (- (us t1) (us t0)))))
(define (xyz x y : z) (list (cons 'x x) (cons 'y y) (cons 'z z)))
(define (killer) (call/cc (lambda (exit) (spawn (sleep 10) (exit 'killed)) (A 2 2))))
(if (= (let ((x 2) (y 3)) (let ((x 7) (z (+ x y))) (* z x))) 35) 'pass (fail! 'test-let))