jsx
Version:
a faster, safer, easier JavaScript
2,175 lines (1,949 loc) • 195 kB
JavaScript
// This file is automatically generated by scheme2js, except for the
// benchmark harness code at the beginning and end of the file.
var EarleyBoyer = new BenchmarkSuite('EarleyBoyer', 666463, [
new Benchmark("Earley", function () { BgL_earleyzd2benchmarkzd2(); }),
new Benchmark("Boyer", function () { BgL_nboyerzd2benchmarkzd2(); })
]);
/************* GENERATED FILE - DO NOT EDIT *************/
/************* GENERATED FILE - DO NOT EDIT *************/
/************* GENERATED FILE - DO NOT EDIT *************/
/************* GENERATED FILE - DO NOT EDIT *************/
/************* GENERATED FILE - DO NOT EDIT *************/
/************* GENERATED FILE - DO NOT EDIT *************/
/************* GENERATED FILE - DO NOT EDIT *************/
/************* GENERATED FILE - DO NOT EDIT *************/
/*
* To use write/prints/... the default-output port has to be set first.
* Simply setting SC_DEFAULT_OUT and SC_ERROR_OUT to the desired values
* should do the trick.
* In the following example the std-out and error-port are redirected to
* a DIV.
function initRuntime() {
function escapeHTML(s) {
var tmp = s;
tmp = tmp.replace(/&/g, "&");
tmp = tmp.replace(/</g, "<");
tmp = tmp.replace(/>/g, ">");
tmp = tmp.replace(/ /g, " ");
tmp = tmp.replace(/\n/g, "<br />");
tmp = tmp.replace(/\t/g, "  ");
return tmp;
}
document.write("<div id='stdout'></div>");
SC_DEFAULT_OUT = new sc_GenericOutputPort(
function(s) {
var stdout = document.getElementById('stdout');
stdout.innerHTML = stdout.innerHTML + escapeHTML(s);
});
SC_ERROR_OUT = SC_DEFAULT_OUT;
}
*/
function sc_print_debug() {
sc_print.apply(null, arguments);
}
/*** META ((export *js*)) */
var sc_JS_GLOBALS = this;
var __sc_LINE=-1;
var __sc_FILE="";
/*** META ((export #t)) */
function sc_alert() {
var len = arguments.length;
var s = "";
var i;
for( i = 0; i < len; i++ ) {
s += sc_toDisplayString(arguments[ i ]);
}
return alert( s );
}
/*** META ((export #t)) */
function sc_typeof( x ) {
return typeof x;
}
/*** META ((export #t)) */
function sc_error() {
var a = [sc_jsstring2symbol("*error*")];
for (var i = 0; i < arguments.length; i++) {
a[i+1] = arguments[i];
}
throw a;
}
/*** META ((export #t)
(peephole (prefix "throw ")))
*/
function sc_raise(obj) {
throw obj;
}
/*** META ((export with-handler-lambda)) */
function sc_withHandlerLambda(handler, body) {
try {
return body();
} catch(e) {
if (!e._internalException)
return handler(e);
else
throw e;
}
}
var sc_properties = new Object();
/*** META ((export #t)) */
function sc_putpropBang(sym, key, val) {
var ht = sc_properties[sym];
if (!ht) {
ht = new Object();
sc_properties[sym] = ht;
}
ht[key] = val;
}
/*** META ((export #t)) */
function sc_getprop(sym, key) {
var ht = sc_properties[sym];
if (ht) {
if (key in ht)
return ht[key];
else
return false;
} else
return false;
}
/*** META ((export #t)) */
function sc_rempropBang(sym, key) {
var ht = sc_properties[sym];
if (ht)
delete ht[key];
}
/*** META ((export #t)) */
function sc_any2String(o) {
return jsstring2string(sc_toDisplayString(o));
}
/*** META ((export #t)
(peephole (infix 2 2 "==="))
(type bool))
*/
function sc_isEqv(o1, o2) {
return (o1 === o2);
}
/*** META ((export #t)
(peephole (infix 2 2 "==="))
(type bool))
*/
function sc_isEq(o1, o2) {
return (o1 === o2);
}
/*** META ((export #t)
(type bool))
*/
function sc_isNumber(n) {
return (typeof n === "number");
}
/*** META ((export #t)
(type bool))
*/
function sc_isComplex(n) {
return sc_isNumber(n);
}
/*** META ((export #t)
(type bool))
*/
function sc_isReal(n) {
return sc_isNumber(n);
}
/*** META ((export #t)
(type bool))
*/
function sc_isRational(n) {
return sc_isReal(n);
}
/*** META ((export #t)
(type bool))
*/
function sc_isInteger(n) {
return (parseInt(n) === n);
}
/*** META ((export #t)
(type bool)
(peephole (postfix ", false")))
*/
// we don't have exact numbers...
function sc_isExact(n) {
return false;
}
/*** META ((export #t)
(peephole (postfix ", true"))
(type bool))
*/
function sc_isInexact(n) {
return true;
}
/*** META ((export = =fx =fl)
(type bool)
(peephole (infix 2 2 "===")))
*/
function sc_equal(x) {
for (var i = 1; i < arguments.length; i++)
if (x !== arguments[i])
return false;
return true;
}
/*** META ((export < <fx <fl)
(type bool)
(peephole (infix 2 2 "<")))
*/
function sc_less(x) {
for (var i = 1; i < arguments.length; i++) {
if (x >= arguments[i])
return false;
x = arguments[i];
}
return true;
}
/*** META ((export > >fx >fl)
(type bool)
(peephole (infix 2 2 ">")))
*/
function sc_greater(x, y) {
for (var i = 1; i < arguments.length; i++) {
if (x <= arguments[i])
return false;
x = arguments[i];
}
return true;
}
/*** META ((export <= <=fx <=fl)
(type bool)
(peephole (infix 2 2 "<=")))
*/
function sc_lessEqual(x, y) {
for (var i = 1; i < arguments.length; i++) {
if (x > arguments[i])
return false;
x = arguments[i];
}
return true;
}
/*** META ((export >= >=fl >=fx)
(type bool)
(peephole (infix 2 2 ">=")))
*/
function sc_greaterEqual(x, y) {
for (var i = 1; i < arguments.length; i++) {
if (x < arguments[i])
return false;
x = arguments[i];
}
return true;
}
/*** META ((export #t)
(type bool)
(peephole (postfix "=== 0")))
*/
function sc_isZero(x) {
return (x === 0);
}
/*** META ((export #t)
(type bool)
(peephole (postfix "> 0")))
*/
function sc_isPositive(x) {
return (x > 0);
}
/*** META ((export #t)
(type bool)
(peephole (postfix "< 0")))
*/
function sc_isNegative(x) {
return (x < 0);
}
/*** META ((export #t)
(type bool)
(peephole (postfix "%2===1")))
*/
function sc_isOdd(x) {
return (x % 2 === 1);
}
/*** META ((export #t)
(type bool)
(peephole (postfix "%2===0")))
*/
function sc_isEven(x) {
return (x % 2 === 0);
}
/*** META ((export #t)) */
var sc_max = Math.max;
/*** META ((export #t)) */
var sc_min = Math.min;
/*** META ((export + +fx +fl)
(peephole (infix 0 #f "+" "0")))
*/
function sc_plus() {
var sum = 0;
for (var i = 0; i < arguments.length; i++)
sum += arguments[i];
return sum;
}
/*** META ((export * *fx *fl)
(peephole (infix 0 #f "*" "1")))
*/
function sc_multi() {
var product = 1;
for (var i = 0; i < arguments.length; i++)
product *= arguments[i];
return product;
}
/*** META ((export - -fx -fl)
(peephole (minus)))
*/
function sc_minus(x) {
if (arguments.length === 1)
return -x;
else {
var res = x;
for (var i = 1; i < arguments.length; i++)
res -= arguments[i];
return res;
}
}
/*** META ((export / /fl)
(peephole (div)))
*/
function sc_div(x) {
if (arguments.length === 1)
return 1/x;
else {
var res = x;
for (var i = 1; i < arguments.length; i++)
res /= arguments[i];
return res;
}
}
/*** META ((export #t)) */
var sc_abs = Math.abs;
/*** META ((export quotient /fx)
(peephole (hole 2 "parseInt(" x "/" y ")")))
*/
function sc_quotient(x, y) {
return parseInt(x / y);
}
/*** META ((export #t)
(peephole (infix 2 2 "%")))
*/
function sc_remainder(x, y) {
return x % y;
}
/*** META ((export #t)
(peephole (modulo)))
*/
function sc_modulo(x, y) {
var remainder = x % y;
// if they don't have the same sign
if ((remainder * y) < 0)
return remainder + y;
else
return remainder;
}
function sc_euclid_gcd(a, b) {
var temp;
if (a === 0) return b;
if (b === 0) return a;
if (a < 0) {a = -a;};
if (b < 0) {b = -b;};
if (b > a) {temp = a; a = b; b = temp;};
while (true) {
a %= b;
if(a === 0) {return b;};
b %= a;
if(b === 0) {return a;};
};
return b;
}
/*** META ((export #t)) */
function sc_gcd() {
var gcd = 0;
for (var i = 0; i < arguments.length; i++)
gcd = sc_euclid_gcd(gcd, arguments[i]);
return gcd;
}
/*** META ((export #t)) */
function sc_lcm() {
var lcm = 1;
for (var i = 0; i < arguments.length; i++) {
var f = Math.round(arguments[i] / sc_euclid_gcd(arguments[i], lcm));
lcm *= Math.abs(f);
}
return lcm;
}
// LIMITATION: numerator and denominator don't make sense in floating point world.
//var SC_MAX_DECIMALS = 1000000
//
// function sc_numerator(x) {
// var rounded = Math.round(x * SC_MAX_DECIMALS);
// return Math.round(rounded / sc_euclid_gcd(rounded, SC_MAX_DECIMALS));
// }
// function sc_denominator(x) {
// var rounded = Math.round(x * SC_MAX_DECIMALS);
// return Math.round(SC_MAX_DECIMALS / sc_euclid_gcd(rounded, SC_MAX_DECIMALS));
// }
/*** META ((export #t)) */
var sc_floor = Math.floor;
/*** META ((export #t)) */
var sc_ceiling = Math.ceil;
/*** META ((export #t)) */
var sc_truncate = parseInt;
/*** META ((export #t)) */
var sc_round = Math.round;
// LIMITATION: sc_rationalize doesn't make sense in a floating point world.
/*** META ((export #t)) */
var sc_exp = Math.exp;
/*** META ((export #t)) */
var sc_log = Math.log;
/*** META ((export #t)) */
var sc_sin = Math.sin;
/*** META ((export #t)) */
var sc_cos = Math.cos;
/*** META ((export #t)) */
var sc_tan = Math.tan;
/*** META ((export #t)) */
var sc_asin = Math.asin;
/*** META ((export #t)) */
var sc_acos = Math.acos;
/*** META ((export #t)) */
var sc_atan = Math.atan;
/*** META ((export #t)) */
var sc_sqrt = Math.sqrt;
/*** META ((export #t)) */
var sc_expt = Math.pow;
// LIMITATION: we don't have complex numbers.
// LIMITATION: the following functions are hence not implemented.
// LIMITATION: make-rectangular, make-polar, real-part, imag-part, magnitude, angle
// LIMITATION: 2 argument atan
/*** META ((export #t)
(peephole (id)))
*/
function sc_exact2inexact(x) {
return x;
}
/*** META ((export #t)
(peephole (id)))
*/
function sc_inexact2exact(x) {
return x;
}
function sc_number2jsstring(x, radix) {
if (radix)
return x.toString(radix);
else
return x.toString();
}
function sc_jsstring2number(s, radix) {
if (s === "") return false;
if (radix) {
var t = parseInt(s, radix);
if (!t && t !== 0) return false;
// verify that each char is in range. (parseInt ignores leading
// white and trailing chars)
var allowedChars = "01234567890abcdefghijklmnopqrstuvwxyz".substring(0, radix+1);
if ((new RegExp("^["+allowedChars+"]*$", "i")).test(s))
return t;
else return false;
} else {
var t = +s; // does not ignore trailing chars.
if (!t && t !== 0) return false;
// simply verify that first char is not whitespace.
var c = s.charAt(0);
// if +c is 0, but the char is not "0", then we have a whitespace.
if (+c === 0 && c !== "0") return false;
return t;
}
}
/*** META ((export #t)
(type bool)
(peephole (not)))
*/
function sc_not(b) {
return b === false;
}
/*** META ((export #t)
(type bool))
*/
function sc_isBoolean(b) {
return (b === true) || (b === false);
}
function sc_Pair(car, cdr) {
this.car = car;
this.cdr = cdr;
}
sc_Pair.prototype.toString = function() {
return sc_toDisplayString(this);
};
sc_Pair.prototype.sc_toWriteOrDisplayString = function(writeOrDisplay) {
var current = this;
var res = "(";
while(true) {
res += writeOrDisplay(current.car);
if (sc_isPair(current.cdr)) {
res += " ";
current = current.cdr;
} else if (current.cdr !== null) {
res += " . " + writeOrDisplay(current.cdr);
break;
} else // current.cdr == null
break;
}
res += ")";
return res;
};
sc_Pair.prototype.sc_toDisplayString = function() {
return this.sc_toWriteOrDisplayString(sc_toDisplayString);
};
sc_Pair.prototype.sc_toWriteString = function() {
return this.sc_toWriteOrDisplayString(sc_toWriteString);
};
// sc_Pair.prototype.sc_toWriteCircleString in IO.js
/*** META ((export #t)
(type bool)
(peephole (postfix " instanceof sc_Pair")))
*/
function sc_isPair(p) {
return (p instanceof sc_Pair);
}
function sc_isPairEqual(p1, p2, comp) {
return (comp(p1.car, p2.car) && comp(p1.cdr, p2.cdr));
}
/*** META ((export #t)
(peephole (hole 2 "new sc_Pair(" car ", " cdr ")")))
*/
function sc_cons(car, cdr) {
return new sc_Pair(car, cdr);
}
/*** META ((export cons*)) */
function sc_consStar() {
var res = arguments[arguments.length - 1];
for (var i = arguments.length-2; i >= 0; i--)
res = new sc_Pair(arguments[i], res);
return res;
}
/*** META ((export #t)
(peephole (postfix ".car")))
*/
function sc_car(p) {
return p.car;
}
/*** META ((export #t)
(peephole (postfix ".cdr")))
*/
function sc_cdr(p) {
return p.cdr;
}
/*** META ((export #t)
(peephole (hole 2 p ".car = " val)))
*/
function sc_setCarBang(p, val) {
p.car = val;
}
/*** META ((export #t)
(peephole (hole 2 p ".cdr = " val)))
*/
function sc_setCdrBang(p, val) {
p.cdr = val;
}
/*** META ((export #t)
(peephole (postfix ".car.car")))
*/
function sc_caar(p) { return p.car.car; }
/*** META ((export #t)
(peephole (postfix ".cdr.car")))
*/
function sc_cadr(p) { return p.cdr.car; }
/*** META ((export #t)
(peephole (postfix ".car.cdr")))
*/
function sc_cdar(p) { return p.car.cdr; }
/*** META ((export #t)
(peephole (postfix ".cdr.cdr")))
*/
function sc_cddr(p) { return p.cdr.cdr; }
/*** META ((export #t)
(peephole (postfix ".car.car.car")))
*/
function sc_caaar(p) { return p.car.car.car; }
/*** META ((export #t)
(peephole (postfix ".car.cdr.car")))
*/
function sc_cadar(p) { return p.car.cdr.car; }
/*** META ((export #t)
(peephole (postfix ".cdr.car.car")))
*/
function sc_caadr(p) { return p.cdr.car.car; }
/*** META ((export #t)
(peephole (postfix ".cdr.cdr.car")))
*/
function sc_caddr(p) { return p.cdr.cdr.car; }
/*** META ((export #t)
(peephole (postfix ".car.car.cdr")))
*/
function sc_cdaar(p) { return p.car.car.cdr; }
/*** META ((export #t)
(peephole (postfix ".cdr.car.cdr")))
*/
function sc_cdadr(p) { return p.cdr.car.cdr; }
/*** META ((export #t)
(peephole (postfix ".car.cdr.cdr")))
*/
function sc_cddar(p) { return p.car.cdr.cdr; }
/*** META ((export #t)
(peephole (postfix ".cdr.cdr.cdr")))
*/
function sc_cdddr(p) { return p.cdr.cdr.cdr; }
/*** META ((export #t)
(peephole (postfix ".car.car.car.car")))
*/
function sc_caaaar(p) { return p.car.car.car.car; }
/*** META ((export #t)
(peephole (postfix ".car.cdr.car.car")))
*/
function sc_caadar(p) { return p.car.cdr.car.car; }
/*** META ((export #t)
(peephole (postfix ".cdr.car.car.car")))
*/
function sc_caaadr(p) { return p.cdr.car.car.car; }
/*** META ((export #t)
(peephole (postfix ".cdr.cdr.car.car")))
*/
function sc_caaddr(p) { return p.cdr.cdr.car.car; }
/*** META ((export #t)
(peephole (postfix ".car.car.car.cdr")))
*/
function sc_cdaaar(p) { return p.car.car.car.cdr; }
/*** META ((export #t)
(peephole (postfix ".car.cdr.car.cdr")))
*/
function sc_cdadar(p) { return p.car.cdr.car.cdr; }
/*** META ((export #t)
(peephole (postfix ".cdr.car.car.cdr")))
*/
function sc_cdaadr(p) { return p.cdr.car.car.cdr; }
/*** META ((export #t)
(peephole (postfix ".cdr.cdr.car.cdr")))
*/
function sc_cdaddr(p) { return p.cdr.cdr.car.cdr; }
/*** META ((export #t)
(peephole (postfix ".car.car.cdr.car")))
*/
function sc_cadaar(p) { return p.car.car.cdr.car; }
/*** META ((export #t)
(peephole (postfix ".car.cdr.cdr.car")))
*/
function sc_caddar(p) { return p.car.cdr.cdr.car; }
/*** META ((export #t)
(peephole (postfix ".cdr.car.cdr.car")))
*/
function sc_cadadr(p) { return p.cdr.car.cdr.car; }
/*** META ((export #t)
(peephole (postfix ".cdr.cdr.cdr.car")))
*/
function sc_cadddr(p) { return p.cdr.cdr.cdr.car; }
/*** META ((export #t)
(peephole (postfix ".car.car.cdr.cdr")))
*/
function sc_cddaar(p) { return p.car.car.cdr.cdr; }
/*** META ((export #t)
(peephole (postfix ".car.cdr.cdr.cdr")))
*/
function sc_cdddar(p) { return p.car.cdr.cdr.cdr; }
/*** META ((export #t)
(peephole (postfix ".cdr.car.cdr.cdr")))
*/
function sc_cddadr(p) { return p.cdr.car.cdr.cdr; }
/*** META ((export #t)
(peephole (postfix ".cdr.cdr.cdr.cdr")))
*/
function sc_cddddr(p) { return p.cdr.cdr.cdr.cdr; }
/*** META ((export #t)) */
function sc_lastPair(l) {
if (!sc_isPair(l)) sc_error("sc_lastPair: pair expected");
var res = l;
var cdr = l.cdr;
while (sc_isPair(cdr)) {
res = cdr;
cdr = res.cdr;
}
return res;
}
/*** META ((export #t)
(type bool)
(peephole (postfix " === null")))
*/
function sc_isNull(o) {
return (o === null);
}
/*** META ((export #t)
(type bool))
*/
function sc_isList(o) {
var rabbit;
var turtle;
var rabbit = o;
var turtle = o;
while (true) {
if (rabbit === null ||
(rabbit instanceof sc_Pair && rabbit.cdr === null))
return true; // end of list
else if ((rabbit instanceof sc_Pair) &&
(rabbit.cdr instanceof sc_Pair)) {
rabbit = rabbit.cdr.cdr;
turtle = turtle.cdr;
if (rabbit === turtle) return false; // cycle
} else
return false; // not pair
}
}
/*** META ((export #t)) */
function sc_list() {
var res = null;
var a = arguments;
for (var i = a.length-1; i >= 0; i--)
res = new sc_Pair(a[i], res);
return res;
}
/*** META ((export #t)) */
function sc_iota(num, init) {
var res = null;
if (!init) init = 0;
for (var i = num - 1; i >= 0; i--)
res = new sc_Pair(i + init, res);
return res;
}
/*** META ((export #t)) */
function sc_makeList(nbEls, fill) {
var res = null;
for (var i = 0; i < nbEls; i++)
res = new sc_Pair(fill, res);
return res;
}
/*** META ((export #t)) */
function sc_length(l) {
var res = 0;
while (l !== null) {
res++;
l = l.cdr;
}
return res;
}
/*** META ((export #t)) */
function sc_remq(o, l) {
var dummy = { cdr : null };
var tail = dummy;
while (l !== null) {
if (l.car !== o) {
tail.cdr = sc_cons(l.car, null);
tail = tail.cdr;
}
l = l.cdr;
}
return dummy.cdr;
}
/*** META ((export #t)) */
function sc_remqBang(o, l) {
var dummy = { cdr : null };
var tail = dummy;
var needsAssig = true;
while (l !== null) {
if (l.car === o) {
needsAssig = true;
} else {
if (needsAssig) {
tail.cdr = l;
needsAssig = false;
}
tail = l;
}
l = l.cdr;
}
tail.cdr = null;
return dummy.cdr;
}
/*** META ((export #t)) */
function sc_delete(o, l) {
var dummy = { cdr : null };
var tail = dummy;
while (l !== null) {
if (!sc_isEqual(l.car, o)) {
tail.cdr = sc_cons(l.car, null);
tail = tail.cdr;
}
l = l.cdr;
}
return dummy.cdr;
}
/*** META ((export #t)) */
function sc_deleteBang(o, l) {
var dummy = { cdr : null };
var tail = dummy;
var needsAssig = true;
while (l !== null) {
if (sc_isEqual(l.car, o)) {
needsAssig = true;
} else {
if (needsAssig) {
tail.cdr = l;
needsAssig = false;
}
tail = l;
}
l = l.cdr;
}
tail.cdr = null;
return dummy.cdr;
}
function sc_reverseAppendBang(l1, l2) {
var res = l2;
while (l1 !== null) {
var tmp = res;
res = l1;
l1 = l1.cdr;
res.cdr = tmp;
}
return res;
}
function sc_dualAppend(l1, l2) {
if (l1 === null) return l2;
if (l2 === null) return l1;
var rev = sc_reverse(l1);
return sc_reverseAppendBang(rev, l2);
}
/*** META ((export #t)) */
function sc_append() {
if (arguments.length === 0)
return null;
var res = arguments[arguments.length - 1];
for (var i = arguments.length - 2; i >= 0; i--)
res = sc_dualAppend(arguments[i], res);
return res;
}
function sc_dualAppendBang(l1, l2) {
if (l1 === null) return l2;
if (l2 === null) return l1;
var tmp = l1;
while (tmp.cdr !== null) tmp=tmp.cdr;
tmp.cdr = l2;
return l1;
}
/*** META ((export #t)) */
function sc_appendBang() {
var res = null;
for (var i = 0; i < arguments.length; i++)
res = sc_dualAppendBang(res, arguments[i]);
return res;
}
/*** META ((export #t)) */
function sc_reverse(l1) {
var res = null;
while (l1 !== null) {
res = sc_cons(l1.car, res);
l1 = l1.cdr;
}
return res;
}
/*** META ((export #t)) */
function sc_reverseBang(l) {
return sc_reverseAppendBang(l, null);
}
/*** META ((export #t)) */
function sc_listTail(l, k) {
var res = l;
for (var i = 0; i < k; i++) {
res = res.cdr;
}
return res;
}
/*** META ((export #t)) */
function sc_listRef(l, k) {
return sc_listTail(l, k).car;
}
/* // unoptimized generic versions
function sc_memX(o, l, comp) {
while (l != null) {
if (comp(l.car, o))
return l;
l = l.cdr;
}
return false;
}
function sc_memq(o, l) { return sc_memX(o, l, sc_isEq); }
function sc_memv(o, l) { return sc_memX(o, l, sc_isEqv); }
function sc_member(o, l) { return sc_memX(o, l, sc_isEqual); }
*/
/* optimized versions */
/*** META ((export #t)) */
function sc_memq(o, l) {
while (l !== null) {
if (l.car === o)
return l;
l = l.cdr;
}
return false;
}
/*** META ((export #t)) */
function sc_memv(o, l) {
while (l !== null) {
if (l.car === o)
return l;
l = l.cdr;
}
return false;
}
/*** META ((export #t)) */
function sc_member(o, l) {
while (l !== null) {
if (sc_isEqual(l.car,o))
return l;
l = l.cdr;
}
return false;
}
/* // generic unoptimized versions
function sc_assX(o, al, comp) {
while (al != null) {
if (comp(al.car.car, o))
return al.car;
al = al.cdr;
}
return false;
}
function sc_assq(o, al) { return sc_assX(o, al, sc_isEq); }
function sc_assv(o, al) { return sc_assX(o, al, sc_isEqv); }
function sc_assoc(o, al) { return sc_assX(o, al, sc_isEqual); }
*/
// optimized versions
/*** META ((export #t)) */
function sc_assq(o, al) {
while (al !== null) {
if (al.car.car === o)
return al.car;
al = al.cdr;
}
return false;
}
/*** META ((export #t)) */
function sc_assv(o, al) {
while (al !== null) {
if (al.car.car === o)
return al.car;
al = al.cdr;
}
return false;
}
/*** META ((export #t)) */
function sc_assoc(o, al) {
while (al !== null) {
if (sc_isEqual(al.car.car, o))
return al.car;
al = al.cdr;
}
return false;
}
/* can be used for mutable strings and characters */
function sc_isCharStringEqual(cs1, cs2) { return cs1.val === cs2.val; }
function sc_isCharStringLess(cs1, cs2) { return cs1.val < cs2.val; }
function sc_isCharStringGreater(cs1, cs2) { return cs1.val > cs2.val; }
function sc_isCharStringLessEqual(cs1, cs2) { return cs1.val <= cs2.val; }
function sc_isCharStringGreaterEqual(cs1, cs2) { return cs1.val >= cs2.val; }
function sc_isCharStringCIEqual(cs1, cs2)
{ return cs1.val.toLowerCase() === cs2.val.toLowerCase(); }
function sc_isCharStringCILess(cs1, cs2)
{ return cs1.val.toLowerCase() < cs2.val.toLowerCase(); }
function sc_isCharStringCIGreater(cs1, cs2)
{ return cs1.val.toLowerCase() > cs2.val.toLowerCase(); }
function sc_isCharStringCILessEqual(cs1, cs2)
{ return cs1.val.toLowerCase() <= cs2.val.toLowerCase(); }
function sc_isCharStringCIGreaterEqual(cs1, cs2)
{ return cs1.val.toLowerCase() >= cs2.val.toLowerCase(); }
function sc_Char(c) {
var cached = sc_Char.lazy[c];
if (cached)
return cached;
this.val = c;
sc_Char.lazy[c] = this;
// add return, so FF does not complain.
return undefined;
}
sc_Char.lazy = new Object();
// thanks to Eric
sc_Char.char2readable = {
"\000": "#\\null",
"\007": "#\\bell",
"\010": "#\\backspace",
"\011": "#\\tab",
"\012": "#\\newline",
"\014": "#\\page",
"\015": "#\\return",
"\033": "#\\escape",
"\040": "#\\space",
"\177": "#\\delete",
/* poeticless names */
"\001": "#\\soh",
"\002": "#\\stx",
"\003": "#\\etx",
"\004": "#\\eot",
"\005": "#\\enq",
"\006": "#\\ack",
"\013": "#\\vt",
"\016": "#\\so",
"\017": "#\\si",
"\020": "#\\dle",
"\021": "#\\dc1",
"\022": "#\\dc2",
"\023": "#\\dc3",
"\024": "#\\dc4",
"\025": "#\\nak",
"\026": "#\\syn",
"\027": "#\\etb",
"\030": "#\\can",
"\031": "#\\em",
"\032": "#\\sub",
"\033": "#\\esc",
"\034": "#\\fs",
"\035": "#\\gs",
"\036": "#\\rs",
"\037": "#\\us"};
sc_Char.readable2char = {
"null": "\000",
"bell": "\007",
"backspace": "\010",
"tab": "\011",
"newline": "\012",
"page": "\014",
"return": "\015",
"escape": "\033",
"space": "\040",
"delete": "\000",
"soh": "\001",
"stx": "\002",
"etx": "\003",
"eot": "\004",
"enq": "\005",
"ack": "\006",
"bel": "\007",
"bs": "\010",
"ht": "\011",
"nl": "\012",
"vt": "\013",
"np": "\014",
"cr": "\015",
"so": "\016",
"si": "\017",
"dle": "\020",
"dc1": "\021",
"dc2": "\022",
"dc3": "\023",
"dc4": "\024",
"nak": "\025",
"syn": "\026",
"etb": "\027",
"can": "\030",
"em": "\031",
"sub": "\032",
"esc": "\033",
"fs": "\034",
"gs": "\035",
"rs": "\036",
"us": "\037",
"sp": "\040",
"del": "\177"};
sc_Char.prototype.toString = function() {
return this.val;
};
// sc_toDisplayString == toString
sc_Char.prototype.sc_toWriteString = function() {
var entry = sc_Char.char2readable[this.val];
if (entry)
return entry;
else
return "#\\" + this.val;
};
/*** META ((export #t)
(type bool)
(peephole (postfix "instanceof sc_Char")))
*/
function sc_isChar(c) {
return (c instanceof sc_Char);
}
/*** META ((export char=?)
(type bool)
(peephole (hole 2 c1 ".val === " c2 ".val")))
*/
var sc_isCharEqual = sc_isCharStringEqual;
/*** META ((export char<?)
(type bool)
(peephole (hole 2 c1 ".val < " c2 ".val")))
*/
var sc_isCharLess = sc_isCharStringLess;
/*** META ((export char>?)
(type bool)
(peephole (hole 2 c1 ".val > " c2 ".val")))
*/
var sc_isCharGreater = sc_isCharStringGreater;
/*** META ((export char<=?)
(type bool)
(peephole (hole 2 c1 ".val <= " c2 ".val")))
*/
var sc_isCharLessEqual = sc_isCharStringLessEqual;
/*** META ((export char>=?)
(type bool)
(peephole (hole 2 c1 ".val >= " c2 ".val")))
*/
var sc_isCharGreaterEqual = sc_isCharStringGreaterEqual;
/*** META ((export char-ci=?)
(type bool)
(peephole (hole 2 c1 ".val.toLowerCase() === " c2 ".val.toLowerCase()")))
*/
var sc_isCharCIEqual = sc_isCharStringCIEqual;
/*** META ((export char-ci<?)
(type bool)
(peephole (hole 2 c1 ".val.toLowerCase() < " c2 ".val.toLowerCase()")))
*/
var sc_isCharCILess = sc_isCharStringCILess;
/*** META ((export char-ci>?)
(type bool)
(peephole (hole 2 c1 ".val.toLowerCase() > " c2 ".val.toLowerCase()")))
*/
var sc_isCharCIGreater = sc_isCharStringCIGreater;
/*** META ((export char-ci<=?)
(type bool)
(peephole (hole 2 c1 ".val.toLowerCase() <= " c2 ".val.toLowerCase()")))
*/
var sc_isCharCILessEqual = sc_isCharStringCILessEqual;
/*** META ((export char-ci>=?)
(type bool)
(peephole (hole 2 c1 ".val.toLowerCase() >= " c2 ".val.toLowerCase()")))
*/
var sc_isCharCIGreaterEqual = sc_isCharStringCIGreaterEqual;
var SC_NUMBER_CLASS = "0123456789";
var SC_WHITESPACE_CLASS = ' \r\n\t\f';
var SC_LOWER_CLASS = 'abcdefghijklmnopqrstuvwxyz';
var SC_UPPER_CLASS = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
function sc_isCharOfClass(c, cl) { return (cl.indexOf(c) != -1); }
/*** META ((export #t)
(type bool))
*/
function sc_isCharAlphabetic(c)
{ return sc_isCharOfClass(c.val, SC_LOWER_CLASS) ||
sc_isCharOfClass(c.val, SC_UPPER_CLASS); }
/*** META ((export #t)
(type bool)
(peephole (hole 1 "SC_NUMBER_CLASS.indexOf(" c ".val) != -1")))
*/
function sc_isCharNumeric(c)
{ return sc_isCharOfClass(c.val, SC_NUMBER_CLASS); }
/*** META ((export #t)
(type bool))
*/
function sc_isCharWhitespace(c) {
var tmp = c.val;
return tmp === " " || tmp === "\r" || tmp === "\n" || tmp === "\t" || tmp === "\f";
}
/*** META ((export #t)
(type bool)
(peephole (hole 1 "SC_UPPER_CLASS.indexOf(" c ".val) != -1")))
*/
function sc_isCharUpperCase(c)
{ return sc_isCharOfClass(c.val, SC_UPPER_CLASS); }
/*** META ((export #t)
(type bool)
(peephole (hole 1 "SC_LOWER_CLASS.indexOf(" c ".val) != -1")))
*/
function sc_isCharLowerCase(c)
{ return sc_isCharOfClass(c.val, SC_LOWER_CLASS); }
/*** META ((export #t)
(peephole (postfix ".val.charCodeAt(0)")))
*/
function sc_char2integer(c)
{ return c.val.charCodeAt(0); }
/*** META ((export #t)
(peephole (hole 1 "new sc_Char(String.fromCharCode(" n "))")))
*/
function sc_integer2char(n)
{ return new sc_Char(String.fromCharCode(n)); }
/*** META ((export #t)
(peephole (hole 1 "new sc_Char(" c ".val.toUpperCase())")))
*/
function sc_charUpcase(c)
{ return new sc_Char(c.val.toUpperCase()); }
/*** META ((export #t)
(peephole (hole 1 "new sc_Char(" c ".val.toLowerCase())")))
*/
function sc_charDowncase(c)
{ return new sc_Char(c.val.toLowerCase()); }
function sc_makeJSStringOfLength(k, c) {
var fill;
if (c === undefined)
fill = " ";
else
fill = c;
var res = "";
var len = 1;
// every round doubles the size of fill.
while (k >= len) {
if (k & len)
res = res.concat(fill);
fill = fill.concat(fill);
len *= 2;
}
return res;
}
function sc_makejsString(k, c) {
var fill;
if (c)
fill = c.val;
else
fill = " ";
return sc_makeJSStringOfLength(k, fill);
}
function sc_jsstring2list(s) {
var res = null;
for (var i = s.length - 1; i >= 0; i--)
res = sc_cons(new sc_Char(s.charAt(i)), res);
return res;
}
function sc_list2jsstring(l) {
var a = new Array();
while(l !== null) {
a.push(l.car.val);
l = l.cdr;
}
return "".concat.apply("", a);
}
var sc_Vector = Array;
sc_Vector.prototype.sc_toWriteOrDisplayString = function(writeOrDisplay) {
if (this.length === 0) return "#()";
var res = "#(" + writeOrDisplay(this[0]);
for (var i = 1; i < this.length; i++)
res += " " + writeOrDisplay(this[i]);
res += ")";
return res;
};
sc_Vector.prototype.sc_toDisplayString = function() {
return this.sc_toWriteOrDisplayString(sc_toDisplayString);
};
sc_Vector.prototype.sc_toWriteString = function() {
return this.sc_toWriteOrDisplayString(sc_toWriteString);
};
/*** META ((export vector? array?)
(type bool)
(peephole (postfix " instanceof sc_Vector")))
*/
function sc_isVector(v) {
return (v instanceof sc_Vector);
}
// only applies to vectors
function sc_isVectorEqual(v1, v2, comp) {
if (v1.length !== v2.length) return false;
for (var i = 0; i < v1.length; i++)
if (!comp(v1[i], v2[i])) return false;
return true;
}
/*** META ((export make-vector make-array)) */
function sc_makeVector(size, fill) {
var a = new sc_Vector(size);
if (fill !== undefined)
sc_vectorFillBang(a, fill);
return a;
}
/*** META ((export vector array)
(peephole (vector)))
*/
function sc_vector() {
var a = new sc_Vector();
for (var i = 0; i < arguments.length; i++)
a.push(arguments[i]);
return a;
}
/*** META ((export vector-length array-length)
(peephole (postfix ".length")))
*/
function sc_vectorLength(v) {
return v.length;
}
/*** META ((export vector-ref array-ref)
(peephole (hole 2 v "[" pos "]")))
*/
function sc_vectorRef(v, pos) {
return v[pos];
}
/*** META ((export vector-set! array-set!)
(peephole (hole 3 v "[" pos "] = " val)))
*/
function sc_vectorSetBang(v, pos, val) {
v[pos] = val;
}
/*** META ((export vector->list array->list)) */
function sc_vector2list(a) {
var res = null;
for (var i = a.length-1; i >= 0; i--)
res = sc_cons(a[i], res);
return res;
}
/*** META ((export list->vector list->array)) */
function sc_list2vector(l) {
var a = new sc_Vector();
while(l !== null) {
a.push(l.car);
l = l.cdr;
}
return a;
}
/*** META ((export vector-fill! array-fill!)) */
function sc_vectorFillBang(a, fill) {
for (var i = 0; i < a.length; i++)
a[i] = fill;
}
/*** META ((export #t)) */
function sc_copyVector(a, len) {
if (len <= a.length)
return a.slice(0, len);
else {
var tmp = a.concat();
tmp.length = len;
return tmp;
}
}
/*** META ((export #t)
(peephole (hole 3 a ".slice(" start "," end ")")))
*/
function sc_vectorCopy(a, start, end) {
return a.slice(start, end);
}
/*** META ((export #t)) */
function sc_vectorCopyBang(target, tstart, source, sstart, send) {
if (!sstart) sstart = 0;
if (!send) send = source.length;
// if target == source we don't want to overwrite not yet copied elements.
if (tstart <= sstart) {
for (var i = tstart, j = sstart; j < send; i++, j++) {
target[i] = source[j];
}
} else {
var diff = send - sstart;
for (var i = tstart + diff - 1, j = send - 1;
j >= sstart;
i--, j--) {
target[i] = source[j];
}
}
return target;
}
/*** META ((export #t)
(type bool)
(peephole (hole 1 "typeof " o " === 'function'")))
*/
function sc_isProcedure(o) {
return (typeof o === "function");
}
/*** META ((export #t)) */
function sc_apply(proc) {
var args = new Array();
// first part of arguments are not in list-form.
for (var i = 1; i < arguments.length - 1; i++)
args.push(arguments[i]);
var l = arguments[arguments.length - 1];
while (l !== null) {
args.push(l.car);
l = l.cdr;
}
return proc.apply(null, args);
}
/*** META ((export #t)) */
function sc_map(proc, l1) {
if (l1 === undefined)
return null;
// else
var nbApplyArgs = arguments.length - 1;
var applyArgs = new Array(nbApplyArgs);
var revres = null;
while (l1 !== null) {
for (var i = 0; i < nbApplyArgs; i++) {
applyArgs[i] = arguments[i + 1].car;
arguments[i + 1] = arguments[i + 1].cdr;
}
revres = sc_cons(proc.apply(null, applyArgs), revres);
}
return sc_reverseAppendBang(revres, null);
}
/*** META ((export #t)) */
function sc_mapBang(proc, l1) {
if (l1 === undefined)
return null;
// else
var l1_orig = l1;
var nbApplyArgs = arguments.length - 1;
var applyArgs = new Array(nbApplyArgs);
while (l1 !== null) {
var tmp = l1;
for (var i = 0; i < nbApplyArgs; i++) {
applyArgs[i] = arguments[i + 1].car;
arguments[i + 1] = arguments[i + 1].cdr;
}
tmp.car = proc.apply(null, applyArgs);
}
return l1_orig;
}
/*** META ((export #t)) */
function sc_forEach(proc, l1) {
if (l1 === undefined)
return undefined;
// else
var nbApplyArgs = arguments.length - 1;
var applyArgs = new Array(nbApplyArgs);
while (l1 !== null) {
for (var i = 0; i < nbApplyArgs; i++) {
applyArgs[i] = arguments[i + 1].car;
arguments[i + 1] = arguments[i + 1].cdr;
}
proc.apply(null, applyArgs);
}
// add return so FF does not complain.
return undefined;
}
/*** META ((export #t)) */
function sc_filter(proc, l1) {
var dummy = { cdr : null };
var tail = dummy;
while (l1 !== null) {
if (proc(l1.car) !== false) {
tail.cdr = sc_cons(l1.car, null);
tail = tail.cdr;
}
l1 = l1.cdr;
}
return dummy.cdr;
}
/*** META ((export #t)) */
function sc_filterBang(proc, l1) {
var head = sc_cons("dummy", l1);
var it = head;
var next = l1;
while (next !== null) {
if (proc(next.car) !== false) {
it.cdr = next
it = next;
}
next = next.cdr;
}
it.cdr = null;
return head.cdr;
}
function sc_filterMap1(proc, l1) {
var revres = null;
while (l1 !== null) {
var tmp = proc(l1.car)
if (tmp !== false) revres = sc_cons(tmp, revres);
l1 = l1.cdr;
}
return sc_reverseAppendBang(revres, null);
}
function sc_filterMap2(proc, l1, l2) {
var revres = null;
while (l1 !== null) {
var tmp = proc(l1.car, l2.car);
if(tmp !== false) revres = sc_cons(tmp, revres);
l1 = l1.cdr;
l2 = l2.cdr
}
return sc_reverseAppendBang(revres, null);
}
/*** META ((export #t)) */
function sc_filterMap(proc, l1, l2, l3) {
if (l2 === undefined)
return sc_filterMap1(proc, l1);
else if (l3 === undefined)
return sc_filterMap2(proc, l1, l2);
// else
var nbApplyArgs = arguments.length - 1;
var applyArgs = new Array(nbApplyArgs);
var revres = null;
while (l1 !== null) {
for (var i = 0; i < nbApplyArgs; i++) {
applyArgs[i] = arguments[i + 1].car;
arguments[i + 1] = arguments[i + 1].cdr;
}
var tmp = proc.apply(null, applyArgs);
if(tmp !== false) revres = sc_cons(tmp, revres);
}
return sc_reverseAppendBang(revres, null);
}
/*** META ((export #t)) */
function sc_any(proc, l) {
var revres = null;
while (l !== null) {
var tmp = proc(l.car);
if(tmp !== false) return tmp;
l = l.cdr;
}
return false;
}
/*** META ((export any?)
(peephole (hole 2 "sc_any(" proc "," l ") !== false")))
*/
function sc_anyPred(proc, l) {
return sc_any(proc, l)!== false;
}
/*** META ((export #t)) */
function sc_every(proc, l) {
var revres = null;
var tmp = true;
while (l !== null) {
tmp = proc(l.car);
if (tmp === false) return false;
l = l.cdr;
}
return tmp;
}
/*** META ((export every?)
(peephole (hole 2 "sc_every(" proc "," l ") !== false")))
*/
function sc_everyPred(proc, l) {
var tmp = sc_every(proc, l);
if (tmp !== false) return true;
return false;
}
/*** META ((export #t)
(peephole (postfix "()")))
*/
function sc_force(o) {
return o();
}
/*** META ((export #t)) */
function sc_makePromise(proc) {
var isResultReady = false;
var result = undefined;
return function() {
if (!isResultReady) {
var tmp = proc();
if (!isResultReady) {
isResultReady = true;
result = tmp;
}
}
return result;
};
}
function sc_Values(values) {
this.values = values;
}
/*** META ((export #t)
(peephole (values)))
*/
function sc_values() {
if (arguments.length === 1)
return arguments[0];
else
return new sc_Values(arguments);
}
/*** META ((export #t)) */
function sc_callWithValues(producer, consumer) {
var produced = producer();
if (produced instanceof sc_Values)
return consumer.apply(null, produced.values);
else
return consumer(produced);
}
/*** META ((export #t)) */
function sc_dynamicWind(before, thunk, after) {
before();
try {
var res = thunk();
return res;
} finally {
after();
}
}
// TODO: eval/scheme-report-environment/null-environment/interaction-environment
// LIMITATION: 'load' doesn't exist without files.
// LIMITATION: transcript-on/transcript-off doesn't exist without files.
function sc_Struct(name) {
this.name = name;
}
sc_Struct.prototype.sc_toDisplayString = function() {
return "#<struct" + sc_hash(this) + ">";
};
sc_Struct.prototype.sc_toWriteString = sc_Struct.prototype.sc_toDisplayString;
/*** META ((export #t)
(peephole (hole 1 "new sc_Struct(" name ")")))
*/
function sc_makeStruct(name) {
return new sc_Struct(name);
}
/*** META ((export #t)
(type bool)
(peephole (postfix " instanceof sc_Struct")))
*/
function sc_isStruct(o) {
return (o instanceof sc_Struct);
}
/*** META ((export #t)
(type bool)
(peephole (hole 2 "(" 1 " instanceof sc_Struct) && ( " 1 ".name === " 0 ")")))
*/
function sc_isStructNamed(name, s) {
return ((s instanceof sc_Struct) && (s.name === name));
}
/*** META ((export struct-field)
(peephole (hole 3 0 "[" 2 "]")))
*/
function sc_getStructField(s, name, field) {
return s[field];
}
/*** META ((export struct-field-set!)
(peephole (hole 4 0 "[" 2 "] = " 3)))
*/
function sc_setStructFieldBang(s, name, field, val) {
s[field] = val;
}
/*** META ((export #t)
(peephole (prefix "~")))
*/
function sc_bitNot(x) {
return ~x;
}
/*** META ((export #t)
(peephole (infix 2 2 "&")))
*/
function sc_bitAnd(x, y) {
return x & y;
}
/*** META ((export #t)
(peephole (infix 2 2 "|")))
*/
function sc_bitOr(x, y) {
return x | y;
}
/*** META ((export #t)
(peephole (infix 2 2 "^")))
*/
function sc_bitXor(x, y) {
return x ^ y;
}
/*** META ((export #t)
(peephole (infix 2 2 "<<")))
*/
function sc_bitLsh(x, y) {
return x << y;
}
/*** META ((export #t)
(peephole (infix 2 2 ">>")))
*/
function sc_bitRsh(x, y) {
return x >> y;
}
/*** META ((export #t)
(peephole (infix 2 2 ">>>")))
*/
function sc_bitUrsh(x, y) {
return x >>> y;
}
/*** META ((export js-field js-property)
(peephole (hole 2 o "[" field "]")))
*/
function sc_jsField(o, field) {
return o[field];
}
/*** META ((export js-field-set! js-property-set!)
(peephole (hole 3 o "[" field "] = " val)))
*/
function sc_setJsFieldBang(o, field, val) {
return o[field] = val;
}
/*** META ((export js-field-delete! js-property-delete!)
(peephole (hole 2 "delete" o "[" field "]")))
*/
function sc_deleteJsFieldBang(o, field) {
delete o[field];
}
/*** META ((export #t)
(peephole (jsCall)))
*/
function sc_jsCall(o, fun) {
var args = new Array();
for (var i = 2; i < arguments.length; i++)
args[i-2] = arguments[i];
return fun.apply(o, args);
}
/*** META ((export #t)
(peephole (jsMethodCall)))
*/
function sc_jsMethodCall(o, field) {
var args = new Array();
for (var i = 2; i < arguments.length; i++)
args[i-2] = arguments[i];
return o[field].apply(o, args);
}
/*** META ((export new js-new)
(peephole (jsNew)))
*/
function sc_jsNew(c) {
var evalStr = "new c(";
evalStr +=arguments.length > 1? "arguments[1]": "";
for (var i = 2; i < arguments.length; i++)
evalStr += ", arguments[" + i + "]";
evalStr +=")";
return eval(evalStr);
}
// ======================== RegExp ====================
/*** META ((export #t)) */
function sc_pregexp(re) {
return new RegExp(sc_string2jsstring(re));
}
/*** META ((export #t)) */
function sc_pregexpMatch(re, s) {
var reg = (re instanceof RegExp) ? re : sc_pregexp(re);
var tmp = reg.exec(sc_string2jsstring(s));
if (tmp == null) return false;
var res = null;
for (var i = tmp.length-1; i >= 0; i--) {
if (tmp[i] !== null) {
res = sc_cons(sc_jsstring2string(tmp[i]), res);
} else {
res = sc_cons(false, res);
}
}
return res;
}
/*** META ((export #t)) */
function sc_pregexpReplace(re, s1, s2) {
var reg;
var jss1 = sc_string2jsstring(s1);
var jss2 = sc_string2jsstring(s2);
if (re instanceof RegExp) {
if (re.global)
reg = re;
else
reg = new RegExp(re.source);
} else {
reg = new RegExp(sc_string2jsstring(re));
}
return jss1.replace(reg, jss2);
}
/*** META ((export pregexp-replace*)) */
function sc_pregexpReplaceAll(re, s1, s2) {
var reg;
var jss1 = sc_string2jsstring(s1);
var jss2 = sc_string2jsstring(s2);
if (re instanceof RegExp) {
if (re.global)
reg = re;
else
reg = new RegExp(re.source, "g");
} else {
reg = new RegExp(sc_string2jsstring(re), "g");
}
return jss1.replace(reg, jss2);
}
/*** META ((export #t)) */
function sc_pregexpSplit(re, s) {
var reg = ((re instanceof RegExp) ?
re :
new RegExp(sc_string2jsstring(re)));
var jss = sc_string2jsstring(s);
var tmp = jss.split(reg);
if (tmp == null) return false;
return sc_vector2list(tmp);
}
/* =========================================================================== */
/* Other library stuff */
/* =========================================================================== */
/*** META ((export #t)
(peephole (hole 1 "Math.floor(Math.random()*" 'n ")")))
*/
function sc_random(n) {
return Math.floor(Math.random()*n);
}
/*** META ((export current-date)
(peephole (hole 0 "new Date()")))
*/
function sc_currentDate() {
return new Date();
}
function sc_Hashtable() {
}
sc_Hashtable.prototype.toString = function() {
return "#{%hashtable}";
};
// sc_toWriteString == sc_toDisplayString == toString
function sc_HashtableElement(key, val) {
this.key = key;
this.val = val;
}
/*** META ((export #t)
(peephole (hole 0 "new sc_Hashtable()")))
*/
function sc_makeHashtable() {
return new sc_Hashtable();
}
/*** META ((export #t)) */
function sc_hashtablePutBang(ht, key, val) {
var hash = sc_hash(key);
ht[hash] = new sc_HashtableElement(key, val);
}
/*** META ((export #t)) */
function sc_hashtableGet(ht, key) {
var hash = sc_hash(key);
if (hash in ht)
return ht[hash].val;
else
return false;
}
/*** META ((export #t)) */
function sc_hashtableForEach(ht, f) {
for (var v in ht) {
if (ht[v] instanceof sc_HashtableElement)
f(ht[v].key, ht[v].val);
}
}
/*** META ((export hashtable-contains?)
(peephole (hole 2 "sc_hash(" 1 ") in " 0)))
*/
function sc_hashtableContains(ht, key) {
var hash = sc_hash(key);
if (hash in ht)
return true;
else
return false;
}
var SC_HASH_COUNTER = 0;
function sc_hash(o) {
if (o === null)
return "null";
else if (o === undefined)
return "undefined";
else if (o === true)
return "true";
else if (o === false)
return "false";
else if (typeof o === "number")
return "num-" + o;
else if (typeof o === "string")
return "jsstr-" + o;
else if (o.sc_getHash)
return o.sc_getHash();
else
return sc_counterHash.call(o);
}
function sc_counterHash() {
if (!this.sc_hash) {
this.sc_hash = "hash-" + SC_HASH_COUNTER;
SC_HASH_COUNTER++;
}
return this.sc_hash;
}
function sc_Trampoline(args, maxTailCalls) {
this['__trampoline return__'] = true;
this.args = args;
this.MAX_TAIL_CALLs = maxTailCalls;
}
// TODO: call/cc stuff
sc_Trampoline.prototype.restart = function() {
var o = this;
while (true) {
// set both globals.
SC_TAIL_OBJECT.calls = o.MAX_TAIL_CALLs-1;
var fun = o.args.callee;
var res = fun.apply(SC_TAIL_OBJECT, o.args);
if (res instanceof sc_Trampoline)
o = res;
else
return res;
}
}
/*** META ((export bind-exit-lambda)) */
function sc_bindExitLambda(proc) {
var escape_obj = new sc_BindExitException();
var escape = function(res) {
escape_obj.res = res;
throw escape_obj;
};
try {
return proc(escape);
} catch(e) {
if (e === escape_obj) {
return e.res;
}
throw e;
}
}
function sc_BindExitException() {
this._internalException = true;
}
var SC_SCM2JS_GLOBALS = new Object();
// default tail-call depth.
// normally the program should set it again. but just in case...
var SC_TAIL_OBJECT = new Object();
SC_SCM2JS_GLOBALS.TAIL_OBJECT = SC_TAIL_OBJECT;
// ======================== I/O =======================
/*------------------------------------------------------------------*/
function sc_EOF() {
}
var SC_EOF_OBJECT = new sc_EOF();
function sc_Port() {
}
/* --------------- Input ports -------------------------------------*/
function sc_InputPort() {
}
sc_InputPort.prototype = new sc_Port();
sc_InputPort.prototype.peekChar = function() {
if (!("peeked" in this))
this.peeked = this.getNextChar();
return this.peeked;
}
sc_InputPort.prototype.readChar = function() {
var tmp = this.peekChar();
delete this.peeked;
return tmp;
}
sc_InputPort.prototype.isCharReady = function() {
return true;
}
sc_InputPort.prototype.close = function() {
// do nothing
}
/* .............. String port ..........................*/
function sc_ErrorInputPort() {
};
sc_ErrorInputPort.prototype = new sc_InputPort();
sc_ErrorInputPort.prototype.getNextChar = function() {
throw "can't read from error-port.";
};
sc_ErrorInputPort.prototype.isCharReady = function() {
return false;
};
/* .............. String port ..........................*/
function sc_StringInputPort(jsStr) {
// we are going to do some charAts on the str.
// instead of recreating all the time a String-object, we
// create one in the beginning. (not sure, if this is really an optim)
this.str = new String(jsStr);
this.pos = 0;
}
sc_StringInputPort.prototype = new sc_InputPort();
sc_StringInputPort.prototype.getNextChar = function() {
if (this.pos >= this.str.length)
return SC_EOF_OBJECT;
return this.str.charAt(this.pos++);
};
/* ------------- Read and other lib-funs -------------------------------*/
function sc_Token(type, val, pos) {
this.type = type;
this.val = val;
this.pos = pos;
}
sc_Token.EOF = 0/*EOF*/;
sc_Token.OPEN_PAR = 1/*OPEN_PAR*/;
sc_Token.CLOSE_PAR = 2/*CLOSE_PAR*/;
sc_Token.OPEN_BRACE = 3/*OPEN_BRACE*/;
sc_Token.CLOSE_BRACE = 4/*CLOSE_BRACE*/;
sc_Token.OPEN_BRACKET = 5/*OPEN_BRACKET*/;
sc_Token.CLOSE_BRACKET = 6/*CLOSE_BRACKET*/;
sc_Token.WHITESPACE = 7/*WHITESPACE*/;
sc_Token.QUOTE = 8/*QUOTE*/;
sc_Token.ID = 9/*ID*/;
sc_Token.DOT = 10/*DOT*/;
sc_Token.STRING = 11/*STRING*/;
s