Quellcode durchsuchen

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 vor 12 Jahren
Ursprung
Commit
2965944979
1 geänderte Dateien mit 53 neuen und 0 gelöschten Zeilen
  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))