Parcourir la Source

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 ans auparavant
Parent
commit
2965944979
1 fichiers modifiés avec 53 ajouts et 0 suppressions
  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))