Selaa lähdekoodia

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 vuotta sitten
vanhempi
commit
2965944979
1 muutettua tiedostoa jossa 53 lisäystä ja 0 poistoa
  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))