Repository navigation
Expand file tree
/
Copy pathlibrary.scm
More file actions
30 lines (30 loc) · 2.42 KB
/
Copy pathlibrary.scm
File metadata and controls
30 lines (30 loc) · 2.42 KB
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))