git.iko.soy/urbit.org
on a485497 help sign in
urbit.org/docs/nock/implementations/clojure.md
124 lines 3.5 kB history raw
1---
2title: Clojure
3sort: 5
4next: true
5---
7# Clojure
9From [Matt Earnshaw](https://github.com/mattearnshaw/anock/blob/master/src/anock/core.clj):
11```
12(ns anock.core
13 (:import anock.NockException))
15(declare atom? cell? cell)
17(defn noun?
18 "A noun is an atom or a cell."
19 [noun & ns]
20 (if ns false
21 (or (atom? noun) (cell? noun))))
23(defn atom?
24 "An atom is a natural number."
25 [noun & ns]
26 (if ns false
27 (and (integer? noun) (>= noun 0))))
29(defn cell?
30 "A cell is an ordered pair of nouns."
31 [noun]
32 (cond
33 (atom? noun) false
34 (nil? noun) false
35 (not= 2 (count noun)) false
36 :else (and (noun? (first noun))
37 (noun? (second noun)))))
39(defn tis
40 "= (pronounced 'tis') tests a cell for equality."
41 [noun]
42 (if (atom? noun) (throw (anock.NockException. "Cannot tis an atom."))
43 (let [[a b] noun]
44 (if (= a b) 0 1))))
46(defn wut
47 "? (pronounced 'wut') tests whether a noun is a cell."
48 [noun]
49 (cond
50 (atom? noun) 1
51 (cell? noun) 0
52 :else (throw (anock.NockException. "Invalid noun."))))
54(defn lus
55 "+ (pronounced 'lus') adds 1 to an atom."
56 [noun]
57 (if (atom? noun) (inc noun)
58 (throw (anock.NockException. "Can only lus atoms."))))
60(defn fas
61 "/ (pronounced 'fas') is a tree address function."
62 [noun]
63 (if (atom? noun) (throw (anock.NockException. "Cannot fas an atom."))
64 (let [[a b] (cell noun)]
65 (assert (and (pos? a) (atom? a)) "Subject of fas must be a positive atom.")
66 (if (and (not (coll? b)) (or (= 2 a) (= 3 a)))
67 (throw (anock.NockException. (str "Cannot fas noun: " noun))))
68 (cond
69 (= 1 a) b
70 (= 2 a) (first b)
71 (= 3 a) (second b)
72 (even? a) (fas [2 (fas [(/ a 2) b])])
73 (odd? a) (fas [3 (fas [(/ (dec a) 2) b])])))))
75(defn tar
76 "* (pronounced 'tar') means Nock"
77 [noun]
78 (if (atom? noun) (throw (anock.NockException. "Cannot tar an atom."))
79 (try
80 (let [noun (cell noun) [x [y z]] noun]
81 (cond
82 (cell? y) (cell (tar [x y]) (tar [x z]))
83 (zero? y) (fas [z x])
84 (= 1 y) z
85 (= 3 y) (wut (tar [x z]))
86 (= 4 y) (lus (tar [x z]))
87 (= 5 y) (tis (tar [x z]))
88 :else (let [[p q] z]
89 (cond
90 (= 2 y) (tar [(tar [x p]) (tar [x q])])
91 (= 6 y) (tar [x 2 [0 1] 2 [1 (first q) (second q)]
92 [1 0] 2 [1 2 3] [1 0] 4 4 p])
93 (= 7 y) (tar [x 2 p 1 q])
94 (= 8 y) (tar [x 7 [[7 [0 1] p] 0 1] q])
95 (= 9 y) (tar [x 7 q 2 [0 1] 0 p])
96 (= 10 y) (if (cell? p)
97 (tar [x 8 (second p) 7 [0 3] q])
98 (tar [x q]))))))
99 (catch RuntimeException e
100 (throw (anock.NockException. (str "Cannot tar the noun " noun)))))))
102(def nock tar)
104; Some convenience functions
105(defn apply* [f x]
106 (if (and (= 1 (count x)) (coll? (first x)))
107 (apply f x)
108 (f x)))
110(defn bracket
111 "[a b c] -> [a [b c]]"
112 [[a & b :as c]]
113 (let [b (vec b)]
114 (cond
115 (and (noun? a) (apply noun? b)) (vec c)
116 (apply noun? b) (apply vector (bracket a) b)
117 (noun? a) [a (apply* bracket b)]
118 :else [(bracket a) (apply* bracket b)])))
120(defn cell [& nouns]
121 (if (apply atom? nouns)
122 (throw (anock.NockException. "Cannot convert atom to cell."))
123 (apply* bracket nouns)))
124```