1 // This file is automatically generated by scheme2js, except for the
2 // benchmark harness code at the beginning and end of the file.
4 var EarleyBoyer = new BenchmarkSuite('EarleyBoyer', [666463], [
5 new Benchmark("Earley", true, false, function () { BgL_earleyzd2benchmarkzd2(); }),
6 new Benchmark("Boyer", true, false, function () { BgL_nboyerzd2benchmarkzd2(); })
10 /************* GENERATED FILE - DO NOT EDIT *************/
11 /************* GENERATED FILE - DO NOT EDIT *************/
12 /************* GENERATED FILE - DO NOT EDIT *************/
13 /************* GENERATED FILE - DO NOT EDIT *************/
14 /************* GENERATED FILE - DO NOT EDIT *************/
15 /************* GENERATED FILE - DO NOT EDIT *************/
16 /************* GENERATED FILE - DO NOT EDIT *************/
17 /************* GENERATED FILE - DO NOT EDIT *************/
19 * To use write/prints/... the default-output port has to be set first.
20 * Simply setting SC_DEFAULT_OUT and SC_ERROR_OUT to the desired values
21 * should do the trick.
22 * In the following example the std-out and error-port are redirected to
24 function initRuntime() {
25 function escapeHTML(s) {
27 tmp = tmp.replace(/&/g, "&");
28 tmp = tmp.replace(/</g, "<");
29 tmp = tmp.replace(/>/g, ">");
30 tmp = tmp.replace(/ /g, " ");
31 tmp = tmp.replace(/\n/g, "<br />");
32 tmp = tmp.replace(/\t/g, "  ");
37 document.write("<div id='stdout'></div>");
38 SC_DEFAULT_OUT = new sc_GenericOutputPort(
40 var stdout = document.getElementById('stdout');
41 stdout.innerHTML = stdout.innerHTML + escapeHTML(s);
43 SC_ERROR_OUT = SC_DEFAULT_OUT;
48 function sc_print_debug() {
49 sc_print.apply(null, arguments);
51 /*** META ((export *js*)) */
52 var sc_JS_GLOBALS = this;
57 /*** META ((export #t)) */
59 var len = arguments.length;
63 for( i = 0; i < len; i++ ) {
64 s += sc_toDisplayString(arguments[ i ]);
70 /*** META ((export #t)) */
71 function sc_typeof( x ) {
75 /*** META ((export #t)) */
77 var a = [sc_jsstring2symbol("*error*")];
78 for (var i = 0; i < arguments.length; i++) {
79 a[i+1] = arguments[i];
84 /*** META ((export #t)
85 (peephole (prefix "throw ")))
87 function sc_raise(obj) {
91 /*** META ((export with-handler-lambda)) */
92 function sc_withHandlerLambda(handler, body) {
96 if (!e._internalException)
103 var sc_properties = new Object();
105 /*** META ((export #t)) */
106 function sc_putpropBang(sym, key, val) {
107 var ht = sc_properties[sym];
110 sc_properties[sym] = ht;
115 /*** META ((export #t)) */
116 function sc_getprop(sym, key) {
117 var ht = sc_properties[sym];
127 /*** META ((export #t)) */
128 function sc_rempropBang(sym, key) {
129 var ht = sc_properties[sym];
134 /*** META ((export #t)) */
135 function sc_any2String(o) {
136 return jsstring2string(sc_toDisplayString(o));
139 /*** META ((export #t)
140 (peephole (infix 2 2 "==="))
143 function sc_isEqv(o1, o2) {
147 /*** META ((export #t)
148 (peephole (infix 2 2 "==="))
151 function sc_isEq(o1, o2) {
155 /*** META ((export #t)
158 function sc_isNumber(n) {
159 return (typeof n === "number");
162 /*** META ((export #t)
165 function sc_isComplex(n) {
166 return sc_isNumber(n);
169 /*** META ((export #t)
172 function sc_isReal(n) {
173 return sc_isNumber(n);
176 /*** META ((export #t)
179 function sc_isRational(n) {
183 /*** META ((export #t)
186 function sc_isInteger(n) {
187 return (parseInt(n) === n);
190 /*** META ((export #t)
192 (peephole (postfix ", false")))
194 // we don't have exact numbers...
195 function sc_isExact(n) {
199 /*** META ((export #t)
200 (peephole (postfix ", true"))
203 function sc_isInexact(n) {
207 /*** META ((export = =fx =fl)
209 (peephole (infix 2 2 "===")))
211 function sc_equal(x) {
212 for (var i = 1; i < arguments.length; i++)
213 if (x !== arguments[i])
218 /*** META ((export < <fx <fl)
220 (peephole (infix 2 2 "<")))
222 function sc_less(x) {
223 for (var i = 1; i < arguments.length; i++) {
224 if (x >= arguments[i])
231 /*** META ((export > >fx >fl)
233 (peephole (infix 2 2 ">")))
235 function sc_greater(x, y) {
236 for (var i = 1; i < arguments.length; i++) {
237 if (x <= arguments[i])
244 /*** META ((export <= <=fx <=fl)
246 (peephole (infix 2 2 "<=")))
248 function sc_lessEqual(x, y) {
249 for (var i = 1; i < arguments.length; i++) {
250 if (x > arguments[i])
257 /*** META ((export >= >=fl >=fx)
259 (peephole (infix 2 2 ">=")))
261 function sc_greaterEqual(x, y) {
262 for (var i = 1; i < arguments.length; i++) {
263 if (x < arguments[i])
270 /*** META ((export #t)
272 (peephole (postfix "=== 0")))
274 function sc_isZero(x) {
278 /*** META ((export #t)
280 (peephole (postfix "> 0")))
282 function sc_isPositive(x) {
286 /*** META ((export #t)
288 (peephole (postfix "< 0")))
290 function sc_isNegative(x) {
294 /*** META ((export #t)
296 (peephole (postfix "%2===1")))
298 function sc_isOdd(x) {
299 return (x % 2 === 1);
302 /*** META ((export #t)
304 (peephole (postfix "%2===0")))
306 function sc_isEven(x) {
307 return (x % 2 === 0);
310 /*** META ((export #t)) */
311 var sc_max = Math.max;
312 /*** META ((export #t)) */
313 var sc_min = Math.min;
315 /*** META ((export + +fx +fl)
316 (peephole (infix 0 #f "+" "0")))
320 for (var i = 0; i < arguments.length; i++)
325 /*** META ((export * *fx *fl)
326 (peephole (infix 0 #f "*" "1")))
328 function sc_multi() {
330 for (var i = 0; i < arguments.length; i++)
331 product *= arguments[i];
335 /*** META ((export - -fx -fl)
338 function sc_minus(x) {
339 if (arguments.length === 1)
343 for (var i = 1; i < arguments.length; i++)
349 /*** META ((export / /fl)
353 if (arguments.length === 1)
357 for (var i = 1; i < arguments.length; i++)
363 /*** META ((export #t)) */
364 var sc_abs = Math.abs;
366 /*** META ((export quotient /fx)
367 (peephole (hole 2 "parseInt(" x "/" y ")")))
369 function sc_quotient(x, y) {
370 return parseInt(x / y);
373 /*** META ((export #t)
374 (peephole (infix 2 2 "%")))
376 function sc_remainder(x, y) {
380 /*** META ((export #t)
383 function sc_modulo(x, y) {
384 var remainder = x % y;
385 // if they don't have the same sign
386 if ((remainder * y) < 0)
387 return remainder + y;
392 function sc_euclid_gcd(a, b) {
394 if (a === 0) return b;
395 if (b === 0) return a;
396 if (a < 0) {a = -a;};
397 if (b < 0) {b = -b;};
398 if (b > a) {temp = a; a = b; b = temp;};
401 if(a === 0) {return b;};
403 if(b === 0) {return a;};
408 /*** META ((export #t)) */
411 for (var i = 0; i < arguments.length; i++)
412 gcd = sc_euclid_gcd(gcd, arguments[i]);
416 /*** META ((export #t)) */
419 for (var i = 0; i < arguments.length; i++) {
420 var f = Math.round(arguments[i] / sc_euclid_gcd(arguments[i], lcm));
426 // LIMITATION: numerator and denominator don't make sense in floating point world.
427 //var SC_MAX_DECIMALS = 1000000
429 // function sc_numerator(x) {
430 // var rounded = Math.round(x * SC_MAX_DECIMALS);
431 // return Math.round(rounded / sc_euclid_gcd(rounded, SC_MAX_DECIMALS));
434 // function sc_denominator(x) {
435 // var rounded = Math.round(x * SC_MAX_DECIMALS);
436 // return Math.round(SC_MAX_DECIMALS / sc_euclid_gcd(rounded, SC_MAX_DECIMALS));
439 /*** META ((export #t)) */
440 var sc_floor = Math.floor;
441 /*** META ((export #t)) */
442 var sc_ceiling = Math.ceil;
443 /*** META ((export #t)) */
444 var sc_truncate = parseInt;
445 /*** META ((export #t)) */
446 var sc_round = Math.round;
448 // LIMITATION: sc_rationalize doesn't make sense in a floating point world.
450 /*** META ((export #t)) */
451 var sc_exp = Math.exp;
452 /*** META ((export #t)) */
453 var sc_log = Math.log;
454 /*** META ((export #t)) */
455 var sc_sin = Math.sin;
456 /*** META ((export #t)) */
457 var sc_cos = Math.cos;
458 /*** META ((export #t)) */
459 var sc_tan = Math.tan;
460 /*** META ((export #t)) */
461 var sc_asin = Math.asin;
462 /*** META ((export #t)) */
463 var sc_acos = Math.acos;
464 /*** META ((export #t)) */
465 var sc_atan = Math.atan;
467 /*** META ((export #t)) */
468 var sc_sqrt = Math.sqrt;
469 /*** META ((export #t)) */
470 var sc_expt = Math.pow;
472 // LIMITATION: we don't have complex numbers.
473 // LIMITATION: the following functions are hence not implemented.
474 // LIMITATION: make-rectangular, make-polar, real-part, imag-part, magnitude, angle
475 // LIMITATION: 2 argument atan
477 /*** META ((export #t)
480 function sc_exact2inexact(x) {
484 /*** META ((export #t)
487 function sc_inexact2exact(x) {
491 function sc_number2jsstring(x, radix) {
493 return x.toString(radix);
498 function sc_jsstring2number(s, radix) {
499 if (s === "") return false;
502 var t = parseInt(s, radix);
503 if (!t && t !== 0) return false;
504 // verify that each char is in range. (parseInt ignores leading
505 // white and trailing chars)
506 var allowedChars = "01234567890abcdefghijklmnopqrstuvwxyz".substring(0, radix+1);
507 if ((new RegExp("^["+allowedChars+"]*$", "i")).test(s))
511 var t = +s; // does not ignore trailing chars.
512 if (!t && t !== 0) return false;
513 // simply verify that first char is not whitespace.
515 // if +c is 0, but the char is not "0", then we have a whitespace.
516 if (+c === 0 && c !== "0") return false;
521 /*** META ((export #t)
529 /*** META ((export #t)
532 function sc_isBoolean(b) {
533 return (b === true) || (b === false);
536 function sc_Pair(car, cdr) {
541 sc_Pair.prototype.toString = function() {
542 return sc_toDisplayString(this);
544 sc_Pair.prototype.sc_toWriteOrDisplayString = function(writeOrDisplay) {
550 res += writeOrDisplay(current.car);
551 if (sc_isPair(current.cdr)) {
553 current = current.cdr;
554 } else if (current.cdr !== null) {
555 res += " . " + writeOrDisplay(current.cdr);
557 } else // current.cdr == null
565 sc_Pair.prototype.sc_toDisplayString = function() {
566 return this.sc_toWriteOrDisplayString(sc_toDisplayString);
568 sc_Pair.prototype.sc_toWriteString = function() {
569 return this.sc_toWriteOrDisplayString(sc_toWriteString);
571 // sc_Pair.prototype.sc_toWriteCircleString in IO.js
573 /*** META ((export #t)
575 (peephole (postfix " instanceof sc_Pair")))
577 function sc_isPair(p) {
578 return (p instanceof sc_Pair);
581 function sc_isPairEqual(p1, p2, comp) {
582 return (comp(p1.car, p2.car) && comp(p1.cdr, p2.cdr));
585 /*** META ((export #t)
586 (peephole (hole 2 "new sc_Pair(" car ", " cdr ")")))
588 function sc_cons(car, cdr) {
589 return new sc_Pair(car, cdr);
592 /*** META ((export cons*)) */
593 function sc_consStar() {
594 var res = arguments[arguments.length - 1];
595 for (var i = arguments.length-2; i >= 0; i--)
596 res = new sc_Pair(arguments[i], res);
600 /*** META ((export #t)
601 (peephole (postfix ".car")))
607 /*** META ((export #t)
608 (peephole (postfix ".cdr")))
614 /*** META ((export #t)
615 (peephole (hole 2 p ".car = " val)))
617 function sc_setCarBang(p, val) {
621 /*** META ((export #t)
622 (peephole (hole 2 p ".cdr = " val)))
624 function sc_setCdrBang(p, val) {
628 /*** META ((export #t)
629 (peephole (postfix ".car.car")))
631 function sc_caar(p) { return p.car.car; }
632 /*** META ((export #t)
633 (peephole (postfix ".cdr.car")))
635 function sc_cadr(p) { return p.cdr.car; }
636 /*** META ((export #t)
637 (peephole (postfix ".car.cdr")))
639 function sc_cdar(p) { return p.car.cdr; }
640 /*** META ((export #t)
641 (peephole (postfix ".cdr.cdr")))
643 function sc_cddr(p) { return p.cdr.cdr; }
644 /*** META ((export #t)
645 (peephole (postfix ".car.car.car")))
647 function sc_caaar(p) { return p.car.car.car; }
648 /*** META ((export #t)
649 (peephole (postfix ".car.cdr.car")))
651 function sc_cadar(p) { return p.car.cdr.car; }
652 /*** META ((export #t)
653 (peephole (postfix ".cdr.car.car")))
655 function sc_caadr(p) { return p.cdr.car.car; }
656 /*** META ((export #t)
657 (peephole (postfix ".cdr.cdr.car")))
659 function sc_caddr(p) { return p.cdr.cdr.car; }
660 /*** META ((export #t)
661 (peephole (postfix ".car.car.cdr")))
663 function sc_cdaar(p) { return p.car.car.cdr; }
664 /*** META ((export #t)
665 (peephole (postfix ".cdr.car.cdr")))
667 function sc_cdadr(p) { return p.cdr.car.cdr; }
668 /*** META ((export #t)
669 (peephole (postfix ".car.cdr.cdr")))
671 function sc_cddar(p) { return p.car.cdr.cdr; }
672 /*** META ((export #t)
673 (peephole (postfix ".cdr.cdr.cdr")))
675 function sc_cdddr(p) { return p.cdr.cdr.cdr; }
676 /*** META ((export #t)
677 (peephole (postfix ".car.car.car.car")))
679 function sc_caaaar(p) { return p.car.car.car.car; }
680 /*** META ((export #t)
681 (peephole (postfix ".car.cdr.car.car")))
683 function sc_caadar(p) { return p.car.cdr.car.car; }
684 /*** META ((export #t)
685 (peephole (postfix ".cdr.car.car.car")))
687 function sc_caaadr(p) { return p.cdr.car.car.car; }
688 /*** META ((export #t)
689 (peephole (postfix ".cdr.cdr.car.car")))
691 function sc_caaddr(p) { return p.cdr.cdr.car.car; }
692 /*** META ((export #t)
693 (peephole (postfix ".car.car.car.cdr")))
695 function sc_cdaaar(p) { return p.car.car.car.cdr; }
696 /*** META ((export #t)
697 (peephole (postfix ".car.cdr.car.cdr")))
699 function sc_cdadar(p) { return p.car.cdr.car.cdr; }
700 /*** META ((export #t)
701 (peephole (postfix ".cdr.car.car.cdr")))
703 function sc_cdaadr(p) { return p.cdr.car.car.cdr; }
704 /*** META ((export #t)
705 (peephole (postfix ".cdr.cdr.car.cdr")))
707 function sc_cdaddr(p) { return p.cdr.cdr.car.cdr; }
708 /*** META ((export #t)
709 (peephole (postfix ".car.car.cdr.car")))
711 function sc_cadaar(p) { return p.car.car.cdr.car; }
712 /*** META ((export #t)
713 (peephole (postfix ".car.cdr.cdr.car")))
715 function sc_caddar(p) { return p.car.cdr.cdr.car; }
716 /*** META ((export #t)
717 (peephole (postfix ".cdr.car.cdr.car")))
719 function sc_cadadr(p) { return p.cdr.car.cdr.car; }
720 /*** META ((export #t)
721 (peephole (postfix ".cdr.cdr.cdr.car")))
723 function sc_cadddr(p) { return p.cdr.cdr.cdr.car; }
724 /*** META ((export #t)
725 (peephole (postfix ".car.car.cdr.cdr")))
727 function sc_cddaar(p) { return p.car.car.cdr.cdr; }
728 /*** META ((export #t)
729 (peephole (postfix ".car.cdr.cdr.cdr")))
731 function sc_cdddar(p) { return p.car.cdr.cdr.cdr; }
732 /*** META ((export #t)
733 (peephole (postfix ".cdr.car.cdr.cdr")))
735 function sc_cddadr(p) { return p.cdr.car.cdr.cdr; }
736 /*** META ((export #t)
737 (peephole (postfix ".cdr.cdr.cdr.cdr")))
739 function sc_cddddr(p) { return p.cdr.cdr.cdr.cdr; }
741 /*** META ((export #t)) */
742 function sc_lastPair(l) {
743 if (!sc_isPair(l)) sc_error("sc_lastPair: pair expected");
746 while (sc_isPair(cdr)) {
753 /*** META ((export #t)
755 (peephole (postfix " === null")))
757 function sc_isNull(o) {
761 /*** META ((export #t)
764 function sc_isList(o) {
771 if (rabbit === null ||
772 (rabbit instanceof sc_Pair && rabbit.cdr === null))
773 return true; // end of list
774 else if ((rabbit instanceof sc_Pair) &&
775 (rabbit.cdr instanceof sc_Pair)) {
776 rabbit = rabbit.cdr.cdr;
778 if (rabbit === turtle) return false; // cycle
780 return false; // not pair
784 /*** META ((export #t)) */
788 for (var i = a.length-1; i >= 0; i--)
789 res = new sc_Pair(a[i], res);
793 /*** META ((export #t)) */
794 function sc_iota(num, init) {
797 for (var i = num - 1; i >= 0; i--)
798 res = new sc_Pair(i + init, res);
802 /*** META ((export #t)) */
803 function sc_makeList(nbEls, fill) {
805 for (var i = 0; i < nbEls; i++)
806 res = new sc_Pair(fill, res);
810 /*** META ((export #t)) */
811 function sc_length(l) {
820 /*** META ((export #t)) */
821 function sc_remq(o, l) {
822 var dummy = { cdr : null };
826 tail.cdr = sc_cons(l.car, null);
834 /*** META ((export #t)) */
835 function sc_remqBang(o, l) {
836 var dummy = { cdr : null };
838 var needsAssig = true;
855 /*** META ((export #t)) */
856 function sc_delete(o, l) {
857 var dummy = { cdr : null };
860 if (!sc_isEqual(l.car, o)) {
861 tail.cdr = sc_cons(l.car, null);
869 /*** META ((export #t)) */
870 function sc_deleteBang(o, l) {
871 var dummy = { cdr : null };
873 var needsAssig = true;
875 if (sc_isEqual(l.car, o)) {
890 function sc_reverseAppendBang(l1, l2) {
892 while (l1 !== null) {
901 function sc_dualAppend(l1, l2) {
902 if (l1 === null) return l2;
903 if (l2 === null) return l1;
904 var rev = sc_reverse(l1);
905 return sc_reverseAppendBang(rev, l2);
908 /*** META ((export #t)) */
909 function sc_append() {
910 if (arguments.length === 0)
912 var res = arguments[arguments.length - 1];
913 for (var i = arguments.length - 2; i >= 0; i--)
914 res = sc_dualAppend(arguments[i], res);
918 function sc_dualAppendBang(l1, l2) {
919 if (l1 === null) return l2;
920 if (l2 === null) return l1;
922 while (tmp.cdr !== null) tmp=tmp.cdr;
927 /*** META ((export #t)) */
928 function sc_appendBang() {
930 for (var i = 0; i < arguments.length; i++)
931 res = sc_dualAppendBang(res, arguments[i]);
935 /*** META ((export #t)) */
936 function sc_reverse(l1) {
938 while (l1 !== null) {
939 res = sc_cons(l1.car, res);
945 /*** META ((export #t)) */
946 function sc_reverseBang(l) {
947 return sc_reverseAppendBang(l, null);
950 /*** META ((export #t)) */
951 function sc_listTail(l, k) {
953 for (var i = 0; i < k; i++) {
959 /*** META ((export #t)) */
960 function sc_listRef(l, k) {
961 return sc_listTail(l, k).car;
964 /* // unoptimized generic versions
965 function sc_memX(o, l, comp) {
973 function sc_memq(o, l) { return sc_memX(o, l, sc_isEq); }
974 function sc_memv(o, l) { return sc_memX(o, l, sc_isEqv); }
975 function sc_member(o, l) { return sc_memX(o, l, sc_isEqual); }
978 /* optimized versions */
979 /*** META ((export #t)) */
980 function sc_memq(o, l) {
988 /*** META ((export #t)) */
989 function sc_memv(o, l) {
997 /*** META ((export #t)) */
998 function sc_member(o, l) {
1000 if (sc_isEqual(l.car,o))
1007 /* // generic unoptimized versions
1008 function sc_assX(o, al, comp) {
1009 while (al != null) {
1010 if (comp(al.car.car, o))
1016 function sc_assq(o, al) { return sc_assX(o, al, sc_isEq); }
1017 function sc_assv(o, al) { return sc_assX(o, al, sc_isEqv); }
1018 function sc_assoc(o, al) { return sc_assX(o, al, sc_isEqual); }
1020 // optimized versions
1021 /*** META ((export #t)) */
1022 function sc_assq(o, al) {
1023 while (al !== null) {
1024 if (al.car.car === o)
1030 /*** META ((export #t)) */
1031 function sc_assv(o, al) {
1032 while (al !== null) {
1033 if (al.car.car === o)
1039 /*** META ((export #t)) */
1040 function sc_assoc(o, al) {
1041 while (al !== null) {
1042 if (sc_isEqual(al.car.car, o))
1049 /* can be used for mutable strings and characters */
1050 function sc_isCharStringEqual(cs1, cs2) { return cs1.val === cs2.val; }
1051 function sc_isCharStringLess(cs1, cs2) { return cs1.val < cs2.val; }
1052 function sc_isCharStringGreater(cs1, cs2) { return cs1.val > cs2.val; }
1053 function sc_isCharStringLessEqual(cs1, cs2) { return cs1.val <= cs2.val; }
1054 function sc_isCharStringGreaterEqual(cs1, cs2) { return cs1.val >= cs2.val; }
1055 function sc_isCharStringCIEqual(cs1, cs2)
1056 { return cs1.val.toLowerCase() === cs2.val.toLowerCase(); }
1057 function sc_isCharStringCILess(cs1, cs2)
1058 { return cs1.val.toLowerCase() < cs2.val.toLowerCase(); }
1059 function sc_isCharStringCIGreater(cs1, cs2)
1060 { return cs1.val.toLowerCase() > cs2.val.toLowerCase(); }
1061 function sc_isCharStringCILessEqual(cs1, cs2)
1062 { return cs1.val.toLowerCase() <= cs2.val.toLowerCase(); }
1063 function sc_isCharStringCIGreaterEqual(cs1, cs2)
1064 { return cs1.val.toLowerCase() >= cs2.val.toLowerCase(); }
1069 function sc_Char(c) {
1070 var cached = sc_Char.lazy[c];
1074 sc_Char.lazy[c] = this;
1075 // add return, so FF does not complain.
1078 sc_Char.lazy = new Object();
1080 sc_Char.char2readable = {
1083 "\010": "#\\backspace",
1085 "\012": "#\\newline",
1087 "\015": "#\\return",
1088 "\033": "#\\escape",
1090 "\177": "#\\delete",
1092 /* poeticless names */
1122 sc_Char.readable2char = {
1125 "backspace": "\010",
1167 sc_Char.prototype.toString = function() {
1170 // sc_toDisplayString == toString
1171 sc_Char.prototype.sc_toWriteString = function() {
1172 var entry = sc_Char.char2readable[this.val];
1176 return "#\\" + this.val;
1179 /*** META ((export #t)
1181 (peephole (postfix "instanceof sc_Char")))
1183 function sc_isChar(c) {
1184 return (c instanceof sc_Char);
1187 /*** META ((export char=?)
1189 (peephole (hole 2 c1 ".val === " c2 ".val")))
1191 var sc_isCharEqual = sc_isCharStringEqual;
1192 /*** META ((export char<?)
1194 (peephole (hole 2 c1 ".val < " c2 ".val")))
1196 var sc_isCharLess = sc_isCharStringLess;
1197 /*** META ((export char>?)
1199 (peephole (hole 2 c1 ".val > " c2 ".val")))
1201 var sc_isCharGreater = sc_isCharStringGreater;
1202 /*** META ((export char<=?)
1204 (peephole (hole 2 c1 ".val <= " c2 ".val")))
1206 var sc_isCharLessEqual = sc_isCharStringLessEqual;
1207 /*** META ((export char>=?)
1209 (peephole (hole 2 c1 ".val >= " c2 ".val")))
1211 var sc_isCharGreaterEqual = sc_isCharStringGreaterEqual;
1212 /*** META ((export char-ci=?)
1214 (peephole (hole 2 c1 ".val.toLowerCase() === " c2 ".val.toLowerCase()")))
1216 var sc_isCharCIEqual = sc_isCharStringCIEqual;
1217 /*** META ((export char-ci<?)
1219 (peephole (hole 2 c1 ".val.toLowerCase() < " c2 ".val.toLowerCase()")))
1221 var sc_isCharCILess = sc_isCharStringCILess;
1222 /*** META ((export char-ci>?)
1224 (peephole (hole 2 c1 ".val.toLowerCase() > " c2 ".val.toLowerCase()")))
1226 var sc_isCharCIGreater = sc_isCharStringCIGreater;
1227 /*** META ((export char-ci<=?)
1229 (peephole (hole 2 c1 ".val.toLowerCase() <= " c2 ".val.toLowerCase()")))
1231 var sc_isCharCILessEqual = sc_isCharStringCILessEqual;
1232 /*** META ((export char-ci>=?)
1234 (peephole (hole 2 c1 ".val.toLowerCase() >= " c2 ".val.toLowerCase()")))
1236 var sc_isCharCIGreaterEqual = sc_isCharStringCIGreaterEqual;
1238 var SC_NUMBER_CLASS = "0123456789";
1239 var SC_WHITESPACE_CLASS = ' \r\n\t\f';
1240 var SC_LOWER_CLASS = 'abcdefghijklmnopqrstuvwxyz';
1241 var SC_UPPER_CLASS = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
1243 function sc_isCharOfClass(c, cl) { return (cl.indexOf(c) != -1); }
1244 /*** META ((export #t)
1247 function sc_isCharAlphabetic(c)
1248 { return sc_isCharOfClass(c.val, SC_LOWER_CLASS) ||
1249 sc_isCharOfClass(c.val, SC_UPPER_CLASS); }
1250 /*** META ((export #t)
1252 (peephole (hole 1 "SC_NUMBER_CLASS.indexOf(" c ".val) != -1")))
1254 function sc_isCharNumeric(c)
1255 { return sc_isCharOfClass(c.val, SC_NUMBER_CLASS); }
1256 /*** META ((export #t)
1259 function sc_isCharWhitespace(c) {
1261 return tmp === " " || tmp === "\r" || tmp === "\n" || tmp === "\t" || tmp === "\f";
1263 /*** META ((export #t)
1265 (peephole (hole 1 "SC_UPPER_CLASS.indexOf(" c ".val) != -1")))
1267 function sc_isCharUpperCase(c)
1268 { return sc_isCharOfClass(c.val, SC_UPPER_CLASS); }
1269 /*** META ((export #t)
1271 (peephole (hole 1 "SC_LOWER_CLASS.indexOf(" c ".val) != -1")))
1273 function sc_isCharLowerCase(c)
1274 { return sc_isCharOfClass(c.val, SC_LOWER_CLASS); }
1276 /*** META ((export #t)
1277 (peephole (postfix ".val.charCodeAt(0)")))
1279 function sc_char2integer(c)
1280 { return c.val.charCodeAt(0); }
1281 /*** META ((export #t)
1282 (peephole (hole 1 "new sc_Char(String.fromCharCode(" n "))")))
1284 function sc_integer2char(n)
1285 { return new sc_Char(String.fromCharCode(n)); }
1287 /*** META ((export #t)
1288 (peephole (hole 1 "new sc_Char(" c ".val.toUpperCase())")))
1290 function sc_charUpcase(c)
1291 { return new sc_Char(c.val.toUpperCase()); }
1292 /*** META ((export #t)
1293 (peephole (hole 1 "new sc_Char(" c ".val.toLowerCase())")))
1295 function sc_charDowncase(c)
1296 { return new sc_Char(c.val.toLowerCase()); }
1298 function sc_makeJSStringOfLength(k, c) {
1300 if (c === undefined)
1306 // every round doubles the size of fill.
1309 res = res.concat(fill);
1310 fill = fill.concat(fill);
1316 function sc_makejsString(k, c) {
1322 return sc_makeJSStringOfLength(k, fill);
1325 function sc_jsstring2list(s) {
1327 for (var i = s.length - 1; i >= 0; i--)
1328 res = sc_cons(new sc_Char(s.charAt(i)), res);
1332 function sc_list2jsstring(l) {
1333 var a = new Array();
1338 return "".concat.apply("", a);
1341 var sc_Vector = Array;
1343 sc_Vector.prototype.sc_toWriteOrDisplayString = function(writeOrDisplay) {
1344 if (this.length === 0) return "#()";
1346 var res = "#(" + writeOrDisplay(this[0]);
1347 for (var i = 1; i < this.length; i++)
1348 res += " " + writeOrDisplay(this[i]);
1352 sc_Vector.prototype.sc_toDisplayString = function() {
1353 return this.sc_toWriteOrDisplayString(sc_toDisplayString);
1355 sc_Vector.prototype.sc_toWriteString = function() {
1356 return this.sc_toWriteOrDisplayString(sc_toWriteString);
1359 /*** META ((export vector? array?)
1361 (peephole (postfix " instanceof sc_Vector")))
1363 function sc_isVector(v) {
1364 return (v instanceof sc_Vector);
1367 // only applies to vectors
1368 function sc_isVectorEqual(v1, v2, comp) {
1369 if (v1.length !== v2.length) return false;
1370 for (var i = 0; i < v1.length; i++)
1371 if (!comp(v1[i], v2[i])) return false;
1375 /*** META ((export make-vector make-array)) */
1376 function sc_makeVector(size, fill) {
1377 var a = new sc_Vector(size);
1378 if (fill !== undefined)
1379 sc_vectorFillBang(a, fill);
1383 /*** META ((export vector array)
1384 (peephole (vector)))
1386 function sc_vector() {
1387 var a = new sc_Vector();
1388 for (var i = 0; i < arguments.length; i++)
1389 a.push(arguments[i]);
1393 /*** META ((export vector-length array-length)
1394 (peephole (postfix ".length")))
1396 function sc_vectorLength(v) {
1400 /*** META ((export vector-ref array-ref)
1401 (peephole (hole 2 v "[" pos "]")))
1403 function sc_vectorRef(v, pos) {
1407 /*** META ((export vector-set! array-set!)
1408 (peephole (hole 3 v "[" pos "] = " val)))
1410 function sc_vectorSetBang(v, pos, val) {
1414 /*** META ((export vector->list array->list)) */
1415 function sc_vector2list(a) {
1417 for (var i = a.length-1; i >= 0; i--)
1418 res = sc_cons(a[i], res);
1422 /*** META ((export list->vector list->array)) */
1423 function sc_list2vector(l) {
1424 var a = new sc_Vector();
1432 /*** META ((export vector-fill! array-fill!)) */
1433 function sc_vectorFillBang(a, fill) {
1434 for (var i = 0; i < a.length; i++)
1439 /*** META ((export #t)) */
1440 function sc_copyVector(a, len) {
1441 if (len <= a.length)
1442 return a.slice(0, len);
1444 var tmp = a.concat();
1450 /*** META ((export #t)
1451 (peephole (hole 3 a ".slice(" start "," end ")")))
1453 function sc_vectorCopy(a, start, end) {
1454 return a.slice(start, end);
1457 /*** META ((export #t)) */
1458 function sc_vectorCopyBang(target, tstart, source, sstart, send) {
1459 if (!sstart) sstart = 0;
1460 if (!send) send = source.length;
1462 // if target == source we don't want to overwrite not yet copied elements.
1463 if (tstart <= sstart) {
1464 for (var i = tstart, j = sstart; j < send; i++, j++) {
1465 target[i] = source[j];
1468 var diff = send - sstart;
1469 for (var i = tstart + diff - 1, j = send - 1;
1472 target[i] = source[j];
1478 /*** META ((export #t)
1480 (peephole (hole 1 "typeof " o " === 'function'")))
1482 function sc_isProcedure(o) {
1483 return (typeof o === "function");
1486 /*** META ((export #t)) */
1487 function sc_apply(proc) {
1488 var args = new Array();
1489 // first part of arguments are not in list-form.
1490 for (var i = 1; i < arguments.length - 1; i++)
1491 args.push(arguments[i]);
1492 var l = arguments[arguments.length - 1];
1493 while (l !== null) {
1497 return proc.apply(null, args);
1500 /*** META ((export #t)) */
1501 function sc_map(proc, l1) {
1502 if (l1 === undefined)
1505 var nbApplyArgs = arguments.length - 1;
1506 var applyArgs = new Array(nbApplyArgs);
1508 while (l1 !== null) {
1509 for (var i = 0; i < nbApplyArgs; i++) {
1510 applyArgs[i] = arguments[i + 1].car;
1511 arguments[i + 1] = arguments[i + 1].cdr;
1513 revres = sc_cons(proc.apply(null, applyArgs), revres);
1515 return sc_reverseAppendBang(revres, null);
1518 /*** META ((export #t)) */
1519 function sc_mapBang(proc, l1) {
1520 if (l1 === undefined)
1524 var nbApplyArgs = arguments.length - 1;
1525 var applyArgs = new Array(nbApplyArgs);
1526 while (l1 !== null) {
1528 for (var i = 0; i < nbApplyArgs; i++) {
1529 applyArgs[i] = arguments[i + 1].car;
1530 arguments[i + 1] = arguments[i + 1].cdr;
1532 tmp.car = proc.apply(null, applyArgs);
1537 /*** META ((export #t)) */
1538 function sc_forEach(proc, l1) {
1539 if (l1 === undefined)
1542 var nbApplyArgs = arguments.length - 1;
1543 var applyArgs = new Array(nbApplyArgs);
1544 while (l1 !== null) {
1545 for (var i = 0; i < nbApplyArgs; i++) {
1546 applyArgs[i] = arguments[i + 1].car;
1547 arguments[i + 1] = arguments[i + 1].cdr;
1549 proc.apply(null, applyArgs);
1551 // add return so FF does not complain.
1555 /*** META ((export #t)) */
1556 function sc_filter(proc, l1) {
1557 var dummy = { cdr : null };
1559 while (l1 !== null) {
1560 if (proc(l1.car) !== false) {
1561 tail.cdr = sc_cons(l1.car, null);
1569 /*** META ((export #t)) */
1570 function sc_filterBang(proc, l1) {
1571 var head = sc_cons("dummy", l1);
1574 while (next !== null) {
1575 if (proc(next.car) !== false) {
1585 function sc_filterMap1(proc, l1) {
1587 while (l1 !== null) {
1588 var tmp = proc(l1.car)
1589 if (tmp !== false) revres = sc_cons(tmp, revres);
1592 return sc_reverseAppendBang(revres, null);
1594 function sc_filterMap2(proc, l1, l2) {
1596 while (l1 !== null) {
1597 var tmp = proc(l1.car, l2.car);
1598 if(tmp !== false) revres = sc_cons(tmp, revres);
1602 return sc_reverseAppendBang(revres, null);
1605 /*** META ((export #t)) */
1606 function sc_filterMap(proc, l1, l2, l3) {
1607 if (l2 === undefined)
1608 return sc_filterMap1(proc, l1);
1609 else if (l3 === undefined)
1610 return sc_filterMap2(proc, l1, l2);
1612 var nbApplyArgs = arguments.length - 1;
1613 var applyArgs = new Array(nbApplyArgs);
1615 while (l1 !== null) {
1616 for (var i = 0; i < nbApplyArgs; i++) {
1617 applyArgs[i] = arguments[i + 1].car;
1618 arguments[i + 1] = arguments[i + 1].cdr;
1620 var tmp = proc.apply(null, applyArgs);
1621 if(tmp !== false) revres = sc_cons(tmp, revres);
1623 return sc_reverseAppendBang(revres, null);
1626 /*** META ((export #t)) */
1627 function sc_any(proc, l) {
1629 while (l !== null) {
1630 var tmp = proc(l.car);
1631 if(tmp !== false) return tmp;
1637 /*** META ((export any?)
1638 (peephole (hole 2 "sc_any(" proc "," l ") !== false")))
1640 function sc_anyPred(proc, l) {
1641 return sc_any(proc, l)!== false;
1644 /*** META ((export #t)) */
1645 function sc_every(proc, l) {
1648 while (l !== null) {
1650 if (tmp === false) return false;
1656 /*** META ((export every?)
1657 (peephole (hole 2 "sc_every(" proc "," l ") !== false")))
1659 function sc_everyPred(proc, l) {
1660 var tmp = sc_every(proc, l);
1661 if (tmp !== false) return true;
1665 /*** META ((export #t)
1666 (peephole (postfix "()")))
1668 function sc_force(o) {
1672 /*** META ((export #t)) */
1673 function sc_makePromise(proc) {
1674 var isResultReady = false;
1675 var result = undefined;
1677 if (!isResultReady) {
1679 if (!isResultReady) {
1680 isResultReady = true;
1688 function sc_Values(values) {
1689 this.values = values;
1692 /*** META ((export #t)
1693 (peephole (values)))
1695 function sc_values() {
1696 if (arguments.length === 1)
1697 return arguments[0];
1699 return new sc_Values(arguments);
1702 /*** META ((export #t)) */
1703 function sc_callWithValues(producer, consumer) {
1704 var produced = producer();
1705 if (produced instanceof sc_Values)
1706 return consumer.apply(null, produced.values);
1708 return consumer(produced);
1711 /*** META ((export #t)) */
1712 function sc_dynamicWind(before, thunk, after) {
1723 // TODO: eval/scheme-report-environment/null-environment/interaction-environment
1725 // LIMITATION: 'load' doesn't exist without files.
1726 // LIMITATION: transcript-on/transcript-off doesn't exist without files.
1729 function sc_Struct(name) {
1732 sc_Struct.prototype.sc_toDisplayString = function() {
1733 return "#<struct" + sc_hash(this) + ">";
1735 sc_Struct.prototype.sc_toWriteString = sc_Struct.prototype.sc_toDisplayString;
1737 /*** META ((export #t)
1738 (peephole (hole 1 "new sc_Struct(" name ")")))
1740 function sc_makeStruct(name) {
1741 return new sc_Struct(name);
1744 /*** META ((export #t)
1746 (peephole (postfix " instanceof sc_Struct")))
1748 function sc_isStruct(o) {
1749 return (o instanceof sc_Struct);
1752 /*** META ((export #t)
1754 (peephole (hole 2 "(" 1 " instanceof sc_Struct) && ( " 1 ".name === " 0 ")")))
1756 function sc_isStructNamed(name, s) {
1757 return ((s instanceof sc_Struct) && (s.name === name));
1760 /*** META ((export struct-field)
1761 (peephole (hole 3 0 "[" 2 "]")))
1763 function sc_getStructField(s, name, field) {
1767 /*** META ((export struct-field-set!)
1768 (peephole (hole 4 0 "[" 2 "] = " 3)))
1770 function sc_setStructFieldBang(s, name, field, val) {
1774 /*** META ((export #t)
1775 (peephole (prefix "~")))
1777 function sc_bitNot(x) {
1781 /*** META ((export #t)
1782 (peephole (infix 2 2 "&")))
1784 function sc_bitAnd(x, y) {
1788 /*** META ((export #t)
1789 (peephole (infix 2 2 "|")))
1791 function sc_bitOr(x, y) {
1795 /*** META ((export #t)
1796 (peephole (infix 2 2 "^")))
1798 function sc_bitXor(x, y) {
1802 /*** META ((export #t)
1803 (peephole (infix 2 2 "<<")))
1805 function sc_bitLsh(x, y) {
1809 /*** META ((export #t)
1810 (peephole (infix 2 2 ">>")))
1812 function sc_bitRsh(x, y) {
1816 /*** META ((export #t)
1817 (peephole (infix 2 2 ">>>")))
1819 function sc_bitUrsh(x, y) {
1823 /*** META ((export js-field js-property)
1824 (peephole (hole 2 o "[" field "]")))
1826 function sc_jsField(o, field) {
1830 /*** META ((export js-field-set! js-property-set!)
1831 (peephole (hole 3 o "[" field "] = " val)))
1833 function sc_setJsFieldBang(o, field, val) {
1834 return o[field] = val;
1837 /*** META ((export js-field-delete! js-property-delete!)
1838 (peephole (hole 2 "delete" o "[" field "]")))
1840 function sc_deleteJsFieldBang(o, field) {
1844 /*** META ((export #t)
1845 (peephole (jsCall)))
1847 function sc_jsCall(o, fun) {
1848 var args = new Array();
1849 for (var i = 2; i < arguments.length; i++)
1850 args[i-2] = arguments[i];
1851 return fun.apply(o, args);
1854 /*** META ((export #t)
1855 (peephole (jsMethodCall)))
1857 function sc_jsMethodCall(o, field) {
1858 var args = new Array();
1859 for (var i = 2; i < arguments.length; i++)
1860 args[i-2] = arguments[i];
1861 return o[field].apply(o, args);
1864 /*** META ((export new js-new)
1867 function sc_jsNew(c) {
1868 var evalStr = "new c(";
1869 evalStr +=arguments.length > 1? "arguments[1]": "";
1870 for (var i = 2; i < arguments.length; i++)
1871 evalStr += ", arguments[" + i + "]";
1873 return eval(evalStr);
1876 // ======================== RegExp ====================
1877 /*** META ((export #t)) */
1878 function sc_pregexp(re) {
1879 return new RegExp(sc_string2jsstring(re));
1882 /*** META ((export #t)) */
1883 function sc_pregexpMatch(re, s) {
1884 var reg = (re instanceof RegExp) ? re : sc_pregexp(re);
1885 var tmp = reg.exec(sc_string2jsstring(s));
1887 if (tmp == null) return false;
1890 for (var i = tmp.length-1; i >= 0; i--) {
1891 if (tmp[i] !== null) {
1892 res = sc_cons(sc_jsstring2string(tmp[i]), res);
1894 res = sc_cons(false, res);
1900 /*** META ((export #t)) */
1901 function sc_pregexpReplace(re, s1, s2) {
1903 var jss1 = sc_string2jsstring(s1);
1904 var jss2 = sc_string2jsstring(s2);
1906 if (re instanceof RegExp) {
1910 reg = new RegExp(re.source);
1912 reg = new RegExp(sc_string2jsstring(re));
1915 return jss1.replace(reg, jss2);
1918 /*** META ((export pregexp-replace*)) */
1919 function sc_pregexpReplaceAll(re, s1, s2) {
1921 var jss1 = sc_string2jsstring(s1);
1922 var jss2 = sc_string2jsstring(s2);
1924 if (re instanceof RegExp) {
1928 reg = new RegExp(re.source, "g");
1930 reg = new RegExp(sc_string2jsstring(re), "g");
1933 return jss1.replace(reg, jss2);
1936 /*** META ((export #t)) */
1937 function sc_pregexpSplit(re, s) {
1938 var reg = ((re instanceof RegExp) ?
1940 new RegExp(sc_string2jsstring(re)));
1941 var jss = sc_string2jsstring(s);
1942 var tmp = jss.split(reg);
1944 if (tmp == null) return false;
1946 return sc_vector2list(tmp);
1950 /* =========================================================================== */
1951 /* Other library stuff */
1952 /* =========================================================================== */
1954 /*** META ((export #t)
1955 (peephole (hole 1 "Math.floor(Math.random()*" 'n ")")))
1957 function sc_random(n) {
1958 return Math.floor(Math.random()*n);
1961 /*** META ((export current-date)
1962 (peephole (hole 0 "new Date()")))
1964 function sc_currentDate() {
1968 function sc_Hashtable() {
1970 sc_Hashtable.prototype.toString = function() {
1971 return "#{%hashtable}";
1973 // sc_toWriteString == sc_toDisplayString == toString
1975 function sc_HashtableElement(key, val) {
1980 /*** META ((export #t)
1981 (peephole (hole 0 "new sc_Hashtable()")))
1983 function sc_makeHashtable() {
1984 return new sc_Hashtable();
1987 /*** META ((export #t)) */
1988 function sc_hashtablePutBang(ht, key, val) {
1989 var hash = sc_hash(key);
1990 ht[hash] = new sc_HashtableElement(key, val);
1993 /*** META ((export #t)) */
1994 function sc_hashtableGet(ht, key) {
1995 var hash = sc_hash(key);
1997 return ht[hash].val;
2002 /*** META ((export #t)) */
2003 function sc_hashtableForEach(ht, f) {
2005 if (ht[v] instanceof sc_HashtableElement)
2006 f(ht[v].key, ht[v].val);
2010 /*** META ((export hashtable-contains?)
2011 (peephole (hole 2 "sc_hash(" 1 ") in " 0)))
2013 function sc_hashtableContains(ht, key) {
2014 var hash = sc_hash(key);
2021 var SC_HASH_COUNTER = 0;
2023 function sc_hash(o) {
2026 else if (o === undefined)
2028 else if (o === true)
2030 else if (o === false)
2032 else if (typeof o === "number")
2034 else if (typeof o === "string")
2035 return "jsstr-" + o;
2036 else if (o.sc_getHash)
2037 return o.sc_getHash();
2039 return sc_counterHash.call(o);
2041 function sc_counterHash() {
2042 if (!this.sc_hash) {
2043 this.sc_hash = "hash-" + SC_HASH_COUNTER;
2046 return this.sc_hash;
2049 function sc_Trampoline(args, maxTailCalls) {
2050 this['__trampoline return__'] = true;
2052 this.MAX_TAIL_CALLs = maxTailCalls;
2054 // TODO: call/cc stuff
2055 sc_Trampoline.prototype.restart = function() {
2058 // set both globals.
2059 SC_TAIL_OBJECT.calls = o.MAX_TAIL_CALLs-1;
2060 var fun = o.args.callee;
2061 var res = fun.apply(SC_TAIL_OBJECT, o.args);
2062 if (res instanceof sc_Trampoline)
2069 /*** META ((export bind-exit-lambda)) */
2070 function sc_bindExitLambda(proc) {
2071 var escape_obj = new sc_BindExitException();
2072 var escape = function(res) {
2073 escape_obj.res = res;
2077 return proc(escape);
2079 if (e === escape_obj) {
2085 function sc_BindExitException() {
2086 this._internalException = true;
2089 var SC_SCM2JS_GLOBALS = new Object();
2091 // default tail-call depth.
2092 // normally the program should set it again. but just in case...
2093 var SC_TAIL_OBJECT = new Object();
2094 SC_SCM2JS_GLOBALS.TAIL_OBJECT = SC_TAIL_OBJECT;
2095 // ======================== I/O =======================
2097 /*------------------------------------------------------------------*/
2101 var SC_EOF_OBJECT = new sc_EOF();
2103 function sc_Port() {
2106 /* --------------- Input ports -------------------------------------*/
2108 function sc_InputPort() {
2110 sc_InputPort.prototype = new sc_Port();
2112 sc_InputPort.prototype.peekChar = function() {
2113 if (!("peeked" in this))
2114 this.peeked = this.getNextChar();
2117 sc_InputPort.prototype.readChar = function() {
2118 var tmp = this.peekChar();
2122 sc_InputPort.prototype.isCharReady = function() {
2125 sc_InputPort.prototype.close = function() {
2129 /* .............. String port ..........................*/
2130 function sc_ErrorInputPort() {
2132 sc_ErrorInputPort.prototype = new sc_InputPort();
2133 sc_ErrorInputPort.prototype.getNextChar = function() {
2134 throw "can't read from error-port.";
2136 sc_ErrorInputPort.prototype.isCharReady = function() {
2141 /* .............. String port ..........................*/
2143 function sc_StringInputPort(jsStr) {
2144 // we are going to do some charAts on the str.
2145 // instead of recreating all the time a String-object, we
2146 // create one in the beginning. (not sure, if this is really an optim)
2147 this.str = new String(jsStr);
2150 sc_StringInputPort.prototype = new sc_InputPort();
2151 sc_StringInputPort.prototype.getNextChar = function() {
2152 if (this.pos >= this.str.length)
2153 return SC_EOF_OBJECT;
2154 return this.str.charAt(this.pos++);
2157 /* ------------- Read and other lib-funs -------------------------------*/
2158 function sc_Token(type, val, pos) {
2163 sc_Token.EOF = 0/*EOF*/;
2164 sc_Token.OPEN_PAR = 1/*OPEN_PAR*/;
2165 sc_Token.CLOSE_PAR = 2/*CLOSE_PAR*/;
2166 sc_Token.OPEN_BRACE = 3/*OPEN_BRACE*/;
2167 sc_Token.CLOSE_BRACE = 4/*CLOSE_BRACE*/;
2168 sc_Token.OPEN_BRACKET = 5/*OPEN_BRACKET*/;
2169 sc_Token.CLOSE_BRACKET = 6/*CLOSE_BRACKET*/;
2170 sc_Token.WHITESPACE = 7/*WHITESPACE*/;
2171 sc_Token.QUOTE = 8/*QUOTE*/;
2172 sc_Token.ID = 9/*ID*/;
2173 sc_Token.DOT = 10/*DOT*/;
2174 sc_Token.STRING = 11/*STRING*/;
2175 sc_Token.NUMBER = 12/*NUMBER*/;
2176 sc_Token.ERROR = 13/*ERROR*/;
2177 sc_Token.VECTOR_BEGIN = 14/*VECTOR_BEGIN*/;
2178 sc_Token.TRUE = 15/*TRUE*/;
2179 sc_Token.FALSE = 16/*FALSE*/;
2180 sc_Token.UNSPECIFIED = 17/*UNSPECIFIED*/;
2181 sc_Token.REFERENCE = 18/*REFERENCE*/;
2182 sc_Token.STORE = 19/*STORE*/;
2183 sc_Token.CHAR = 20/*CHAR*/;
2185 var SC_ID_CLASS = SC_LOWER_CLASS + SC_UPPER_CLASS + "!$%*+-./:<=>?@^_~";
2186 function sc_Tokenizer(port) {
2189 sc_Tokenizer.prototype.peekToken = function() {
2192 var newToken = this.nextToken();
2193 this.peeked = newToken;
2196 sc_Tokenizer.prototype.readToken = function() {
2197 var tmp = this.peekToken();
2201 sc_Tokenizer.prototype.nextToken = function() {
2202 var port = this.port;
2204 function isNumberChar(c) {
2205 return (c >= "0" && c <= "9");
2207 function isIdOrNumberChar(c) {
2208 return SC_ID_CLASS.indexOf(c) != -1 || // ID-char
2209 (c >= "0" && c <= "9");
2211 function isWhitespace(c) {
2212 return c === " " || c === "\r" || c === "\n" || c === "\t" || c === "\f";
2214 function isWhitespaceOrEOF(c) {
2215 return isWhitespace(c) || c === SC_EOF_OBJECT;
2218 function readString() {
2221 var c = port.readChar();
2224 return new sc_Token(11/*STRING*/, res);
2226 var tmp = port.readChar();
2228 case '0': res += "\0"; break;
2229 case 'a': res += "\a"; break;
2230 case 'b': res += "\b"; break;
2231 case 'f': res += "\f"; break;
2232 case 'n': res += "\n"; break;
2233 case 'r': res += "\r"; break;
2234 case 't': res += "\t"; break;
2235 case 'v': res += "\v"; break;
2236 case '"': res += '"'; break;
2237 case '\\': res += '\\'; break;
2242 var hexC = port.peekChar();
2243 if (hexC >= '0' && hexC <= '9') {
2245 nb = nb * 16 + hexC.charCodeAt(0) - '0'.charCodeAt(0);
2246 } else if (hexC >= 'a' && hexC <= 'f') {
2248 nb = nb * 16 + hexC.charCodeAt(0) - 'a'.charCodeAt(0);
2249 } else if (hexC >= 'A' && hexC <= 'F') {
2251 nb = nb * 16 + hexC.charCodeAt(0) - 'A'.charCodeAt(0);
2253 // next char isn't part of hex.
2254 res += String.fromCharCode(nb);
2260 if (tmp === SC_EOF_OBJECT) {
2261 return new sc_Token(13/*ERROR*/, "unclosed string-literal" + res);
2267 if (c === SC_EOF_OBJECT) {
2268 return new sc_Token(13/*ERROR*/, "unclosed string-literal" + res);
2274 function readIdOrNumber(firstChar) {
2275 var res = firstChar;
2276 while (isIdOrNumberChar(port.peekChar()))
2277 res += port.readChar();
2279 return new sc_Token(9/*ID*/, res);
2281 return new sc_Token(12/*NUMBER*/, res - 0);
2284 function skipWhitespaceAndComments() {
2288 while (isWhitespace(port.peekChar()))
2290 if (port.peekChar() === ';') {
2294 curChar = port.readChar();
2295 if (curChar === SC_EOF_OBJECT ||
2303 function readDot() {
2304 if (isWhitespace(port.peekChar()))
2305 return new sc_Token(10/*DOT*/);
2307 return readIdOrNumber(".");
2310 function readSharp() {
2311 var c = port.readChar();
2312 if (isWhitespace(c))
2313 return new sc_Token(13/*ERROR*/, "bad #-pattern0.");
2316 if (isNumberChar(c)) {
2318 while (isNumberChar(port.peekChar()))
2319 nb = nb*10 + (port.readChar() - 0);
2320 switch (port.readChar()) {
2322 return new sc_Token(18/*REFERENCE*/, nb);
2324 return new sc_Token(19/*STORE*/, nb);
2326 return new sc_Token(13/*ERROR*/, "bad #-pattern1." + nb);
2331 return new sc_Token(14/*VECTOR_BEGIN*/);
2333 if (c === "\\") { // character
2335 while (!isWhitespaceOrEOF(port.peekChar()))
2336 tmp += port.readChar();
2337 switch (tmp.length) {
2338 case 0: // it's escaping a whitespace char:
2339 if (sc_isEOFObject(port.peekChar))
2340 return new sc_Token(13/*ERROR*/, "bad #-pattern2.");
2342 return new sc_Token(20/*CHAR*/, port.readChar());
2344 return new sc_Token(20/*CHAR*/, tmp);
2346 var entry = sc_Char.readable2char[tmp.toLowerCase()];
2348 return new sc_Token(20/*CHAR*/, entry);
2350 return new sc_Token(13/*ERROR*/, "unknown character description: #\\" + tmp);
2354 // some constants (#t, #f, #unspecified)
2358 case 't': res = new sc_Token(15/*TRUE*/, true); needing = ""; break;
2359 case 'f': res = new sc_Token(16/*FALSE*/, false); needing = ""; break;
2360 case 'u': res = new sc_Token(17/*UNSPECIFIED*/, undefined); needing = "nspecified"; break;
2362 return new sc_Token(13/*ERROR*/, "bad #-pattern3: " + c);
2365 c = port.peekChar();
2366 if ((isWhitespaceOrEOF(c) || c === ')') &&
2369 else if (isWhitespace(c) || needing == "")
2370 return new sc_Token(13/*ERROR*/, "bad #-pattern4 " + c + " " + needing);
2371 else if (needing.charAt(0) == c) {
2372 port.readChar(); // consume
2373 needing = needing.slice(1);
2375 return new sc_Token(13/*ERROR*/, "bad #-pattern5");
2380 skipWhitespaceAndComments();
2381 var curChar = port.readChar();
2382 if (curChar === SC_EOF_OBJECT)
2383 return new sc_Token(0/*EOF*/, curChar);
2389 return readWhitespace();
2391 return new sc_Token(1/*OPEN_PAR*/);
2393 return new sc_Token(2/*CLOSE_PAR*/);
2395 return new sc_Token(3/*OPEN_BRACE*/);
2397 return new sc_Token(4/*CLOSE_BRACE*/);
2399 return new sc_Token(5/*OPEN_BRACKET*/);
2401 return new sc_Token(6/*CLOSE_BRACKET*/);
2403 return new sc_Token(8/*QUOTE*/);
2409 return readString();
2411 if (isIdOrNumberChar(curChar))
2412 return readIdOrNumber(curChar);
2413 throw "unexpected character: " + curChar;
2417 function sc_Reader(tokenizer) {
2418 this.tokenizer = tokenizer;
2419 this.backref = new Array();
2421 sc_Reader.prototype.read = function() {
2422 function readList(listBeginType) {
2423 function matchesPeer(open, close) {
2424 return open === 1/*OPEN_PAR*/ && close === 2/*CLOSE_PAR*/
2425 || open === 3/*OPEN_BRACE*/ && close === 4/*CLOSE_BRACE*/
2426 || open === 5/*OPEN_BRACKET*/ && close === 6/*CLOSE_BRACKET*/;
2431 var token = tokenizer.peekToken();
2433 switch (token.type) {
2434 case 2/*CLOSE_PAR*/:
2435 case 4/*CLOSE_BRACE*/:
2436 case 6/*CLOSE_BRACKET*/:
2437 if (matchesPeer(listBeginType, token.type)) {
2438 tokenizer.readToken(); // consume token
2439 return sc_reverseBang(res);
2441 throw "closing par doesn't match: " + listBeginType
2442 + " " + listEndType;
2445 throw "unexpected end of file";
2448 tokenizer.readToken(); // consume token
2449 var cdr = this.read();
2450 var par = tokenizer.readToken();
2451 if (!matchesPeer(listBeginType, par.type))
2452 throw "closing par doesn't match: " + listBeginType
2455 return sc_reverseAppendBang(res, cdr);
2459 res = sc_cons(this.read(), res);
2463 function readQuote() {
2464 return sc_cons("quote", sc_cons(this.read(), null));
2466 function readVector() {
2467 // opening-parenthesis is already consumed
2468 var a = new Array();
2470 var token = tokenizer.peekToken();
2471 switch (token.type) {
2472 case 2/*CLOSE_PAR*/:
2473 tokenizer.readToken();
2477 a.push(this.read());
2482 function storeRefence(nb) {
2483 var tmp = this.read();
2484 this.backref[nb] = tmp;
2488 function readReference(nb) {
2489 if (nb in this.backref)
2490 return this.backref[nb];
2492 throw "bad reference: " + nb;
2495 var tokenizer = this.tokenizer;
2497 var token = tokenizer.readToken();
2500 if (token.type === 13/*ERROR*/)
2503 switch (token.type) {
2505 case 3/*OPEN_BRACE*/:
2506 case 5/*OPEN_BRACKET*/:
2507 return readList.call(this, token.type);
2509 return readQuote.call(this);
2511 return sc_jsstring2string(token.val);
2513 return new sc_Char(token.val);
2514 case 14/*VECTOR_BEGIN*/:
2515 return readVector.call(this);
2516 case 18/*REFERENCE*/:
2517 return readReference.call(this, token.val);
2519 return storeRefence.call(this, token.val);
2521 return sc_jsstring2symbol(token.val);
2526 case 17/*UNSPECIFIED*/:
2529 throw "unexpected token " + token.type + " " + token.val;
2533 /*** META ((export #t)) */
2534 function sc_read(port) {
2535 if (port === undefined) // we assume the port hasn't been given.
2536 port = SC_DEFAULT_IN; // THREAD: shared var...
2537 var reader = new sc_Reader(new sc_Tokenizer(port));
2538 return reader.read();
2540 /*** META ((export #t)) */
2541 function sc_readChar(port) {
2542 if (port === undefined) // we assume the port hasn't been given.
2543 port = SC_DEFAULT_IN; // THREAD: shared var...
2544 var t = port.readChar();
2545 return t === SC_EOF_OBJECT? t: new sc_Char(t);
2547 /*** META ((export #t)) */
2548 function sc_peekChar(port) {
2549 if (port === undefined) // we assume the port hasn't been given.
2550 port = SC_DEFAULT_IN; // THREAD: shared var...
2551 var t = port.peekChar();
2552 return t === SC_EOF_OBJECT? t: new sc_Char(t);
2554 /*** META ((export #t)
2557 function sc_isCharReady(port) {
2558 if (port === undefined) // we assume the port hasn't been given.
2559 port = SC_DEFAULT_IN; // THREAD: shared var...
2560 return port.isCharReady();
2562 /*** META ((export #t)
2563 (peephole (postfix ".close()")))
2565 function sc_closeInputPort(p) {
2569 /*** META ((export #t)
2571 (peephole (postfix " instanceof sc_InputPort")))
2573 function sc_isInputPort(o) {
2574 return (o instanceof sc_InputPort);
2577 /*** META ((export eof-object?)
2579 (peephole (postfix " === SC_EOF_OBJECT")))
2581 function sc_isEOFObject(o) {
2582 return o === SC_EOF_OBJECT;
2585 /*** META ((export #t)
2586 (peephole (hole 0 "SC_DEFAULT_IN")))
2588 function sc_currentInputPort() {
2589 return SC_DEFAULT_IN;
2592 /* ------------ file operations are not supported -----------*/
2593 /*** META ((export #t)) */
2594 function sc_callWithInputFile(s, proc) {
2595 throw "can't open " + s;
2598 /*** META ((export #t)) */
2599 function sc_callWithOutputFile(s, proc) {
2600 throw "can't open " + s;
2603 /*** META ((export #t)) */
2604 function sc_withInputFromFile(s, thunk) {
2605 throw "can't open " + s;
2608 /*** META ((export #t)) */
2609 function sc_withOutputToFile(s, thunk) {
2610 throw "can't open " + s;
2613 /*** META ((export #t)) */
2614 function sc_openInputFile(s) {
2615 throw "can't open " + s;
2618 /*** META ((export #t)) */
2619 function sc_openOutputFile(s) {
2620 throw "can't open " + s;
2623 /* ----------------------------------------------------------------------------*/
2624 /*** META ((export #t)) */
2625 function sc_basename(p) {
2626 var i = p.lastIndexOf('/');
2629 return p.substring(i + 1, p.length);
2634 /*** META ((export #t)) */
2635 function sc_dirname(p) {
2636 var i = p.lastIndexOf('/');
2639 return p.substring(0, i);
2644 /* ----------------------------------------------------------------------------*/
2646 /*** META ((export #t)) */
2647 function sc_withInputFromPort(p, thunk) {
2649 var tmp = SC_DEFAULT_IN; // THREAD: shared var.
2653 SC_DEFAULT_IN = tmp;
2657 /*** META ((export #t)) */
2658 function sc_withInputFromString(s, thunk) {
2659 return sc_withInputFromPort(new sc_StringInputPort(sc_string2jsstring(s)), thunk);
2662 /*** META ((export #t)) */
2663 function sc_withOutputToPort(p, thunk) {
2665 var tmp = SC_DEFAULT_OUT; // THREAD: shared var.
2669 SC_DEFAULT_OUT = tmp;
2673 /*** META ((export #t)) */
2674 function sc_withOutputToString(thunk) {
2675 var p = new sc_StringOutputPort();
2676 sc_withOutputToPort(p, thunk);
2680 /*** META ((export #t)) */
2681 function sc_withOutputToProcedure(proc, thunk) {
2682 var t = function(s) { proc(sc_jsstring2string(s)); };
2683 return sc_withOutputToPort(new sc_GenericOutputPort(t), thunk);
2686 /*** META ((export #t)
2687 (peephole (hole 0 "new sc_StringOutputPort()")))
2689 function sc_openOutputString() {
2690 return new sc_StringOutputPort();
2693 /*** META ((export #t)) */
2694 function sc_openInputString(str) {
2695 return new sc_StringInputPort(sc_string2jsstring(str));
2698 /* ----------------------------------------------------------------------------*/
2700 function sc_OutputPort() {
2702 sc_OutputPort.prototype = new sc_Port();
2703 sc_OutputPort.prototype.appendJSString = function(obj) {
2706 sc_OutputPort.prototype.close = function() {
2710 function sc_StringOutputPort() {
2713 sc_StringOutputPort.prototype = new sc_OutputPort();
2714 sc_StringOutputPort.prototype.appendJSString = function(s) {
2717 sc_StringOutputPort.prototype.close = function() {
2718 return sc_jsstring2string(this.res);
2721 /*** META ((export #t)) */
2722 function sc_getOutputString(sp) {
2723 return sc_jsstring2string(sp.res);
2727 function sc_ErrorOutputPort() {
2729 sc_ErrorOutputPort.prototype = new sc_OutputPort();
2730 sc_ErrorOutputPort.prototype.appendJSString = function(s) {
2731 throw "don't write on ErrorPort!";
2733 sc_ErrorOutputPort.prototype.close = function() {
2737 function sc_GenericOutputPort(appendJSString, close) {
2738 this.appendJSString = appendJSString;
2742 sc_GenericOutputPort.prototype = new sc_OutputPort();
2744 /*** META ((export #t)
2746 (peephole (postfix " instanceof sc_OutputPort")))
2748 function sc_isOutputPort(o) {
2749 return (o instanceof sc_OutputPort);
2752 /*** META ((export #t)
2753 (peephole (postfix ".close()")))
2755 function sc_closeOutputPort(p) {
2759 /* ------------------ write ---------------------------------------------------*/
2761 /*** META ((export #t)) */
2762 function sc_write(o, p) {
2763 if (p === undefined) // we assume not given
2765 p.appendJSString(sc_toWriteString(o));
2768 function sc_toWriteString(o) {
2771 else if (o === true)
2773 else if (o === false)
2775 else if (o === undefined)
2776 return "#unspecified";
2777 else if (typeof o === 'function')
2778 return "#<procedure " + sc_hash(o) + ">";
2779 else if (o.sc_toWriteString)
2780 return o.sc_toWriteString();
2782 return o.toString();
2785 function sc_escapeWriteString(s) {
2788 for (i = 0; i < s.length; i++) {
2789 switch (s.charAt(i)) {
2790 case "\0": res += s.substring(j, i) + "\\0"; j = i + 1; break;
2791 case "\b": res += s.substring(j, i) + "\\b"; j = i + 1; break;
2792 case "\f": res += s.substring(j, i) + "\\f"; j = i + 1; break;
2793 case "\n": res += s.substring(j, i) + "\\n"; j = i + 1; break;
2794 case "\r": res += s.substring(j, i) + "\\r"; j = i + 1; break;
2795 case "\t": res += s.substring(j, i) + "\\t"; j = i + 1; break;
2796 case "\v": res += s.substring(j, i) + "\\v"; j = i + 1; break;
2797 case '"': res += s.substring(j, i) + '\\"'; j = i + 1; break;
2798 case "\\": res += s.substring(j, i) + "\\\\"; j = i + 1; break;
2800 var c = s.charAt(i);
2801 if ("\a" !== "a" && c == "\a") {
2802 res += s.substring(j, i) + "\\a"; j = i + 1; continue;
2804 if ("\v" !== "v" && c == "\v") {
2805 res += s.substring(j, i) + "\\v"; j = i + 1; continue;
2807 //if (s.charAt(i) < ' ' || s.charCodeAt(i) > 127) {
2808 // CARE: Manuel is this OK with HOP?
2809 if (s.charAt(i) < ' ') {
2810 /* non printable character and special chars */
2811 res += s.substring(j, i) + "\\x" + s.charCodeAt(i).toString(16);
2814 // else just let i increase...
2817 res += s.substring(j, i);
2821 /* ------------------ display ---------------------------------------------------*/
2823 /*** META ((export #t)) */
2824 function sc_display(o, p) {
2825 if (p === undefined) // we assume not given
2827 p.appendJSString(sc_toDisplayString(o));
2830 function sc_toDisplayString(o) {
2833 else if (o === true)
2835 else if (o === false)
2837 else if (o === undefined)
2838 return "#unspecified";
2839 else if (typeof o === 'function')
2840 return "#<procedure " + sc_hash(o) + ">";
2841 else if (o.sc_toDisplayString)
2842 return o.sc_toDisplayString();
2844 return o.toString();
2847 /* ------------------ newline ---------------------------------------------------*/
2849 /*** META ((export #t)) */
2850 function sc_newline(p) {
2851 if (p === undefined) // we assume not given
2853 p.appendJSString("\n");
2856 /* ------------------ write-char ---------------------------------------------------*/
2858 /*** META ((export #t)) */
2859 function sc_writeChar(c, p) {
2860 if (p === undefined) // we assume not given
2862 p.appendJSString(c.val);
2865 /* ------------------ write-circle ---------------------------------------------------*/
2867 /*** META ((export #t)) */
2868 function sc_writeCircle(o, p) {
2869 if (p === undefined) // we assume not given
2871 p.appendJSString(sc_toWriteCircleString(o));
2874 function sc_toWriteCircleString(o) {
2875 var symb = sc_gensym("writeCircle");
2876 var nbPointer = new Object();
2878 sc_prepWriteCircle(o, symb, nbPointer);
2879 return sc_genToWriteCircleString(o, symb);
2882 function sc_prepWriteCircle(o, symb, nbPointer) {
2884 if (o instanceof sc_Pair ||
2885 o instanceof sc_Vector) {
2886 if (o[symb] !== undefined) {
2887 // not the first visit.
2889 // unless there is already a number, assign one.
2890 if (!o[symb + "nb"]) o[symb + "nb"] = nbPointer.nb++;
2894 if (o instanceof sc_Pair) {
2895 sc_prepWriteCircle(o.car, symb, nbPointer);
2896 sc_prepWriteCircle(o.cdr, symb, nbPointer);
2898 for (var i = 0; i < o.length; i++)
2899 sc_prepWriteCircle(o[i], symb, nbPointer);
2904 function sc_genToWriteCircleString(o, symb) {
2905 if (!(o instanceof sc_Pair ||
2906 o instanceof sc_Vector))
2907 return sc_toWriteString(o);
2908 return o.sc_toWriteCircleString(symb);
2910 sc_Pair.prototype.sc_toWriteCircleString = function(symb, inList) {
2911 if (this[symb + "use"]) { // use-flag is set. Just use it.
2912 var nb = this[symb + "nb"];
2913 if (this[symb]-- === 0) { // if we are the last use. remove all fields.
2915 delete this[symb + "nb"];
2916 delete this[symb + "use"];
2919 return '. #' + nb + '#';
2921 return '#' + nb + '#';
2923 if (this[symb]-- === 0) { // if we are the last use. remove all fields.
2925 delete this[symb + "nb"];
2926 delete this[symb + "use"];
2931 if (this[symb] !== undefined) { // implies > 0
2932 this[symb + "use"] = true;
2934 res += '. #' + this[symb + "nb"] + '=';
2936 res += '#' + this[symb + "nb"] + '=';
2944 res += sc_genToWriteCircleString(this.car, symb);
2946 if (sc_isPair(this.cdr)) {
2947 res += " " + this.cdr.sc_toWriteCircleString(symb, true);
2948 } else if (this.cdr !== null) {
2949 res += " . " + sc_genToWriteCircleString(this.cdr, symb);
2955 sc_Vector.prototype.sc_toWriteCircleString = function(symb) {
2956 if (this[symb + "use"]) { // use-flag is set. Just use it.
2957 var nb = this[symb + "nb"];
2958 if (this[symb]-- === 0) { // if we are the last use. remove all fields.
2960 delete this[symb + "nb"];
2961 delete this[symb + "use"];
2963 return '#' + nb + '#';
2965 if (this[symb]-- === 0) { // if we are the last use. remove all fields.
2967 delete this[symb + "nb"];
2968 delete this[symb + "use"];
2972 if (this[symb] !== undefined) { // implies > 0
2973 this[symb + "use"] = true;
2974 res += '#' + this[symb + "nb"] + '=';
2977 for (var i = 0; i < this.length; i++) {
2978 res += sc_genToWriteCircleString(this[i], symb);
2979 if (i < this.length - 1) res += " ";
2986 /* ------------------ print ---------------------------------------------------*/
2988 /*** META ((export #t)) */
2989 function sc_print(s) {
2990 if (arguments.length === 1) {
2995 for (var i = 0; i < arguments.length; i++)
2996 sc_display(arguments[i]);
3001 /* ------------------ format ---------------------------------------------------*/
3002 /*** META ((export #t)) */
3003 function sc_format(s, args) {
3005 var p = new sc_StringOutputPort();
3009 var i2 = s.indexOf("~", i);
3012 p.appendJSString( s.substring( i, len ) );
3016 if (i2 == (len - 1)) {
3017 p.appendJSString(s.substring(i, len));
3020 p.appendJSString(s.substring(i, i2));
3025 switch(s.charCodeAt(i2 + 1)) {
3029 sc_display(arguments[j], p);
3036 sc_write(arguments[j], p);
3043 sc_display(arguments[j], p);
3044 p.appendJSString("\n");
3051 p.appendJSString(String.fromCharCode(arguments[j]));
3058 p.appendJSString(arguments[j].toString(6));
3065 p.appendJSString(arguments[j].toString(8));
3072 p.appendJSString(arguments[j].toString(2));
3079 p.appendJSString("\n");
3084 p.appendJSString("\r");
3089 p.appendJSString("~");
3093 sc_error( "format: illegal ~"
3094 + String.fromCharCode(s.charCodeAt(i2 + 1))
3104 /* ------------------ global ports ---------------------------------------------------*/
3106 var SC_DEFAULT_IN = new sc_ErrorInputPort();
3107 var SC_DEFAULT_OUT = new sc_ErrorOutputPort();
3108 var SC_ERROR_OUT = new sc_ErrorOutputPort();
3110 var sc_SYMBOL_PREFIX = "\u1E9C";
3111 var sc_KEYWORD_PREFIX = "\u1E9D";
3113 /*** META ((export #t)
3115 function sc_jsstring2string(s) {
3119 /*** META ((export #t)
3120 (peephole (prefix "'\\u1E9C' +")))
3122 function sc_jsstring2symbol(s) {
3123 return sc_SYMBOL_PREFIX + s;
3126 /*** META ((export #t)
3129 function sc_string2jsstring(s) {
3133 /*** META ((export #t)
3134 (peephole (symbol2jsstring_immutable)))
3136 function sc_symbol2jsstring(s) {
3140 /*** META ((export #t)
3141 (peephole (postfix ".slice(1)")))
3143 function sc_keyword2jsstring(k) {
3147 /*** META ((export #t)
3148 (peephole (prefix "'\\u1E9D' +")))
3150 function sc_jsstring2keyword(s) {
3151 return sc_KEYWORD_PREFIX + s;
3154 /*** META ((export #t)
3157 function sc_isKeyword(s) {
3158 return (typeof s === "string") &&
3159 (s.charAt(0) === sc_KEYWORD_PREFIX);
3163 /*** META ((export #t)) */
3164 var sc_gensym = function() {
3166 return function(sym) {
3168 if (!sym) sym = sc_SYMBOL_PREFIX;
3169 return sym + "s" + counter + "~" + "^sC-GeNsYm ";
3174 /*** META ((export #t)
3177 function sc_isEqual(o1, o2) {
3178 return ((o1 === o2) ||
3179 (sc_isPair(o1) && sc_isPair(o2)
3180 && sc_isPairEqual(o1, o2, sc_isEqual)) ||
3181 (sc_isVector(o1) && sc_isVector(o2)
3182 && sc_isVectorEqual(o1, o2, sc_isEqual)));
3185 /*** META ((export number->symbol integer->symbol)) */
3186 function sc_number2symbol(x, radix) {
3187 return sc_SYMBOL_PREFIX + sc_number2jsstring(x, radix);
3190 /*** META ((export number->string integer->string)) */
3191 var sc_number2string = sc_number2jsstring;
3193 /*** META ((export #t)) */
3194 function sc_symbol2number(s, radix) {
3195 return sc_jsstring2number(s.slice(1), radix);
3198 /*** META ((export #t)) */
3199 var sc_string2number = sc_jsstring2number;
3201 /*** META ((export #t)
3202 (peephole (prefix "+" s)))
3203 ;; peephole will only apply if no radix is given.
3205 function sc_string2integer(s, radix) {
3206 if (!radix) return +s;
3207 return parseInt(s, radix);
3210 /*** META ((export #t)
3211 (peephole (prefix "+")))
3213 function sc_string2real(s) {
3218 /*** META ((export #t)
3221 function sc_isSymbol(s) {
3222 return (typeof s === "string") &&
3223 (s.charAt(0) === sc_SYMBOL_PREFIX);
3226 /*** META ((export #t)
3227 (peephole (symbol2string_immutable)))
3229 function sc_symbol2string(s) {
3233 /*** META ((export #t)
3234 (peephole (prefix "'\\u1E9C' +")))
3236 function sc_string2symbol(s) {
3237 return sc_SYMBOL_PREFIX + s;
3240 /*** META ((export symbol-append)
3241 (peephole (symbolAppend_immutable)))
3243 function sc_symbolAppend() {
3244 var res = sc_SYMBOL_PREFIX;
3245 for (var i = 0; i < arguments.length; i++)
3246 res += arguments[i].slice(1);
3250 /*** META ((export #t)
3251 (peephole (postfix ".val")))
3253 function sc_char2string(c) { return c.val; }
3255 /*** META ((export #t)
3256 (peephole (hole 1 "'\\u1E9C' + " c ".val")))
3258 function sc_char2symbol(c) { return sc_SYMBOL_PREFIX + c.val; }
3260 /*** META ((export #t)
3263 function sc_isString(s) {
3264 return (typeof s === "string") &&
3265 (s.charAt(0) !== sc_SYMBOL_PREFIX);
3268 /*** META ((export #t)) */
3269 var sc_makeString = sc_makejsString;
3272 /*** META ((export #t)) */
3273 function sc_string() {
3274 for (var i = 0; i < arguments.length; i++)
3275 arguments[i] = arguments[i].val;
3276 return "".concat.apply("", arguments);
3279 /*** META ((export #t)
3280 (peephole (postfix ".length")))
3282 function sc_stringLength(s) { return s.length; }
3284 /*** META ((export #t)) */
3285 function sc_stringRef(s, k) {
3286 return new sc_Char(s.charAt(k));
3289 /* there's no stringSet in the immutable version
3290 function sc_stringSet(s, k, c)
3294 /*** META ((export string=?)
3296 (peephole (hole 2 str1 " === " str2)))
3298 function sc_isStringEqual(s1, s2) {
3301 /*** META ((export string<?)
3303 (peephole (hole 2 str1 " < " str2)))
3305 function sc_isStringLess(s1, s2) {
3308 /*** META ((export string>?)
3310 (peephole (hole 2 str1 " > " str2)))
3312 function sc_isStringGreater(s1, s2) {
3315 /*** META ((export string<=?)
3317 (peephole (hole 2 str1 " <= " str2)))
3319 function sc_isStringLessEqual(s1, s2) {
3322 /*** META ((export string>=?)
3324 (peephole (hole 2 str1 " >= " str2)))
3326 function sc_isStringGreaterEqual(s1, s2) {
3329 /*** META ((export string-ci=?)
3331 (peephole (hole 2 str1 ".toLowerCase() === " str2 ".toLowerCase()")))
3333 function sc_isStringCIEqual(s1, s2) {
3334 return s1.toLowerCase() === s2.toLowerCase();
3336 /*** META ((export string-ci<?)
3338 (peephole (hole 2 str1 ".toLowerCase() < " str2 ".toLowerCase()")))
3340 function sc_isStringCILess(s1, s2) {
3341 return s1.toLowerCase() < s2.toLowerCase();
3343 /*** META ((export string-ci>?)
3345 (peephole (hole 2 str1 ".toLowerCase() > " str2 ".toLowerCase()")))
3347 function sc_isStringCIGreater(s1, s2) {
3348 return s1.toLowerCase() > s2.toLowerCase();
3350 /*** META ((export string-ci<=?)
3352 (peephole (hole 2 str1 ".toLowerCase() <= " str2 ".toLowerCase()")))
3354 function sc_isStringCILessEqual(s1, s2) {
3355 return s1.toLowerCase() <= s2.toLowerCase();
3357 /*** META ((export string-ci>=?)
3359 (peephole (hole 2 str1 ".toLowerCase() >= " str2 ".toLowerCase()")))
3361 function sc_isStringCIGreaterEqual(s1, s2) {
3362 return s1.toLowerCase() >= s2.toLowerCase();
3365 /*** META ((export #t)
3366 (peephole (hole 3 s ".substring(" start ", " end ")")))
3368 function sc_substring(s, start, end) {
3369 return s.substring(start, end);
3372 /*** META ((export #t))
3374 function sc_isSubstring_at(s1, s2, i) {
3375 return s2 == s1.substring(i, i+ s2.length);
3378 /*** META ((export #t)
3379 (peephole (infix 0 #f "+" "''")))
3381 function sc_stringAppend() {
3382 return "".concat.apply("", arguments);
3385 /*** META ((export #t)) */
3386 var sc_string2list = sc_jsstring2list;
3388 /*** META ((export #t)) */
3389 var sc_list2string = sc_list2jsstring;
3391 /*** META ((export #t)
3394 function sc_stringCopy(s) {
3398 /* there's no string-fill in the immutable version
3399 function sc_stringFill(s, c)
3402 /*** META ((export #t)
3403 (peephole (postfix ".slice(1)")))
3405 function sc_keyword2string(o) {
3409 /*** META ((export #t)
3410 (peephole (prefix "'\\u1E9D' +")))
3412 function sc_string2keyword(o) {
3413 return sc_KEYWORD_PREFIX + o;
3416 String.prototype.sc_toDisplayString = function() {
3417 if (this.charAt(0) === sc_SYMBOL_PREFIX)
3418 // TODO: care for symbols with spaces (escape-chars symbols).
3419 return this.slice(1);
3420 else if (this.charAt(0) === sc_KEYWORD_PREFIX)
3421 return ":" + this.slice(1);
3423 return this.toString();
3426 String.prototype.sc_toWriteString = function() {
3427 if (this.charAt(0) === sc_SYMBOL_PREFIX)
3428 // TODO: care for symbols with spaces (escape-chars symbols).
3429 return this.slice(1);
3430 else if (this.charAt(0) === sc_KEYWORD_PREFIX)
3431 return ":" + this.slice(1);
3433 return '"' + sc_escapeWriteString(this) + '"';
3435 /* Exported Variables */
3436 var BgL_testzd2boyerzd2;
3437 var BgL_nboyerzd2benchmarkzd2;
3438 var BgL_setupzd2boyerzd2;
3441 var translate_term_nboyer;
3442 var translate_args_nboyer;
3443 var untranslate_term_nboyer;
3444 var BgL_sc_symbolzd2ze3symbolzd2record_1ze3_nboyer;
3445 var BgL_sc_za2symbolzd2recordszd2alistza2_2z00_nboyer;
3446 var translate_alist_nboyer;
3447 var apply_subst_nboyer;
3448 var apply_subst_lst_nboyer;
3449 var tautologyp_nboyer;
3450 var if_constructor_nboyer;
3451 var rewrite_count_nboyer;
3453 var rewrite_args_nboyer;
3454 var unify_subst_nboyer;
3455 var one_way_unify1_nboyer;
3456 var false_term_nboyer;
3457 var true_term_nboyer;
3458 var trans_of_implies1_nboyer;
3459 var is_term_equal_nboyer;
3460 var is_term_member_nboyer;
3462 var sc_const_3_nboyer;
3463 var sc_const_4_nboyer;
3465 (sc_const_4_nboyer = (new sc_Pair("\u1E9Cimplies",(new sc_Pair((new sc_Pair("\u1E9Cand",(new sc_Pair((new sc_Pair("\u1E9Cimplies",(new sc_Pair("\u1E9Cx",(new sc_Pair("\u1E9Cy",null)))))),(new sc_Pair((new sc_Pair("\u1E9Cand",(new sc_Pair((new sc_Pair("\u1E9Cimplies",(new sc_Pair("\u1E9Cy",(new sc_Pair("\u1E9Cz",null)))))),(new sc_Pair((new sc_Pair("\u1E9Cand",(new sc_Pair((new sc_Pair("\u1E9Cimplies",(new sc_Pair("\u1E9Cz",(new sc_Pair("\u1E9Cu",null)))))),(new sc_Pair((new sc_Pair("\u1E9Cimplies",(new sc_Pair("\u1E9Cu",(new sc_Pair("\u1E9Cw",null)))))),null)))))),null)))))),null)))))),(new sc_Pair((new sc_Pair("\u1E9Cimplies",(new sc_Pair("\u1E9Cx",(new sc_Pair("\u1E9Cw",null)))))),null)))))));
3466 (sc_const_3_nboyer = sc_list((new sc_Pair("\u1E9Cequal",(new sc_Pair((new sc_Pair("\u1E9Ccompile",(new sc_Pair("\u1E9Cform",null)))),(new sc_Pair((new sc_Pair("\u1E9Creverse",(new sc_Pair((new sc_Pair("\u1E9Ccodegen",(new sc_Pair((new sc_Pair("\u1E9Coptimize",(new sc_Pair("\u1E9Cform",null)))),(new sc_Pair((new sc_Pair("\u1E9Cnil",null)),null)))))),null)))),null)))))), (new sc_Pair("\u1E9Cequal",(new sc_Pair((new sc_Pair("\u1E9Ceqp",(new sc_Pair("\u1E9Cx",(new sc_Pair("\u1E9Cy",null)))))),(new sc_Pair((new sc_Pair("\u1E9Cequal",(new sc_Pair((new sc_Pair("\u1E9Cfix",(new sc_Pair("\u1E9Cx",null)))),(new sc_Pair((new sc_Pair("\u1E9Cfix",(new sc_Pair("\u1E9Cy",null)))),null)))))),null)))))), (new sc_Pair("\u1E9Cequal",(new sc_Pair((new sc_Pair("\u1E9Cgreaterp",(new sc_Pair("\u1E9Cx",(new sc_Pair("\u1E9Cy",null)))))),(new sc_Pair((new sc_Pair("\u1E9Clessp",(new sc_Pair("\u1E9Cy",(new sc_Pair("\u1E9Cx",null)))))),null)))))), (new sc_Pair("\u1E9Cequal",(new sc_Pair((new sc_Pair("\u1E9Clesseqp",(new sc_Pair("\u1E9Cx",(new sc_Pair("\u1E9Cy",null)))))),(new sc_Pair((new sc_Pair("\u1E9Cnot",(new sc_Pair((new sc_Pair("\u1E9Clessp",(new sc_Pair("\u1E9Cy",(new sc_Pair("\u1E9Cx",null)))))),null)))),null)))))), (new sc_Pair("\u1E9Cequal",(new sc_Pair((new sc_Pair("\u1E9Cgreatereqp",(new sc_Pair("\u1E9Cx",(new sc_Pair("\u1E9Cy",null)))))),(new sc_Pair((new sc_Pair("\u1E9Cnot",(new sc_Pair((new sc_Pair("\u1E9Clessp",(new sc_Pair("\u1E9Cx",(new sc_Pair("\u1E9Cy",null)))))),null)))),null)))))), (new sc_Pair("\u1E9Ceq