summaryrefslogtreecommitdiff
path: root/module/language/js-il/runtime.js
diff options
context:
space:
mode:
Diffstat (limited to 'module/language/js-il/runtime.js')
-rw-r--r--module/language/js-il/runtime.js1519
1 files changed, 1519 insertions, 0 deletions
diff --git a/module/language/js-il/runtime.js b/module/language/js-il/runtime.js
new file mode 100644
index 000000000..142e3db86
--- /dev/null
+++ b/module/language/js-il/runtime.js
@@ -0,0 +1,1519 @@
+// JavaScript Runtime
+
+// Copyright (C) 2015, 2017 Free Software Foundation, Inc.
+
+// This library is free software; you can redistribute it and/or
+// modify it under the terms of the GNU Lesser General Public
+// License as published by the Free Software Foundation; either
+// version 3 of the License, or (at your option) any later version.
+//
+// This library is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+// Lesser General Public License for more details.
+//
+// You should have received a copy of the GNU Lesser General Public
+// License along with this library; if not, write to the Free Software
+// Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+// Code:
+
+var scheme = {
+ obarray : {},
+ primitives : {},
+ utils : {},
+ env : {},
+ cache: [],
+ module_cache: {},
+ builtins: [],
+ dynstack : [],
+ // TODO: placeholders
+ FALSE : false,
+ TRUE : true,
+ NIL : false,
+ EMPTY : [],
+ UNSPECIFIED : [],
+ // FIXME: wingo says not to leak undefined to users
+ UNDEFINED: undefined
+};
+
+function not_implemented_yet() {
+ throw "not implemented yet";
+};
+
+function coerce_bool(obj) {
+ return obj ? scheme.TRUE : scheme.FALSE;
+};
+
+// Numbers
+scheme.primitives.add = function (x, y) {
+ return x + y;
+};
+
+scheme.primitives.add1 = function (x) {
+ return x + 1;
+};
+
+scheme.primitives["add/immediate"] = function (x, y) {
+ return x + y;
+};
+
+scheme.primitives.sub = function (x, y) {
+ return x - y;
+};
+
+scheme.primitives.sub1 = function (x) {
+ return x - 1;
+};
+
+scheme.primitives["sub/immediate"] = function (x, y) {
+ return x - y;
+};
+
+scheme.primitives.mul = function (x, y) {
+ return x * y;
+};
+
+scheme.primitives.div = function (x, y) {
+ return x / y;
+};
+
+scheme.primitives["="] = function (x, y) {
+ return coerce_bool(x == y);
+};
+
+scheme.primitives["<"] = function (x, y) {
+ return coerce_bool(x < y);
+};
+
+scheme.primitives["<="] = function (x, y) {
+ return coerce_bool(x <= y);
+};
+
+scheme.primitives[">"] = function (x, y) {
+ return coerce_bool(x > y);
+};
+
+scheme.primitives[">="] = function (x, y) {
+ return coerce_bool(x >= y);
+};
+
+scheme.primitives.quo = not_implemented_yet;
+scheme.primitives.rem = not_implemented_yet;
+scheme.primitives.mod = not_implemented_yet;
+
+// Unboxed Numbers
+scheme.primitives["load-u64"] = function(x) {
+ return x;
+};
+
+scheme.primitives["u64-="] = function(x, y) {
+ return coerce_bool(x === y);
+};
+
+scheme.primitives["u64-=-scm"] = function(x, y) {
+ // i.e. br-if-u64-=-scm
+ return coerce_bool(x === y);
+};
+
+scheme.primitives["u64-<=-scm"] = function(x, y) {
+ return coerce_bool(x <= y);
+};
+
+scheme.primitives["u64-<-scm"] = function(x, y) {
+ return coerce_bool(x < y);
+};
+
+scheme.primitives["u64->-scm"] = function(x, y) {
+ return coerce_bool(x > y);
+};
+
+scheme.primitives["u64->=-scm"] = function(x, y) {
+ return coerce_bool(x >= y);
+};
+
+scheme.primitives["scm->u64"] = function(x) {
+ return x;
+};
+
+scheme.primitives["u64->scm"] = function(x) {
+ return x;
+};
+
+// Boxes
+scheme.Box = function (x) {
+ this.x = x;
+ return this;
+};
+
+scheme.primitives["box"] = function(x) {
+ return new scheme.Box(x);
+};
+
+scheme.primitives["box-ref"] = function (box) {
+ return box.x;
+};
+
+scheme.primitives["box-set!"] = function (box, val) {
+ box.x = val;
+};
+
+// Lists
+scheme.Pair = function (car, cdr) {
+ this.car = car;
+ this.cdr = cdr;
+ return this;
+};
+
+scheme.primitives["pair?"] = function (obj) {
+ return coerce_bool(obj instanceof scheme.Pair);
+};
+
+scheme.primitives.cons = function (car, cdr) {
+ return new scheme.Pair(car,cdr);
+};
+
+scheme.primitives.car = function (obj) {
+ return obj.car;
+};
+
+scheme.primitives.cdr = function (obj) {
+ return obj.cdr;
+};
+
+scheme.primitives["set-car!"] = function (pair, obj) {
+ obj.car = obj;
+};
+
+scheme.primitives["set-cdr!"] = function (pair, obj) {
+ obj.cdr = obj;
+};
+
+scheme.list = function () {
+ var l = scheme.EMPTY;
+ for (var i = arguments.length - 1; i >= 0; i--){
+ l = scheme.primitives.cons(arguments[i],l);
+ };
+ return l;
+};
+
+scheme.primitives["null?"] = function(obj) {
+ return coerce_bool(scheme.EMPTY == obj);
+};
+
+// Symbols
+scheme.Symbol = function(s) {
+ if (scheme.obarray[s]) {
+ return scheme.obarray[s];
+ } else {
+ this.name = s;
+ scheme.obarray[s] = this;
+ return this;
+ };
+};
+
+scheme.primitives["symbol?"] = function (obj) {
+ return coerce_bool(obj instanceof scheme.Symbol);
+};
+
+// Keywords
+scheme.Keyword = function(s) {
+ this.name = s;
+ return this;
+};
+
+scheme.primitives["keyword?"] = function (obj) {
+ return coerce_bool(obj instanceof scheme.Keyword);
+};
+
+scheme.utils.keyword_ref = function(kw, args, start, dflt) {
+ var l = args.length;
+
+ if ((l - start) % 2 == 1) {
+ // FIXME: should error
+ return undefined;
+ }
+ // Need to loop in reverse because last matching keyword wins
+ for (var i = l - 2; i >= start; i -= 2) {
+ if (!(args[i] instanceof scheme.Keyword)) {
+ return undefined;
+ }
+ if (args[i].name === kw.name) {
+ return args[i + 1];
+ }
+ }
+ return dflt;
+};
+
+// Vectors
+scheme.Vector = function () {
+ this.array = Array.prototype.slice.call(arguments);
+ return this;
+};
+
+scheme.primitives["vector-ref"] = function (vec, idx) {
+ return vec.array[idx];
+};
+
+scheme.primitives["vector-set!"] = function (vec, idx, obj) {
+ return vec.array[idx] = obj;
+};
+
+scheme.primitives["vector-length"] = function (vec) {
+ return vec.array.length;
+};
+
+scheme.primitives["vector?"] = function (obj) {
+ return coerce_bool(obj instanceof scheme.Vector);
+};
+
+scheme.primitives["make-vector/immediate"] = function(length, init) {
+ var v = new scheme.Vector();
+
+ var temp = []
+ for (var i=0; i < length; i++) {
+ temp[i] = init;
+ }
+
+ v.array = temp;
+
+ return v;
+};
+
+scheme.primitives["vector-set!/immediate"] = scheme.primitives["vector-set!"];
+scheme.primitives["vector-ref/immediate"] = scheme.primitives["vector-ref"];
+
+// Bytevectors
+
+// Booleans
+
+scheme.primitives["boolean?"] = not_implemented_yet;
+
+// Chars
+scheme.Char = function(c) {
+ this.c = c;
+ return this;
+};
+
+scheme.primitives["char?"] = function (obj) {
+ return coerce_bool(obj instanceof scheme.Char);
+};
+
+// Strings
+scheme.String = function(s) {
+ this.s = s;
+ return this;
+};
+
+scheme.primitives["string?"] = function (obj) {
+ return coerce_bool(obj instanceof scheme.String);
+};
+
+scheme.primitives["string-length"] = function (str) {
+ return str.s.length;
+};
+
+scheme.primitives["string-ref"] = function (str, idx) {
+ return new scheme.Char(str.s[idx]);
+};
+
+// Closures
+scheme.Closure = function(f, size) {
+ this.fun = f;
+ this.freevars = new Array(size);
+ return this;
+};
+
+scheme.primitives["free-set!"] = function (closure, idx, obj) {
+ closure.freevars[idx] = obj;
+};
+
+scheme.primitives["free-ref"] = function (closure, idx) {
+ return closure.freevars[idx];
+};
+
+scheme.primitives["builtin-ref"] = function (idx) {
+ return scheme.builtins[idx];
+};
+
+// Syntax Objects
+scheme.Syntax = function (expr, wrap, module) {
+ this.expr = expr;
+ this.wrap = wrap;
+ this.module = module;
+ return this;
+};
+
+// Hashtables
+scheme.HashTable = function (is_weak) {
+ // HashTable definition needs to come before scm_pre_modules_obarray
+
+ // ignore the is_weak argument, since we can't iterate over js WeakMaps
+ this.table = new Map(); // WeakMap();
+
+ this.lookup = function (obj, dflt) {
+ if (this.table.has(obj)) {
+ return this.table.get(obj);
+ } else {
+ return dflt;
+ }
+ };
+
+ this.get = function(key) {
+ return this.table.get(key);
+ };
+
+ this.set = function (key, obj) {
+ this.table.set(key, obj);
+ return obj;
+ };
+
+ this.delete = function (key) {
+ this.table.delete(key);
+ return scheme.FALSE; // or handle
+ };
+
+ this.clear = function () {
+ this.table.clear();
+ return scheme.UNSPECIFIED;
+ };
+
+ this.keys = function () {
+ return [...this.table.keys()];
+ };
+
+ return this;
+};
+
+// Modules
+scheme.primitives["define!"] = function(sym) {
+ var mod = scm_current_module ();
+ var v = scm_module_ensure_local_variable (mod, sym);
+ return v;
+};
+
+scheme.primitives["cache-current-module!"] = function (module, scope) {
+ scheme.cache[scope] = module;
+};
+
+scheme.primitives["cached-toplevel-box"] = function (scope, sym, is_bound) {
+ var module = scheme.cache[scope]; // FIXME: what if not there?
+
+ if (!scheme.is_true(module)) {
+ module = scm_the_root_module();
+ }
+
+ var v = scm_module_lookup(module, sym);
+
+ if (is_bound) {
+ // not_implemented_yet();
+ }
+
+ return v;
+};
+
+var scm_pre_modules_obarray = new scheme.HashTable();
+var the_root_module;
+
+function scm_the_root_module() {
+ if (module_system_is_booted)
+ return the_root_module.x;
+ else
+ return scheme.FALSE;
+}
+
+scheme.primitives["cached-module-box"] = function (module_name, sym, is_public, is_bound) {
+ var v;
+
+ if (!module_system_is_booted) {
+ if (module_name instanceof scheme.Pair
+ && module_name.car.name === "guile"
+ && module_name.cdr === scheme.EMPTY) {
+ v = scm_lookup (sym);
+ } else {
+ not_implemented_yet();
+ }
+ } else if (sym.name === "equal?") {
+ // FIXME: this hack exists to work around a miscompilation of
+ // equal? which is not being handled as a toplevel reference.
+ // This leads to an infinite loop in the temporary definition of
+ // resolve-module, which is called by cache-module-box.
+ v = scm_pre_modules_obarray.get(sym);
+ } else if (scheme.is_true(is_public)) {
+ v = scm_public_lookup (module_name, sym);
+ } else {
+ v = scm_private_lookup (module_name, sym);
+ }
+
+ if (is_bound) {
+ // not_implemented_yet();
+ }
+
+ return v;
+};
+
+function scm_public_lookup(module_name, name) {
+ var v = scm_public_variable (module_name, name);
+ // if false, error
+ return v;
+}
+
+function scm_public_variable(module_name, name) {
+ var mod = scheme.call(resolve_module_var.x, module_name, k_ensure, scheme.FALSE);
+
+ // if (scm_is_false (mod))
+ // scm_misc_error ("public-lookup", "Module named ~s does not exist",
+ // scm_list_1 (module_name));
+
+ var iface = scm_module_public_interface (mod);
+
+ // if (scm_is_false (iface))
+ // scm_misc_error ("public-lookup", "Module ~s has no public interface",
+ // scm_list_1 (mod));
+
+ return scm_module_variable (iface, name);
+}
+
+var module_public_interface_var;
+
+function scm_module_public_interface (module) {
+ return scheme.call(module_public_interface_var.x, module);
+}
+
+function scm_private_lookup(module_name, sym) {
+ // FIXME: scm_private_variable + miscerror if not bound
+ return scm_private_variable(module_name, sym);
+}
+
+function scm_private_variable (module_name, name) {
+ var mod = scheme.call(resolve_module_var.x, module_name, k_ensure, scheme.FALSE);
+
+ // if (scm_is_false (mod))
+ // scm_misc_error ("private-lookup", "Module named ~s does not exist",
+ // scm_list_1 (module_name));
+
+ return scm_module_variable (mod, name);
+}
+
+scheme.primitives["current-module"] = scm_current_module;
+
+scheme.primitives["resolve"] = function (sym, is_bound) {
+ var v = scm_lookup(sym);
+
+ if (is_bound) {
+ // not_implemented_yet();
+ };
+
+ return v;
+};
+
+function scm_current_module() {
+ if (module_system_is_booted) {
+ return the_module.value;
+ } else {
+ return scheme.FALSE;
+ }
+}
+
+function scm_lookup(sym) {
+ return scm_module_lookup(scm_current_module(), sym);
+};
+
+scheme.call = function (func) {
+ var args = Array.prototype.slice.call(arguments, 1);
+ args.unshift(scheme.initial_cont);
+ args.unshift(func);
+ return func.fun.apply(func, args);
+};
+
+function scm_module_ensure_local_variable(module, sym) {
+ if (module_system_is_booted) {
+ // SCM_VALIDATE_MODULE (1, module);
+ // SCM_VALIDATE_SYMBOL (2, sym);
+ // FIXME: this will need a specific continuation
+ return scheme.call(module_make_local_var_x_var.x, module, sym);
+ } else {
+ var box = scm_pre_modules_obarray.lookup(sym, false);
+ if (box) {
+ return box;
+ } else {
+ var v = new scheme.Box(scheme.UNDEFINED);
+ scm_pre_modules_obarray.set(sym, v);
+ return v;
+ }
+ }
+}
+
+function scm_module_variable(module, sym) {
+ // if booted, validate module
+ // validate symbol
+ if (scheme.is_true(module)) {
+ // 1. Check Module Obarray
+ if (module instanceof scheme.Struct) {
+ var obarray = module.fields[0];
+ var v = obarray.lookup(sym, scheme.UNDEFINED);
+ if (v === scheme.UNDEFINED) { // is_false
+ // 2. Search among the imported variables
+ v = module_imported_variable(module, sym);
+ return v;
+ // can't be imported
+ not_implemented_yet();
+ } else {
+ return v;
+ }
+ }
+ // 2. Search among the imported variables
+ // 3. Query the custom binder
+ // 4. Return False
+ not_implemented_yet();
+ }
+
+ return scm_pre_modules_obarray.lookup(sym, scheme.UNDEFINED);
+}
+
+var scm_module_index_obarray = 0;
+var scm_module_index_uses = 1;
+var scm_module_index_import_obarray = 8;
+function module_imported_variable(module, sym) {
+ // search cached imported bindings
+ var imports = module.fields[scm_module_index_import_obarray];
+ var v = imports.lookup(sym, scheme.UNDEFINED);
+ if (!(scheme.UNDEFINED === (v))) {
+ return v;
+ }
+ // search use list
+ var uses = module.fields[scm_module_index_uses];
+ var found_var = scheme.FALSE;
+ var found_iface = scheme.FALSE;
+ for (; uses instanceof scheme.Pair; uses = uses.cdr) {
+ var iface = uses.car;
+ var v = scm_module_variable(iface, sym);
+ if (scheme.is_true(v)) {
+ if (scheme.is_true(found_var)) {
+ console.log("resolve duplicate binding");
+ not_implemented_yet();
+ } else {
+ found_var = v;
+ found_iface = iface;
+ }
+ }
+ }
+ if (scheme.is_true(found_var)) {
+ imports.set(sym, found_var);
+ return found_var;
+ }
+ return scheme.FALSE;
+}
+
+function scm_module_define(module, sym, val) {
+ var v = scm_module_ensure_local_variable(module, sym);
+ v.x = val;
+ return v;
+}
+
+function scm_module_lookup(module, sym) {
+ var v = scm_module_variable(module, sym);
+ if (scheme.is_true(v)) {
+ return v;
+ }
+ not_implemented_yet(); // FIXME: unbound
+}
+
+
+var module_system_is_booted = false;
+
+var module_make_local_var_x_var =
+ scm_module_define(scm_current_module(),
+ new scheme.Symbol("module-make-local-var!"),
+ scheme.UNDEFINED);
+
+
+// bleh
+scheme.initial_cont = function (x) { return x; };
+scheme.primitives.return = function (x) { return x; };
+scheme.is_true = function (obj) {
+ return !(obj === scheme.FALSE || obj === scheme.NIL);
+};
+
+// Builtins
+var apply = function(self, k, f) {
+ var args = Array.prototype.slice.call(arguments, 3);
+ var tail = args.pop();
+
+ while (scheme.is_true(scheme.primitives["pair?"](tail))) {
+ args.push(tail.car);
+ tail = tail.cdr;
+ };
+
+ return f.fun.apply(f.fun, [f,k].concat(args));
+};
+
+var values = function(self, k) {
+ var args = Array.prototype.slice.call(arguments, 2);
+ return k.apply(k,args);
+};
+
+var abort_to_prompt = function(self, k, prompt) {
+
+ var args = Array.prototype.slice.call(arguments, 3);
+ var idx = find_prompt(prompt);
+ var frame = scheme.dynstack[idx];
+
+ var kont = undefined; // actual value doesn't matter
+
+ if (!scheme.is_true(frame.escape_only)) {
+ var f = function (self, k2) {
+ var args = Array.prototype.slice.call(arguments, 2);
+ return k.apply(k,args);
+ };
+ kont = new scheme.Closure(f, 0);
+ };
+
+ unwind(scheme.dynstack, idx); // FIXME:
+
+ var handler = frame.handler;
+ args.unshift(kont);
+ return handler.apply(handler, args);
+};
+
+var call_with_values = function (self, k, producer, consumer) {
+ var k2 = function () {
+ var args = Array.prototype.slice.call(arguments);
+ return consumer.fun.apply(consumer.fun, [consumer, k].concat(args));
+ };
+ return producer.fun(producer, k2);
+};
+
+var callcc = function (self, k, closure) {
+ var dynstack = scheme.dynstack.slice();
+
+ var f = function (self, k2) {
+ var args = Array.prototype.slice.call(arguments, 2);
+
+ var i = shared_stack_length(dynstack, scheme.dynstack);
+
+ unwind(scheme.dynstack, i);
+ wind(dynstack, i);
+ scheme.dynstack = dynstack;
+
+ return k.apply(k,args);
+ };
+ return closure.fun(closure, k, new scheme.Closure(f, 0));
+};
+scheme.builtins[0] = new scheme.Closure(apply, 0);
+scheme.builtins[1] = new scheme.Closure(values, 0);
+scheme.builtins[2] = new scheme.Closure(abort_to_prompt, 0);
+scheme.builtins[3] = new scheme.Closure(call_with_values, 0);
+scheme.builtins[4] = new scheme.Closure(callcc, 0);
+
+// Structs
+scheme.Struct = function (vtable, nfields) {
+ this.is_vtable = false;
+ this.vtable = vtable;
+ this.fields = [];
+
+ if (this.vtable && this.vtable.hasOwnProperty('children_applicable_vtables')) {
+ this.is_vtable = true;
+ this.children_applicable = true;
+ }
+
+ if (this.vtable && this.vtable.hasOwnProperty('children_applicable')) {
+ this.is_applicable = true;
+ this.fun = function (self, cont) {
+ var scm_applicable_struct_index_procedure = 0;
+ var clos = self.fields[scm_applicable_struct_index_procedure];
+ return clos.fun(clos, cont);
+ };
+ } else {
+ this.fun = function () { throw "not applicable"; };
+ }
+
+ // FIXME: worth doing?
+ for(var i = 0; i < nfields; i++){
+ this.fields[i]=scheme.UNDEFINED;
+ }
+
+ return this;
+};
+
+scheme.primitives["struct?"] = function (obj) {
+ return coerce_bool(obj instanceof scheme.Struct);
+};
+
+scheme.primitives["allocate-struct/immediate"] = function (vtable, nfields) {
+ return new scheme.Struct(vtable, nfields);
+};
+
+scheme.primitives["struct-vtable"] = function(struct) {
+ return struct.vtable;
+};
+
+scheme.primitives["struct-set!"] = function (struct, idx, obj) {
+ struct.fields[idx] = obj;
+ return;
+};
+
+scheme.primitives["struct-ref"] = function (struct, idx) {
+ return struct.fields[idx];
+};
+
+scheme.primitives["struct-set!/immediate"] = scheme.primitives["struct-set!"];
+scheme.primitives["struct-ref/immediate"] = scheme.primitives["struct-ref"];
+
+// Equality
+scheme.primitives["eq?"] = function(x, y) {
+ return coerce_bool(x === y);
+};
+
+scheme.primitives["eqv?"] = function(x, y) {
+ return coerce_bool(x === y);
+};
+
+// Fluids
+scheme.Fluid = function (x) {
+ this.value = x;
+ return this;
+};
+
+var the_module = new scheme.Fluid(scheme.FALSE);
+
+scheme.primitives["pop-fluid"] = function () {
+ var frame = scheme.dynstack.shift();
+ if (frame instanceof scheme.frame.Fluid) {
+ frame.fluid.value = frame.old_value;
+ return;
+ } else {
+ throw "not a frame";
+ };
+};
+
+scheme.primitives["push-fluid"] = function (fluid, new_value) {
+ var old_value = fluid.value;
+ fluid.value = new_value;
+ var frame = new scheme.frame.Fluid(fluid, old_value);
+ scheme.dynstack.unshift(frame);
+ return;
+};
+
+scheme.primitives["fluid-ref"] = function (fluid) {
+ // TODO: check fluid type
+ return fluid.value;
+};
+
+// Variables
+scheme.primitives["variable?"] = function (obj) {
+ // FIXME: should variables be distinct from boxes?
+ return coerce_bool(obj instanceof scheme.Box);
+};
+
+// Dynamic Wind
+scheme.primitives["wind"] = function(enter, leave) {
+ var frame = new scheme.frame.DynWind(enter, leave);
+ scheme.dynstack.unshift(frame);
+};
+
+scheme.primitives["unwind"] = function () {
+ var frame = scheme.dynstack.shift();
+ if (!(frame instanceof scheme.frame.DynWind) &&
+ !(frame instanceof scheme.frame.Prompt)) {
+ throw "not a dynamic wind frame";
+ };
+};
+
+// Misc
+scheme.primitives["prompt"] = function(escape_only, tag, handler){
+ var frame = new scheme.frame.Prompt(tag, escape_only, handler);
+ scheme.dynstack.unshift(frame);
+};
+
+var shared_stack_length = function (dynstack1, dynstack2) {
+ // Assumes that if it matches at i then it matches for all x<i,
+ // which will be fine given that we don't reuse frames
+ var size1 = dynstack1.length;
+ var size2 = dynstack2.length;
+ var last = Math.min(size1, size2);
+
+ var i = last-1;
+ for (; i >= 0; i--) {
+ if (dynstack1[i] === dynstack2[i]) {
+ break;
+ }
+ };
+
+ return i + 1;
+};
+
+var wind = function (dynstack, idx) {
+ for (var i = idx; i < dynstack.length; i++) {
+ var frame = dynstack[i];
+ if (frame instanceof scheme.frame.DynWind) {
+ // TODO: how to handle continuations and errors in this?
+ frame.wind.fun(frame.wind, scheme.initial_cont);
+ } else {
+ throw "unsupported frame type -- wind";
+ }
+ }
+};
+
+var unwind = function (dynstack, idx) {
+ for (var i = dynstack.length - 1; i >= idx; i--) {
+ var frame = dynstack[i];
+ if (frame instanceof scheme.frame.DynWind) {
+ // TODO: how to handle continuations and errors in this?
+ frame.unwind.fun(frame.unwind, scheme.initial_cont);
+ } else {
+ throw "unsupported frame type -- unwind";
+ }
+ }
+};
+
+var find_prompt = function(prompt) {
+ var eq = scheme.primitives["eq?"];
+ function test(x){
+ return scheme.is_true(eq(x,prompt)) || scheme.is_true(eq(x,scheme.TRUE));
+ };
+ for (idx in scheme.dynstack) {
+ var frame = scheme.dynstack[idx];
+ if (frame instanceof scheme.frame.Prompt && test(frame.tag)) {
+ return idx;
+ };
+ };
+ // FIXME: should error
+ return undefined;
+};
+
+scheme.primitives["handle-interrupts"] = function () {
+ // TODO: implement
+ return;
+};
+
+// Dynstack frames
+scheme.frame = {};
+
+scheme.frame.Prompt = function(tag, escape_only, handler){
+ this.tag = tag;
+ this.escape_only = escape_only;
+ this.handler = handler;
+};
+
+scheme.frame.Fluid = function(fluid, old_value) {
+ this.fluid = fluid;
+ this.old_value = old_value;
+};
+
+scheme.frame.DynWind = function(wind, unwind) {
+ this.wind = wind;
+ this.unwind = unwind;
+};
+
+function def_guile0 (name, fn) {
+ var clos = new scheme.Closure(fn, 0);
+ def_guile_val(name, clos);
+};
+
+function def_guile_val (name, val) {
+ var sym = new scheme.Symbol(name); // put in obarray
+ var box = new scheme.Box(val);
+ scm_pre_modules_obarray.set(sym,box);
+};
+
+function scm_list (self, cont) {
+ var l = scheme.EMPTY;
+ for (var i = arguments.length - 1; i >= 2; i--){
+ l = scheme.primitives.cons(arguments[i],l);
+ };
+ return cont(l);
+};
+def_guile0("list", scm_list);
+
+// Numbers
+function scm_add(self, cont) {
+
+ var total = 0;
+ for (var i = arguments.length - 1; i >= 2; i--){
+ total += arguments[i];
+ };
+ return cont(total);
+
+};
+def_guile0("+", scm_add);
+
+function scm_mul(self, cont) {
+
+ var total = 1;
+ for (var i = arguments.length - 1; i >= 2; i--){
+ total *= arguments[i];
+ };
+ return cont(total);
+
+};
+def_guile0("*", scm_mul);
+
+def_guile0("integer?", function(self, cont, obj) {
+ // return coerce_bool(Number.isInteger(obj)); // ES6
+ return cont(coerce_bool(typeof(obj) === 'number'));
+});
+
+// Lists
+def_guile0("make-list", function (self, cont, n, obj) {
+ var list = scheme.EMPTY;
+
+ for (var i = 0; i <= n; i++) {
+ list = new scheme.Pair(obj, list);
+ }
+
+ return cont(list);
+});
+
+def_guile0("cons", function (self, cont, car, cdr) {
+ return cont(scheme.primitives.cons(car, cdr));
+});
+
+def_guile0("length", function (self, cont, list) {
+ var len = 0;
+
+ while (!scheme.is_true(scheme.primitives["null?"](list))) {
+ if (scheme.is_true(scheme.primitives["pair?"](list))) {
+ list = list.cdr;
+ len += 1;
+ } else {
+ console.log("length bad");
+ not_implemented_yet();
+ }
+ }
+
+ return cont(len);
+});
+
+def_guile0("list?", function (self, cont, list) {
+
+ while (!scheme.is_true(scheme.primitives["null?"](list))) {
+ if (scheme.is_true(scheme.primitives["pair?"](list))) {
+ list = list.cdr;
+ } else {
+ return cont(scheme.FALSE);
+ }
+ }
+
+ return cont(scheme.TRUE);
+});
+
+def_guile0("reverse", function (self, cont, lst) {
+ var l = scheme.EMPTY;
+ while (lst != scheme.EMPTY) {
+ l = scheme.primitives.cons(lst.car, l);
+ lst = lst.cdr;
+ }
+ return cont(l);
+});
+
+def_guile0("append", function (self, cont, l1, l2) {
+ if (arguments.length != 4) {
+ console.log("FIXAPPEND", arguments.length);
+ throw "fail";
+ }
+
+
+ if (l1 === scheme.EMPTY) {
+ return cont(l2);
+ }
+
+ var l = new scheme.Pair(l1.car, l2);
+
+ var lp = l;
+ while (scheme.is_true(scheme.primitives["pair?"](l1.cdr))) {
+
+ var lo = new scheme.Pair(l1.cdr.car, l2);
+ lp.cdr = l2;
+
+ lp = lp.cdr;
+ l1 = l1.cdr;
+ }
+
+ return cont(l);
+});
+
+function scm_equal(x,y) {
+ if (x instanceof scheme.Pair) {
+ if (y instanceof scheme.Pair) {
+ return (scm_equal(x.car,y.car) && scm_equal(x.cdr,y.cdr));
+ } else {
+ return false;
+ }
+ } else if (y instanceof scheme.Pair) {
+ return false;
+ } else {
+ return (x === y);
+ }
+}
+
+def_guile0("equal?", function (self, cont, x, y) {
+ return cont(coerce_bool(scm_equal(x,y)));
+});
+
+def_guile0("memq", function (self, cont, elt, list) {
+ // FIXME: validate list
+ for (; list != scheme.EMPTY && list != scheme.NIL; list = list.cdr) {
+ if (elt === list.car) { // FIXME: eqv
+ return cont(list);
+ }
+ }
+ return cont(scheme.FALSE);
+});
+
+def_guile0("member", function (self, cont, elt, list) {
+ // FIXME: validate list
+ for (; list != scheme.EMPTY && list != scheme.NIL; list = list.cdr) {
+ if (scm_equal(elt, list.car)) {
+ return cont(list);
+ }
+ }
+ return cont(scheme.FALSE);
+});
+
+def_guile0("delete!", function (self, cont, elt, list) {
+ // FIXME: validate list
+ if (list instanceof scheme.Pair) {
+ // initially skip car;
+ for (var prev = list, walk = list.cdr;
+ walk instanceof scheme.Pair;
+ walk = walk.cdr) {
+
+ if (scm_equal(walk.car, elt)) {
+ prev.cdr = walk.cdr;
+ } else {
+ prev = prev.cdr;
+ }
+ }
+ // fixup car in return value, but can't delete
+ if (scm_equal(list.car, elt)) {
+ return cont(list.cdr);
+ }
+ }
+
+ return cont(list);
+});
+
+// Macros
+scheme.Macro = function (name, type, binding) {
+ // TODO: prim field?
+ this.name = name;
+ this.type = type;
+ this.binding = binding;
+ return this;
+};
+
+def_guile0("make-syntax-transformer", function (self, cont, name, type, binding) {
+ return cont(new scheme.Macro(name, type, binding));
+});
+
+function scm_is_syntax (self, cont, obj) {
+ return cont(coerce_bool(obj instanceof scheme.Syntax));
+};
+def_guile0("syntax?", scm_is_syntax);
+
+def_guile0("make-syntax", function (self, cont, expr, wrap, module) {
+ return cont(new scheme.Syntax(expr, wrap, module));
+});
+
+def_guile0("syntax-expression", function (self, cont, obj) {
+ return cont(obj.expr);
+});
+
+def_guile0("syntax-wrap", function (self, cont, obj) {
+ return cont(obj.wrap);
+});
+
+def_guile0("syntax-module", function (self, cont, obj) {
+ return cont(obj.module);
+});
+
+// Symbols
+def_guile0("symbol->string", function (self, cont, sym) {
+ return cont(new scheme.String(sym.name));
+});
+
+var gensym_counter = 0;
+function scm_gensym (self, cont, prefix) {
+ var name = prefix ? prefix.s : "gen ";
+ name += gensym_counter;
+ gensym_counter += 1;
+
+ return cont(new scheme.Symbol(name));
+};
+def_guile0("gensym", scm_gensym);
+
+// Chars
+def_guile0("char=?", function (self, cont, char1, char2) {
+ return cont(char1.c === char2.c);
+});
+
+// Strings
+def_guile0("string=?", function (self, cont, s1, s2) {
+ return cont(coerce_bool(s1.s === s2.s));
+});
+
+def_guile0("string-append", function (self, cont, s1, s2) {
+ var s = "";
+
+ for (var i = 2; i < arguments.length; i++) {
+ s += arguments[i].s;
+ }
+
+ //console.log("sap", s1, s2, arguments.length);
+ return cont(new scheme.String(s));
+});
+
+def_guile0("string-join", function (self, cont, strings) {
+ var s = "";
+
+ while (!scheme.is_true(scheme.primitives["null?"](strings))) {
+ if (scheme.is_true(scheme.primitives["pair?"](strings))) {
+ s += strings.car.s;
+ strings = strings.cdr;
+ } else {
+ console.log("string-join bad");
+ not_implemented_yet();
+ }
+ }
+
+ return cont(new scheme.String(s));
+});
+
+// Fluids
+def_guile0("make-fluid", function (self, cont, val) {
+ if (val === undefined) {
+ val = scheme.FALSE;
+ }
+ return cont(new scheme.Fluid(val));
+});
+
+// Structs
+var vtable_base_layout = new scheme.String("pruhsruhpwphuhuh");
+def_guile_val("standard-vtable-fields", vtable_base_layout);
+
+var scm_vtable_index_layout = 0;
+var scm_vtable_index_flags = 1;
+var scm_vtable_index_self = 2;
+var scm_vtable_index_instance_finalize = 3;
+var scm_vtable_index_instance_printer = 4;
+var scm_vtable_index_name = 5;
+var scm_vtable_index_size = 6;
+var scm_vtable_index_reserved_7 = 7;
+var scm_vtable_offset_user = 8;
+
+function scm_struct_init(struct, layout, args) {
+ // FIXME: assumes there are no tail arrays
+ var nfields = layout.length / 2; // assumes even
+ var arg = 0;
+
+ for (var i = 0; i < nfields; i++) {
+ if (layout[2*i+1] == 'o' || layout[2*i+1] == 'h') {
+ continue;
+ }
+ switch (layout[2*i]) {
+ case 'p' :
+ struct.fields[i] = (arg < args.length) ? args[arg] : scheme.FALSE;
+ arg += 1;
+ break;
+ case 'u' :
+ struct.fields[i] = (arg < args.length) ? args[arg] : 0;
+ arg += 1;
+ break;
+ case 's' :
+ struct.fields[i] = struct;
+ }
+ }
+};
+
+// Set up <standard-vtable>
+var scm_standard_vtable = new scheme.Struct(undefined, 0);
+scm_standard_vtable.vtable = scm_standard_vtable;
+scm_standard_vtable.is_vtable = true; // ?
+scm_struct_init(scm_standard_vtable,
+ vtable_base_layout.s,
+ [new scheme.Symbol(vtable_base_layout.s)]);
+// scm_set_struct_vtable_name_x (scm_standard_vtable_vtable, name);
+
+def_guile_val("<standard-vtable>", scm_standard_vtable);
+def_guile_val("vtable-index-layout", scm_vtable_index_layout);
+def_guile_val("vtable-index-printer", scm_vtable_index_instance_printer);
+def_guile_val("vtable-offset-user", scm_vtable_offset_user);
+
+
+function scm_make_struct (vtable, args) {
+ var layout = vtable.fields[scm_vtable_index_layout].name;
+ var s = new scheme.Struct(vtable, layout.length / 2);
+ scm_struct_init(s, layout, args);
+ return s;
+}
+
+def_guile0("make-struct/no-tail", function (self, cont, vtable) {
+ var args = Array.prototype.slice.call(arguments, 3);
+ return cont(scm_make_struct(vtable, args));
+});
+
+def_guile0("make-vtable", function(self, cont, fields, printer) {
+ var layout = new scheme.Symbol(fields.s); // make-struct-layout
+ var str = scm_make_struct(scm_standard_vtable, [layout, printer]);
+ str.is_vtable = true;
+ return cont(str);
+});
+
+def_guile0("make-struct-layout", function (self, cont, str) {
+ var layout = new scheme.Symbol(str.s);
+ return cont(layout);
+});
+
+def_guile0("struct-vtable?", function (self, cont, obj) {
+ // We don't inherit flags, so =struct-vtable?= may give the wrong
+ // answer where SCM_VTABLE_FLAG_VTABLE would have been set
+ var bool = coerce_bool(obj instanceof scheme.Struct && obj.is_vtable);
+ return cont(bool);
+});
+
+var applicable_vtable = scm_make_struct(scm_standard_vtable, [new scheme.Symbol(vtable_base_layout.s)]);
+applicable_vtable.children_applicable_vtables = true;
+
+def_guile_val("<applicable-struct-vtable>", applicable_vtable);
+
+def_guile_val("record-type-vtable", scm_standard_vtable); // FIXME:
+
+def_guile0("set-struct-vtable-name!", function (self, cont, val, args) {
+ // FIXME:
+ return cont(scheme.FALSE);
+});
+
+def_guile0("make-struct", function (self, cont, vtable, tailsize) {
+ if (tailsize === 0) {
+ // make-struct/no-tail
+ var args = Array.prototype.slice.call(arguments, 4);
+ return cont(scm_make_struct(vtable, args));
+ } else {
+ console.log("make-struct with tail", arguments);
+ not_implemented_yet();
+ }
+});
+
+// Procedures
+def_guile0("procedure?", function (self, cont, obj) {
+ return cont(coerce_bool(obj instanceof scheme.Closure));
+});
+
+def_guile0("set-procedure-property!", function (self, cont, procedure, property, obj) {
+ return cont(scheme.FALSE);
+});
+
+def_guile0("make-procedure-with-setter", function (self, cont, procedure, setter) {
+ return cont(scheme.FALSE);
+});
+
+// Hashtables
+def_guile0("make-hash-table", function (self, cont, size) {
+ return cont(new scheme.HashTable());
+});
+
+def_guile0("make-weak-key-hash-table", function (self, cont, size) {
+ return cont(new scheme.HashTable(true));
+});
+
+def_guile0("make-weak-value-hash-table", function (self, cont, size) {
+ // FIXME:
+ return cont(new scheme.HashTable(true));
+});
+
+def_guile0("hash-clear!", function (self, cont, hashtable) {
+ return cont(hashtable.clear());
+});
+
+def_guile0("hashq-remove!", function (self, cont, htable, key) {
+ return cont(htable.delete(key));
+});
+
+def_guile0("hashq-ref", function(self, cont, obarray, sym, dflt) {
+ return cont(obarray.lookup(sym, dflt ? dflt : scheme.FALSE));
+});
+
+def_guile0("hashq-set!", function (self, cont, hashtable, key, obj) {
+ return cont(hashtable.set(key,obj));
+});
+
+def_guile0("hash-for-each", function (self, cont, proc, htable) {
+ var keys = htable.keys(); // don't know if I can use js iterators
+
+ var loop = function (i) {
+ if (i === keys.length) {
+ return cont(scheme.UNSPECIFIED);
+ } else {
+ var newk = function() {
+ return loop(i+1);
+ };
+ return proc.fun(proc, newk, keys[i], htable.get(keys[i]));
+ }
+ };
+
+ return loop(0);
+});
+
+def_guile0("hash-map->list", function (self, cont, proc, htable) {
+ var keys = htable.keys(); // don't know if I can use js iterators
+
+ var loop = function (i, retval, k) {
+ if (i === keys.length) {
+ return k(retval);
+ } else {
+ var newk = function(result) {
+ return loop(i+1, scheme.primitives.cons(result, retval), k);
+ };
+ return proc.fun(proc, newk, keys[i], htable.get(keys[i]));
+ }
+ };
+
+ return loop(0, scheme.EMPTY, cont);
+});
+
+// Modules
+def_guile0("make-variable", function (self, cont, val) {
+ return cont(new scheme.Box(val));
+});
+def_guile0("make-undefined-variable", function (self, cont, val) {
+ return cont(new scheme.Box(scheme.UNDEFINED));
+});
+
+def_guile0("variable-bound?", function (self, cont, box) {
+ return cont(coerce_bool(!(box.x === scheme.UNDEFINED)));
+});
+
+def_guile0("define!", function (self, cont, symbol, value) {
+ // FIXME: validate symbol
+ return cont(scm_module_define(scm_current_module(), symbol, value));
+});
+
+var boot_modules = {};
+
+function scm_primitive_load_path (self, cont, path) {
+ if (path.s in boot_modules) {
+ return boot_modules[path.s](cont);
+ } else {
+ console.log("primitive load path", arguments);
+ not_implemented_yet();
+ }
+};
+def_guile0("primitive-load-path", scm_primitive_load_path);
+
+boot_modules["ice-9/deprecated"] = function () {};
+boot_modules["ice-9/ports"] = function () {};
+boot_modules["ice-9/posix"] = function () {};
+boot_modules["ice-9/threads"] = function () {};
+boot_modules["srfi/srfi-4"] = function () {};
+
+def_guile0("module-local-variable", function (self, cont, module, symbol) {
+ // module system is booted, then validate module
+ // validate symbol
+ if (!scheme.is_true(module)) {
+ // hashq ref
+ return cont(scm_pre_modules_obarray.lookup(symbol, scheme.UNDEFINED));
+ }
+ // 1. check module_obarray
+ var obarray = module.fields[0]; // SCM_MODULE_OBARRAY
+ var b = obarray.lookup(symbol, scheme.UNDEFINED);
+ if (b != scheme.UNDEFINED) { // is_true
+ return cont(b);
+ }
+
+ // FIXME: check binders
+ return cont(scheme.FALSE);
+});
+
+def_guile0("module-variable", function (self, cont, module, symbol) {
+ return cont(scm_module_variable(module, symbol));
+});
+
+def_guile0("%get-pre-modules-obarray", function (self, cont) {
+ return cont(scm_pre_modules_obarray);
+});
+
+def_guile0("set-current-module", function (self, cont, module) {
+
+ if (!module_system_is_booted) {
+ scm_post_boot_init_modules ();
+ }
+ // SCM_VALIDATE_MODULE (SCM_ARG1, module);
+
+ var old = scm_current_module ();
+ the_module.value = module;
+ return cont(old);
+});
+
+var k_ensure;
+var resolve_module_var;
+
+function scm_post_boot_init_modules() {
+ module_system_is_booted = true;
+ the_root_module = scm_lookup (new scheme.Symbol("the-root-module"));
+ k_ensure = new scheme.Keyword("ensure");
+ resolve_module_var = scm_lookup (new scheme.Symbol("resolve-module"));
+ module_public_interface_var = scm_lookup (new scheme.Symbol("module-public-interface"));
+}
+
+// Stubs
+function stub(name) {
+ function scm_fn (self, cont) {
+ console.log(name, arguments);
+ not_implemented_yet();
+ };
+ def_guile0(name, scm_fn);
+};
+
+stub("syntax-session-id");
+stub("macroexpand");
+stub("%exception-handler");
+stub("print-exception");
+def_guile_val("*features*", scheme.EMPTY);
+stub("%load-hook");
+stub("current-reader");
+
+def_guile0("read-hash-extend", function (self, cont, char, fun) {
+ return cont(scheme.FALSE);
+});
+
+scheme.Hook = function (arity) {
+ this.arity = arity;
+ this.procs = [];
+};
+
+def_guile0("make-hook", function (self, cont, nargs) {
+ var arity = (nargs === undefined) ? 0 : nargs;
+ return cont(new scheme.Hook(arity));
+});
+
+def_guile0("run-hook", function (self, cont, hook) {
+ var procs = hook.procs;
+ var args = Array.prototype.slice.call(arguments, 3);
+ // FIXME: validate hook
+ // FIXME: check num args = arity or error
+
+ var loop = function (i) {
+ if (i === procs.length) {
+ return cont(scheme.UNSPECIFIED);
+ } else {
+ var newk = function() {
+ return loop(i+1);
+ };
+
+ var proc = procs[i];
+ return proc.fun.apply(proc.fun, [proc, newk].concat(args));
+ }
+ };
+ return loop(0);
+});
+
+function scm_simple_format (self, cont) {
+ not_implemented_yet();
+};
+def_guile0("simple-format", scm_simple_format);
+
+def_guile0("scm-error", function (self, cont, key, subr, message, args, data) {
+ not_implemented_yet();
+});
+