瀏覽代碼

something similar to clojure's assoc/dissoc/get-in in scheme.

only works for association lists, not for vectors. or if we make vectors
be association lists internally, then this would work as well.
Lucas Stadler 12 年之前
父節點
當前提交
2965944979
共有 1 個文件被更改,包括 53 次插入0 次删除
  1. 53 0
      scm/clojure.scm

+ 53 - 0
scm/clojure.scm

@ -0,0 +1,53 @@
1
; let's have a bit of clojure in scheme
2
3
(define nil #f)
4
5
(define ex-m '((x . 10) (y . 13) (z . -37)))
6
7
(define (clj-assoc m k v)
8
  (if (null? m)
9
    `((,k . ,v))
10
    (let ((e (car m)))
11
      (if (equal? (car e) k)
12
        `((,k . ,v) . ,(cdr m))
13
        `(,e . ,(clj-assoc (cdr m) k v))))))
14
15
(clj-assoc ex-m 'a 10)
16
(clj-assoc ex-m 'y 3)
17
18
(define (clj-dissoc m k)
19
  (if (null? m)
20
    m
21
    (let ((e (car m)))
22
      (if (equal? (car e) k)
23
        (cdr m)
24
        `(,e . ,(clj-dissoc (cdr m) k))))))
25
26
(clj-dissoc ex-m 'z)
27
(clj-dissoc ex-m 'a)
28
29
(define (clj-get m k)
30
  (if (null? m)
31
    nil
32
    (let ((e (car m)))
33
      (if (equal? (car e) k)
34
        (cdr e)
35
        (clj-get (cdr m) k)))))
36
37
(clj-get ex-m 'z)
38
(clj-get ex-m 'a)
39
40
(define (clj-get-in m ks)
41
  (cond
42
    ((null? m) nil)
43
    ((null? ks) m)
44
    (else (let ((s (clj-get m (car ks))))
45
            (if s
46
              (clj-get-in s (cdr ks))
47
              nil)))))
48
49
(define ex-nested-m `((a . ,ex-m) (b . ((c . ((d . ((e . ,ex-m) (f . 42)))))))))
50
51
(clj-get-in ex-nested-m '(a z))
52
(clj-get-in ex-nested-m '(b c d f))
53
(clj-get-in ex-nested-m '(b x y z))