8f2c1b26f8808c2c3789072979adfcc10249f39f
[jscl.git] / 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 }