Ver Código Fonte

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 anos atrás
pai
commit
2965944979
1 arquivos alterados com 53 adições e 0 exclusões
  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))