src/prelude.js

   1 // This file is prepended to the result of compile jscl.lisp, and
   2 // contain runtime code that jscl assumes to exist.
   3
   4 var window = this;
   5
   6 var t;
   7 var nil;
   8
   9 var lisp = {};
  10
  11 globalEval = eval;  // Just an indirect eval
  12
  13 function pv (x) { return x==undefined? nil: x; }
  14
  15 function mv(){
  16   var r = [].slice.call(arguments);
  17   r['multiple-value'] = true;
  18   return r;
  19 }
  20
  21 function forcemv (x) {
  22   return typeof x == 'object' && 'multiple-value' in x? x: mv(x);
  23 }
  24
  25 // NOTE: Define VALUES to be MV for toplevel forms. It is because
  26 // `eval' compiles the forms and execute the Javascript code at
  27 // toplevel with `js-eval', so it is necessary to return multiple
  28 // values from the eval function.
  29 var values = mv;
  30
  31 function checkArgsAtLeast(args, n){
  32   if (args < n) throw 'too few arguments';
  33 }
  34
  35 function checkArgsAtMost(args, n){
  36   if (args > n) throw 'too many arguments';
  37 }
  38
  39 function checkArgs(args, n){
  40   checkArgsAtLeast(args, n);
  41   checkArgsAtMost(args, n);
  42 }
  43
  44 // Improper list constructor (like LIST*)
  45 function QIList(){
  46   if (arguments.length == 1)
  47     return arguments[0];
  48   else {
  49     var i = arguments.length-1;
  50     var r = arguments[i--];
  51     for (; i>=0; i--){
  52       r = {car: arguments[i], cdr: r};
  53     }
  54     return r;
  55   }
  56 }
  57
  58 // Return a new Array of strings, each either length-1, or length-2 (a UTF-16 surrogate pair).
  59 function codepoints(string) {
  60   return string.split(/(?![\udc00-\udfff])/);
  61 }
  62
  63 // Create and return a lisp string for the Javascript string STRING.
  64 function make_lisp_string (string){
  65   var array = codepoints(string);
  66   array.stringp = 1
  67   return array;
  68 }
  69
  70 function char_to_codepoint(ch) {
  71   if (ch.length == 1) {
  72     return ch.charCodeAt(0);
  73   } else {
  74     var xh = ch.charCodeAt(0) - 0xD800;
  75     var xl = ch.charCodeAt(1) - 0xDC00;
  76     return 0x10000 + (xh << 10) + (xl);
  77   }
  78 }
  79
  80 function char_from_codepoint(x) {
  81   if (x <= 0xFFFF) {
  82     return String.fromCharCode(x);
  83   } else {
  84     x -= 0x10000;
  85     var xh = x >> 10;
  86     var xl = x & 0x3FF;
  87     return String.fromCharCode(0xD800 + xh) + String.fromCharCode(0xDC00 + xl);
  88   }
  89 }
  90
  91 // if a char (JS string) has the same number of codepoints after .toUpperCase(), return that, else the original.
  92 function safe_char_upcase(x) {
  93   var xu = x.toUpperCase();
  94   if (codepoints(xu).length == 1) {
  95     return xu;
  96   } else {
  97     return x;
  98   }
  99 }
 100 function safe_char_downcase(x) {
 101   var xl = x.toLowerCase();
 102   if (codepoints(xl).length == 1) {
 103     return xl;
 104   } else {
 105     return x;
 106   }
 107 }
 108
 109 function xstring(x){ return x.join(''); }
 110
 111
 112 function Symbol(name, package_name){
 113   this.name = name;
 114   if (package_name)
 115     this['package'] = package_name;
 116 }
 117
 118 function lisp_to_js (x) {
 119   if (typeof x == 'object' && 'length' in x && x.stringp == 1)
 120     return xstring(x);
 121   else if (x === t)
 122     return true;
 123   else if (x === nil)
 124     return false;
 125   else if (typeof x == 'function'){
 126     // Trampoline calling the Lisp function
 127     return (function(){
 128       var args = Array.prototype.slice.call(arguments);
 129       for (var i in args)
 130         args[i] = js_to_lisp(args[i]);
 131       return lisp_to_js(x.apply(this, [pv, arguments.length].concat(args)));
 132     });
 133   }
 134   else return x;
 135 }
 136
 137 function js_to_lisp (x) {
 138   if (typeof x == 'string')
 139     return make_lisp_string(x);
 140   else if (x === true)
 141     return t;
 142   else if (x === false)
 143     return nil;
 144   else if (typeof x == 'function'){
 145     // Trampoline calling the JS function
 146     return (function(values, nargs){
 147       var args = Array.prototype.slice.call(arguments, 2);
 148       for (var i in args)
 149         args[i] = lisp_to_js(args[i]);
 150       return values(js_to_lisp(x.apply(this, args)));
 151     });
 152   } else return x;
 153 }
 154
 155
 156 // Non-local exits
 157
 158 function BlockNLX (id, values, name){
 159   this.id = id;
 160   this.values = values;
 161   this.name = name;
 162 }
 163
 164 function CatchNLX (id, values){
 165   this.id = id;
 166   this.values = values;
 167 }
 168
 169 function TagNLX (id, label){
 170   this.id = id;
 171   this.label = label;
 172 }