nendo 0.0.1
Sign up to get free protection for your applications and to get access to all the features.
- data/README +10 -0
- data/bin/nendo +17 -0
- data/lib/init.nnd +486 -0
- data/lib/nendo.rb +1270 -0
- metadata +58 -0
data/README
ADDED
data/bin/nendo
ADDED
@@ -0,0 +1,17 @@
|
|
1
|
+
#!/usr/local/bin/ruby -W0
|
2
|
+
#
|
3
|
+
# Nendo: "Principle of Least Surprise (for Rubyist)"
|
4
|
+
#
|
5
|
+
require 'nendo'
|
6
|
+
|
7
|
+
def main
|
8
|
+
core = Nendo.new()
|
9
|
+
core.loadInitFile
|
10
|
+
if 0 < ARGV.length
|
11
|
+
core.load( ARGV[0] )
|
12
|
+
else
|
13
|
+
core.repl
|
14
|
+
end
|
15
|
+
end
|
16
|
+
|
17
|
+
main
|
data/lib/init.nnd
ADDED
@@ -0,0 +1,486 @@
|
|
1
|
+
;;-*- mode: nendo; syntax: scheme -*-;;
|
2
|
+
|
3
|
+
;; ----------------------------------------
|
4
|
+
;; define
|
5
|
+
;; ----------------------------------------
|
6
|
+
(set! define
|
7
|
+
(macro (arg . body)
|
8
|
+
(if (not (pair? arg))
|
9
|
+
(cons 'set!
|
10
|
+
(cons arg
|
11
|
+
body))
|
12
|
+
(cons 'set!
|
13
|
+
(cons (car arg)
|
14
|
+
(list
|
15
|
+
(cons 'lambda
|
16
|
+
(cons (cdr arg)
|
17
|
+
body))))))))
|
18
|
+
|
19
|
+
;; ----------------------------------------
|
20
|
+
;; car and cdr functions
|
21
|
+
;; ----------------------------------------
|
22
|
+
(define (caar x) (car (car x)))
|
23
|
+
(define (cadr x) (car (cdr x)))
|
24
|
+
(define (cdar x) (cdr (car x)))
|
25
|
+
(define (cddr x) (cdr (cdr x)))
|
26
|
+
(define (caaar x) (car (car (car x))))
|
27
|
+
(define (caadr x) (car (car (cdr x))))
|
28
|
+
(define (cadar x) (car (cdr (car x))))
|
29
|
+
(define (caddr x) (car (cdr (cdr x))))
|
30
|
+
(define (cdaar x) (cdr (car (car x))))
|
31
|
+
(define (cdadr x) (cdr (car (cdr x))))
|
32
|
+
(define (cddar x) (cdr (cdr (car x))))
|
33
|
+
(define (cdddr x) (cdr (cdr (cdr x))))
|
34
|
+
(define (caaaar x) (car (car (car (car x)))))
|
35
|
+
(define (caaadr x) (car (car (car (cdr x)))))
|
36
|
+
(define (caadar x) (car (car (cdr (car x)))))
|
37
|
+
(define (caaddr x) (car (car (cdr (cdr x)))))
|
38
|
+
(define (cadaar x) (car (cdr (car (car x)))))
|
39
|
+
(define (cadadr x) (car (cdr (car (cdr x)))))
|
40
|
+
(define (caddar x) (car (cdr (cdr (car x)))))
|
41
|
+
(define (cadddr x) (car (cdr (cdr (cdr x)))))
|
42
|
+
(define (cdaaar x) (cdr (car (car (car x)))))
|
43
|
+
(define (cdaadr x) (cdr (car (car (cdr x)))))
|
44
|
+
(define (cdadar x) (cdr (car (cdr (car x)))))
|
45
|
+
(define (cdaddr x) (cdr (car (cdr (cdr x)))))
|
46
|
+
(define (cddaar x) (cdr (cdr (car (car x)))))
|
47
|
+
(define (cddadr x) (cdr (cdr (car (cdr x)))))
|
48
|
+
(define (cdddar x) (cdr (cdr (cdr (car x)))))
|
49
|
+
(define (cddddr x) (cdr (cdr (cdr (cdr x)))))
|
50
|
+
|
51
|
+
|
52
|
+
;; ----------------------------------------
|
53
|
+
;; List Utility functions
|
54
|
+
;; ----------------------------------------
|
55
|
+
(define iota range)
|
56
|
+
|
57
|
+
(define (append a b)
|
58
|
+
(define (append-reverse a b)
|
59
|
+
(if (pair? a)
|
60
|
+
(append-reverse (cdr a) (cons (car a) b))
|
61
|
+
b))
|
62
|
+
(append-reverse (reverse a) b))
|
63
|
+
|
64
|
+
;; ----------------------------------------
|
65
|
+
;; Utility functions
|
66
|
+
;; ----------------------------------------
|
67
|
+
(define (even? n) (= (% n 2) 0))
|
68
|
+
(define (odd? n) (not (= (% n 2) 0)))
|
69
|
+
(define (zero? n) (= n 0))
|
70
|
+
(define (positive? n) (> n 0))
|
71
|
+
(define (negative? n) (< n 0))
|
72
|
+
(define (abs n) (if (>= n 0) n (- n)))
|
73
|
+
(define (max . lst)
|
74
|
+
(foldr (lambda (a b) (if (> a b) a b)) (car lst) (cdr lst)))
|
75
|
+
(define (min . lst)
|
76
|
+
(foldr (lambda (a b) (if (< a b) a b)) (car lst) (cdr lst)))
|
77
|
+
(define (succ x) (+ x 1))
|
78
|
+
(define (pred x) (- x 1))
|
79
|
+
(define (nth n lst)
|
80
|
+
(define (nth-iter n index lst)
|
81
|
+
(if (null? lst)
|
82
|
+
nil
|
83
|
+
(if (not (pair? lst))
|
84
|
+
(error "Error: nth got improper list.")
|
85
|
+
(if (eqv? n index)
|
86
|
+
(car lst)
|
87
|
+
(nth-iter n (+ index 1) (cdr lst))))))
|
88
|
+
(nth-iter n 0 lst))
|
89
|
+
(define (first lst) (nth 0 lst))
|
90
|
+
(define (second lst) (nth 1 lst))
|
91
|
+
(define (third lst) (nth 2 lst))
|
92
|
+
(define (fourth lst) (nth 3 lst))
|
93
|
+
(define (fifth lst) (nth 4 lst))
|
94
|
+
(define (sixth lst) (nth 5 lst))
|
95
|
+
(define (seventh lst) (nth 6 lst))
|
96
|
+
(define (eighth lst) (nth 7 lst))
|
97
|
+
(define (ninth lst) (nth 8 lst))
|
98
|
+
(define (tenth lst) (nth 9 lst))
|
99
|
+
|
100
|
+
|
101
|
+
;; ----------------------------------------
|
102
|
+
;; basic forms
|
103
|
+
;; ----------------------------------------
|
104
|
+
(define (macroexpand sexp)
|
105
|
+
(let ((newsexp (macroexpand-1 sexp)))
|
106
|
+
(if (not (equal? sexp newsexp))
|
107
|
+
(macroexpand newsexp)
|
108
|
+
newsexp)))
|
109
|
+
|
110
|
+
(define (feedto)
|
111
|
+
(error "=> (feedto) appeared outside cond or case."))
|
112
|
+
|
113
|
+
(define cond
|
114
|
+
(macro lst
|
115
|
+
(define (case-block elem . elseblock)
|
116
|
+
(let ((condition (if (eq? 'else (car elem))
|
117
|
+
true
|
118
|
+
(car elem)))
|
119
|
+
(body (cdr elem))
|
120
|
+
(tmpsym (gensym)))
|
121
|
+
;;(display "CONDITION") (print condition)
|
122
|
+
;;(display "BODY") (print body)
|
123
|
+
;;(display "TMPSYM") (print tmpsym)
|
124
|
+
(append
|
125
|
+
(if (eq? 'feedto (car body))
|
126
|
+
(cons 'if
|
127
|
+
(list
|
128
|
+
(list 'set! tmpsym condition)
|
129
|
+
(list (cadr body) tmpsym)))
|
130
|
+
(cons 'if
|
131
|
+
(list
|
132
|
+
condition
|
133
|
+
(cons 'begin body))))
|
134
|
+
(if (< 0 (length elseblock))
|
135
|
+
elseblock
|
136
|
+
'()))))
|
137
|
+
|
138
|
+
(define (cond-iter lst)
|
139
|
+
(if (eq? 0 (length lst))
|
140
|
+
'()
|
141
|
+
(if (eq? 1 (length lst))
|
142
|
+
(case-block (car lst) '())
|
143
|
+
(case-block (car lst)
|
144
|
+
(cond-iter (cdr lst))))))
|
145
|
+
|
146
|
+
(cond-iter lst)))
|
147
|
+
|
148
|
+
(define let1
|
149
|
+
(macro (var expr . body)
|
150
|
+
(append
|
151
|
+
(list 'let (list (list var expr)))
|
152
|
+
body)))
|
153
|
+
|
154
|
+
(define or
|
155
|
+
(macro lst
|
156
|
+
(define (or-iter lst)
|
157
|
+
(cond
|
158
|
+
((eq? 0 (length lst))
|
159
|
+
false)
|
160
|
+
((eq? 1 (length lst))
|
161
|
+
(let1 sym (gensym)
|
162
|
+
(list 'let1 sym (car lst)
|
163
|
+
(list 'if sym sym false))))
|
164
|
+
(else
|
165
|
+
(let1 sym (gensym)
|
166
|
+
(list 'let1 sym (car lst)
|
167
|
+
(list 'if sym sym (or-iter (cdr lst))))))))
|
168
|
+
(or-iter lst)))
|
169
|
+
|
170
|
+
(define and
|
171
|
+
(macro lst
|
172
|
+
(define (and-iter lst)
|
173
|
+
(cond
|
174
|
+
((eq? 0 (length lst))
|
175
|
+
true)
|
176
|
+
((eq? 1 (length lst))
|
177
|
+
(car lst))
|
178
|
+
(else
|
179
|
+
(list 'if (list 'not (list 'eq? 'false (car lst)))
|
180
|
+
(and-iter (cdr lst))
|
181
|
+
'false))))
|
182
|
+
(and-iter lst)))
|
183
|
+
|
184
|
+
(define apply
|
185
|
+
(macro (proc . args)
|
186
|
+
(define (strip-quote lst)
|
187
|
+
(if (eq? 'quote (car lst))
|
188
|
+
(cadr lst)
|
189
|
+
lst))
|
190
|
+
(define (apply-iter lst)
|
191
|
+
(cond
|
192
|
+
((eq? 0 (length lst))
|
193
|
+
'())
|
194
|
+
((eq? 1 (length lst))
|
195
|
+
(if (pair? (car lst))
|
196
|
+
(strip-quote (car lst))
|
197
|
+
(error "not a proper list")))
|
198
|
+
(else
|
199
|
+
(append (list (car lst)) (apply-iter (cdr lst))))))
|
200
|
+
(append (list proc) (apply-iter args))))
|
201
|
+
|
202
|
+
|
203
|
+
;; The following quasiquote macro is due to Eric S. Tiedemann. ( Imported from TinyScheme )
|
204
|
+
;; Copyright 1988 by Eric S. Tiedemann; all rights reserved.
|
205
|
+
;;
|
206
|
+
;; Subsequently modified for initialize library for nendo: Kiyoka Nishiyama
|
207
|
+
(define quasiquote
|
208
|
+
(macro (l)
|
209
|
+
(define (mcons f l r)
|
210
|
+
(if (and (pair? r)
|
211
|
+
(eq? (car r) 'quote)
|
212
|
+
(eq? (car (cdr r)) (cdr f))
|
213
|
+
(pair? l)
|
214
|
+
(eq? (car l) 'quote)
|
215
|
+
(eq? (car (cdr l)) (car f)))
|
216
|
+
(if (or (procedure? f) (number? f) (string? f))
|
217
|
+
f
|
218
|
+
(list 'quote f))
|
219
|
+
(list 'cons l r)))
|
220
|
+
(define (mappend f l r)
|
221
|
+
(if (or (null? (cdr f))
|
222
|
+
(and (pair? r)
|
223
|
+
(eq? (car r) 'quote)
|
224
|
+
(eq? (car (cdr r)) '())))
|
225
|
+
l
|
226
|
+
(list 'append l r)))
|
227
|
+
(define (foo level form)
|
228
|
+
(cond ((not (pair? form))
|
229
|
+
(if (or (procedure? form) (number? form) (string? form))
|
230
|
+
form
|
231
|
+
(list 'quote form))
|
232
|
+
)
|
233
|
+
((eq? 'quasiquote (car form))
|
234
|
+
(mcons form ''quasiquote (foo (+ level 1) (cdr form))))
|
235
|
+
(else (if (zero? level)
|
236
|
+
(cond ((eq? (car form) 'unquote) (car (cdr form)))
|
237
|
+
((eq? (car form) 'unquote-splicing)
|
238
|
+
(error "Unquote-splicing wasn't in a list:"
|
239
|
+
form))
|
240
|
+
((and (pair? (car form))
|
241
|
+
(eq? (car (car form)) 'unquote-splicing))
|
242
|
+
(mappend form (car (cdr (car form)))
|
243
|
+
(foo level (cdr form))))
|
244
|
+
(else (mcons form (foo level (car form))
|
245
|
+
(foo level (cdr form)))))
|
246
|
+
(cond ((eq? (car form) 'unquote)
|
247
|
+
(mcons form ''unquote (foo (- level 1)
|
248
|
+
(cdr form))))
|
249
|
+
((eq? (car form) 'unquote-splicing)
|
250
|
+
(mcons form ''unquote-splicing
|
251
|
+
(foo (- level 1) (cdr form))))
|
252
|
+
(else (mcons form (foo level (car form))
|
253
|
+
(foo level (cdr form)))))))))
|
254
|
+
(foo 0 l)))
|
255
|
+
|
256
|
+
(define unquote
|
257
|
+
(macro (lst)
|
258
|
+
(error "unquote appeared outside quasiquote")))
|
259
|
+
|
260
|
+
(define unquote-splicing
|
261
|
+
(macro (lst)
|
262
|
+
(error "unquote-splicing appeared outside quasiquote")))
|
263
|
+
|
264
|
+
|
265
|
+
(define when
|
266
|
+
(macro form
|
267
|
+
`(if ,(car form) (begin ,@(cdr form)))))
|
268
|
+
|
269
|
+
(define unless
|
270
|
+
(macro form
|
271
|
+
`(if (not ,(car form)) (begin ,@(cdr form)))))
|
272
|
+
|
273
|
+
(define while
|
274
|
+
(macro form
|
275
|
+
(let1 sym (gensym)
|
276
|
+
`(begin
|
277
|
+
(define ,sym
|
278
|
+
(lambda ()
|
279
|
+
(if ,(car form)
|
280
|
+
(begin ,@(cdr form)
|
281
|
+
(,sym)))))
|
282
|
+
(,sym)))))
|
283
|
+
|
284
|
+
(define until
|
285
|
+
(macro form
|
286
|
+
`(while (not ,(car form))
|
287
|
+
,@(cdr form))))
|
288
|
+
|
289
|
+
|
290
|
+
;; ----------------------------------------
|
291
|
+
;; List utilities imported from TinyScheme
|
292
|
+
;; ----------------------------------------
|
293
|
+
;; generic-member
|
294
|
+
(define (generic-member cmp obj lst)
|
295
|
+
(cond
|
296
|
+
((null? lst) false)
|
297
|
+
((cmp obj (car lst)) lst)
|
298
|
+
(else (generic-member cmp obj (cdr lst)))))
|
299
|
+
|
300
|
+
(define (memq obj lst)
|
301
|
+
(generic-member eq? obj lst))
|
302
|
+
(define (memv obj lst)
|
303
|
+
(generic-member eqv? obj lst))
|
304
|
+
(define (member obj lst)
|
305
|
+
(generic-member equal? obj lst))
|
306
|
+
|
307
|
+
;; generic-assoc
|
308
|
+
(define (generic-assoc cmp obj alst)
|
309
|
+
(cond
|
310
|
+
((null? alst) false)
|
311
|
+
((cmp obj (caar alst)) (car alst))
|
312
|
+
(else (generic-assoc cmp obj (cdr alst)))))
|
313
|
+
|
314
|
+
(define (assq obj alst)
|
315
|
+
(generic-assoc eq? obj alst))
|
316
|
+
(define (assv obj alst)
|
317
|
+
(generic-assoc eqv? obj alst))
|
318
|
+
(define (assoc obj alst)
|
319
|
+
(generic-assoc equal? obj alst))
|
320
|
+
|
321
|
+
(define (acons x y z) (cons (cons x y) z))
|
322
|
+
|
323
|
+
(define (assq-ref obj alst)
|
324
|
+
(cond ((assq obj alst) => cdr)
|
325
|
+
(else nil)))
|
326
|
+
(define (assv-ref obj alst)
|
327
|
+
(cond ((assv obj alst) => cdr)
|
328
|
+
(else nil)))
|
329
|
+
(define (assoc-ref obj alst)
|
330
|
+
(cond ((assoc obj alst) => cdr)
|
331
|
+
(else nil)))
|
332
|
+
|
333
|
+
|
334
|
+
;; ----------------------------------------
|
335
|
+
;; Higher-order functions
|
336
|
+
;; ----------------------------------------
|
337
|
+
(define (map pred lst)
|
338
|
+
(if (null? lst)
|
339
|
+
'()
|
340
|
+
(cons
|
341
|
+
(pred (car lst))
|
342
|
+
(map pred (cdr lst)))))
|
343
|
+
(define for-each map)
|
344
|
+
|
345
|
+
(define (filter pred lst)
|
346
|
+
(if (null? lst)
|
347
|
+
'()
|
348
|
+
(let1 result (pred (car lst))
|
349
|
+
(if result
|
350
|
+
(cons
|
351
|
+
result
|
352
|
+
(filter pred (cdr lst)))
|
353
|
+
(filter pred (cdr lst))))))
|
354
|
+
|
355
|
+
(define (filter-map pred lst)
|
356
|
+
(if (null? lst)
|
357
|
+
'()
|
358
|
+
(if (pred (car lst))
|
359
|
+
(cons
|
360
|
+
(car lst)
|
361
|
+
(filter-map pred (cdr lst)))
|
362
|
+
(filter-map pred (cdr lst)))))
|
363
|
+
|
364
|
+
|
365
|
+
;; ----------------------------------------
|
366
|
+
;; other forms
|
367
|
+
;; ----------------------------------------
|
368
|
+
(define case
|
369
|
+
(macro (cond-exp . body)
|
370
|
+
(define (case-block val . elem)
|
371
|
+
(let1 block (car elem)
|
372
|
+
(let ((cond-vals (car block))
|
373
|
+
(body (cdr block)))
|
374
|
+
(let1 v
|
375
|
+
(if (eq? 'else cond-vals)
|
376
|
+
cond-vals
|
377
|
+
(cons 'or
|
378
|
+
(map
|
379
|
+
(lambda (x)
|
380
|
+
`(eqv? ,x ,val))
|
381
|
+
cond-vals)))
|
382
|
+
`((,v
|
383
|
+
,@body))))))
|
384
|
+
|
385
|
+
(define (case-iter val lst)
|
386
|
+
(cond
|
387
|
+
((eq? 0 (length lst))
|
388
|
+
'())
|
389
|
+
((eq? 1 (length lst))
|
390
|
+
(case-block val (car lst)))
|
391
|
+
(else
|
392
|
+
(append (case-block val (car lst))
|
393
|
+
(case-iter val (cdr lst))))))
|
394
|
+
|
395
|
+
(let1 sym (gensym)
|
396
|
+
`(let1 ,sym ,cond-exp
|
397
|
+
(cond
|
398
|
+
,@(case-iter sym body))))))
|
399
|
+
|
400
|
+
|
401
|
+
(define let*
|
402
|
+
(macro (exps . body)
|
403
|
+
(define (let*-expand rest body)
|
404
|
+
(case (length rest)
|
405
|
+
((0)
|
406
|
+
'())
|
407
|
+
((1)
|
408
|
+
`(let (,(car rest))
|
409
|
+
,@body))
|
410
|
+
(else
|
411
|
+
`(let (,(car rest))
|
412
|
+
,(let*-expand (cdr rest) body)))))
|
413
|
+
|
414
|
+
(let*-expand exps body)))
|
415
|
+
|
416
|
+
|
417
|
+
;; ----------------------------------------
|
418
|
+
;; for Ruby interop
|
419
|
+
;; ----------------------------------------
|
420
|
+
;; dot_operator
|
421
|
+
(define dot-operator
|
422
|
+
(macro lst
|
423
|
+
(define (dot-operator-iter lst)
|
424
|
+
(cond
|
425
|
+
((null? lst)
|
426
|
+
'())
|
427
|
+
((pair? lst)
|
428
|
+
(if (eq? 'dot-operator (car lst))
|
429
|
+
(intern
|
430
|
+
(string-join
|
431
|
+
(map
|
432
|
+
(lambda (x)
|
433
|
+
(if (pair? x)
|
434
|
+
(to-s (dot-operator-iter x))
|
435
|
+
(if (symbol? x)
|
436
|
+
(to-s x)
|
437
|
+
(error (sprintf "dot-operator requires symbol, but got %s" x)))))
|
438
|
+
(cdr lst))
|
439
|
+
"."))
|
440
|
+
(error "dot-operator requires symbol or (. symbol symbol) form.")))
|
441
|
+
(else
|
442
|
+
lst)))
|
443
|
+
|
444
|
+
(cond
|
445
|
+
((eq? 0 (length lst))
|
446
|
+
(error ". operator requires argument"))
|
447
|
+
((and (eq? 1 (length lst))
|
448
|
+
(symbol? (car lst)))
|
449
|
+
(intern (+ "." (to-s (car lst)))))
|
450
|
+
(else
|
451
|
+
((dot-operator-iter
|
452
|
+
(cons 'dot-operator lst)))))))
|
453
|
+
|
454
|
+
(define (with-open filename pred . lst)
|
455
|
+
(let1 len (length lst)
|
456
|
+
(let1 f (cond
|
457
|
+
((= 0 len)
|
458
|
+
(.open filename))
|
459
|
+
((< 0 len)
|
460
|
+
(.open filename (car lst)))
|
461
|
+
(else
|
462
|
+
(error "with-open requires 2 or 3 arguments.")))
|
463
|
+
(let1 result (pred f)
|
464
|
+
(f.close)
|
465
|
+
result))))
|
466
|
+
|
467
|
+
|
468
|
+
;; ----------------------------------------
|
469
|
+
;; List library functions
|
470
|
+
;; ----------------------------------------
|
471
|
+
(define (last-pair x)
|
472
|
+
(if (pair? (cdr x))
|
473
|
+
(last-pair (cdr x))
|
474
|
+
x))
|
475
|
+
|
476
|
+
|
477
|
+
;; ----------------------------------------
|
478
|
+
;; Utility function for testing
|
479
|
+
;; ----------------------------------------
|
480
|
+
;; pass through the argument value as return value.
|
481
|
+
(define (pass x) x)
|
482
|
+
|
483
|
+
;; ruby's p like function.
|
484
|
+
(define (p x)
|
485
|
+
(printf "%s\n" x)
|
486
|
+
x)
|