forked from eigenhombre/l1
-
Notifications
You must be signed in to change notification settings - Fork 0
/
meta.l1
38 lines (33 loc) · 951 Bytes
/
meta.l1
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
(defn member (x l)
(some (partial = x) l))
(defn assoc (x pairs)
(cond ((not pairs) ())
((= x (caar pairs))
(car pairs))
(t (assoc x (cdr pairs)))))
(defn increment-key (k pairs)
(let ((pair (assoc k pairs)))
(if-not pair
(cons (cons k 0) pairs)
(cons (cons k (inc (cdr pair))) pairs))))
(defn clear-dup-keys (pairs)
(let ((seen ())
(ret ()))
(foreach p pairs
(when-not (member (car p) seen)
(set! seen (cons (car p) seen))
(set! ret (cons p ret))))
ret))
(defn frequencies (l)
(let ((state ()))
(foreach x l
(set! state (increment-key x state)))
(clear-dup-keys state)))
(let ((fs (forms)))
(printl `(There are ~(len fs) forms ~COLON))
(foreach pair (reverse
(sort-by cdr
(frequencies
(map second fs))))
(printl `(~TAB type ~(car pair) ~COLON ~(cdr pair))))
())