(+ (* 1.2 (- 2 1/3)) -8.7)(/ (+ (/ 2 3) (/ 4 9)) (- (/ 5 11) (/ 4 3)))(+ 1 (/ 1 (+ 2 (/ 1 (+ 1 (/ 1 2))))))(* 1 (* -2 (* 3 (* -4 (* 5 (* -6 7))))))(+ 1 2.0)(- 1 1.0)(+ 1/3 2/3)(* 1.0 0)(/ 0 1)(/ 1 3)- (car . cdr)
- (this (is silly))
- (is this silly?)
- (+ 2 3)
- (+ 2 3)
- +
- (2 3)
- procedure cons
- cons
- (quote cons)
- quote
- 5
- 5
- 5
- 5
(list
(cons 'car 'cdr)
(list 'this '(is silly))
(cons 'is '(this silly?))
(quote (+ 2 3))
(cons '+ '(2 3))
(car '(+ 2 3))
(cdr '(+ 2 3))
cons
(quote cons)
(quote (quote cons))
(car (quote (quote cons)))
(+ 2 3)
(+ '2 '3)
(+ (car '(2 3)) (car (cdr '(2 3))))
((car (list + - * /)) 2 3))(car (cdr (car '((a b) (c d)))))(car (car (cdr '((a b) (c d)))))(car (cdr (car (cdr '((a b) (c d))))))(cons (cons 'a 'b) (cons (cons (cons 'c '()) (cons 'd '())) (cons '() '())))(cons 1 (cons '(2 . ((3) . ())) (cons '(()) (cons 4 5))))(let ((l '((a b) (c d))))
(list
(car l)
(car (car l))
(cdr (car l))
(car (cdr (car l)))
(cdr (cdr (car l)))
#:cdr
(cdr l)
(cdr (cdr l))
(car (cdr l))
(car (car (cdr l)))
(cdr (car (cdr l)))
(car (cdr (car (cdr l))))
(cdr (cdr (car (cdr l))))
))(+ 1 2) ((car ‘(+ - * /)) 1 2 (* 3 4))
(e0 e1 e2…)
((car (cdr (list + - * /))) 17 5)
- (list + - * /) => (+ - * /)
- (cdr (list + - * /)) => (- * /)
- (car ‘(- * /)) => -
- (- 17 5) => 12
(let ([a 1]
[b 2])
(list
#:want
(+ (- (* 3 a) b) (+ (* 3 a) b))
#:get
(let ([x (* 3 a)])
(+ (- x b) (+ x b)))))(cons (car (list a b c))
(cdr (list a b c)))
(let ((lst (list a b c)))
(cons (car lst) (cdr lst)))54
(let ([x 9])
(* x
(let ([x (/ x 3)])
(+ x x))))(let ([x 'a] [y 'b])
(list (let ([x 'c]) (cons x y))
(let ([y 'd]) (cons x y))))(let ([x 'a] [y 'b])
(list (let ([new-x 'c]) (cons new-x y))
(let ([new-y 'd]) (cons x new-y))))(let ([x '((a b) c)])
(cons (let ([x (cdr x)]) ; x => (c)
(car x)) ; c
(let ([x (car x)]) ; x => (a b)
(cons (let ([x (cdr x)]) ; x => (b)
(car x)) ; b
(cons (let ([x (car x)]) ; x => a
x) ; a
(cdr x)))))) ; (b)
;; (cons 'c (cons 'b (cons 'a '(b))))
;; =>
;; (c b a b)
(let ([x '((a b) c)])
(cons (let ([x1 (cdr x)])
(car x1))
(let ([x2 (car x)])
(cons (let ([x3 (cdr x2)])
(car x3))
(cons (let ([x4 (car x2)])
x4)
(cdr x2))))))(let ([f (lambda (x) x)])
(f 'a))
;; a
(let ([f (lambda x x)])
(f 'a))
;; (a)
(let ([f (lambda (x . y) x)])
(f 'a))
;; a
(let ([f (lambda (x . y) y)])
(f 'a))
;; ()(let ([list (lambda x x)])
(list
(list)
(list (list 1) 2 3 '(4 5))
(list 1 2 3)))(lambda (f x) (f x)) ;; none
(lambda (x) (+ x x)) ;; +
(lambda (x y) (f x y)) ;; f
(lambda (x)
(cons x (f x y))) ;; f y
(lambda (x)
(let ([z (cons x y)])
(x y z))) ;; y
(lambda (x)
(let ([y (cons x y)])
(x y z))) ;; y z(define doubler
(lambda (f)
(lambda (x) (f x x))))
((doubler +) 1)
;; (define double-any
;; (lambda (f x)
;; ((doubler f) x)))
;; (double-any + 2)
;; double-any 就是 (lambda (f x) (f x x))(double-any double-any double-any)
;; =>
(double-any double-any double-any)
;; =>
(double-any double-any double-any)
;; 死循环(define compose
(lambda (f g)
(lambda (x)
(f (g x)))))
(define my-cadr (compose car cdr))
(define my-cddr (compose cdr cdr))
(list (my-cadr '(a b c))
(my-cddr '(a b c)))(let ([caar (compose car car)]
[cadr (compose car cdr)]
[cdar (compose cdr car)]
[cddr (compose cdr cdr)]
[l '((1 2) (3 4))])
(list (caar l) 1
(cadr l) '(3 4)
(cdar l) '(2)
(cddr l) '()
))(let ([caaar (compose car (compose car car))]
[cdaar (compose (compose cdr car) car)]
[cadar (compose (compose car cdr) car)]
[l '(((1 2) (3 4)) ((5 6) (7 8)))])
(list (caaar l) 1
(cdaar l) '(2)
(cadar l) '(3 4)))(let ([caadar (compose car (compose car (compose cdr car)))])
(caddar '((1 2 3))))(define atom?
(lambda (x)
(not (pair? x))))
(map atom? '(1 () (2 3) "hello" a 2.3))(define shorter
(lambda (lst1 lst2)
(if (<= (length lst1)
(length lst2))
lst1
lst2)))
(shorter '(a b) '(c d e))(use-modules (rnrs base)) ; error
(define shorter
(lambda (lst1 lst2)
(cond
[(not (and (list? lst1) (list? lst2)))
(assertion-violation
'shorter
"improper argument"
lst1 lst2)]
[(<= (length lst1) (length lst2))
lst1])))
(shorter '(a b) '(c d e))
(shorter '(a b) '(c d))
(shorter '(a b) '(c))
;; (shorter 12 '(c))(define tree-copy
(lambda (tr)
(if (not (pair? tr))
tr
(cons (tree-copy (car tr))
(tree-copy (cdr tr))))))
(tree-copy '((a . b) . (c . d)))(define tree-copy
(lambda (tr)
(if (not (pair? tr))
tr
(cons (tree-copy (cdr tr))
(tree-copy (car tr))))))
(tree-copy '((a . b) . (c . (d . g))))tree 所有 pair 的 car 和 cdr 都会相互交换
(append '(a b) '(c d e))(define append
(lambda (ls1 ls2)
(if (null? ls1)
ls2
(cons (car ls1) (append (cdr ls1) ls2)))))
(append '(1 2 3) '(4 5))应该会返回 (3 2 1 4 5)
(define append
(lambda (ls1 ls2)
(if (null? ls1)
ls2
(append (cdr ls1) (cons (car ls1) ls2)))))
(append '(1 2 3) '(4 5))(define make-list
(lambda (n x)
(if (= n 0)
'()
(cons x (make-list (1- n) x)))))
(make-list 7 '())(define list-ref
(lambda (ls n)
(if (zero? n)
(car ls)
(list-ref (cdr ls) (1- n)))))
(list-ref '(1 2 3 4) 0)
;; => 1
;; 1
(list-ref '(a short (nested) list) 2)
;; => (nested)
;; (nested)(define list-tail
(lambda (ls n)
(if (zero? n)
ls
(list-tail (cdr ls) (1- n)))))
(list-tail '(1 2 3 4) 0)
;; => (1 2 3 4)
(list-tail '(a short (nested) list) 2)
;; => ((nested) list)
(define shorter?
(lambda (ls1 ls2)
(cond
[(null? ls1) #t]
[(null? ls2) #f]
[else (shorter? (cdr ls1) (cdr ls2))])))
(define shorter
(lambda (ls1 ls2)
(if (shorter? ls1 ls2)
ls1
ls2)))
(shorter '(a b) '(c d e))
;; (shorter '(a b 1 2) '(c d e))(define even?
(lambda (n)
(if (zero? n)
#t
(odd? (1- n)))))
(define odd?
(lambda (n)
(if (zero? n)
#f
(even? (1- n)))))
(even? 17)
;; => #f
(odd? 17)
;; => #t(define transpose
(lambda (ls)
(cons (map car ls)
(map cdr ls))))
;; => #<unspecified>
(map car '((a . 1) (b . 2) (c . 3)))
;; => (a b c)
(map cdr '((a . 1) (b . 2) (c . 3)))
;; => (1 2 3)
(transpose '((a . 1) (b . 2) (c . 3)))
;; => ((a b c) 1 2 3)
;; ((a b c) . (1 2 3))(define make-counter
(lambda (count step)
(lambda ()
(let ([v count])
(set! count (+ count step))
v))))
(let ([c1 (make-counter 0 1)]
[c2 (make-counter 100 2)])
(list (c1) (c1) (c1)
(c2) (c2) (c2)))(define make-stack
(lambda ()
(let ([ls '()])
(lambda (msg . args)
(case msg
[(empty? mt?) (null? ls)]
[(push!) (set! ls (cons (car args) ls))]
[(top) (car ls)]
[(pop!) (set! ls (cdr ls))]
[else "oops"])))))
(let ([st (make-stack)])
(st 'push! 1)
(st 'push! 2)
(st 'push! 3)
(st 'mt?)
(st 'pop!)
(st 'top))(define make-stack
(lambda ()
(let ([ls '()])
(lambda (msg . args)
(case msg
[(empty? mt?) (null? ls)]
[(push!) (set! ls (cons (car args) ls))]
[(top) (car ls)]
[(pop!) (set! ls (cdr ls))]
[(ref) (list-ref ls (car args))]
[(set!) (set-car! (list-tail ls (car args)) (cadr args))]
[else "oops"])))))
(let ([stack (make-stack)])
(stack 'push! 'a)
(stack 'push! 'b)
(stack 'push! 'c)
(stack 'top))(define make-stack
(lambda (n)
(let ([v (make-vector n)]
[i 0])
(lambda (msg . args)
(case msg
[(empty?) (zero? i)]
[(push!) (vector-set! v i (car args))
(set! i (1+ i))]
[(top) (vector-ref v (1- i))]
[(pop!) (set! i (1- i))]
[(ref) (vector-ref v (- i 1 (car args)))]
[(set!) (vector-set! v (- i 1 (car args)) (cadr args))]
[else "oops"])))))
(let ([stack (make-stack 10)])
(stack 'push! 'a)
(stack 'push! 'b)
(stack 'push! 'c)
(stack 'push! 'd)
(stack 'set! 1 'CCC)
(stack 'pop!)
(stack 'top))(define emptyq?
(lambda (q)
(null? (cdr (car q)))))
(use-modules (rnrs base))
(define getq
(lambda (q)
(if (emptyq? q)
(assertion-violation 'getq "the queue is empty")
(car (car q)))))
(define delq!
(lambda (q)
(if (emptyq? q)
(assertion-violation 'delq! "the queue is empty")
(set-car! q (cdr (car q))))))first try
(define make-queue
(lambda () (cons 'ignored '())))
(define q (cons 'ignored '()))
(define putq!
(lambda (q v)
(let ([tail (list-tail q (1- (length q)))])
(set-car! tail v)
(set-cdr! tail (cons 'ignored '())))))
(define getq car)
(define delq!
(lambda (q)
()))
(cdr q)
'(#:beg #:end)
(define q (make-queue))
;; => #<unspecified>
q
;; => (1 2 3 ignored)second try
(define make-queue
(lambda () (list #:beg #:end)))
(define putq!
(lambda (q v)
(let ([tail (list-tail q (1- (length q)))])
(set-car! tail v)
(set-cdr! tail (cons #:end '())))))
(define getq cadr)
(define delq!
(lambda (q)
(set-cdr! q (cddr q))))(let ([ls (cons 'a '())])
(set-cdr! ls ls)
ls)(let ([ls (cons 'a '())])
(set-cdr! ls ls)
ls)(define simple-length
(lambda (ls)
(if (null? ls)
0
(1+ (simple-length (cdr ls))))))
(simple-length '(a b c))
(let ([ls (cons 'a '())])
(set-cdr! ls ls)
(simple-length ls))simple-length 死循环，自带 length 会报错。
(define simple-list?
(lambda (ls)
(if (null? ls)
#t
(if (pair? ls)
(simple-list? (cdr ls))
#f))))
(simple-list? '())
;; => #t
(simple-list? '(a b c))
;; => #t
(simple-list? '(a b . c))
;; => #f(define cycle?
(lambda (hare tortoise)
(format #t "hello: ~a, ~a\n" hare tortoise)
(if (eq? hare tortoise)
#t
(if (and (pair? hare)
(pair? (cdr hare))
(pair? tortoise))
(cycle? (cddr hare)
(cdr tortoise))
#f))))
(define better-list?
(lambda (x)
(cond
[(null? x) #t]
[(not (pair? x)) #f]
[else
(cond [(and (pair? (cdr x))
(cycle? (cddr x) (cdr x)))
#f]
[else (better-list? (cdr x))])])))
(let ([ls (cons 'a '())])
(set-cdr! ls ls)
(eq? (cdr ls) (cddr ls))
(better-list? ls))
;; => #f
(better-list? '(1 2 3))
;; => #t
(better-list? '())
;; => #t
(let ([ls (list 'a 'b 'c)])
(set-cdr! (cddr ls) ls)
(better-list? ls))
;; => #f
(let ([x (memv 'a ls)))
(and x (memv 'b x)))
((lambda (x)
(if x
(memv 'b x)
#f))
(memv 'a ls))(or (memv x '(a b c)) (list x))
(let ([t (memv x '(a b c))])
(if t t (or (list x))))
(let ([t (memv x '(a b c))])
(if t t (list x)))
((lambda (t) (if t t (list x)))
(memv x '(a b c)))(let* ([a 5]
[b (+ a a)]
[c (+ a b)])
(list a b c))
;; => (5 10 15)
(let ([a 5])
(let ([b (+ a a)])
(let ([c (+ a b)])
(list a b c))))
;; => (5 10 15)
(define-syntax mylet*
(syntax-rules ()
[(_ () b1 b2 ...)
(let () b1 b2 ...)]
;; [(_ ((x e)) b1 b2 ...)
;; (let ((x e)) b1 b2 ...)]
[(_ ((x1 e1) (x2 e2) ...) b1 b2 ...)
(let ((x1 e1))
(mylet* ((x2 e2) ...)
b1 b2 ...))]))
(mylet* () (+ 1 2))
;; => 3
(mylet* ((x 1)) (+ 2 x))
;; => 3
(mylet* ([a 5]
[b (+ a a)]
[c (+ a b)])
(list a b c))
;; => (5 10 15)(when #f 1 2 3)
;; => #<void>
(if #f
(begin 1 2 3)
#f)
(when #t 1 2 3)
;; => 3
(define-syntax my-when
(syntax-rules ()
[(_ t e1 e2 ...)
(if t
(begin e1 e2 ...)
#f)]))
(my-when 1 2 3)
;; => 3
(expand '(my-when 1 2 3))
;; => (if 1 (begin 2 3) #f)
(my-when #f 1 2 3 4)
;; => #f
(expand '(my-when #f 1 2 3 4))
;; => (if #f (begin 1 2 3 4) #f)
(define-syntax unless
(syntax-rules ()
[(_ t e1 e2 ...)
(my-when (not t) e1 e2 ...)]))
(unless #f 1 2 3)
;; => 3
(unless #t 1 2 3)
;; => #<void>
(expand '(unless #f 1 2 3))
;; => (if (#2%not #f) (begin 1 2 3) #f)
(expand '(unless #t 1 2 3))
;; => (if (#2%not #t) (begin 1 2 3) #f)(define factor
(lambda (n)
(let f ([n n] [i 2])
(cond
[(>= i n) (list n)]
[(integer? (/ n i))
(cons i (f (/ n i) i))]
[else (f n (+ i 1))]))))
(define factor
(lambda (n)
(letrec ([f (lambda (n i)
(cond
[(>= i n) (list n)]
[(integer? (/ n i))
(cons i (f (/ n i) i))]
[else (f n (+ i 1))]))])
(f n 2))))
(define factor
(lambda (n)
((letrec ([f (lambda (n i)
(cond
[(>= i n) (list n)]
[(integer? (/ n i))
(cons i (f (/ n i) i))]
[else (f n (+ i 1))]))])
f)
n 2)))不行，even? 不知道 odd? 的绑定
(letrec ([even? (lambda (n)
(if (= n 0)
#t
(odd? (- n 1))))]
[odd? (lambda (n)
(if (= n 0)
#f
(even? (- n 1))))])
(list (even? 12) (odd? 12)))| v1 | v2 | |
|---|---|---|
| 10 | 177 | 10 |
| 30 | 2692537 | 30 |
(define fibonacci-v1-count 0)
(define fibonacci-v1
(lambda (n)
(let fib ([i n])
(set! fibonacci-v1-count (+ fibonacci-v1-count 1))
(cond
[(= i 0) 0]
[(= i 1) 1]
(else (+ (fib (- i 1)) (fib (- i 2))))))))
(fibonacci-v1 10)
;; => 55
fibonacci-v1-count
;; => 177
(define fibonacci-v2-count 0)
(define fibonacci-v2
(lambda (n)
(if (= n 0)
0
(let fib ([i n] [a1 1] [a2 0])
(set! fibonacci-v2-count (+ fibonacci-v2-count 1))
(if (= i 1)
a1
(fib (- i 1) (+ a1 a2) a1))))))
(fibonacci-v2 10)
;; => 55
fibonacci-v2-count
;; => 10(define-syntax mylet
(syntax-rules ()
[(_ ((x e) ...) b1 b2 ...)
((lambda (x ...) b1 b2 ...)
e ...)]
[(_ name ((x e) ...) b1 b2 ...)
((letrec ([name (lambda (x ...) b1 b2 ...)])
name)
e ...)]))不把 (or e) 当作基的话，展开会很大，不清楚为何。tail recursive?
(trace-define-syntax my-or
(syntax-rules ()
[(_) #f]
[(_ e1 e2 ...)
(let ([t e1])
(if e1 e1 (my-or e2 ...)))]))
(expand '(my-or (my-or (my-or 1)) 2))
(let ([#{t a6c8lvvu4iquenqq7kziuzlxh-17} (let ([#{t a6c8lvvu4iquenqq7kziuzlxh-18} 1])
(if 1 1 #f))])
(if (let ([#{t a6c8lvvu4iquenqq7kziuzlxh-19} 1])
(if 1 1 #f))
(let ([#{t a6c8lvvu4iquenqq7kziuzlxh-20} 1]) (if 1 1 #f))
(let ([#{t a6c8lvvu4iquenqq7kziuzlxh-21} 2]) (if 2 2 #f))))
(trace-define-syntax my-or2
(syntax-rules ()
[(_) #f]
[(_ e) e]
[(_ e1 e2 e3 ...)
(let ([t e1])
(if e1 e1 (my-or e2 e3 ...)))]))
(expand '(my-or2 (my-or2 (my-or2 1)) 2))
(let ([#{t a6c8lvvu4iquenqq7kziuzlxh-36} 1])
(if 1
1
(let ([#{t a6c8lvvu4iquenqq7kziuzlxh-37} 2]) (if 2 2 #f))))(define product
(lambda (ls)
(trace-let f ([ls ls] [acc 1])
(cond
[(null? ls) acc]
[(= (car ls) 0) 0]
[else (f (cdr ls) (* (car ls) acc))]))))(define reciprocal
(lambda (n success failure)
(if (= n 0)
(failure "oops")
(success (/ 1 n)))))
(reciprocal 10 list list)
;; => (1/10)
(reciprocal 0 list list)
;; => ("oops")(define factorial
(lambda (x k)
(if (= x 0)
(k 1)
(* x (factorial (- x 1) k)))))
(factorial 4 (lambda (x) x))
;; => 24
(factorial 4 (lambda (x) 3))
;; => 72模仿 product
(define reciprocals
(lambda (ls k)
(let ([break k])
(let f ([ls ls] [k k])
(cond
[(null? ls) (k '())]
[(= (car ls) 0) (break "zero found")]
[else (f (cdr ls)
(lambda (x)
(k (cons (/ 1 (car ls)) x))))])))))(define-syntax complain
(syntax-rules ()
[(_ ek args ...)
(ek args ...)]))(define calc #f)
(let ()
(define do-calc
(lambda (expr)
(cond
[(number? expr) expr]
[(and (list? expr) (= (length expr) 3))
(let ([op (car expr)] [args (cdr expr)])
(case op
[(add) (apply-op + args)]
[(sub) (apply-op - args)]
[(mul) (apply-op * args)]
[(div) (apply-op / args)]
[else (complain "invalid operator" op)]))]
[else (complain "invalid expression" expr)])))
(define apply-op
(lambda (op args)
(op (do-calc (car args)) (do-calc (cadr args)))))
(define complain
(lambda (msg expr)
(ek (list msg expr))))
(define ek #f)
(set! calc
(lambda (expr)
;; grab an error continuation ek
(call/cc
(lambda (k)
(set! ek k)
(do-calc expr))))))(define calc #f)
(let ()
(define do-calc
(lambda (expr)
(cond
[(number? expr) expr]
[(and (list? expr) (= (length expr) 3))
(let ([op (car expr)] [args (cdr expr)])
(case op
[(add) (apply-op + args)]
[(sub) (apply-op - args)]
[(mul) (apply-op * args)]
[(div) (apply-op / args)]
[else (complain "invalid operator" op)]))]
[else (complain "invalid expression" expr)])))
(define apply-op
(lambda (op args)
(op (do-calc (car args)) (do-calc (cadr args)))))
(define complain
(lambda (msg expr)
(assertion-violation 'calc msg expr)))
(set! calc
(lambda (expr)
(do-calc expr))))
(calc '(add (mul 3 2) -4))
;; => 2
(calc '(div 1/2 1/6))
;; => 3
(calc '(add (mul 3 2) (div 4)))
;; Exception in calc: invalid expression with irritant (div 4)(let ()
(define do-calc
(lambda (expr)
(cond
[(number? expr) expr]
[(and (list? expr)
(= (length expr) 2)
(eq? (car expr) 'minus))
(- (do-calc (cadr expr)))]
[(and (list? expr) (= (length expr) 3))
(let ([op (car expr)] [args (cdr expr)])
(case op
[(add) (apply-op + args)]
[(sub) (apply-op - args)]
[(mul) (apply-op * args)]
[(div) (apply-op / args)]
[else (complain "invalid operator" op)]))]
[else (complain "invalid expression" expr)])))
(define apply-op
(lambda (op args)
(op (do-calc (car args)) (do-calc (cadr args)))))
(define complain
(lambda (msg expr)
(assertion-violation 'calc msg expr)))
(set! calc
(lambda (expr)
(do-calc expr))))(define-syntax gpa
(syntax-rules ()
[(_ g1 g2 ...)
(let ([ls (map letter->number
(filter (lambda (x) (not (eq? x 'x)))
'(g1 g2 ...)))])
(if (= (length ls) 0)
(assertion-violation 'grade "invalid grades, all x")
(/ (apply + ls) (length ls))))]))(define-syntax distribution
(syntax-rules ()
[(_ g1 g2 ...)
(let ([a 0]
[b 0]
[c 0]
[d 0]
[f 0])
(for-each
(lambda (x)
(case x
[(a) (set! a (+ a 1))]
[(b) (set! b (+ b 1))]
[(c) (set! c (+ c 1))]
[(d) (set! d (+ d 1))]
[(f) (set! f (+ f 1))]))
'(g1 g2 ...))
`((,a a) (,b b) (,c c) (,d d) (,f f)))]))(define histogram
(lambda (port distribution)
(for-each
(lambda (x)
(display (format "~a: ~a\n"
(cadr x)
(make-string (car x) #\*))
port))
distribution)))