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