yhara-tickets 0.1.0
This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
- data/README.rdoc +20 -0
- data/TODO +61 -0
- data/bin/tickets-server +101 -0
- data/db/migrate/001_create_tickets.rb +14 -0
- data/db/migrate/002_add_deleted_to_tickets.rb +13 -0
- data/db/migrate/003_add_timeouted_to_tickets.rb +13 -0
- data/dot.tickets.conf.sample +9 -0
- data/model/ticket.rb +36 -0
- data/public/biwascheme/MIT-LICENSE.txt +20 -0
- data/public/biwascheme/README +38 -0
- data/public/biwascheme/lib/biwascheme.js +101 -0
- data/public/biwascheme/lib/extra_lib.js +513 -0
- data/public/biwascheme/lib/io.js +326 -0
- data/public/biwascheme/lib/prototype.js +4320 -0
- data/public/biwascheme/lib/r6rs_lib.js +2388 -0
- data/public/biwascheme/lib/stackbase.js +1798 -0
- data/public/biwascheme/lib/webscheme_lib.js +762 -0
- data/public/js/builder.js +136 -0
- data/public/js/controls.js +965 -0
- data/public/js/dragdrop.js +975 -0
- data/public/js/effects.js +1130 -0
- data/public/js/scriptaculous.js +60 -0
- data/public/js/slider.js +275 -0
- data/public/js/sound.js +55 -0
- data/public/js/unittest.js +568 -0
- data/public/scm/main.scm +65 -0
- data/public/scm/ticket.scm +98 -0
- data/tickets.gemspec +41 -0
- data/view/index.xhtml +61 -0
- metadata +121 -0
@@ -0,0 +1,2388 @@
|
|
1
|
+
//
|
2
|
+
// R6RS Base library
|
3
|
+
//
|
4
|
+
function dump(){}
|
5
|
+
|
6
|
+
if( typeof(BiwaScheme)!='object' ) BiwaScheme={}; with(BiwaScheme) {
|
7
|
+
/* --------------------------------------- namespace webscheme */
|
8
|
+
|
9
|
+
///
|
10
|
+
/// Utility functions
|
11
|
+
///
|
12
|
+
|
13
|
+
//
|
14
|
+
// Iterator - external iterator
|
15
|
+
//
|
16
|
+
BiwaScheme.Iterator = {
|
17
|
+
ForArray: Class.create({
|
18
|
+
initialize: function(arr){
|
19
|
+
this.arr = arr;
|
20
|
+
this.i = 0;
|
21
|
+
},
|
22
|
+
has_next: function(){
|
23
|
+
return this.i < this.arr.length;
|
24
|
+
},
|
25
|
+
next: function(){
|
26
|
+
return this.arr[this.i++];
|
27
|
+
}
|
28
|
+
}),
|
29
|
+
ForString: Class.create({
|
30
|
+
initialize: function(str){
|
31
|
+
this.str = str;
|
32
|
+
this.i = 0;
|
33
|
+
},
|
34
|
+
has_next: function(){
|
35
|
+
return this.i < this.str.length;
|
36
|
+
},
|
37
|
+
next: function(){
|
38
|
+
return Char.get(this.str.charAt(this.i++));
|
39
|
+
}
|
40
|
+
}),
|
41
|
+
ForList: Class.create({
|
42
|
+
initialize: function(ls){
|
43
|
+
this.ls = ls;
|
44
|
+
},
|
45
|
+
has_next: function(){
|
46
|
+
return (this.ls instanceof Pair) && this.ls != nil;
|
47
|
+
},
|
48
|
+
next: function(){
|
49
|
+
var pair = this.ls;
|
50
|
+
this.ls = this.ls.cdr;
|
51
|
+
return pair;
|
52
|
+
}
|
53
|
+
}),
|
54
|
+
ForMulti: Class.create({
|
55
|
+
initialize: function(objs){
|
56
|
+
this.objs = objs;
|
57
|
+
this.size = objs.length;
|
58
|
+
this.iterators = objs.map(function(x){
|
59
|
+
return Iterator.of(x);
|
60
|
+
})
|
61
|
+
},
|
62
|
+
has_next: function(){
|
63
|
+
for(var i=0; i<this.size; i++)
|
64
|
+
if(!this.iterators[i].has_next())
|
65
|
+
return false;
|
66
|
+
|
67
|
+
return true;
|
68
|
+
},
|
69
|
+
next: function(){
|
70
|
+
return this.iterators.map(function(ite){
|
71
|
+
return ite.next();
|
72
|
+
})
|
73
|
+
}
|
74
|
+
}),
|
75
|
+
of: function(obj){
|
76
|
+
switch(true){
|
77
|
+
case (obj instanceof Array):
|
78
|
+
return new this.ForArray(obj);
|
79
|
+
case (typeof(obj) == "string"):
|
80
|
+
return new this.ForString(obj);
|
81
|
+
case (obj instanceof Pair):
|
82
|
+
return new this.ForList(obj);
|
83
|
+
default:
|
84
|
+
throw new Bug("Iterator.of: unknown class: "+Object.inspect(obj));
|
85
|
+
}
|
86
|
+
}
|
87
|
+
}
|
88
|
+
|
89
|
+
//
|
90
|
+
// Call.foreach - wrapper of Call
|
91
|
+
//
|
92
|
+
BiwaScheme.Call.default_callbacks = {
|
93
|
+
call: function(x){ return new Call(this.proc, [x]) },
|
94
|
+
result: Prototype.emptyFunction,
|
95
|
+
finish: Prototype.emptyFunction
|
96
|
+
}
|
97
|
+
BiwaScheme.Call.foreach = function(obj, callbacks, is_multi){
|
98
|
+
is_multi || (is_multi = false);
|
99
|
+
["call", "result", "finish"].each(function(key){
|
100
|
+
if(!callbacks[key])
|
101
|
+
callbacks[key] = Call.default_callbacks[key];
|
102
|
+
})
|
103
|
+
|
104
|
+
var iterator = null;
|
105
|
+
var x = null;
|
106
|
+
|
107
|
+
var loop = function(ar){
|
108
|
+
if(iterator){
|
109
|
+
var ret = callbacks["result"](ar[0], x);
|
110
|
+
if(ret !== undefined) return ret;
|
111
|
+
}
|
112
|
+
else{
|
113
|
+
if(is_multi)
|
114
|
+
iterator = new Iterator.ForMulti(obj);
|
115
|
+
else
|
116
|
+
iterator = Iterator.of(obj);
|
117
|
+
}
|
118
|
+
|
119
|
+
if(!iterator.has_next())
|
120
|
+
return callbacks["finish"]();
|
121
|
+
else{
|
122
|
+
x = iterator.next();
|
123
|
+
var result = callbacks["call"](x);
|
124
|
+
result.after = loop;
|
125
|
+
return result;
|
126
|
+
}
|
127
|
+
}
|
128
|
+
return loop(null);
|
129
|
+
}
|
130
|
+
BiwaScheme.Call.multi_foreach = function(obj, callbacks){
|
131
|
+
return Call.foreach(obj, callbacks, true);
|
132
|
+
}
|
133
|
+
|
134
|
+
//
|
135
|
+
// define_*func - define library functions
|
136
|
+
//
|
137
|
+
BiwaScheme.check_arity = function(len, min, max){
|
138
|
+
var fname = arguments.callee.caller
|
139
|
+
? arguments.callee.caller.fname
|
140
|
+
: "";
|
141
|
+
if(len < min){
|
142
|
+
if(max && max == min)
|
143
|
+
throw new Error(fname+": wrong number of arguments (expected: "+min+" got: "+len+")");
|
144
|
+
else
|
145
|
+
throw new Error(fname+": too few arguments (at least: "+min+" got: "+len+")");
|
146
|
+
}
|
147
|
+
else if(max && max < len)
|
148
|
+
throw new Error(fname+": too many arguments (at most: "+max+" got: "+len+")");
|
149
|
+
}
|
150
|
+
BiwaScheme.define_libfunc = function(fname, min, max, func){
|
151
|
+
var f = function(ar, intp){
|
152
|
+
check_arity(ar.length, min, max);
|
153
|
+
var result = func(ar, intp);
|
154
|
+
return (result === undefined) ? BiwaScheme.undef : result;
|
155
|
+
};
|
156
|
+
|
157
|
+
func["fname"] = fname; // for assert_*
|
158
|
+
f["fname"] = fname; // for check_arity
|
159
|
+
f["inspect"] = function(){ return this.fname; }
|
160
|
+
CoreEnv[fname] = f;
|
161
|
+
}
|
162
|
+
BiwaScheme.define_syntax = function(name, func){
|
163
|
+
TopEnv[name] = new Syntax(func);
|
164
|
+
}
|
165
|
+
BiwaScheme.define_scmfunc = function(fname, min, max, str){
|
166
|
+
(new Interpreter).evaluate("(define "+fname+" "+str+"\n)");
|
167
|
+
}
|
168
|
+
|
169
|
+
define_scmfunc("map+", 2, null,
|
170
|
+
"(lambda (proc ls) (if (null? ls) ls (cons (proc (car ls)) (map proc (cdr ls)))))");
|
171
|
+
|
172
|
+
//
|
173
|
+
// assert_* : type assertion
|
174
|
+
//
|
175
|
+
var make_assert = function(check){
|
176
|
+
return function(/*args*/){
|
177
|
+
var fname = arguments.callee.caller
|
178
|
+
? arguments.callee.caller.fname
|
179
|
+
: "";
|
180
|
+
check.apply(this, [fname].concat($A(arguments)));
|
181
|
+
}
|
182
|
+
}
|
183
|
+
var make_simple_assert = function(type, test){
|
184
|
+
return make_assert(function(fname, obj){
|
185
|
+
if(!test(obj))
|
186
|
+
throw new Error(fname + ": " + type + " required, but got " + to_write(obj));
|
187
|
+
})
|
188
|
+
}
|
189
|
+
var assert_number = make_simple_assert("number", function(obj){
|
190
|
+
return typeof(obj) == 'number' || (obj instanceof Complex);
|
191
|
+
})
|
192
|
+
var assert_integer = make_simple_assert("integer", function(obj){
|
193
|
+
return typeof(obj) == 'number' && (obj % 1 == 0)
|
194
|
+
})
|
195
|
+
var assert_symbol = make_simple_assert("symbol", function(obj){
|
196
|
+
return obj instanceof Symbol;
|
197
|
+
})
|
198
|
+
var assert_string = make_simple_assert("string", function(obj){
|
199
|
+
return typeof(obj) == 'string';
|
200
|
+
})
|
201
|
+
var assert_vector = make_simple_assert("vector", function(obj){
|
202
|
+
return (obj instanceof Array) && (obj.closure_p !== true);
|
203
|
+
})
|
204
|
+
var assert_pair = make_simple_assert("pair", function(obj){
|
205
|
+
return obj instanceof Pair;
|
206
|
+
})
|
207
|
+
var assert_char = make_simple_assert("character", function(obj){
|
208
|
+
return obj instanceof Char;
|
209
|
+
})
|
210
|
+
var assert_port = make_simple_assert("port", function(obj){
|
211
|
+
return obj instanceof Port;
|
212
|
+
})
|
213
|
+
var assert_date = make_simple_assert("date", function(obj){
|
214
|
+
return obj instanceof Date;
|
215
|
+
})
|
216
|
+
var assert_hashtable = make_simple_assert("hashtable", function(obj){
|
217
|
+
return obj instanceof Hash;
|
218
|
+
})
|
219
|
+
var assert_function = make_simple_assert("JavaScript function", function(obj){
|
220
|
+
return (obj instanceof Function) || (typeof obj == 'function');
|
221
|
+
})
|
222
|
+
var assert_between = make_assert(function(fname, obj, from, to){
|
223
|
+
if( typeof(obj) != 'number' || obj != Math.round(obj) )
|
224
|
+
throw new Error(fname + ": " + "number required, but got " + to_write(obj));
|
225
|
+
|
226
|
+
if( obj < from || to < obj )
|
227
|
+
throw new Error(fname + ": " + "number must be between " +
|
228
|
+
from + " and " + to + ", but got " + to_write(obj));
|
229
|
+
})
|
230
|
+
var assert = make_assert(function(fname, test){
|
231
|
+
})
|
232
|
+
|
233
|
+
///
|
234
|
+
/// Classes
|
235
|
+
///
|
236
|
+
|
237
|
+
BiwaScheme.Complex = Class.create({
|
238
|
+
initialize: function(real, imag){
|
239
|
+
this.real = real;
|
240
|
+
this.imag = imag;
|
241
|
+
},
|
242
|
+
magnitude: function(){
|
243
|
+
return Math.sqrt(z.real * z.real + z.imag * z.imag);
|
244
|
+
},
|
245
|
+
angle: function(){
|
246
|
+
return Math.acos(this.real / this.magnitude());
|
247
|
+
}
|
248
|
+
})
|
249
|
+
BiwaScheme.Complex.from_polar = function(r, theta){
|
250
|
+
var real = r * Math.cos(theta);
|
251
|
+
var imag = r * Math.sin(theta);
|
252
|
+
return new Complex(real, imag);
|
253
|
+
}
|
254
|
+
BiwaScheme.Complex.assure = function(num){
|
255
|
+
if(num instanceof Complex)
|
256
|
+
return num
|
257
|
+
else
|
258
|
+
return new Complex(num, 0);
|
259
|
+
}
|
260
|
+
|
261
|
+
BiwaScheme.Rational = Class.create({
|
262
|
+
initialize: function(numerator, denominator){
|
263
|
+
this.numerator = numerator;
|
264
|
+
this.denominator = denominator;
|
265
|
+
}
|
266
|
+
})
|
267
|
+
|
268
|
+
///
|
269
|
+
/// R6RS Base library
|
270
|
+
///
|
271
|
+
|
272
|
+
//
|
273
|
+
// 11.4 Expressions
|
274
|
+
//
|
275
|
+
// 11.4.1 Quotation
|
276
|
+
//(quote)
|
277
|
+
// 11.4.2 Procedures
|
278
|
+
//(lambda)
|
279
|
+
// 11.4.3 Conditionaar
|
280
|
+
//(if)
|
281
|
+
// 11.4.4 Assignments
|
282
|
+
//(set!)
|
283
|
+
// 11.4.5 Derived conditionaar
|
284
|
+
|
285
|
+
define_syntax("cond", function(x){
|
286
|
+
var clauses = x.cdr;
|
287
|
+
if(!(clauses instanceof Pair) || clauses === nil){
|
288
|
+
throw new Error("malformed cond: cond needs list but got " +
|
289
|
+
to_write_ss(clauses));
|
290
|
+
}
|
291
|
+
// TODO: assert that clauses is a proper list
|
292
|
+
|
293
|
+
var ret = null;
|
294
|
+
clauses.to_array().reverse().each(function(clause){
|
295
|
+
if(!(clause instanceof Pair)){
|
296
|
+
throw new Error("bad clause in cond: " + to_write_ss(clause));
|
297
|
+
}
|
298
|
+
|
299
|
+
if(clause.car === Sym("else")){
|
300
|
+
if(ret !== null){
|
301
|
+
throw new Error("'else' clause of cond followed by more clauses: " +
|
302
|
+
to_write_ss(clauses));
|
303
|
+
}
|
304
|
+
else if(clause.cdr === nil){
|
305
|
+
// pattern A: (else)
|
306
|
+
// -> #f ; not specified in R6RS...?
|
307
|
+
ret = false;
|
308
|
+
}
|
309
|
+
else if(clause.cdr.cdr === nil){
|
310
|
+
// pattern B: (else expr)
|
311
|
+
// -> expr
|
312
|
+
ret = clause.cdr.car;
|
313
|
+
}
|
314
|
+
else{
|
315
|
+
// pattern C: (else expr ...)
|
316
|
+
// -> (begin expr ...)
|
317
|
+
ret = new Pair(Sym("begin"), clause.cdr);
|
318
|
+
}
|
319
|
+
}
|
320
|
+
else if(ret === null){
|
321
|
+
// pattern D: no else clause
|
322
|
+
// -> #<undef>
|
323
|
+
ret = BiwaScheme.undef;
|
324
|
+
}
|
325
|
+
else{
|
326
|
+
var test = clause.car;
|
327
|
+
if(clause.cdr === nil){
|
328
|
+
// pattern 1: (test)
|
329
|
+
// -> (or test ret)
|
330
|
+
ret = [Sym("or"), test, ret].to_list();
|
331
|
+
}
|
332
|
+
else if (clause.cdr.cdr === nil){
|
333
|
+
// pattern 2: (test expr)
|
334
|
+
// -> (if test expr ret)
|
335
|
+
ret = [Sym("if"), test, clause.cdr.car, ret].to_list();
|
336
|
+
}
|
337
|
+
else if(clause.cdr.car === Sym("=>")){
|
338
|
+
// pattern 3: (test => expr)
|
339
|
+
// -> (let ((#<gensym1> test))
|
340
|
+
// (if test (expr #<gensym1>) ret))
|
341
|
+
var test = clause.car, expr = clause.cdr.cdr.car;
|
342
|
+
var tmp_sym = BiwaScheme.gensym();
|
343
|
+
|
344
|
+
ret = List(Sym("let"),
|
345
|
+
List( List(tmp_sym, test) ),
|
346
|
+
List(Sym("if"), test, List(expr, tmp_sym), ret));
|
347
|
+
}
|
348
|
+
else{
|
349
|
+
// pattern 4: (test expr ...)
|
350
|
+
// -> (if test (begin expr ...) ret)
|
351
|
+
ret = [Sym("if"), test,
|
352
|
+
new Pair(Sym("begin"), clause.cdr),
|
353
|
+
ret].to_list();
|
354
|
+
}
|
355
|
+
}
|
356
|
+
});
|
357
|
+
return ret;
|
358
|
+
});
|
359
|
+
|
360
|
+
define_syntax("case", function(x){
|
361
|
+
var tmp_sym = BiwaScheme.gensym();
|
362
|
+
|
363
|
+
if(x.cdr === nil){
|
364
|
+
throw new Error("case: at least one clause is required");
|
365
|
+
}
|
366
|
+
else if(!(x.cdr instanceof Pair)){
|
367
|
+
throw new Error("case: proper list is required");
|
368
|
+
}
|
369
|
+
else{
|
370
|
+
// (case key clauses ....)
|
371
|
+
// -> (let ((#<gensym1> key))
|
372
|
+
var key = x.cdr.car;
|
373
|
+
var clauses = x.cdr.cdr;
|
374
|
+
|
375
|
+
var ret = undefined;
|
376
|
+
clauses.to_array().reverse().each(function(clause){
|
377
|
+
if(clause.car === Sym("else")){
|
378
|
+
// pattern 0: (else expr ...)
|
379
|
+
// -> (begin expr ...)
|
380
|
+
if(ret === undefined){
|
381
|
+
ret = new Pair(Sym("begin"), clause.cdr);
|
382
|
+
}
|
383
|
+
else{
|
384
|
+
throw new Error("case: 'else' clause followed by more clauses: " +
|
385
|
+
to_write_ss(clauses));
|
386
|
+
}
|
387
|
+
}
|
388
|
+
else{
|
389
|
+
// pattern 1: ((datum ...) expr ...)
|
390
|
+
// -> (if (or (eqv? key (quote d1)) ...) (begin expr ...) ret)
|
391
|
+
ret = [
|
392
|
+
Sym("if"),
|
393
|
+
new Pair(Sym("or"), clause.car.to_array().map(function(d){
|
394
|
+
return [Sym("eqv?"),
|
395
|
+
tmp_sym,
|
396
|
+
[Sym("quote"), d].to_list() ].to_list();
|
397
|
+
}).to_list()),
|
398
|
+
new Pair(Sym("begin"), clause.cdr),
|
399
|
+
ret
|
400
|
+
].to_list();
|
401
|
+
}
|
402
|
+
});
|
403
|
+
return new Pair(Sym("let1"),
|
404
|
+
new Pair(tmp_sym,
|
405
|
+
new Pair(key,
|
406
|
+
new Pair(ret, nil))));
|
407
|
+
}
|
408
|
+
});
|
409
|
+
|
410
|
+
define_syntax("and", function(x){
|
411
|
+
// (and a b c) => (if a (if b c #f) #f)
|
412
|
+
//todo: check improper list
|
413
|
+
if(x.cdr == nil) return true;
|
414
|
+
|
415
|
+
var objs = x.cdr.to_array();
|
416
|
+
var i = objs.length-1;
|
417
|
+
var t = objs[i];
|
418
|
+
for(i=i-1; i>=0; i--)
|
419
|
+
t = [Sym("if"), objs[i], t, false].to_list();
|
420
|
+
|
421
|
+
return t;
|
422
|
+
})
|
423
|
+
|
424
|
+
define_syntax("or", function(x){
|
425
|
+
// (or a b c) => (if a a (if b b (if c c #f)))
|
426
|
+
//todo: check improper list
|
427
|
+
|
428
|
+
var objs = x.cdr.to_array()
|
429
|
+
var f = false;
|
430
|
+
for(var i=objs.length-1; i>=0; i--)
|
431
|
+
f = [Sym("if"), objs[i], objs[i], f].to_list();
|
432
|
+
|
433
|
+
return f;
|
434
|
+
})
|
435
|
+
|
436
|
+
// 11.4.6 Binding constructs
|
437
|
+
define_syntax("let", function(x){
|
438
|
+
//(let ((a 1) (b 2)) (print a) (+ a b))
|
439
|
+
//=> ((lambda (a b) (print a) (+ a b)) 1 2)
|
440
|
+
var name = null;
|
441
|
+
if (x.cdr.car instanceof Symbol) {
|
442
|
+
name = x.cdr.car;
|
443
|
+
x = x.cdr;
|
444
|
+
}
|
445
|
+
var binds = x.cdr.car, body = x.cdr.cdr;
|
446
|
+
|
447
|
+
if(!(binds instanceof Pair))
|
448
|
+
throw new Error("let: need a pair for bindings: got "+to_write(binds));
|
449
|
+
|
450
|
+
var vars = nil, vals = nil;
|
451
|
+
for(var p=binds; p instanceof Pair && p!=nil; p=p.cdr){
|
452
|
+
vars = new Pair(p.car.car, vars);
|
453
|
+
vals = new Pair(p.car.cdr.car, vals);
|
454
|
+
}
|
455
|
+
|
456
|
+
var lambda = null;
|
457
|
+
if (name) {
|
458
|
+
// (let loop ((a 1) (b 2)) body ..)
|
459
|
+
//=> (letrec ((loop (lambda (a b) body ..))) (loop 1 2))
|
460
|
+
vars = vars.to_array().reverse().to_list();
|
461
|
+
vals = vals.to_array().reverse().to_list();
|
462
|
+
|
463
|
+
var body_lambda = new Pair(Sym("lambda"), new Pair(vars, body));
|
464
|
+
var init_call = new Pair(name, vals);
|
465
|
+
|
466
|
+
lambda = [Sym("letrec"),
|
467
|
+
new Pair([name, body_lambda].to_list(), nil),
|
468
|
+
init_call
|
469
|
+
].to_list();
|
470
|
+
}
|
471
|
+
else {
|
472
|
+
lambda = new Pair(new Pair(Sym("lambda"),
|
473
|
+
new Pair(vars, body)),
|
474
|
+
vals);
|
475
|
+
}
|
476
|
+
return lambda;
|
477
|
+
})
|
478
|
+
|
479
|
+
define_syntax("let*", function(x){
|
480
|
+
//(let* ((a 1) (b a)) (print a) (+ a b))
|
481
|
+
//-> (let ((a 1))
|
482
|
+
// (let ((b a)) (print a) (+ a b)))
|
483
|
+
var binds = x.cdr.car, body = x.cdr.cdr;
|
484
|
+
|
485
|
+
if(!(binds instanceof Pair))
|
486
|
+
throw new Error("let*: need a pair for bindings: got "+to_write(binds));
|
487
|
+
|
488
|
+
var ret = null;
|
489
|
+
binds.to_array().reverse().each(function(bind){
|
490
|
+
ret = new Pair(Sym("let"),
|
491
|
+
new Pair(new Pair(bind, nil),
|
492
|
+
ret == null ? body : new Pair(ret, nil)));
|
493
|
+
})
|
494
|
+
return ret;
|
495
|
+
})
|
496
|
+
|
497
|
+
var expand_letrec_star = function(x){
|
498
|
+
var binds = x.cdr.car, body = x.cdr.cdr;
|
499
|
+
|
500
|
+
if(!(binds instanceof Pair))
|
501
|
+
throw new Error("letrec*: need a pair for bindings: got "+to_write(binds));
|
502
|
+
|
503
|
+
var ret = body;
|
504
|
+
binds.to_array().reverse().each(function(bind){
|
505
|
+
ret = new Pair(new Pair(Sym("set!"), bind),
|
506
|
+
ret);
|
507
|
+
})
|
508
|
+
var letbody = nil;
|
509
|
+
binds.to_array().reverse().each(function(bind){
|
510
|
+
letbody = new Pair(new Pair(bind.car,
|
511
|
+
new Pair(BiwaScheme.undef, nil)),
|
512
|
+
letbody);
|
513
|
+
})
|
514
|
+
return new Pair(Sym("let"),
|
515
|
+
new Pair(letbody,
|
516
|
+
ret));
|
517
|
+
}
|
518
|
+
define_syntax("letrec", expand_letrec_star);
|
519
|
+
define_syntax("letrec*", expand_letrec_star);
|
520
|
+
//let-values
|
521
|
+
//let*-values
|
522
|
+
// 11.4.7 Sequencing
|
523
|
+
//(begin)
|
524
|
+
|
525
|
+
//
|
526
|
+
// 11.5 Equivalence predicates
|
527
|
+
//
|
528
|
+
define_libfunc("eqv?", 2, 2, function(ar){
|
529
|
+
return ar[0] == ar[1] && (typeof(ar[0]) == typeof(ar[1]));
|
530
|
+
})
|
531
|
+
define_libfunc("eq?", 2, 2, function(ar){
|
532
|
+
return ar[0] === ar[1];
|
533
|
+
})
|
534
|
+
define_libfunc("equal?", 2, 2, function(ar){
|
535
|
+
//TODO: must terminate for cyclic objects
|
536
|
+
return to_write(ar[0]) == to_write(ar[1]);
|
537
|
+
})
|
538
|
+
|
539
|
+
//
|
540
|
+
// 11.6 Procedure predicate
|
541
|
+
//
|
542
|
+
//"procedure?", 1, 1
|
543
|
+
define_libfunc("procedure?", 1, 1, function(ar){
|
544
|
+
return (ar[0] instanceof Array) && (ar[0].closure_p === true);
|
545
|
+
})
|
546
|
+
|
547
|
+
//
|
548
|
+
// 11.7 Arithmetic
|
549
|
+
//
|
550
|
+
|
551
|
+
// 11.7.1 Propagation of exactness and inexactness
|
552
|
+
// 11.7.2 Representability of infinities and NaNs
|
553
|
+
// 11.7.3 Semantics of common operations
|
554
|
+
// 11.7.3.1 Integer division
|
555
|
+
// 11.7.3.2 Transcendental functions
|
556
|
+
//(no functions are introduced by above sections)
|
557
|
+
|
558
|
+
//
|
559
|
+
// 11.7.4 Numerical operations
|
560
|
+
//
|
561
|
+
|
562
|
+
// 11.7.4.1 Numerical type predicates
|
563
|
+
define_libfunc("number?", 1, 1, function(ar){
|
564
|
+
return (typeof(ar[0]) == 'number') ||
|
565
|
+
(ar[0] instanceof Complex) ||
|
566
|
+
(ar[0] instanceof Rational);
|
567
|
+
});
|
568
|
+
define_libfunc("complex?", 1, 1, function(ar){
|
569
|
+
return (ar[0] instanceof Complex);
|
570
|
+
});
|
571
|
+
define_libfunc("real?", 1, 1, function(ar){
|
572
|
+
return (typeof(ar[0]) == 'number');
|
573
|
+
});
|
574
|
+
define_libfunc("rational?", 1, 1, function(ar){
|
575
|
+
return (ar[0] instanceof Rational);
|
576
|
+
});
|
577
|
+
define_libfunc("integer?", 1, 1, function(ar){
|
578
|
+
return typeof(ar[0]) == 'number' &&
|
579
|
+
ar[0] == Math.round(ar[0]) &&
|
580
|
+
ar[0] != Infinity &&
|
581
|
+
ar[0] != -Infinity;
|
582
|
+
});
|
583
|
+
|
584
|
+
//(real-valued? obj) procedure
|
585
|
+
//(rational-valued? obj) procedure
|
586
|
+
//(integer-valued? obj) procedure
|
587
|
+
//
|
588
|
+
//(exact? z) procedure
|
589
|
+
//(inexact? z) procedure
|
590
|
+
|
591
|
+
// 11.7.4.2 Generic conversions
|
592
|
+
//
|
593
|
+
//(inexact z) procedure
|
594
|
+
//(exact z) procedure
|
595
|
+
//
|
596
|
+
// 11.7.4.3 Arithmetic operations
|
597
|
+
|
598
|
+
//inf & nan: ok (for this section)
|
599
|
+
define_libfunc("=", 2, null, function(ar){
|
600
|
+
var v = ar[0];
|
601
|
+
assert_number(ar[0]);
|
602
|
+
for(var i=1; i<ar.length; i++){
|
603
|
+
assert_number(ar[i]);
|
604
|
+
if(ar[i] != v) return false;
|
605
|
+
}
|
606
|
+
return true;
|
607
|
+
});
|
608
|
+
define_libfunc("<", 2, null, function(ar){
|
609
|
+
assert_number(ar[0]);
|
610
|
+
for(var i=1; i<ar.length; i++){
|
611
|
+
assert_number(ar[i]);
|
612
|
+
if(!(ar[i-1] < ar[i])) return false;
|
613
|
+
}
|
614
|
+
return true;
|
615
|
+
});
|
616
|
+
define_libfunc(">", 2, null, function(ar){
|
617
|
+
assert_number(ar[0]);
|
618
|
+
for(var i=1; i<ar.length; i++){
|
619
|
+
assert_number(ar[i]);
|
620
|
+
if(!(ar[i-1] > ar[i])) return false;
|
621
|
+
}
|
622
|
+
return true;
|
623
|
+
});
|
624
|
+
define_libfunc("<=", 2, null, function(ar){
|
625
|
+
assert_number(ar[0]);
|
626
|
+
for(var i=1; i<ar.length; i++){
|
627
|
+
assert_number(ar[i]);
|
628
|
+
if(!(ar[i-1] <= ar[i])) return false;
|
629
|
+
}
|
630
|
+
return true;
|
631
|
+
});
|
632
|
+
define_libfunc(">=", 2, null, function(ar){
|
633
|
+
assert_number(ar[0]);
|
634
|
+
for(var i=1; i<ar.length; i++){
|
635
|
+
assert_number(ar[i]);
|
636
|
+
if(!(ar[i-1] >= ar[i])) return false;
|
637
|
+
}
|
638
|
+
return true;
|
639
|
+
});
|
640
|
+
|
641
|
+
define_libfunc("zero?", 1, 1, function(ar){
|
642
|
+
assert_number(ar[0]);
|
643
|
+
return ar[0] === 0;
|
644
|
+
});
|
645
|
+
define_libfunc("positive?", 1, 1, function(ar){
|
646
|
+
assert_number(ar[0]);
|
647
|
+
return (ar[0] > 0);
|
648
|
+
});
|
649
|
+
define_libfunc("negative?", 1, 1, function(ar){
|
650
|
+
assert_number(ar[0]);
|
651
|
+
return (ar[0] < 0);
|
652
|
+
});
|
653
|
+
define_libfunc("odd?", 1, 1, function(ar){
|
654
|
+
assert_number(ar[0]);
|
655
|
+
return (ar[0] % 2 == 1) || (ar[0] % 2 == -1);
|
656
|
+
})
|
657
|
+
define_libfunc("even?", 1, 1, function(ar){
|
658
|
+
assert_number(ar[0]);
|
659
|
+
return ar[0] % 2 == 0;
|
660
|
+
})
|
661
|
+
define_libfunc("finite?", 1, 1, function(ar){
|
662
|
+
assert_number(ar[0]);
|
663
|
+
return (ar[0] != Infinity) && (ar[0] != -Infinity) && !isNaN(ar[0]);
|
664
|
+
})
|
665
|
+
define_libfunc("infinite?", 1, 1, function(ar){
|
666
|
+
assert_number(ar[0]);
|
667
|
+
return (ar[0] == Infinity) || (ar[0] == -Infinity);
|
668
|
+
})
|
669
|
+
define_libfunc("nan?", 1, 1, function(ar){
|
670
|
+
assert_number(ar[0]);
|
671
|
+
return isNaN(ar[0]);
|
672
|
+
})
|
673
|
+
define_libfunc("max", 2, null, function(ar){
|
674
|
+
for(var i=0; i<ar.length; i++)
|
675
|
+
assert_number(ar[i]);
|
676
|
+
|
677
|
+
return Math.max.apply(null, ar)
|
678
|
+
});
|
679
|
+
define_libfunc("min", 2, null, function(ar){
|
680
|
+
for(var i=0; i<ar.length; i++)
|
681
|
+
assert_number(ar[i]);
|
682
|
+
|
683
|
+
return Math.min.apply(null, ar);
|
684
|
+
});
|
685
|
+
|
686
|
+
define_libfunc("+", 0,null, function(ar){
|
687
|
+
var n = 0;
|
688
|
+
for(var i=0; i<ar.length; i++){
|
689
|
+
assert_number(ar[i]);
|
690
|
+
n+=ar[i];
|
691
|
+
}
|
692
|
+
return n;
|
693
|
+
});
|
694
|
+
define_libfunc("*", 0,null, function(ar){
|
695
|
+
var n = 1;
|
696
|
+
for(var i=0; i<ar.length; i++){
|
697
|
+
assert_number(ar[i]);
|
698
|
+
n*=ar[i];
|
699
|
+
}
|
700
|
+
return n;
|
701
|
+
});
|
702
|
+
define_libfunc("-", 1,null, function(ar){
|
703
|
+
var len = ar.length;
|
704
|
+
assert_number(ar[0]);
|
705
|
+
|
706
|
+
if(len == 1)
|
707
|
+
return -ar[0];
|
708
|
+
else{
|
709
|
+
var n = ar[0];
|
710
|
+
for(var i=1; i<len; i++){
|
711
|
+
assert_number(ar[i]);
|
712
|
+
n-=ar[i];
|
713
|
+
}
|
714
|
+
return n;
|
715
|
+
}
|
716
|
+
});
|
717
|
+
//for r6rs specification, (/ 0 0) or (/ 3 0) raises '&assertion exception'
|
718
|
+
define_libfunc("/", 1,null, function(ar){
|
719
|
+
var len = ar.length;
|
720
|
+
assert_number(ar[0]);
|
721
|
+
|
722
|
+
if(len == 1)
|
723
|
+
return 1/ar[0];
|
724
|
+
else{
|
725
|
+
var n = ar[0];
|
726
|
+
for(var i=1; i<len; i++){
|
727
|
+
assert_number(ar[i]);
|
728
|
+
n/=ar[i];
|
729
|
+
}
|
730
|
+
return n;
|
731
|
+
}
|
732
|
+
});
|
733
|
+
|
734
|
+
define_libfunc("abs", 1, 1, function(ar){
|
735
|
+
assert_number(ar[0]);
|
736
|
+
return Math.abs(ar[0]);
|
737
|
+
});
|
738
|
+
|
739
|
+
var div = function(n, m){
|
740
|
+
return Math.floor(n / m);
|
741
|
+
}
|
742
|
+
var mod = function(n, m){
|
743
|
+
return n - Math.floor(n / m) * m;
|
744
|
+
}
|
745
|
+
var div0 = function(n, m){
|
746
|
+
return (n > 0) ? Math.floor(n / m) : Math.ceil(n / m);
|
747
|
+
}
|
748
|
+
var mod0 = function(n, m){
|
749
|
+
return (n > 0) ? n - Math.floor(n / m) * m
|
750
|
+
: n - Math.ceil(n / m) * m;
|
751
|
+
}
|
752
|
+
define_libfunc("div0-and-mod0", 2, 2, function(ar){
|
753
|
+
assert_number(ar[0]);
|
754
|
+
assert_number(ar[1]);
|
755
|
+
return new Values([div(ar[0], ar[1]), mod(ar[0], ar[1])]);
|
756
|
+
})
|
757
|
+
define_libfunc("div", 2, 2, function(ar){
|
758
|
+
assert_number(ar[0]);
|
759
|
+
assert_number(ar[1]);
|
760
|
+
return div(ar[0], ar[1]);
|
761
|
+
})
|
762
|
+
define_libfunc("mod", 2, 2, function(ar){
|
763
|
+
assert_number(ar[0]);
|
764
|
+
assert_number(ar[1]);
|
765
|
+
return mod(ar[0], ar[1]);
|
766
|
+
})
|
767
|
+
define_libfunc("div0-and-mod0", 2, 2, function(ar){
|
768
|
+
assert_number(ar[0]);
|
769
|
+
assert_number(ar[1]);
|
770
|
+
return new Values([div0(ar[0], ar[1]), mod0(ar[0], ar[1])]);
|
771
|
+
})
|
772
|
+
define_libfunc("div0", 2, 2, function(ar){
|
773
|
+
assert_number(ar[0]);
|
774
|
+
assert_number(ar[1]);
|
775
|
+
return div0(ar[0], ar[1]);
|
776
|
+
})
|
777
|
+
define_libfunc("mod0", 2, 2, function(ar){
|
778
|
+
assert_number(ar[0]);
|
779
|
+
assert_number(ar[1]);
|
780
|
+
return mod0(ar[0], ar[1]);
|
781
|
+
})
|
782
|
+
|
783
|
+
//(gcd n1 ...) procedure
|
784
|
+
//(lcm n1 ...) procedure
|
785
|
+
|
786
|
+
define_libfunc("numerator", 1, 1, function(ar){
|
787
|
+
assert_number(ar[0]);
|
788
|
+
if(ar[0] instanceof Rational)
|
789
|
+
return ar[0].numerator;
|
790
|
+
else
|
791
|
+
throw new Bug("todo");
|
792
|
+
})
|
793
|
+
define_libfunc("denominator", 1, 1, function(ar){
|
794
|
+
assert_number(ar[0]);
|
795
|
+
if(ar[0] instanceof Rational)
|
796
|
+
return ar[0].denominator;
|
797
|
+
else
|
798
|
+
throw new Bug("todo");
|
799
|
+
})
|
800
|
+
define_libfunc("floor", 1, 1, function(ar){
|
801
|
+
assert_number(ar[0]);
|
802
|
+
return Math.floor(ar[0]);
|
803
|
+
})
|
804
|
+
define_libfunc("ceiling", 1, 1, function(ar){
|
805
|
+
assert_number(ar[0]);
|
806
|
+
return Math.ceil(ar[0]);
|
807
|
+
})
|
808
|
+
define_libfunc("truncate", 1, 1, function(ar){
|
809
|
+
assert_number(ar[0]);
|
810
|
+
return (ar[0] < 0) ? Math.ceil(ar[0]) : Math.floor(ar[0]);
|
811
|
+
})
|
812
|
+
define_libfunc("round", 1, 1, function(ar){
|
813
|
+
assert_number(ar[0]);
|
814
|
+
return Math.round(ar[0]);
|
815
|
+
})
|
816
|
+
|
817
|
+
//(rationalize x1 x2) procedure
|
818
|
+
|
819
|
+
define_libfunc("exp", 1, 1, function(ar){
|
820
|
+
assert_number(ar[0]);
|
821
|
+
return Math.exp(ar[0]);
|
822
|
+
})
|
823
|
+
define_libfunc("log", 1, 2, function(ar){
|
824
|
+
var num = ar[0], base = ar[1];
|
825
|
+
assert_number(num);
|
826
|
+
|
827
|
+
if(base){ // log b num == log e num / log e b
|
828
|
+
assert_number(base);
|
829
|
+
return Math.log(num) / Math.log(b)
|
830
|
+
}
|
831
|
+
else
|
832
|
+
return Math.log(num);
|
833
|
+
})
|
834
|
+
define_libfunc("sin", 1, 1, function(ar){
|
835
|
+
assert_number(ar[0]);
|
836
|
+
return Math.sin(ar[0]);
|
837
|
+
})
|
838
|
+
define_libfunc("cos", 1, 1, function(ar){
|
839
|
+
assert_number(ar[0]);
|
840
|
+
return Math.cos(ar[0]);
|
841
|
+
})
|
842
|
+
define_libfunc("tan", 1, 1, function(ar){
|
843
|
+
assert_number(ar[0]);
|
844
|
+
return Math.tan(ar[0]);
|
845
|
+
})
|
846
|
+
define_libfunc("asin", 1, 1, function(ar){
|
847
|
+
assert_number(ar[0]);
|
848
|
+
return Math.asin(ar[0]);
|
849
|
+
})
|
850
|
+
define_libfunc("acos", 1, 1, function(ar){
|
851
|
+
assert_number(ar[0]);
|
852
|
+
return Math.asos(ar[0]);
|
853
|
+
})
|
854
|
+
define_libfunc("atan", 1, 2, function(ar){
|
855
|
+
assert_number(ar[0]);
|
856
|
+
if(ar[1]){
|
857
|
+
assert_number(ar[1]);
|
858
|
+
return Math.atan2(ar[0], ar[1]);
|
859
|
+
}
|
860
|
+
else
|
861
|
+
return Math.atan(ar[0]);
|
862
|
+
})
|
863
|
+
define_libfunc("sqrt", 1, 1, function(ar){
|
864
|
+
assert_number(ar[0]);
|
865
|
+
return Math.sqrt(ar[0]);
|
866
|
+
})
|
867
|
+
define_libfunc("exact-integer-sqrt", 1, 1, function(ar){
|
868
|
+
assert_number(ar[0]);
|
869
|
+
var sqrt_f = Math.sqrt(ar[0]);
|
870
|
+
var sqrt_i = sqrt_f - (sqrt_f % 1);
|
871
|
+
var rest = ar[0] - sqrt_i * sqrt_i;
|
872
|
+
|
873
|
+
return new Values([sqrt_i, rest]);
|
874
|
+
})
|
875
|
+
define_libfunc("expt", 2, 2, function(ar){
|
876
|
+
assert_number(ar[0]);
|
877
|
+
assert_number(ar[1]);
|
878
|
+
return Math.pow(ar[0], ar[1]);
|
879
|
+
})
|
880
|
+
define_libfunc("make-rectangular", 2, 2, function(ar){
|
881
|
+
assert_number(ar[0]);
|
882
|
+
assert_number(ar[1]);
|
883
|
+
return new Complex(ar[0], ar[1]);
|
884
|
+
})
|
885
|
+
define_libfunc("make-polar", 2, 2, function(ar){
|
886
|
+
assert_number(ar[0]);
|
887
|
+
assert_number(ar[1]);
|
888
|
+
return Complex.from_polar(ar[0], ar[1]);
|
889
|
+
})
|
890
|
+
define_libfunc("real-part", 1, 1, function(ar){
|
891
|
+
assert_number(ar[0]);
|
892
|
+
return Complex.assure(ar[0]).real;
|
893
|
+
})
|
894
|
+
define_libfunc("imag-part", 1, 1, function(ar){
|
895
|
+
assert_number(ar[0]);
|
896
|
+
return Complex.assure(ar[0]).imag;
|
897
|
+
})
|
898
|
+
define_libfunc("magnitude", 1, 1, function(ar){
|
899
|
+
assert_number(ar[0]);
|
900
|
+
return Complex.assure(ar[0]).magnitude();
|
901
|
+
})
|
902
|
+
define_libfunc("angle", 1, 1, function(ar){
|
903
|
+
assert_number(ar[0]);
|
904
|
+
return Complex.assure(ar[0]).angle();
|
905
|
+
})
|
906
|
+
|
907
|
+
//
|
908
|
+
// 11.7.4.4 Numerical Input and Output
|
909
|
+
//
|
910
|
+
define_libfunc("number->string", 1, 3, function(ar){
|
911
|
+
var z = ar[0], radix = ar[1], precision = ar[2];
|
912
|
+
if(precision)
|
913
|
+
throw new Bug("number->string: presition is not yet implemented");
|
914
|
+
|
915
|
+
radix = radix || 10; //TODO: check radix is 2, 8, 10, or 16.
|
916
|
+
return z.toString(radix);
|
917
|
+
})
|
918
|
+
define_libfunc("string->number", 1, 3, function(ar){
|
919
|
+
var s = ar[0], radix = ar[1] || 10;
|
920
|
+
switch(s){
|
921
|
+
case "+inf.0": return Infinity;
|
922
|
+
case "-inf.0": return -Infinity;
|
923
|
+
case "+nan.0": return NaN;
|
924
|
+
default: return parseInt(s, radix);
|
925
|
+
}
|
926
|
+
})
|
927
|
+
|
928
|
+
//
|
929
|
+
// 11.8 Booleans
|
930
|
+
//
|
931
|
+
|
932
|
+
define_libfunc("not", 1, 1, function(ar){
|
933
|
+
return (ar[0] === false) ? true : false;
|
934
|
+
});
|
935
|
+
define_libfunc("boolean?", 1, 1, function(ar){
|
936
|
+
return (ar[0] === false || ar[0] === true) ? true : false;
|
937
|
+
});
|
938
|
+
define_libfunc("boolean=?", 2, null, function(ar){
|
939
|
+
var len = ar.length;
|
940
|
+
for(var i=1; i<len; i++){
|
941
|
+
if(ar[i] != ar[0]) return false;
|
942
|
+
}
|
943
|
+
return true;
|
944
|
+
});
|
945
|
+
|
946
|
+
// 11.9 Pairs and lists
|
947
|
+
|
948
|
+
define_libfunc("pair?", 1, 1, function(ar){
|
949
|
+
return (ar[0] instanceof Pair && ar[0] != nil) ? true : false;
|
950
|
+
});
|
951
|
+
define_libfunc("cons", 2, 2, function(ar){
|
952
|
+
return new Pair(ar[0], ar[1]);
|
953
|
+
});
|
954
|
+
define_libfunc("car", 1, 1, function(ar){
|
955
|
+
//should raise &assertion for '()...
|
956
|
+
if(!ar[0] instanceof Pair) throw new Error("cannot take car of " + ar[0]);
|
957
|
+
return ar[0].car;
|
958
|
+
});
|
959
|
+
define_libfunc("cdr", 1, 1, function(ar){
|
960
|
+
//should raise &assertion for '()...
|
961
|
+
if(!ar[0] instanceof Pair) throw new Error("cannot take cdr of " + ar[0]);
|
962
|
+
return ar[0].cdr;
|
963
|
+
});
|
964
|
+
define_libfunc("set-car!", 2, 2, function(ar){
|
965
|
+
if(!ar[0] instanceof Pair) throw new Error("cannot take set-car! of " + ar[0]);
|
966
|
+
ar[0].car = ar[1];
|
967
|
+
});
|
968
|
+
define_libfunc("set-cdr!", 2, 2, function(ar){
|
969
|
+
if(!ar[0] instanceof Pair) throw new Error("cannot take set-cdr! of " + ar[0]);
|
970
|
+
ar[0].cdr = ar[1];
|
971
|
+
});
|
972
|
+
|
973
|
+
define_libfunc("caar", 1, 1, function(ar){ return ar[0].car.car; });
|
974
|
+
define_libfunc("cadr", 1, 1, function(ar){ return ar[0].cdr.car; });
|
975
|
+
define_libfunc("cdar", 1, 1, function(ar){ return ar[0].car.cdr; });
|
976
|
+
define_libfunc("cddr", 1, 1, function(ar){ return ar[0].cdr.cdr; });
|
977
|
+
define_libfunc("caaar", 1, 1, function(ar){ return ar[0].car.car.car; });
|
978
|
+
define_libfunc("caadr", 1, 1, function(ar){ return ar[0].cdr.car.car; });
|
979
|
+
define_libfunc("cadar", 1, 1, function(ar){ return ar[0].car.cdr.car; });
|
980
|
+
define_libfunc("caddr", 1, 1, function(ar){ return ar[0].cdr.cdr.car; });
|
981
|
+
define_libfunc("cdaar", 1, 1, function(ar){ return ar[0].car.car.cdr; });
|
982
|
+
define_libfunc("cdadr", 1, 1, function(ar){ return ar[0].cdr.car.cdr; });
|
983
|
+
define_libfunc("cddar", 1, 1, function(ar){ return ar[0].car.cdr.cdr; });
|
984
|
+
define_libfunc("cdddr", 1, 1, function(ar){ return ar[0].cdr.cdr.cdr; });
|
985
|
+
define_libfunc("caaaar", 1, 1, function(ar){ return ar[0].car.car.car.car; });
|
986
|
+
define_libfunc("caaadr", 1, 1, function(ar){ return ar[0].cdr.car.car.car; });
|
987
|
+
define_libfunc("caadar", 1, 1, function(ar){ return ar[0].car.cdr.car.car; });
|
988
|
+
define_libfunc("caaddr", 1, 1, function(ar){ return ar[0].cdr.cdr.car.car; });
|
989
|
+
define_libfunc("cadaar", 1, 1, function(ar){ return ar[0].car.car.cdr.car; });
|
990
|
+
define_libfunc("cadadr", 1, 1, function(ar){ return ar[0].cdr.car.cdr.car; });
|
991
|
+
define_libfunc("caddar", 1, 1, function(ar){ return ar[0].car.cdr.cdr.car; });
|
992
|
+
define_libfunc("cadddr", 1, 1, function(ar){ return ar[0].cdr.cdr.cdr.car; });
|
993
|
+
define_libfunc("cdaaar", 1, 1, function(ar){ return ar[0].car.car.car.cdr; });
|
994
|
+
define_libfunc("cdaadr", 1, 1, function(ar){ return ar[0].cdr.car.car.cdr; });
|
995
|
+
define_libfunc("cdadar", 1, 1, function(ar){ return ar[0].car.cdr.car.cdr; });
|
996
|
+
define_libfunc("cdaddr", 1, 1, function(ar){ return ar[0].cdr.cdr.car.cdr; });
|
997
|
+
define_libfunc("cddaar", 1, 1, function(ar){ return ar[0].car.car.cdr.cdr; });
|
998
|
+
define_libfunc("cddadr", 1, 1, function(ar){ return ar[0].cdr.car.cdr.cdr; });
|
999
|
+
define_libfunc("cdddar", 1, 1, function(ar){ return ar[0].car.cdr.cdr.cdr; });
|
1000
|
+
define_libfunc("cddddr", 1, 1, function(ar){ return ar[0].cdr.cdr.cdr.cdr; });
|
1001
|
+
|
1002
|
+
define_libfunc("null?", 1, 1, function(ar){
|
1003
|
+
return (ar[0] === nil);
|
1004
|
+
});
|
1005
|
+
define_libfunc("list?", 1, 1, function(ar){
|
1006
|
+
var contents = [];
|
1007
|
+
for(var o=ar[0]; o != nil; o=o.cdr){
|
1008
|
+
if(!(o instanceof Pair)) return false;
|
1009
|
+
if(contents.find(function(item){ return item === o.car}))
|
1010
|
+
return false; //cyclic
|
1011
|
+
contents.push(o.car);
|
1012
|
+
}
|
1013
|
+
return true;
|
1014
|
+
});
|
1015
|
+
define_libfunc("list", 0, null, function(ar){
|
1016
|
+
var l = nil;
|
1017
|
+
for(var i=ar.length-1; i>=0; i--)
|
1018
|
+
l = new Pair(ar[i], l);
|
1019
|
+
return l;
|
1020
|
+
});
|
1021
|
+
define_libfunc("length", 1, 1, function(ar){
|
1022
|
+
assert_pair(ar[0]);
|
1023
|
+
|
1024
|
+
var n = 0;
|
1025
|
+
for(var o=ar[0]; o!=nil; o=o.cdr)
|
1026
|
+
n++;
|
1027
|
+
return n;
|
1028
|
+
});
|
1029
|
+
define_libfunc("append", 2, null, function(ar){
|
1030
|
+
var k = ar.length
|
1031
|
+
var ret = ar[--k];
|
1032
|
+
while(k--){
|
1033
|
+
ar[k].to_array().reverse().each(function(item){
|
1034
|
+
ret = new Pair(item, ret);
|
1035
|
+
});
|
1036
|
+
}
|
1037
|
+
return ret;
|
1038
|
+
});
|
1039
|
+
define_libfunc("reverse", 1, 1, function(ar){
|
1040
|
+
if(!ar[0] instanceof Pair) throw new Error("reverse needs pair but got " + ar[0]);
|
1041
|
+
|
1042
|
+
var l = nil;
|
1043
|
+
for(var o=ar[0]; o!=nil; o=o.cdr)
|
1044
|
+
l = new Pair(o.car, l);
|
1045
|
+
return l;
|
1046
|
+
});
|
1047
|
+
define_libfunc("list-tail", 2, 2, function(ar){
|
1048
|
+
if(!ar[0] instanceof Pair) throw new Error("list-tail needs pair but got " + ar[0]);
|
1049
|
+
|
1050
|
+
var o = ar[0];
|
1051
|
+
for(var i=0; i<ar[1]; i++){
|
1052
|
+
if(!o instanceof Pair) throw new Error("list-tail: the list is shorter than " + ar[1]);
|
1053
|
+
o = o.cdr;
|
1054
|
+
}
|
1055
|
+
return o;
|
1056
|
+
});
|
1057
|
+
define_libfunc("list-ref", 2, 2, function(ar){
|
1058
|
+
if(!ar[0] instanceof Pair) throw new Error("list-ref needs pair but got " + ar[0]);
|
1059
|
+
|
1060
|
+
var o = ar[0];
|
1061
|
+
for(var i=0; i<ar[1]; i++){
|
1062
|
+
if(!o instanceof Pair) throw new Error("list-ref: the list is shorter than " + ar[1]);
|
1063
|
+
o = o.cdr;
|
1064
|
+
}
|
1065
|
+
return o.car;
|
1066
|
+
});
|
1067
|
+
define_libfunc("map", 2, null, function(ar){
|
1068
|
+
var proc = ar.shift(), lists = ar;
|
1069
|
+
lists.each(function(ls){ assert_pair(ls) });
|
1070
|
+
|
1071
|
+
var a = [];
|
1072
|
+
return Call.multi_foreach(lists, {
|
1073
|
+
call: function(xs){
|
1074
|
+
return new Call(proc, xs.map(function(x){ return x.car }));
|
1075
|
+
},
|
1076
|
+
result: function(res){ a.push(res); },
|
1077
|
+
finish: function(){ return a.to_list(); }
|
1078
|
+
})
|
1079
|
+
})
|
1080
|
+
define_libfunc("for-each", 2, null, function(ar){
|
1081
|
+
var proc = ar.shift(), lists = ar;
|
1082
|
+
lists.each(function(ls){ assert_pair(ls) });
|
1083
|
+
|
1084
|
+
return Call.multi_foreach(lists, {
|
1085
|
+
call: function(xs){
|
1086
|
+
return new Call(proc, xs.map(function(x){ return x.car }));
|
1087
|
+
}
|
1088
|
+
})
|
1089
|
+
})
|
1090
|
+
|
1091
|
+
// 11.10 Symbols
|
1092
|
+
|
1093
|
+
define_libfunc("symbol?", 1, 1, function(ar){
|
1094
|
+
return (ar[0] instanceof Symbol) ? true : false;
|
1095
|
+
});
|
1096
|
+
define_libfunc("symbol->string", 1, 1, function(ar){
|
1097
|
+
assert_symbol(ar[0]);
|
1098
|
+
return ar[0].name;
|
1099
|
+
});
|
1100
|
+
define_libfunc("symbol=?", 2, null, function(ar){
|
1101
|
+
assert_symbol(ar[0]);
|
1102
|
+
for(var i=1; i<ar.length; i++){
|
1103
|
+
assert_symbol(ar[i]);
|
1104
|
+
if(ar[i] != ar[0]) return false;
|
1105
|
+
}
|
1106
|
+
return true;
|
1107
|
+
});
|
1108
|
+
define_libfunc("string->symbol", 1, 1, function(ar){
|
1109
|
+
assert_string(ar[0]);
|
1110
|
+
return Sym(ar[0]);
|
1111
|
+
});
|
1112
|
+
|
1113
|
+
//
|
1114
|
+
// 11.11 Characters
|
1115
|
+
//
|
1116
|
+
define_libfunc('char?', 1, 1, function(ar){
|
1117
|
+
return (ar[0] instanceof Char);
|
1118
|
+
});
|
1119
|
+
define_libfunc('char->integer', 1, 1, function(ar){
|
1120
|
+
assert_char(ar[0]);
|
1121
|
+
return ar[0].value.charCodeAt(0);
|
1122
|
+
})
|
1123
|
+
define_libfunc('integer->char', 1, 1, function(ar){
|
1124
|
+
assert_integer(ar[0]);
|
1125
|
+
return Char.get(String.fromCharCode(ar[0]));
|
1126
|
+
})
|
1127
|
+
|
1128
|
+
var make_char_compare_func = function(test){
|
1129
|
+
return function(ar){
|
1130
|
+
assert_char(ar[0]);
|
1131
|
+
for(var i=1; i<ar.length; i++){
|
1132
|
+
assert_char(ar[i]);
|
1133
|
+
if(!test(ar[i-1].value, ar[i].value))
|
1134
|
+
return false;
|
1135
|
+
}
|
1136
|
+
return true;
|
1137
|
+
}
|
1138
|
+
}
|
1139
|
+
define_libfunc('char=?', 2, null,
|
1140
|
+
make_char_compare_func(function(a, b){ return a == b }))
|
1141
|
+
define_libfunc('char<?', 2, null,
|
1142
|
+
make_char_compare_func(function(a, b){ return a < b }))
|
1143
|
+
define_libfunc('char>?', 2, null,
|
1144
|
+
make_char_compare_func(function(a, b){ return a > b }))
|
1145
|
+
define_libfunc('char<=?', 2, null,
|
1146
|
+
make_char_compare_func(function(a, b){ return a <= b }))
|
1147
|
+
define_libfunc('char>=?', 2, null,
|
1148
|
+
make_char_compare_func(function(a, b){ return a >= b }))
|
1149
|
+
|
1150
|
+
//
|
1151
|
+
// 11.12 Strings
|
1152
|
+
//
|
1153
|
+
define_libfunc("string?", 1, 1, function(ar){
|
1154
|
+
return (typeof(ar[0]) == "string");
|
1155
|
+
})
|
1156
|
+
define_libfunc("make-string", 1, 2, function(ar){
|
1157
|
+
assert_integer(ar[0]);
|
1158
|
+
var c = " ";
|
1159
|
+
if(ar[1]){
|
1160
|
+
assert_char(ar[1]);
|
1161
|
+
c = ar[1].value;
|
1162
|
+
}
|
1163
|
+
return c.times(ar[0]);
|
1164
|
+
})
|
1165
|
+
define_libfunc("string", 1, null, function(ar){
|
1166
|
+
for(var i=0; i<ar.length; i++)
|
1167
|
+
assert_char(ar[i]);
|
1168
|
+
return ar.map(function(c){ return c.value }).join("");
|
1169
|
+
})
|
1170
|
+
define_libfunc("string-length", 1, 1, function(ar){
|
1171
|
+
assert_string(ar[0]);
|
1172
|
+
return ar[0].length;
|
1173
|
+
})
|
1174
|
+
define_libfunc("string-ref", 2, 2, function(ar){
|
1175
|
+
assert_string(ar[0]);
|
1176
|
+
assert_between(ar[1], 0, ar[0].length-1);
|
1177
|
+
return Char.get(ar[0].charAt([ar[1]]));
|
1178
|
+
})
|
1179
|
+
define_libfunc("string=?", 2, null, function(ar){
|
1180
|
+
assert_string(ar[0]);
|
1181
|
+
for(var i=1; i<ar.length; i++){
|
1182
|
+
assert_string(ar[i]);
|
1183
|
+
if(ar[0] != ar[i]) return false;
|
1184
|
+
}
|
1185
|
+
return true;
|
1186
|
+
})
|
1187
|
+
define_libfunc("string<?", 2, null, function(ar){
|
1188
|
+
assert_string(ar[0]);
|
1189
|
+
for(var i=1; i<ar.length; i++){
|
1190
|
+
assert_string(ar[i]);
|
1191
|
+
if(!(ar[i-1] < ar[i])) return false;
|
1192
|
+
}
|
1193
|
+
return true;
|
1194
|
+
})
|
1195
|
+
define_libfunc("string>?", 2, null, function(ar){
|
1196
|
+
assert_string(ar[0]);
|
1197
|
+
for(var i=1; i<ar.length; i++){
|
1198
|
+
assert_string(ar[i]);
|
1199
|
+
if(!(ar[i-1] > ar[i])) return false;
|
1200
|
+
}
|
1201
|
+
return true;
|
1202
|
+
})
|
1203
|
+
define_libfunc("string<=?", 2, null, function(ar){
|
1204
|
+
assert_string(ar[0]);
|
1205
|
+
for(var i=1; i<ar.length; i++){
|
1206
|
+
assert_string(ar[i]);
|
1207
|
+
if(!(ar[i-1] <= ar[i])) return false;
|
1208
|
+
}
|
1209
|
+
return true;
|
1210
|
+
})
|
1211
|
+
define_libfunc("string>=?", 2, null, function(ar){
|
1212
|
+
assert_string(ar[0]);
|
1213
|
+
for(var i=1; i<ar.length; i++){
|
1214
|
+
assert_string(ar[i]);
|
1215
|
+
if(!(ar[i-1] >= ar[i])) return false;
|
1216
|
+
}
|
1217
|
+
return true;
|
1218
|
+
})
|
1219
|
+
|
1220
|
+
define_libfunc("substring", 3, 3, function(ar){
|
1221
|
+
assert_string(ar[0]);
|
1222
|
+
assert_integer(ar[1]);
|
1223
|
+
assert_integer(ar[2]);
|
1224
|
+
|
1225
|
+
if(ar[1] < 0) throw new Error("substring: start too small: "+ar[1]);
|
1226
|
+
if(ar[2] < 0) throw new Error("substring: end too small: "+ar[2]);
|
1227
|
+
if(ar[0].length+1 <= ar[1]) throw new Error("substring: start too big: "+ar[1]);
|
1228
|
+
if(ar[0].length+1 <= ar[2]) throw new Error("substring: end too big: "+ar[2]);
|
1229
|
+
if(!(ar[1] <= ar[2])) throw new Error("substring: not start <= end: "+ar[1]+", "+ar[2]);
|
1230
|
+
|
1231
|
+
return ar[0].substring(ar[1], ar[2]);
|
1232
|
+
})
|
1233
|
+
|
1234
|
+
define_libfunc("string-append", 0, null, function(ar){
|
1235
|
+
for(var i=0; i<ar.length; i++)
|
1236
|
+
assert_string(ar[i]);
|
1237
|
+
|
1238
|
+
return ar.join("");
|
1239
|
+
})
|
1240
|
+
define_libfunc("string->list", 1, 1, function(ar){
|
1241
|
+
assert_string(ar[0]);
|
1242
|
+
var chars = [];
|
1243
|
+
ar[0].scan(/./, function(s){ chars.push(Char.get(s[0])) });
|
1244
|
+
return chars.to_list();
|
1245
|
+
})
|
1246
|
+
define_libfunc("list->string", 1, 1, function(ar){
|
1247
|
+
assert_pair(ar[0]);
|
1248
|
+
return ar[0].to_array().map(function(c){ return c.value; }).join("");
|
1249
|
+
})
|
1250
|
+
define_libfunc("string-for-each", 2, null, function(ar){
|
1251
|
+
var proc = ar.shift(), strs = ar;
|
1252
|
+
strs.each(function(str){ assert_string(str) });
|
1253
|
+
|
1254
|
+
return Call.multi_foreach(strs, {
|
1255
|
+
call: function(chars){ return new Call(proc, chars); }
|
1256
|
+
})
|
1257
|
+
})
|
1258
|
+
define_libfunc("string-copy", 1, 1, function(ar){
|
1259
|
+
// note: this is useless, because javascript strings are immutable
|
1260
|
+
assert_string(ar[0]);
|
1261
|
+
return ar[0];
|
1262
|
+
})
|
1263
|
+
|
1264
|
+
|
1265
|
+
//
|
1266
|
+
// 11.13 Vectors
|
1267
|
+
//
|
1268
|
+
define_libfunc("vector?", 1, 1, function(ar){
|
1269
|
+
return (ar[0] instanceof Array) && (ar[0].closure_p !== true)
|
1270
|
+
})
|
1271
|
+
define_libfunc("make-vector", 1, 2, function(ar){
|
1272
|
+
assert_integer(ar[0]);
|
1273
|
+
var vec = new Array(ar[0]);
|
1274
|
+
|
1275
|
+
if(ar.length == 2){
|
1276
|
+
for(var i=0; i<ar[0]; i++)
|
1277
|
+
vec[i] = ar[1];
|
1278
|
+
}
|
1279
|
+
return vec;
|
1280
|
+
})
|
1281
|
+
define_libfunc("vector", 1, null, function(ar){
|
1282
|
+
return ar;
|
1283
|
+
})
|
1284
|
+
define_libfunc("vector-length", 1, 1, function(ar){
|
1285
|
+
assert_vector(ar[0]);
|
1286
|
+
return ar[0].length;
|
1287
|
+
})
|
1288
|
+
define_libfunc("vector-ref", 2, 2, function(ar){
|
1289
|
+
assert_vector(ar[0]);
|
1290
|
+
assert_integer(ar[1]);
|
1291
|
+
|
1292
|
+
return ar[0][ar[1]];
|
1293
|
+
})
|
1294
|
+
define_libfunc("vector-set!", 3, 3, function(ar){
|
1295
|
+
assert_vector(ar[0]);
|
1296
|
+
assert_integer(ar[1]);
|
1297
|
+
|
1298
|
+
ar[0][ar[1]] = ar[2];
|
1299
|
+
})
|
1300
|
+
define_libfunc("vector->list", 1, 1, function(ar){
|
1301
|
+
assert_vector(ar[0]);
|
1302
|
+
return ar[0].to_list();
|
1303
|
+
})
|
1304
|
+
define_libfunc("list->vector", 1, 1, function(ar){
|
1305
|
+
assert_pair(ar[0]);
|
1306
|
+
return ar[0].to_array();
|
1307
|
+
})
|
1308
|
+
define_libfunc("vector-fill!", 2, 2, function(ar){
|
1309
|
+
assert_vector(ar[0]);
|
1310
|
+
var vec = ar[0], obj = ar[1];
|
1311
|
+
|
1312
|
+
for(var i=0; i<vec.length; i++)
|
1313
|
+
vec[i] = obj;
|
1314
|
+
return vec;
|
1315
|
+
})
|
1316
|
+
define_libfunc("vector-map", 2, null, function(ar){
|
1317
|
+
var proc = ar.shift(), vecs = ar;
|
1318
|
+
vecs.each(function(vec){ assert_vector(vec) });
|
1319
|
+
|
1320
|
+
var a = [];
|
1321
|
+
return Call.multi_foreach(vecs, {
|
1322
|
+
call: function(objs){ return new Call(proc, objs); },
|
1323
|
+
result: function(res){ a.push(res); },
|
1324
|
+
finish: function(){ return a; }
|
1325
|
+
})
|
1326
|
+
})
|
1327
|
+
define_libfunc("vector-for-each", 2, null, function(ar){
|
1328
|
+
var proc = ar.shift(), vecs = ar;
|
1329
|
+
vecs.each(function(vec){ assert_vector(vec) });
|
1330
|
+
|
1331
|
+
return Call.multi_foreach(vecs, {
|
1332
|
+
call: function(objs){ return new Call(proc, objs); }
|
1333
|
+
})
|
1334
|
+
})
|
1335
|
+
|
1336
|
+
//
|
1337
|
+
// 11.14 Errors and violations
|
1338
|
+
//
|
1339
|
+
//(error who message irritant1 ...) procedure
|
1340
|
+
//(assertion-violation who message irritant1 ...) procedure
|
1341
|
+
//(assert <expression>) syntax
|
1342
|
+
|
1343
|
+
//
|
1344
|
+
// 11.15 Control features
|
1345
|
+
//
|
1346
|
+
define_libfunc("apply", 2, null, function(ar){
|
1347
|
+
var proc = ar.shift(), rest_args = ar.pop(), args = ar;
|
1348
|
+
args = args.concat(rest_args.to_array());
|
1349
|
+
|
1350
|
+
return new Call(proc, args);
|
1351
|
+
})
|
1352
|
+
define_syntax("call-with-current-continuation", function(x){
|
1353
|
+
return new Pair(Sym("call/cc"),
|
1354
|
+
x.cdr);
|
1355
|
+
})
|
1356
|
+
define_libfunc("values", 0, null, function(ar){
|
1357
|
+
return new Values(ar);
|
1358
|
+
})
|
1359
|
+
define_libfunc("call-with-values", 2, 2, function(ar){
|
1360
|
+
var producer = ar[0], consumer = ar[1];
|
1361
|
+
return new Call(producer, [], function(ar){
|
1362
|
+
var values = ar[0];
|
1363
|
+
if(!(values instanceof Values))
|
1364
|
+
throw new Error("values expected, but got "+to_write(values));
|
1365
|
+
|
1366
|
+
return new Call(consumer, values.content);
|
1367
|
+
})
|
1368
|
+
})
|
1369
|
+
|
1370
|
+
//
|
1371
|
+
//dynamic-wind
|
1372
|
+
|
1373
|
+
// 11.16 Iteration
|
1374
|
+
//named let
|
1375
|
+
|
1376
|
+
// 11.17 Quasiquotation
|
1377
|
+
//quasiquote
|
1378
|
+
var expand_qq = function(f, lv){
|
1379
|
+
if(f instanceof Symbol || f === nil){
|
1380
|
+
return [Sym("quote"), f].to_list();
|
1381
|
+
}
|
1382
|
+
else if(f instanceof Pair){
|
1383
|
+
var car = f.car;
|
1384
|
+
if(car instanceof Pair && car.car === Sym("unquote-splicing")){
|
1385
|
+
var lv = lv-1;
|
1386
|
+
if(lv == 0)
|
1387
|
+
return [ Sym("append"),
|
1388
|
+
f.car.cdr.car,
|
1389
|
+
expand_qq(f.cdr, lv+1)
|
1390
|
+
].to_list();
|
1391
|
+
else
|
1392
|
+
return [ Sym("cons"),
|
1393
|
+
[Sym("list"), Sym("unquote-splicing"), expand_qq(f.car.cdr.car, lv)].to_list(),
|
1394
|
+
expand_qq(f.cdr, lv+1)
|
1395
|
+
].to_list();
|
1396
|
+
}
|
1397
|
+
else if(car === Sym("unquote")){
|
1398
|
+
var lv = lv-1;
|
1399
|
+
if(lv == 0)
|
1400
|
+
return f.cdr.car;
|
1401
|
+
else
|
1402
|
+
return [ Sym("list"),
|
1403
|
+
[Sym("quote"), Sym("unquote")].to_list(),
|
1404
|
+
expand_qq(f.cdr.car, lv)
|
1405
|
+
].to_list();
|
1406
|
+
}
|
1407
|
+
else if(car === Sym("quasiquote"))
|
1408
|
+
return [
|
1409
|
+
Sym("list"),
|
1410
|
+
Sym("quasiquote"),
|
1411
|
+
expand_qq(f.cdr.car, lv+1)
|
1412
|
+
].to_list();
|
1413
|
+
else
|
1414
|
+
return [
|
1415
|
+
Sym("cons"),
|
1416
|
+
expand_qq(f.car, lv),
|
1417
|
+
expand_qq(f.cdr, lv)
|
1418
|
+
].to_list();
|
1419
|
+
}
|
1420
|
+
else if(f instanceof Array){
|
1421
|
+
throw new Bug("vector quasiquotation is not implemented yet");
|
1422
|
+
}
|
1423
|
+
// // `#(1 2 (unquote f))
|
1424
|
+
// // (vector 1 2 f)
|
1425
|
+
// // `#(1 2 (unquote-splicing f) 3)
|
1426
|
+
// // (vector-append
|
1427
|
+
// // (vector 1 2)
|
1428
|
+
// // f
|
1429
|
+
// // (vector 3))
|
1430
|
+
// // `#(1 2 `#(3 ,,f) 4)
|
1431
|
+
// // (vector 1 2 `#(3 ,g) 4)
|
1432
|
+
// var len = f.length;
|
1433
|
+
// if(len == 0) return f;
|
1434
|
+
//
|
1435
|
+
// var vecs = [[]];
|
1436
|
+
// for(var i=0; i<len; i++){
|
1437
|
+
// if(f[i] instanceof Pair){
|
1438
|
+
// if(f[i].car === Sym("unquote")){
|
1439
|
+
// var lv = lv - 1;
|
1440
|
+
// if(lv == 0)
|
1441
|
+
// vecs.last().push(f[i]);
|
1442
|
+
// else
|
1443
|
+
// vecs.push()
|
1444
|
+
// }
|
1445
|
+
// }
|
1446
|
+
//
|
1447
|
+
// var car = f[0];
|
1448
|
+
// if(car === Sym("unquote")){
|
1449
|
+
// var lv = lv - 1;
|
1450
|
+
// if(lv == 0)
|
1451
|
+
// return f.cdr.car;
|
1452
|
+
// else
|
1453
|
+
// return [ Sym("vector"),
|
1454
|
+
// [Sym("quote"), Sym("unquote")].to_list(),
|
1455
|
+
// expand_qq(f.cdr.car, lv)
|
1456
|
+
// ].to_list();
|
1457
|
+
// }
|
1458
|
+
// else{
|
1459
|
+
//// return [ Sym("vector"),
|
1460
|
+
//// expand_qq(
|
1461
|
+
// }
|
1462
|
+
// }
|
1463
|
+
// }
|
1464
|
+
else
|
1465
|
+
return f;
|
1466
|
+
}
|
1467
|
+
define_syntax("quasiquote", function(x){
|
1468
|
+
return expand_qq(x.cdr.car, 1);
|
1469
|
+
})
|
1470
|
+
//unquote
|
1471
|
+
define_syntax("unquote", function(x){
|
1472
|
+
throw new Error("unquote(,) must be inside quasiquote(`)");
|
1473
|
+
})
|
1474
|
+
//unquote-splicing
|
1475
|
+
define_syntax("unquote-splicing", function(x){
|
1476
|
+
throw new Error("unquote-splicing(,@) must be inside quasiquote(`)");
|
1477
|
+
})
|
1478
|
+
|
1479
|
+
// 11.18 Binding constructs for syntactic keywords
|
1480
|
+
//let-syntax
|
1481
|
+
//letrec-syntax
|
1482
|
+
|
1483
|
+
// 11.19 Macro transformers
|
1484
|
+
//syntax-rules
|
1485
|
+
//identifier-syntax
|
1486
|
+
//
|
1487
|
+
|
1488
|
+
// 11.20 Tail calls and tail contexts
|
1489
|
+
//(no library function introduced)
|
1490
|
+
|
1491
|
+
|
1492
|
+
///
|
1493
|
+
/// R6RS Standard Libraries
|
1494
|
+
///
|
1495
|
+
|
1496
|
+
//
|
1497
|
+
// Chapter 1 Unicode
|
1498
|
+
//
|
1499
|
+
//(char-upcase char) procedure
|
1500
|
+
//(char-downcase char) procedure
|
1501
|
+
//(char-titlecase char) procedure
|
1502
|
+
//(char-foldcase char) procedure
|
1503
|
+
//
|
1504
|
+
//(char-ci=? char1 char2 char3 ...) procedure
|
1505
|
+
//(char-ci<? char1 char2 char3 ...) procedure
|
1506
|
+
//(char-ci>? char1 char2 char3 ...) procedure
|
1507
|
+
//(char-ci<=? char1 char2 char3 ...) procedure
|
1508
|
+
//(char-ci>=? char1 char2 char3 ...) procedure
|
1509
|
+
//
|
1510
|
+
//(char-alphabetic? char) procedure
|
1511
|
+
//(char-numeric? char) procedure
|
1512
|
+
//(char-whitespace? char) procedure
|
1513
|
+
//(char-upper-case? char) procedure
|
1514
|
+
//(char-lower-case? char) procedure
|
1515
|
+
//(char-title-case? char) procedure
|
1516
|
+
//
|
1517
|
+
//(char-general-category char) procedure
|
1518
|
+
|
1519
|
+
//(string-upcase string) procedure
|
1520
|
+
//(string-downcase string) procedure
|
1521
|
+
//(string-titlecase string) procedure
|
1522
|
+
//(string-foldcase string) procedure
|
1523
|
+
//
|
1524
|
+
//(string-ci=? string1 string2 string3 ...) procedure
|
1525
|
+
//(string-ci<? string1 string2 string3 ...) procedure
|
1526
|
+
//(string-ci>? string1 string2 string3 ...) procedure
|
1527
|
+
//(string-ci<=? string1 string2 string3 ...) procedure
|
1528
|
+
//(string-ci>=? string1 string2 string3 ...) procedure
|
1529
|
+
//
|
1530
|
+
//(string-normalize-nfd string) procedure
|
1531
|
+
//(string-normalize-nfkd string) procedure
|
1532
|
+
//(string-normalize-nfc string) procedure
|
1533
|
+
//(string-normalize-nfkc string) procedure
|
1534
|
+
|
1535
|
+
//
|
1536
|
+
// Chapter 2 Bytevectors
|
1537
|
+
//
|
1538
|
+
|
1539
|
+
//
|
1540
|
+
// Chapter 3 List utilities
|
1541
|
+
//
|
1542
|
+
define_libfunc("find", 2, 2, function(ar){
|
1543
|
+
var proc = ar[0], ls = ar[1];
|
1544
|
+
assert_pair(ls);
|
1545
|
+
return Call.foreach(ls, {
|
1546
|
+
call: function(x){ return new Call(proc, [x.car]) },
|
1547
|
+
result: function(res, x){ if(res) return x.car; },
|
1548
|
+
finish: function(){ return false }
|
1549
|
+
})
|
1550
|
+
})
|
1551
|
+
define_libfunc("for-all", 2, null, function(ar){
|
1552
|
+
var proc = ar.shift();
|
1553
|
+
var lists = ar;
|
1554
|
+
lists.each(function(ls){ assert_pair(ls) });
|
1555
|
+
|
1556
|
+
var last = true; //holds last result which proc returns
|
1557
|
+
return Call.multi_foreach(lists, {
|
1558
|
+
call: function(pairs){
|
1559
|
+
return new Call(proc, pairs.map(function(x){ return x.car }));
|
1560
|
+
},
|
1561
|
+
result: function(res, pairs){
|
1562
|
+
if(res === false) return false;
|
1563
|
+
last = res;
|
1564
|
+
},
|
1565
|
+
finish: function(){ return last; }
|
1566
|
+
})
|
1567
|
+
})
|
1568
|
+
define_libfunc("exists", 2, null, function(ar){
|
1569
|
+
var proc = ar.shift();
|
1570
|
+
var lists = ar;
|
1571
|
+
lists.each(function(ls){ assert_pair(ls) });
|
1572
|
+
|
1573
|
+
return Call.multi_foreach(lists, {
|
1574
|
+
call: function(pairs){
|
1575
|
+
return new Call(proc, pairs.map(function(x){ return x.car }));
|
1576
|
+
},
|
1577
|
+
result: function(res, pairs){
|
1578
|
+
if(res !== false) return res;
|
1579
|
+
},
|
1580
|
+
finish: function(){ return false; }
|
1581
|
+
})
|
1582
|
+
})
|
1583
|
+
define_libfunc("filter", 2, 2, function(ar){
|
1584
|
+
var proc = ar[0], ls = ar[1];
|
1585
|
+
assert_pair(ls);
|
1586
|
+
|
1587
|
+
var a = [];
|
1588
|
+
return Call.foreach(ls, {
|
1589
|
+
call: function(x){ return new Call(proc, [x.car]) },
|
1590
|
+
result: function(res, x){ if(res) a.push(x.car); },
|
1591
|
+
finish: function(){ return a.to_list() }
|
1592
|
+
})
|
1593
|
+
})
|
1594
|
+
define_scmfunc("partition+", 2, 2,
|
1595
|
+
"(lambda (proc ls) \
|
1596
|
+
(define (partition2 proc ls t f) \
|
1597
|
+
(if (null? ls) \
|
1598
|
+
(values (reverse t) (reverse f)) \
|
1599
|
+
(if (proc (car ls)) \
|
1600
|
+
(partition2 proc (cdr ls) (cons (car ls) t) f) \
|
1601
|
+
(partition2 proc (cdr ls) t (cons (car ls) f))))) \
|
1602
|
+
(partition2 proc ls '() '()))");
|
1603
|
+
|
1604
|
+
define_libfunc("partition", 2, 2, function(ar){
|
1605
|
+
var proc = ar[0], ls = ar[1];
|
1606
|
+
assert_pair(ls);
|
1607
|
+
|
1608
|
+
var t = [], f = [];
|
1609
|
+
return Call.foreach(ls, {
|
1610
|
+
call: function(x){ return new Call(proc, [x.car]) },
|
1611
|
+
result: function(res, x){
|
1612
|
+
if(res) t.push(x.car);
|
1613
|
+
else f.push(x.car);
|
1614
|
+
},
|
1615
|
+
finish: function(){
|
1616
|
+
return new Values([t.to_list(), f.to_list()]);
|
1617
|
+
}
|
1618
|
+
})
|
1619
|
+
})
|
1620
|
+
define_libfunc("fold-left", 3, null, function(ar){
|
1621
|
+
var proc = ar.shift(), accum = ar.shift(), lists = ar;
|
1622
|
+
lists.each(function(ls){ assert_pair(ls) });
|
1623
|
+
|
1624
|
+
return Call.multi_foreach(lists, {
|
1625
|
+
call: function(pairs){
|
1626
|
+
var args = pairs.map(function(x){ return x.car });
|
1627
|
+
args.unshift(accum);
|
1628
|
+
return new Call(proc, args);
|
1629
|
+
},
|
1630
|
+
result: function(res, pairs){ accum = res; },
|
1631
|
+
finish: function(){ return accum; }
|
1632
|
+
})
|
1633
|
+
})
|
1634
|
+
define_libfunc("fold-right", 3, null, function(ar){
|
1635
|
+
var proc = ar.shift(), accum = ar.shift();
|
1636
|
+
var lists = ar.map(function(ls){
|
1637
|
+
// reverse each list
|
1638
|
+
assert_pair(ls);
|
1639
|
+
return ls.to_array().reverse().to_list();
|
1640
|
+
})
|
1641
|
+
|
1642
|
+
return Call.multi_foreach(lists, {
|
1643
|
+
call: function(pairs){
|
1644
|
+
var args = pairs.map(function(x){ return x.car });
|
1645
|
+
args.push(accum);
|
1646
|
+
return new Call(proc, args);
|
1647
|
+
},
|
1648
|
+
result: function(res, pairs){ accum = res; },
|
1649
|
+
finish: function(){ return accum; }
|
1650
|
+
})
|
1651
|
+
})
|
1652
|
+
define_libfunc("remp", 2, 2, function(ar){
|
1653
|
+
var proc = ar[0], ls = ar[1];
|
1654
|
+
assert_pair(ls);
|
1655
|
+
|
1656
|
+
var ret = [];
|
1657
|
+
return Call.foreach(ls, {
|
1658
|
+
call: function(x){ return new Call(proc, [x.car]) },
|
1659
|
+
result: function(res, x){ if(!res) ret.push(x.car); },
|
1660
|
+
finish: function(){ return ret.to_list(); }
|
1661
|
+
})
|
1662
|
+
})
|
1663
|
+
var make_remover = function(key){
|
1664
|
+
return function(ar){
|
1665
|
+
var obj = ar[0], ls = ar[1];
|
1666
|
+
assert_pair(ls);
|
1667
|
+
|
1668
|
+
var ret = [];
|
1669
|
+
return Call.foreach(ls, {
|
1670
|
+
call: function(x){
|
1671
|
+
return new Call(TopEnv[key] || CoreEnv[key], [obj, x.car])
|
1672
|
+
},
|
1673
|
+
result: function(res, x){ if(!res) ret.push(x.car); },
|
1674
|
+
finish: function(){ return ret.to_list(); }
|
1675
|
+
})
|
1676
|
+
}
|
1677
|
+
}
|
1678
|
+
define_libfunc("remove", 2, 2, make_remover("equal?"));
|
1679
|
+
define_libfunc("remv", 2, 2, make_remover("eqv?"));
|
1680
|
+
define_libfunc("remq", 2, 2, make_remover("eq?"));
|
1681
|
+
|
1682
|
+
define_libfunc("memp", 2, 2, function(ar){
|
1683
|
+
var proc = ar[0], ls = ar[1];
|
1684
|
+
assert_pair(ls);
|
1685
|
+
|
1686
|
+
var ret = [];
|
1687
|
+
return Call.foreach(ls, {
|
1688
|
+
call: function(x){ return new Call(proc, [x.car]) },
|
1689
|
+
result: function(res, x){ if(res) return x; },
|
1690
|
+
finish: function(){ return false; }
|
1691
|
+
})
|
1692
|
+
})
|
1693
|
+
var make_finder = function(key){
|
1694
|
+
return function(ar){
|
1695
|
+
var obj = ar[0], ls = ar[1];
|
1696
|
+
assert_pair(ls);
|
1697
|
+
|
1698
|
+
var ret = [];
|
1699
|
+
return Call.foreach(ls, {
|
1700
|
+
call: function(x){
|
1701
|
+
return new Call(TopEnv[key] || CoreEnv[key], [obj, x.car])
|
1702
|
+
},
|
1703
|
+
result: function(res, x){ if(res) return x; },
|
1704
|
+
finish: function(){ return false; }
|
1705
|
+
})
|
1706
|
+
}
|
1707
|
+
}
|
1708
|
+
define_libfunc("member", 2, 2, make_finder("equal?"));
|
1709
|
+
define_libfunc("memv", 2, 2, make_finder("eqv?"));
|
1710
|
+
define_libfunc("memq", 2, 2, make_finder("eq?"));
|
1711
|
+
|
1712
|
+
define_libfunc("assp", 2, 2, function(ar){
|
1713
|
+
var proc = ar[0], als = ar[1];
|
1714
|
+
assert_pair(als);
|
1715
|
+
|
1716
|
+
var ret = [];
|
1717
|
+
return Call.foreach(als, {
|
1718
|
+
call: function(x){
|
1719
|
+
if(x.car.car)
|
1720
|
+
return new Call(proc, [x.car.car]);
|
1721
|
+
else
|
1722
|
+
throw new Error("ass*: pair required but got "+to_write(x.car));
|
1723
|
+
},
|
1724
|
+
result: function(res, x){ if(res) return x.car; },
|
1725
|
+
finish: function(){ return false; }
|
1726
|
+
})
|
1727
|
+
})
|
1728
|
+
var make_assoc = function(key){
|
1729
|
+
return function(ar){
|
1730
|
+
var obj = ar[0], ls = ar[1];
|
1731
|
+
assert_pair(ls);
|
1732
|
+
|
1733
|
+
var ret = [];
|
1734
|
+
return Call.foreach(ls, {
|
1735
|
+
call: function(x){
|
1736
|
+
if(x.car.car)
|
1737
|
+
return new Call(TopEnv[key] || CoreEnv[key], [obj, x.car.car])
|
1738
|
+
else
|
1739
|
+
throw new Error("ass*: pair required but got "+to_write(x.car));
|
1740
|
+
},
|
1741
|
+
result: function(res, x){ if(res) return x.car; },
|
1742
|
+
finish: function(){ return false; }
|
1743
|
+
})
|
1744
|
+
}
|
1745
|
+
}
|
1746
|
+
define_libfunc("assoc", 2, 2, make_assoc("equal?"));
|
1747
|
+
define_libfunc("assv", 2, 2, make_assoc("eqv?"));
|
1748
|
+
define_libfunc("assq", 2, 2, make_assoc("eq?"));
|
1749
|
+
|
1750
|
+
define_libfunc("cons*", 1, null, function(ar){
|
1751
|
+
if(ar.length == 1)
|
1752
|
+
return ar[0];
|
1753
|
+
else{
|
1754
|
+
var ret = null;
|
1755
|
+
ar.reverse().each(function(x){
|
1756
|
+
if(ret){
|
1757
|
+
ret = new Pair(x, ret);
|
1758
|
+
}
|
1759
|
+
else
|
1760
|
+
ret = x;
|
1761
|
+
})
|
1762
|
+
return ret;
|
1763
|
+
}
|
1764
|
+
})
|
1765
|
+
|
1766
|
+
//
|
1767
|
+
// Chapter 4 Sorting
|
1768
|
+
//
|
1769
|
+
//(list-sort proc list) procedure
|
1770
|
+
//(vector-sort proc vector) procedure
|
1771
|
+
//(vector-sort! proc vector) procedure
|
1772
|
+
|
1773
|
+
//
|
1774
|
+
// Chapter 5 Control Structures
|
1775
|
+
//
|
1776
|
+
define_syntax("when", function(x){
|
1777
|
+
//(when test body ...)
|
1778
|
+
//=> (if test (begin body ...) #<undef>)
|
1779
|
+
var test = x.cdr.car, body = x.cdr.cdr;
|
1780
|
+
|
1781
|
+
return new Pair(Sym("if"),
|
1782
|
+
new Pair(test,
|
1783
|
+
new Pair(new Pair(Sym("begin"), body),
|
1784
|
+
new Pair(BiwaScheme.undef, nil))));
|
1785
|
+
})
|
1786
|
+
define_syntax("unless", function(x){
|
1787
|
+
//(unless test body ...)
|
1788
|
+
//=> (if (not test) (begin body ...) #<undef>)
|
1789
|
+
var test = x.cdr.car, body = x.cdr.cdr;
|
1790
|
+
|
1791
|
+
return new Pair(Sym("if"),
|
1792
|
+
new Pair(new Pair(Sym("not"), new Pair(test, nil)),
|
1793
|
+
new Pair(new Pair(Sym("begin"), body),
|
1794
|
+
new Pair(BiwaScheme.undef, nil))));
|
1795
|
+
})
|
1796
|
+
//(do ((<variable1> <init1> <step1>) syntax
|
1797
|
+
//(case-lambda <case-lambda clause> ...) syntax
|
1798
|
+
|
1799
|
+
//
|
1800
|
+
// Chapter 6 Records
|
1801
|
+
//
|
1802
|
+
//eqv, eq
|
1803
|
+
//(define-record-type <name spec> <record clause>*) syntax
|
1804
|
+
//fields auxiliary syntax
|
1805
|
+
//mutable auxiliary syntax
|
1806
|
+
//immutable auxiliary syntax
|
1807
|
+
//parent auxiliary syntax
|
1808
|
+
//protocol auxiliary syntax
|
1809
|
+
//sealed auxiliary syntax
|
1810
|
+
//opaque auxiliary syntax
|
1811
|
+
//nongenerative auxiliary syntax
|
1812
|
+
//parent-rtd auxiliary syntax
|
1813
|
+
//
|
1814
|
+
//(make-record-type-descriptor name procedure
|
1815
|
+
//(record-type-descriptor? obj) procedure
|
1816
|
+
//(make-record-constructor-descriptor rtd procedure
|
1817
|
+
//(record-constructor constructor-descriptor) procedure
|
1818
|
+
//(record-predicate rtd) procedure
|
1819
|
+
//(record-accessor rtd k) procedure
|
1820
|
+
//(record-mutator rtd k) procedure
|
1821
|
+
//
|
1822
|
+
//(record? obj) procedure
|
1823
|
+
//(record-rtd record) procedure
|
1824
|
+
//(record-type-name rtd) procedure
|
1825
|
+
//(record-type-parent rtd) procedure
|
1826
|
+
//(record-type-uid rtd) procedure
|
1827
|
+
//(record-type-generative? rtd) procedure
|
1828
|
+
//(record-type-sealed? rtd) procedure
|
1829
|
+
//(record-type-opaque? rtd) procedure
|
1830
|
+
//(record-type-field-names rtd) procedure
|
1831
|
+
//(record-field-mutable? rtd k) procedure
|
1832
|
+
|
1833
|
+
//
|
1834
|
+
// Chapter 7 Exceptions and conditions
|
1835
|
+
//
|
1836
|
+
//(with-exception-handler handler thunk) procedure
|
1837
|
+
//(guard (<variable> syntax
|
1838
|
+
//(raise obj) procedure
|
1839
|
+
//(raise-continuable obj) procedure
|
1840
|
+
//
|
1841
|
+
//&condition condition type
|
1842
|
+
//(condition condition1 ...) procedure
|
1843
|
+
//(simple-conditions condition) procedure
|
1844
|
+
//(condition? obj) procedure
|
1845
|
+
//(condition-predicate rtd) procedure
|
1846
|
+
//(condition-accessor rtd proc) procedure
|
1847
|
+
//
|
1848
|
+
//&message condition type
|
1849
|
+
//&warning condition type
|
1850
|
+
//&serious condition type
|
1851
|
+
//&error condition type
|
1852
|
+
//&violation condition type
|
1853
|
+
//&assertion condition type
|
1854
|
+
//&irritants condition type
|
1855
|
+
//&who condition type
|
1856
|
+
//&non-continuable condition type
|
1857
|
+
//&implementation-restriction condition type
|
1858
|
+
//&lexical condition type
|
1859
|
+
//&syntax condition type
|
1860
|
+
//&undefined condition type
|
1861
|
+
|
1862
|
+
//
|
1863
|
+
// Chapter 8 I/O
|
1864
|
+
//
|
1865
|
+
// // 8 I/O
|
1866
|
+
// // 8.1 Condition types
|
1867
|
+
//&i/o condition type
|
1868
|
+
//&i/o-read condition type
|
1869
|
+
//&i/o-write condition type
|
1870
|
+
//&i/o-invalid-position condition type
|
1871
|
+
//&i/o-filename condition type
|
1872
|
+
//&i/o-file-protection condition type
|
1873
|
+
//&i/o-file-is-read-only condition type
|
1874
|
+
//&i/o-file-already-exists condition type
|
1875
|
+
//&i/o-file-does-not-exist condition type
|
1876
|
+
//&i/o-port condition type
|
1877
|
+
//
|
1878
|
+
// // 8.2 Port I/O
|
1879
|
+
// // 8.2.1 File names
|
1880
|
+
// //(no function introduced)
|
1881
|
+
//
|
1882
|
+
// // 8.2.2 File options
|
1883
|
+
//(file-options <file-options symbol> ...) syntax
|
1884
|
+
//
|
1885
|
+
// // 8.2.3 Buffer modes
|
1886
|
+
//(buffer-mode <buffer-mode symbol>) syntax
|
1887
|
+
//(buffer-mode? obj) procedure
|
1888
|
+
//
|
1889
|
+
// // 8.2.4 Transcoders
|
1890
|
+
//(latin-1-codec) procedure
|
1891
|
+
//(utf-8-codec) procedure
|
1892
|
+
//(utf-16-codec) procedure
|
1893
|
+
//(eol-style <eol-style symbol>) syntax
|
1894
|
+
//(native-eol-style) procedure
|
1895
|
+
//&i/o-decoding condition type
|
1896
|
+
//&i/o-encoding condition type
|
1897
|
+
//(error-handling-mode <error-handling-mode symbol>) syntax
|
1898
|
+
//(make-transcoder codec) procedure
|
1899
|
+
//(make-transcoder codec eol-style) procedure
|
1900
|
+
//(make-transcoder codec eol-style handling-mode) procedure
|
1901
|
+
//(native-transcoder) procedure
|
1902
|
+
//(transcoder-codec transcoder) procedure
|
1903
|
+
//(transcoder-eol-style transcoder) procedure
|
1904
|
+
//(transcoder-error-handling-mode transcoder) procedure
|
1905
|
+
//(bytevector->string bytevector transcoder) procedure
|
1906
|
+
//(string->bytevector string transcoder) procedure
|
1907
|
+
//
|
1908
|
+
// 8.2.5 End-of-file object
|
1909
|
+
//8.3 (eof-object) procedure
|
1910
|
+
//8.3 (eof-object? obj) procedure
|
1911
|
+
|
1912
|
+
// 8.2.6 Input and output ports
|
1913
|
+
define_libfunc("port?", 1, 1, function(ar){
|
1914
|
+
return (ar[0] instanceof Port);
|
1915
|
+
})
|
1916
|
+
//(port-transcoder port) procedure
|
1917
|
+
define_libfunc("textual-port?", 1, 1, function(ar){
|
1918
|
+
assert_port(ar[0]);
|
1919
|
+
return !ar[0].is_binary;
|
1920
|
+
})
|
1921
|
+
define_libfunc("binary-port?", 1, 1, function(ar){
|
1922
|
+
assert_port(ar[0]);
|
1923
|
+
return ar[0].is_binary;
|
1924
|
+
})
|
1925
|
+
//(transcoded-port binary-port transcoder) procedure
|
1926
|
+
//(port-has-port-position? port) procedure
|
1927
|
+
//(port-position port) procedure
|
1928
|
+
//(port-has-set-port-position!? port) procedure
|
1929
|
+
//(set-port-position! port pos) procedure
|
1930
|
+
define_libfunc("close-port", 1, 1, function(ar){
|
1931
|
+
assert_port(ar[0]);
|
1932
|
+
ar[0].close();
|
1933
|
+
})
|
1934
|
+
//(call-with-port port proc) procedure
|
1935
|
+
|
1936
|
+
// 8.2.7 Input ports
|
1937
|
+
//8.3 (input-port? obj) procedure
|
1938
|
+
//(port-eof? input-port) procedure
|
1939
|
+
//(open-file-input-port filename) procedure
|
1940
|
+
//(open-bytevector-input-port bytevector) procedure
|
1941
|
+
//(open-string-input-port string) procedure
|
1942
|
+
//(standard-input-port) procedure
|
1943
|
+
//8.3 (current-input-port) procedure
|
1944
|
+
//(make-custom-binary-input-port id read! procedure
|
1945
|
+
//(make-custom-textual-input-port id read! procedure
|
1946
|
+
//
|
1947
|
+
// // 8.2.8 Binary input
|
1948
|
+
//(get-u8 binary-input-port) procedure
|
1949
|
+
//(lookahead-u8 binary-input-port) procedure
|
1950
|
+
//(get-bytevector-n binary-input-port count) procedure
|
1951
|
+
//(get-bytevector-n! binary-input-port procedure
|
1952
|
+
//(get-bytevector-some binary-input-port) procedure
|
1953
|
+
//(get-bytevector-all binary-input-port) procedure
|
1954
|
+
//
|
1955
|
+
// // 8.2.9 Textual input
|
1956
|
+
//(get-char textual-input-port) procedure
|
1957
|
+
//(lookahead-char textual-input-port) procedure
|
1958
|
+
//(get-string-n textual-input-port count) procedure
|
1959
|
+
//(get-string-n! textual-input-port string start count) procedure
|
1960
|
+
//(get-string-all textual-input-port) procedure
|
1961
|
+
//(get-line textual-input-port) procedure
|
1962
|
+
//(get-datum textual-input-port) procedure
|
1963
|
+
//
|
1964
|
+
// 8.2.10 Output ports
|
1965
|
+
//8.3 (output-port? obj) procedure
|
1966
|
+
//(flush-output-port output-port) procedure
|
1967
|
+
//(output-port-buffer-mode output-port) procedure
|
1968
|
+
//(open-file-output-port filename) procedure
|
1969
|
+
//(open-bytevector-output-port) procedure
|
1970
|
+
//(call-with-bytevector-output-port proc) procedure
|
1971
|
+
//(open-string-output-port) procedure
|
1972
|
+
//(call-with-string-output-port proc) procedure
|
1973
|
+
//(standard-output-port) procedure
|
1974
|
+
//(standard-error-port) procedure
|
1975
|
+
//8.3 (current-output-port) procedure
|
1976
|
+
//8.3 (current-error-port) procedure
|
1977
|
+
//(make-custom-binary-output-port id procedure
|
1978
|
+
//(make-custom-textual-output-port id write! get-position set-position! close)
|
1979
|
+
// define_libfunc("make-custom-textual-output-port", 5, 5, function(ar){
|
1980
|
+
// assert_string(ar[0]);
|
1981
|
+
// assert_closure(ar[1]);
|
1982
|
+
// assert_closure(ar[2]);
|
1983
|
+
// assert_closure(ar[3]);
|
1984
|
+
// assert_closure(ar[4]);
|
1985
|
+
// return new Port(ar[0], ar[1], ar[2], ar[3], ar[4]);
|
1986
|
+
// })
|
1987
|
+
//
|
1988
|
+
// // 8.2.11 Binary output
|
1989
|
+
//(put-u8 binary-output-port octet) procedure
|
1990
|
+
//(put-bytevector binary-output-port bytevector) procedure
|
1991
|
+
//
|
1992
|
+
// 8.2.12 Textual output
|
1993
|
+
define_libfunc("put-char", 2, 2, function(ar){
|
1994
|
+
assert_port(ar[0]);
|
1995
|
+
assert_char(ar[1]);
|
1996
|
+
ar[0].put_string(ar[1].value);
|
1997
|
+
})
|
1998
|
+
define_libfunc("put-string", 2, 2, function(ar){
|
1999
|
+
assert_port(ar[0]);
|
2000
|
+
assert_string(ar[1]);
|
2001
|
+
ar[0].put_string(ar[1]);
|
2002
|
+
})
|
2003
|
+
define_libfunc("put-datum", 2, 2, function(ar){
|
2004
|
+
assert_port(ar[0]);
|
2005
|
+
ar[0].put_string(to_write(ar[1]));
|
2006
|
+
})
|
2007
|
+
//
|
2008
|
+
// // 8.2.13 Input/output ports
|
2009
|
+
//(open-file-input/output-port filename) procedure
|
2010
|
+
//(make-custom-binary-input/output-port procedure
|
2011
|
+
//(make-custom-textual-input/output-port procedure
|
2012
|
+
//
|
2013
|
+
// // 8.3 Simple I/O
|
2014
|
+
define_libfunc("eof-object", 0, 0, function(ar){
|
2015
|
+
return eof;
|
2016
|
+
})
|
2017
|
+
define_libfunc("eof-object?", 1, 1, function(ar){
|
2018
|
+
return ar[0] === eof;
|
2019
|
+
})
|
2020
|
+
//(call-with-input-file filename proc) procedure
|
2021
|
+
//(call-with-output-file filename proc) procedure
|
2022
|
+
define_libfunc("input-port?", 1, 1, function(ar){
|
2023
|
+
assert_port(ar[0]);
|
2024
|
+
return ar[0].is_input;
|
2025
|
+
})
|
2026
|
+
define_libfunc("output-port?", 1, 1, function(ar){
|
2027
|
+
assert_port(ar[0]);
|
2028
|
+
return ar[0].is_output;
|
2029
|
+
})
|
2030
|
+
define_libfunc("current-input-port", 0, 0, function(ar){
|
2031
|
+
return Port.current_input;
|
2032
|
+
})
|
2033
|
+
define_libfunc("current-output-port", 0, 0, function(ar){
|
2034
|
+
return Port.current_output;
|
2035
|
+
})
|
2036
|
+
define_libfunc("current-error-port", 0, 0, function(ar){
|
2037
|
+
return Port.current_error;
|
2038
|
+
})
|
2039
|
+
//(with-input-from-file filename thunk) procedure
|
2040
|
+
//(with-output-to-file filename thunk) procedure
|
2041
|
+
//(open-input-file filename) procedure
|
2042
|
+
//(open-output-file filename) procedure
|
2043
|
+
define_libfunc("close-input-port", 1, 1, function(ar){
|
2044
|
+
assert_port(ar[0]);
|
2045
|
+
if(!ar[0].is_input)
|
2046
|
+
throw new Error("close-input-port: port is not input port");
|
2047
|
+
ar[0].close();
|
2048
|
+
});
|
2049
|
+
define_libfunc("close-output-port", 1, 1, function(ar){
|
2050
|
+
assert_port(ar[0]);
|
2051
|
+
if(!ar[0].is_output)
|
2052
|
+
throw new Error("close-output-port: port is not output port");
|
2053
|
+
ar[0].close();
|
2054
|
+
});
|
2055
|
+
//(read-char) procedure
|
2056
|
+
//(peek-char) procedure
|
2057
|
+
define_libfunc("read", 0, 0, function(ar){
|
2058
|
+
return Port.current_input.get_string(function(str){
|
2059
|
+
var parser = new Parser(str);
|
2060
|
+
return parser.getObject();
|
2061
|
+
})
|
2062
|
+
})
|
2063
|
+
|
2064
|
+
// write-char [1,2]
|
2065
|
+
define_libfunc("newline", 0, 1, function(ar){
|
2066
|
+
var port = ar[0] || Port.current_output;
|
2067
|
+
port.put_string("\n");
|
2068
|
+
});
|
2069
|
+
define_libfunc("display", 1, 2, function(ar){
|
2070
|
+
var port = ar[1] || Port.current_output;
|
2071
|
+
port.put_string(to_display(ar[0]));
|
2072
|
+
});
|
2073
|
+
define_libfunc("write", 1, 2, function(ar){
|
2074
|
+
var port = ar[1] || Port.current_output;
|
2075
|
+
port.put_string(to_write(ar[0]));
|
2076
|
+
});
|
2077
|
+
|
2078
|
+
//
|
2079
|
+
// Chapter 9 File System
|
2080
|
+
//
|
2081
|
+
//(file-exists? filename) procedure
|
2082
|
+
define_libfunc("file-exists?", 1, 1, function(ar){
|
2083
|
+
netscape.security.PrivilegeManager.enablePrivilege("UniversalXPConnect"); //TODO: extract to a function
|
2084
|
+
assert_string(ar[0]);
|
2085
|
+
var fileIn = FileIO.open(ar[0]);
|
2086
|
+
return fileIn.exists();
|
2087
|
+
});
|
2088
|
+
//(delete-file filename) procedure
|
2089
|
+
define_libfunc("delete-file", 1, 1, function(ar){
|
2090
|
+
netscape.security.PrivilegeManager.enablePrivilege("UniversalXPConnect"); //TODO: extract to a function
|
2091
|
+
assert_string(ar[0]);
|
2092
|
+
var deleted = FileIO.unlink(FileIO.open(ar[0]));
|
2093
|
+
if(!deleted){
|
2094
|
+
//TODO: raise %i/o-filename if not found or not deletable
|
2095
|
+
puts("delete-file: cannot delete " + ar[0]);
|
2096
|
+
}
|
2097
|
+
});
|
2098
|
+
|
2099
|
+
//
|
2100
|
+
// Chapter 10 Command-line access and exit values
|
2101
|
+
//
|
2102
|
+
//(command-line) procedure
|
2103
|
+
//(exit) procedure
|
2104
|
+
//(exit obj) procedure
|
2105
|
+
|
2106
|
+
//
|
2107
|
+
// Chapter 11 Arithmetic
|
2108
|
+
//
|
2109
|
+
//// 11.1 Bitwise operations
|
2110
|
+
//// 11.2 Fixnums
|
2111
|
+
//(fixnum? obj) procedure
|
2112
|
+
//(fixnum-width) procedure
|
2113
|
+
//(least-fixnum) procedure
|
2114
|
+
//(greatest-fixnum) procedure
|
2115
|
+
//(fx=? fx1 fx2 fx3 ...) procedure
|
2116
|
+
//(fx>? fx1 fx2 fx3 ...) procedure
|
2117
|
+
//(fx<? fx1 fx2 fx3 ...) procedure
|
2118
|
+
//(fx>=? fx1 fx2 fx3 ...) procedure
|
2119
|
+
//(fx<=? fx1 fx2 fx3 ...) procedure
|
2120
|
+
//(fxzero? fx) procedure
|
2121
|
+
//(fxpositive? fx) procedure
|
2122
|
+
//(fxnegative? fx) procedure
|
2123
|
+
//(fxodd? fx) procedure
|
2124
|
+
//(fxeven? fx) procedure
|
2125
|
+
//(fxmax fx1 fx2 ...) procedure
|
2126
|
+
//(fxmin fx1 fx2 ...) procedure
|
2127
|
+
//(fx+ fx1 fx2) procedure
|
2128
|
+
//(fx* fx1 fx2) procedure
|
2129
|
+
//(fx- fx1 fx2) procedure
|
2130
|
+
//(fxdiv-and-mod fx1 fx2) procedure
|
2131
|
+
//(fxdiv fx1 fx2) procedure
|
2132
|
+
//(fxmod fx1 fx2) procedure
|
2133
|
+
//(fxdiv0-and-mod0 fx1 fx2) procedure
|
2134
|
+
//(fxdiv0 fx1 fx2) procedure
|
2135
|
+
//(fxmod0 fx1 fx2) procedure
|
2136
|
+
//(fx+/carry fx1 fx2 fx3) procedure
|
2137
|
+
//(fx-/carry fx1 fx2 fx3) procedure
|
2138
|
+
//(fx*/carry fx1 fx2 fx3) procedure
|
2139
|
+
//(fxnot fx) procedure
|
2140
|
+
//(fxand fx1 ...) procedure
|
2141
|
+
//(fxior fx1 ...) procedure
|
2142
|
+
//(fxxor fx1 ...) procedure
|
2143
|
+
//(fxif fx1 fx2 fx3) procedure
|
2144
|
+
//(fxbit-count fx) procedure
|
2145
|
+
//(fxlength fx) procedure
|
2146
|
+
//(fxfirst-bit-set fx) procedure
|
2147
|
+
//(fxbit-set? fx1 fx2) procedure
|
2148
|
+
//(fxcopy-bit fx1 fx2 fx3) procedure
|
2149
|
+
//(fxbit-field fx1 fx2 fx3) procedure
|
2150
|
+
//(fxcopy-bit-field fx1 fx2 fx3 fx4) procedure
|
2151
|
+
//(fxarithmetic-shift fx1 fx2) procedure
|
2152
|
+
//(fxarithmetic-shift-left fx1 fx2) procedure
|
2153
|
+
//(fxarithmetic-shift-right fx1 fx2) procedure
|
2154
|
+
//(fxrotate-bit-field fx1 fx2 fx3 fx4) procedure
|
2155
|
+
//(fxreverse-bit-field fx1 fx2 fx3) procedure
|
2156
|
+
//
|
2157
|
+
//// 11.3 Flonums
|
2158
|
+
//(flonum? obj) procedure
|
2159
|
+
//(real->flonum x) procedure
|
2160
|
+
//(fl=? fl1 fl2 fl3 ...) procedure
|
2161
|
+
//(fl<? fl1 fl2 fl3 ...) procedure
|
2162
|
+
//(fl<=? fl1 fl2 fl3 ...) procedure
|
2163
|
+
//(fl>? fl1 fl2 fl3 ...) procedure
|
2164
|
+
//(fl>=? fl1 fl2 fl3 ...) procedure
|
2165
|
+
//(flinteger? fl) procedure
|
2166
|
+
//(flzero? fl) procedure
|
2167
|
+
//(flpositive? fl) procedure
|
2168
|
+
//(flnegative? fl) procedure
|
2169
|
+
//(flodd? ifl) procedure
|
2170
|
+
//(fleven? ifl) procedure
|
2171
|
+
//(flfinite? fl) procedure
|
2172
|
+
//(flinfinite? fl) procedure
|
2173
|
+
//(flnan? fl) procedure
|
2174
|
+
//(flmax fl1 fl2 ...) procedure
|
2175
|
+
//(flmin fl1 fl2 ...) procedure
|
2176
|
+
//(fl+ fl1 ...) procedure
|
2177
|
+
//(fl* fl1 ...) procedure
|
2178
|
+
//(fl- fl1 fl2 ...) procedure
|
2179
|
+
//(fl- fl) procedure
|
2180
|
+
//(fl/ fl1 fl2 ...) procedure
|
2181
|
+
//(fl/ fl) procedure
|
2182
|
+
//(flabs fl) procedure
|
2183
|
+
//(fldiv-and-mod fl1 fl2) procedure
|
2184
|
+
//(fldiv fl1 fl2) procedure
|
2185
|
+
//(flmod fl1 fl2) procedure
|
2186
|
+
//(fldiv0-and-mod0 fl1 fl2) procedure
|
2187
|
+
//(fldiv0 fl1 fl2) procedure
|
2188
|
+
//(flmod0 fl1 fl2) procedure
|
2189
|
+
//(flnumerator fl) procedure
|
2190
|
+
//(fldenominator fl) procedure
|
2191
|
+
//(flfloor fl) procedure
|
2192
|
+
//(flceiling fl) procedure
|
2193
|
+
//(fltruncate fl) procedure
|
2194
|
+
//(flround fl) procedure
|
2195
|
+
//(flexp fl) procedure
|
2196
|
+
//(fllog fl) procedure
|
2197
|
+
//(fllog fl1 fl2) procedure
|
2198
|
+
//(flsin fl) procedure
|
2199
|
+
//(flcos fl) procedure
|
2200
|
+
//(fltan fl) procedure
|
2201
|
+
//(flasin fl) procedure
|
2202
|
+
//(flacos fl) procedure
|
2203
|
+
//(flatan fl) procedure
|
2204
|
+
//(flatan fl1 fl2) procedure
|
2205
|
+
//(flsqrt fl) procedure
|
2206
|
+
//(flexpt fl1 fl2) procedure
|
2207
|
+
//&no-infinities condition type
|
2208
|
+
//&no-nans condition type
|
2209
|
+
//(fixnum->flonum fx) procedure
|
2210
|
+
//
|
2211
|
+
//// 11.4 Exact bitwise arithmetic
|
2212
|
+
//(bitwise-not ei) procedure
|
2213
|
+
//(bitwise-and ei1 ...) procedure
|
2214
|
+
//(bitwise-ior ei1 ...) procedure
|
2215
|
+
//(bitwise-xor ei1 ...) procedure
|
2216
|
+
//(bitwise-if ei1 ei2 ei3) procedure
|
2217
|
+
//(bitwise-bit-count ei) procedure
|
2218
|
+
//(bitwise-length ei) procedure
|
2219
|
+
//(bitwise-first-bit-set ei) procedure
|
2220
|
+
//(bitwise-bit-set? ei1 ei2) procedure
|
2221
|
+
//(bitwise-copy-bit ei1 ei2 ei3) procedure
|
2222
|
+
//(bitwise-bit-field ei1 ei2 ei3) procedure
|
2223
|
+
//(bitwise-copy-bit-field ei1 ei2 ei3 ei4) procedure
|
2224
|
+
//(bitwise-arithmetic-shift ei1 ei2) procedure
|
2225
|
+
//(bitwise-arithmetic-shift-left ei1 ei2) procedure
|
2226
|
+
//(bitwise-arithmetic-shift-right ei1 ei2) procedure
|
2227
|
+
//(bitwise-arithmetic-shift-right ei1 ei2)
|
2228
|
+
//(bitwise-rotate-bit-field ei1 ei2 ei3 ei4) procedure
|
2229
|
+
//(bitwise-reverse-bit-field ei1 ei2 ei3) procedure
|
2230
|
+
|
2231
|
+
|
2232
|
+
//
|
2233
|
+
// Chapter 12 syntax-case
|
2234
|
+
//
|
2235
|
+
|
2236
|
+
//
|
2237
|
+
// Chapter 13 Hashtables
|
2238
|
+
//
|
2239
|
+
Hash.prototype.to_write = function(){
|
2240
|
+
return "#<Hashtable:size=" + this.keys().length + ">";
|
2241
|
+
};
|
2242
|
+
//13.1 Constructors
|
2243
|
+
//(define h (make-eq-hashtale)
|
2244
|
+
//(define h (make-eq-hashtable 1000))
|
2245
|
+
define_libfunc("make-eq-hashtable", 0, 1, function(ar){
|
2246
|
+
// ar[1] (hashtable size) is just ignored
|
2247
|
+
return $H({});
|
2248
|
+
});
|
2249
|
+
//(make-eqv-hashtable) procedure
|
2250
|
+
//(make-eqv-hashtable k) procedure
|
2251
|
+
//(make-hashtable hash-function equiv) procedure
|
2252
|
+
//(make-hashtable hash-function equiv k) procedure
|
2253
|
+
|
2254
|
+
//13.2 Procedures
|
2255
|
+
// (hashtable? hash)
|
2256
|
+
define_libfunc("hashtable?", 1, 1, function(ar){
|
2257
|
+
return ar[0] instanceof Hash;
|
2258
|
+
});
|
2259
|
+
//(hashtable-size hash)
|
2260
|
+
define_libfunc("hashtable-size", 1, 1, function(ar){
|
2261
|
+
assert_hashtable(ar[0]);
|
2262
|
+
return ar[0].keys().length;
|
2263
|
+
});
|
2264
|
+
//(hashtable-ref hash "foo" #f)
|
2265
|
+
define_libfunc("hashtable-ref", 3, 3, function(ar){
|
2266
|
+
assert_hashtable(ar[0]);
|
2267
|
+
var found = ar[0].get(ar[1]);
|
2268
|
+
|
2269
|
+
if (found === undefined)
|
2270
|
+
return ar[2];
|
2271
|
+
else
|
2272
|
+
return found;
|
2273
|
+
});
|
2274
|
+
//(hashtable-set! hash "foo" '(1 2))
|
2275
|
+
define_libfunc("hashtable-set!", 3, 3, function(ar){
|
2276
|
+
assert_hashtable(ar[0]);
|
2277
|
+
ar[0].set(ar[1], ar[2]);
|
2278
|
+
});
|
2279
|
+
//(hashtable-delete! hash "foo")
|
2280
|
+
define_libfunc("hashtable-delete!", 2, 2, function(ar){
|
2281
|
+
assert_hashtable(ar[0]);
|
2282
|
+
ar[0].unset(ar[1]);
|
2283
|
+
});
|
2284
|
+
//(hashtable-contains? hash "foo")
|
2285
|
+
define_libfunc("hashtable-contains?", 2, 2, function(ar){
|
2286
|
+
assert_hashtable(ar[0]);
|
2287
|
+
return ar[0].get(ar[1]) !== undefined;
|
2288
|
+
});
|
2289
|
+
//(hashtable-update! hashtable key proc default) procedure
|
2290
|
+
//(hashtable-copy hashtable) procedure
|
2291
|
+
//(hashtable-copy hashtable mutable) procedure
|
2292
|
+
//(hashtable-clear! hashtable) procedure
|
2293
|
+
//(hashtable-clear! hashtable k) procedure
|
2294
|
+
//(hashtable-keys hash) ; => vector
|
2295
|
+
define_libfunc("hashtable-keys", 1, 1, function(ar){
|
2296
|
+
assert_hashtable(ar[0]);
|
2297
|
+
return ar[0].keys();
|
2298
|
+
});
|
2299
|
+
//(hashtable-entries hash) ; => two vectors (keys, values)
|
2300
|
+
define_libfunc("hashtable-entries", 1, 1, function(ar){
|
2301
|
+
assert_hashtable(ar[0]);
|
2302
|
+
return new Values([ar[0].keys(), ar[0].values()]);
|
2303
|
+
//Note: Values of two vectors shall correspond to each other.
|
2304
|
+
// This code assumes Hash#each to always iterate
|
2305
|
+
// hash entries in the same order (is this true?)
|
2306
|
+
});
|
2307
|
+
|
2308
|
+
//13.3 Inspection
|
2309
|
+
//(hashtable-equivalence-function hashtable) procedure
|
2310
|
+
//(hashtable-hash-function hashtable) procedure
|
2311
|
+
//(hashtable-mutable? hashtable) procedure
|
2312
|
+
//13.4 Hash functions
|
2313
|
+
//(equal-hash obj) procedure
|
2314
|
+
//(string-hash string) procedure
|
2315
|
+
//(string-ci-hash string) procedure
|
2316
|
+
//(symbol-hash symbol) procedure
|
2317
|
+
|
2318
|
+
//
|
2319
|
+
// Chapter 14 Enumerators
|
2320
|
+
//
|
2321
|
+
//(make-enumeration symbol-list) procedure
|
2322
|
+
//(enum-set-universe enum-set) procedure
|
2323
|
+
//(enum-set-indexer enum-set) procedure
|
2324
|
+
//(enum-set-constructor enum-set) procedure
|
2325
|
+
//(enum-set->list enum-set) procedure
|
2326
|
+
//(enum-set-member? symbol enum-set) procedure
|
2327
|
+
//(enum-set-subset? enum-set1 enum-set2) procedure
|
2328
|
+
//(enum-set=? enum-set1 enum-set2) procedure
|
2329
|
+
//(enum-set-union enum-set1 enum-set2) procedure
|
2330
|
+
//(enum-set-intersection enum-set1 enum-set2) procedure
|
2331
|
+
//(enum-set-difference enum-set1 enum-set2) procedure
|
2332
|
+
//(enum-set-complement enum-set) procedure
|
2333
|
+
//(enum-set-projection enum-set1 enum-set2) procedure
|
2334
|
+
//(define-enumeration <type-name> syntax
|
2335
|
+
//(<symbol> ...)
|
2336
|
+
//<constructor-syntax>)
|
2337
|
+
|
2338
|
+
//
|
2339
|
+
// Chapter 15 Composite library
|
2340
|
+
//
|
2341
|
+
//(rnrs 6) = all - eval - mutable pairs - mutable strings - r5rs compatibility
|
2342
|
+
|
2343
|
+
//
|
2344
|
+
// Chapter 16 eval
|
2345
|
+
//
|
2346
|
+
//(eval expression environment) procedure
|
2347
|
+
define_libfunc("eval", 1, 1, function(ar, intp){
|
2348
|
+
//TODO: environment
|
2349
|
+
//TODO: this implementation has a bug that
|
2350
|
+
// expressions which contains #<undef>, etc. cannot be evaluated.
|
2351
|
+
var expr = ar[0];
|
2352
|
+
var intp = new BiwaScheme.Interpreter(intp.on_error);
|
2353
|
+
|
2354
|
+
return intp.evaluate(expr.to_write());
|
2355
|
+
});
|
2356
|
+
//(environment import-spec ...) procedure
|
2357
|
+
|
2358
|
+
//
|
2359
|
+
// Chapter 17 Mutable pairs
|
2360
|
+
//
|
2361
|
+
//(set-car! pair obj) procedure
|
2362
|
+
//(set-cdr! pair obj) procedure
|
2363
|
+
|
2364
|
+
//
|
2365
|
+
// Chapter 18 Mutable strings
|
2366
|
+
//
|
2367
|
+
//(string-set! string k char) procedure
|
2368
|
+
// (string-fill! string char) procedure
|
2369
|
+
|
2370
|
+
//
|
2371
|
+
// Chapter 19 R5RS compatibility
|
2372
|
+
//
|
2373
|
+
//(exact->inexact z) procedure
|
2374
|
+
//(inexact->exact z) procedure
|
2375
|
+
//
|
2376
|
+
//(quotient n1 n2) procedure
|
2377
|
+
//(remainder n1 n2) procedure
|
2378
|
+
//(modulo n1 n2) procedure
|
2379
|
+
//
|
2380
|
+
//(delay <expression>) syntax
|
2381
|
+
//(force promise) procedure
|
2382
|
+
//(make-promise (lambda () <expression>))
|
2383
|
+
//
|
2384
|
+
//(null-environment n) procedure
|
2385
|
+
//(scheme-report-environment n) procedure
|
2386
|
+
|
2387
|
+
/* --------------------------------------- namespace webscheme */
|
2388
|
+
}
|