blob: 5ba9f0ea0b3caf410172d0149cbb5f11d2454d23 (
plain)
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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
(def list (fn [& args] args))
(def cons (fn [x seq] (. RT (cons x seq))))
(def defn (fn [name & fdecl]
(list 'def name (cons 'fn fdecl))))
(. (the-var defn) (setMacro))
(def defmacro (fn [name & args]
(list 'do
(cons 'defn (cons name args))
(list '. (list 'the-var name) '(setMacro)))))
(. (the-var defmacro) (setMacro))
(defmacro when [test & body]
(list 'if test (cons 'do body)))
(defmacro when-not [test & body]
(list 'if test null (cons 'do body)))
(def t (. RT T))
(defn vector
([] (. clojure.lang.PersistentVector EMPTY))
([& args]
(. clojure.lang.PersistentVector (create args))))
(defn null? [x] (if x null t))
(defn not [x] (if x null t))
(defn first [x] (. RT (first x)))
(defn rest [x] (. RT (rest x)))
(defn second [x] (. RT (second x)))
(defn eql [x y] (. RT (equal x y)))
(defn strcat [x y] (. x (concat y)))
(defn str [x] (. x (toString)))
(defn gensym
([] (thisfn "G__"))
([prefix-string] (. clojure.lang.Symbol (intern (strcat prefix-string (str (. RT (nextID))))))))
(defmacro cond [& clauses]
(when clauses
(list 'if (first clauses)
(second clauses)
(cons 'cond (rest (rest clauses))))))
(defmacro and
([] t)
([x] x)
([x & rest] (list 'if x (cons 'and rest))))
(defmacro or
([] null)
([x] x)
([x & rest]
(let [gor (gensym "or__")]
(list 'let (vector gor x)
(list 'if gor gor (cons 'or rest))))))
(defn apply
([f & args]
(let [spread (fn [arglist]
(cond
(null? arglist) null
(null? (rest arglist)) (first arglist)
:else (cons (first arglist) (thisfn (rest arglist)))))]
(. f (applyTo (spread args))))))
(defn +
([] 0)
([x] x)
([x y] (. Num (add x y)))
([x y & rest]
(apply thisfn (thisfn x y) rest)))
(defn *
([] 1)
([x] x)
([x y] (. Num (multiply x y)))
([x y & rest]
(apply thisfn (thisfn x y) rest)))
(defn /
([x] (thisfn 1 x))
([x y] (. Num (divide x y)))
([x y & rest]
(apply thisfn (thisfn x y) rest)))
(defn -
([x] (. Num (negate x)))
([x y] (. Num (subtract x y)))
([x y & rest]
(apply thisfn (thisfn x y) rest)))
(defn <
([x] t)
([x y] (. Num (lt x y)))
([x y & rest]
(and (thisfn x y) (apply thisfn y rest))))
(defn <=
([x] t)
([x y] (. Num (lte x y)))
([x y & rest]
(and (thisfn x y) (apply thisfn y rest))))
(defn >
([x] t)
([x y] (. Num (gt x y)))
([x y & rest]
(and (thisfn x y) (apply thisfn y rest))))
(defn >=
([x] t)
([x y] (. Num (gte x y)))
([x y & rest]
(and (thisfn x y) (apply thisfn y rest))))
(defn ==
([x] t)
([x y] (. Num (equiv x y)))
([x y & rest]
(and (thisfn x y) (apply thisfn y rest))))
(defn inc [x]
(. x (onePlus)))
(defn dec [x]
(. x (oneMinus)))
(defn pos? [x]
(. Num (plusp x)))
(defn neg? [x]
(. Num (minusp x)))
(defn zero? [x]
(== x 0))
(defn complement [f]
(fn [& args]
(not (apply f args))))
(defn constantly [x]
(fn [& args] x))
(defn identity [x] x)
|
