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-=-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; }; // 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; }; // Modules scheme.primitives["define!"] = function(sym) { var b = new scheme.Box(scheme.UNDEFINED); scheme.env[sym.name] = b; return b; }; scheme.primitives["cache-current-module!"] = function (module, scope) { scheme.cache[scope] = module; }; scheme.primitives["cached-toplevel-box"] = function (scope, sym, is_bound) { return scheme.cache[scope][sym.name]; }; scheme.primitives["cached-module-box"] = function (module_name, sym, is_public, is_bound) { var cache = scheme.module_cache; while (scheme.EMPTY != module_name.cdr) { cache = cache[module_name.car.name]; } cache = cache[module_name.car.name]; var r = cache[sym.name]; if (typeof r === 'undefined') { throw {r : "cached-module-box", s : sym, m : module_name}; } else { return r; } }; scheme.primitives["current-module"] = function () { return scheme.env; }; scheme.primitives["resolve"] = function (sym, is_bound) { return scheme.env[sym.name]; }; // 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); }; scheme.primitives["equal?"] = not_implemented_yet; // Fluids scheme.Fluid = function (x) { this.value = x; return this; }; scheme.primitives["pop-fluid"] = function () { var frame = scheme.dynstack.shift(); if (frame instanceof scheme.frame.Fluid) { frame.fluid.value = frame.fluid.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= 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; }; // Module Cache scheme.module_cache["guile"] = scheme.env; function def_guile0 (name, fn) { var sym = new scheme.Symbol(name); // put in obarray var clos = new scheme.Closure(fn, 0); var box = new scheme.Box(clos); scheme.module_cache["guile"][name] = box; }; function def_guile_val (name, val) { var sym = new scheme.Symbol(name); // put in obarray var box = new scheme.Box(val); scheme.module_cache["guile"][name] = 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("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); }); def_guile0("memq", function (self, cont, val, args) { return cont(scheme.FALSE); }); def_guile0("member", function (self, cont, elt, list) { // FIXME: needs equal? console.log("member", arguments); // throw ""; return cont(scheme.FALSE); }); def_guile0("delete!", function (self, cont, elt, list) { // FIXME: 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) { 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 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("", 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_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) { // FIXME: not weak return cont(new scheme.HashTable()); }); def_guile0("hash-clear!", function (self, cont, hashtable) { if (hashtable instanceof scheme.HashTable) { hashtable.table = {}; return cont(scheme.FALSE); } else { console.log("hash-clear!", arguments); not_implemented_yet(); } }); def_guile0("hashq-remove!", function (self, cont, htable, key) { if (htable instanceof scheme.HashTable) { delete htable.table[scm_hash(key)]; return cont(scheme.FALSE); } else { console.log("hashq-ref", arguments); not_implemented_yet(); } }); var scm_hash = function (obj) { if (obj instanceof scheme.Symbol) { return obj.name; } console.log("Can't hash object", obj); throw "BadHash"; }; scheme.HashTable = function ( ) { this.table = {}; this.lookup = function (obj, dflt) { var hash = scm_hash(obj); if (this.table.hasOwnProperty(hash)) { return this.table[hash]; } else { return dflt; } }; return this; } def_guile0("hashq-ref", function(self, cont, obarray, sym, dflt) { if (obarray instanceof scheme.HashTable) { return cont(obarray.lookup(sym, dflt ? dflt : scheme.FALSE)); } else { console.log("hashq-ref", arguments); not_implemented_yet(); } }); def_guile0("hashq-set!", function (self, cont, hashtable, key, obj) { if (hashtable instanceof scheme.HashTable) { hashtable.table[scm_hash(key)] = obj; return cont(scheme.FALSE); } else { console.log("hashq-set!", arguments); not_implemented_yet(); } }); def_guile0("hash-for-each", function (self, cont, module, symbol) { // FIXME: return cont(scheme.FALSE); }); // Modules def_guile0("make-variable", function (self, cont, val) { return cont(new scheme.Box(val)); }); def_guile0("define!", function (self, cont, symbol, value) { // FIXME: reuse module-define! if (symbol.name in scheme.env) { scheme.env[symbol.name].x = value; } else { scheme.env[symbol.name] = new scheme.Box(value); } return cont(); }); 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) { if (module instanceof scheme.Struct) { // Assumes we get a module with a hashtable var obarray = scheme.primitives["struct-ref"](module, 0); return cont(obarray.lookup(symbol, scheme.FALSE)); // hashq-ref } else { // FIXME: could be #f, then should use the pre-mod obarray console.log("module-local-variable needs real modules"); throw "fail"; } }); def_guile0("module-variable", function (self, cont, module, symbol) { if (module instanceof scheme.Struct) { console.log("FIXME: should only be called pre-bootstrap"); throw "fail"; } if (module instanceof scheme.HashTable) { console.log("modvar htable"); throw "fail"; } return cont(module[symbol.name]); }); def_guile0("%get-pre-modules-obarray", function (self, cont) { var obarray = new scheme.HashTable(); obarray.table = scheme.env; return cont(obarray); }); def_guile0("set-current-module", function (self, cont, module) { return cont(scheme.FALSE); }); // 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"); stub("*features*"); stub("%load-hook"); stub("current-reader"); def_guile0("read-hash-extend", function (self, cont, char, fun) { return cont(scheme.FALSE); }); def_guile0("make-hook", function (self, cont, nargs) { return cont(scheme.FALSE); }); 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(); });