whalesong/js-assembler/runtime-src/js-vm-primitives.js

4702 lines
126 KiB
JavaScript

if (! this['plt']) { this['plt'] = {}; }
/**
Note: all primitives in this file should be written so that it's easy
to syntactically pull out all of the implemented primitives. Make
sure that any new primitive is written as:
PRIMITIVES[name-of-primitive] = ...
That way, we can do a simple grep.
*/
(function(scope) {
var primitives = {};
scope.primitives = primitives;
var PRIMITIVES = {};
var types = scope.types;
var helpers = scope.helpers;
var CALL, PAUSE, PrimProc, CasePrimitive, makeOptionPrimitive, procArityContains;
var assocListToHash, raise;
var isList, isListOf;
var check;
var checkListOf;
CALL = types.internalCall;
PAUSE = types.internalPause;
PrimProc = types.PrimProc;
CasePrimitive = types.CasePrimitive;
makeOptionPrimitive = types.makeOptionPrimitive;
procArityContains = helpers.procArityContains;
assocListToHash = helpers.assocListToHash;
raise = helpers.raise;
isList = helpers.isList;
isListOf = helpers.isListOf;
check = helpers.check;
checkListOf = helpers.checkListOf;
scope.link.ready('types',
function() {
types = scope.types;
CALL = types.internalCall;
PAUSE = types.internalPause;
PrimProc = types.PrimProc;
CasePrimitive = types.CasePrimitive;
makeOptionPrimitive = types.makeOptionPrimitive;
});
scope.link.ready('helpers',
function() {
helpers = scope.helpers;
procArityContains = helpers.procArityContains;
assocListToHash = helpers.assocListToHash;
raise = helpers.raise;
isList = helpers.isList;
isListOf = helpers.isListOf;
check = helpers.check;
checkListOf = helpers.checkListOf;
});
//////////////////////////////////////////////////////////////////////
// Helper Functions
var id = function(x) { return x; };
var sub1 = function(x) {
check(x, isNumber, 'sub1', 'number', 1, [x]);
return jsnums.subtract(x, 1);
}
var add1 = function(x) {
check(x, isNumber, 'add1', 'number', 1, [x]);
return jsnums.add(x, 1);
}
var callWithValues = function(f, vals) {
if (vals instanceof types.ValuesWrapper) {
return CALL(f, vals.elts, id);
}
else {
return CALL(f, [vals], id);
}
};
// onSingleResult: x (x -> y) -> y
// Applies f on x, but first checks that x is a single value.
// If it isn't, raises an arity error.
var onSingleResult = function(x, f) {
if (x instanceof types.ValuesWrapper) {
if (x.elts.length === 1) {
return f(x.elts[0]);
} else {
var argsStr = helpers.map(function(x) { return "~s"; }, x.elts).join(' ');
raise(types.incompleteExn(
types.exnFailContractArity,
helpers.format(
'context expected 1 value, received ~s values: ' + argsStr,
[x.elts.length].concat(x.elts))));
}
} else {
return f(x);
}
};
var procedureArity = function(proc) {
check(proc, isFunction, 'procedure-arity', 'procedure', 1, [proc]);
var singleCaseArity = function(aCase) {
if (aCase instanceof types.ContinuationClosureValue) {
return types.arityAtLeast(0);
}
else if (aCase.isRest) {
return types.arityAtLeast(aCase.numParams);
}
else {
return aCase.numParams;
}
}
if ( proc instanceof PrimProc ||
proc instanceof types.ClosureValue ||
proc instanceof types.ContinuationClosureValue ) {
return singleCaseArity(proc);
}
else {
var cases;
if ( proc instanceof CasePrimitive ) {
cases = proc.cases;
}
else if ( proc instanceof types.CaseLambdaValue ) {
cases = proc.closures;
}
else {
throw types.internalError('procedure-arity given wrong type that passed isFunction!', false);
}
var ret = [];
for (var i = 0; i < cases.length; i++) {
ret.push( singleCaseArity(cases[i]) );
}
ret = normalizeArity(ret);
return ret.length == 1 ? ret[0] : types.list(ret);
}
};
var normalizeArity = function(arity) {
var newArity = arity.slice(0);
var sortFunc = function(x, y) {
if ( types.isArityAtLeast(x) ) {
if ( types.isArityAtLeast(y) ) {
return types.arityAtLeastValue(x) - types.arityAtLeastValue(y);
}
else {
return types.arityAtLeastValue(x) - y - 0.5;
}
}
else {
if ( types.isArityAtLeast(y) ) {
return x - types.arityAtLeastValue(y) + 0.5;
}
else {
return x - y;
}
}
};
newArity.sort(sortFunc);
for (var i = 0; i < newArity.length-1; i++) {
if ( types.isArityAtLeast(newArity[i]) ) {
return newArity.slice(0, i+1);
}
}
return newArity;
};
var length = function(lst) {
checkList(lst, 'length', 1, [lst]);
var ret = 0;
for (; !lst.isEmpty(); lst = lst.rest) {
ret = ret+1;
}
return ret;
}
var append = function(initArgs) {
if (initArgs.length == 0) {
return types.EMPTY;
}
var args = initArgs.slice(0, initArgs.length-1);
var lastArg = initArgs[initArgs.length - 1];
arrayEach(args, function(x, i) {checkList(x, 'append', i+1, initArgs);});
var ret = lastArg;
for (var i = args.length-1; i >= 0; i--) {
ret = args[i].append(ret);
}
return ret;
}
var foldHelp = function(f, acc, args) {
if ( args[0].isEmpty() ) {
return acc;
}
var fArgs = [];
var argsRest = [];
for (var i = 0; i < args.length; i++) {
fArgs.push(args[i].first);
argsRest.push(args[i].rest);
}
fArgs.push(acc);
return CALL(f, fArgs,
function(result) {
return foldHelp(f, result, argsRest);
});
}
var quicksort = function(functionName) {
return function(initList, comp) {
checkList(initList, functionName, 1, arguments);
check(comp, procArityContains(2), functionName, 'procedure (arity 2)', 2, arguments);
var quicksortHelp = function(k) {
return function(lst) {
if ( lst.isEmpty() ) {
return k(types.EMPTY);
}
var compYes = new PrimProc('compYes', 1, false, false,
function(x) { return CALL(comp, [x, lst.first], id); });
var compNo = new PrimProc('compNo', 1, false, false,
function(x) { return CALL(comp, [x, lst.first],
function(res) { return !res; });
});
return CALL(PRIMITIVES['filter'],
[compYes, lst.rest],
quicksortHelp(function(sorted1) {
return CALL(PRIMITIVES['filter'],
[compNo, lst.rest],
quicksortHelp(function(sorted2) {
return k( append([sorted1,
types.list([lst.first]),
sorted2]) );
}));
}));
};
}
return quicksortHelp(id)(initList);
};
}
var compare = function(args, comp) {
var curArg = args[0];
for (var i = 1; i < args.length; i++) {
if ( !comp(curArg, args[i]) ) {
return false;
}
curArg = args[i];
}
return true;
}
// isAlphabeticString: string -> boolean
var isAlphabeticString = function(s) {
for(var i = 0; i < s.length; i++) {
if (! ((s.charAt(i) >= "a" && s.charAt(i) <= "z") ||
(s.charAt(i) >= "A" && s.charAt(i) <= "Z"))) {
return false;
}
}
return true;
};
var isMutableString = function(s) {
return isString(s) && typeof s != 'string';
};
var isNumericString = function(s) {
for (var i = 0; i < s.length; i++) {
if ( ! (s.charAt(i) >= '0' && s.charAt(i) <= '9') ) {
return false;
}
}
return true;
}
// isWhitespaceString: string -> boolean
var isWhitespaceString = (function() {
var pat = new RegExp("^\\s*$");
return function(s) {
return (s.match(pat) ? true : false);
}
}());
var isImmutable = function(x) {
return ((isString(x) ||
isByteString(x) ||
isVector(x) ||
isHash(x) ||
isBox(x)) &&
!x.mutable);
};
// On any numeric error, throw a contract error.
jsnums.onThrowRuntimeError = function(msg, x, y) {
raise(types.incompleteExn(
types.exnFailContract,
helpers.format("~a: ~s ~s", [msg, x, y]),
[]));
};
var checkAndGetGuard = function(funName, guard, numberOfGuardArgs) {
if ( !guard ) {
return false;
}
// Check the number of arguments on the guard
if ( !procArityContains(numberOfGuardArgs)(guard) ) {
raise(types.incompleteExn(
types.exnFailContract,
helpers.format(
'~a: guard procedure does not accept ~a arguments '
+ '(one more than the number constructor arguments): ~s',
[funName, numberOfGuardArgs, guard]),
[]));
}
// if the guard has the right number of arguments,
// then construct a javascript function to call it
return function(args, name, k) {
args = args.concat([name]);
return CALL(guard, args,
function(res) {
if ( res instanceof types.ValuesWrapper ) {
return k(res.elts);
}
else {
return k([res]);
}
});
};
};
var getMakeStructTypeReturns = function(aStructType) {
var name = aStructType.name;
return new types.ValuesWrapper(
[aStructType,
(new types.StructConstructorProc(aStructType,
'make-'+name,
aStructType.numberOfArgs,
false,
false,
aStructType.constructor)),
(new types.StructPredicateProc(aStructType, name+'?', 1, false, false, aStructType.predicate)),
(new types.StructAccessorProc(aStructType,
name+'-ref',
2,
false,
false,
function(x, i) {
check(x, aStructType.predicate, name+'-ref', 'struct:'+name, 1, arguments);
check(i, isNatural, name+'-ref', 'non-negative exact integer', 2, arguments);
var numFields = aStructType.numberOfFields;
if ( jsnums.greaterThanOrEqual(i, numFields) ) {
var msg = (name+'-ref: slot index for <struct:'+name+'> not in ' +
'[0, ' + (numFields-1) + ']: ' + i);
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
return aStructType.accessor(x, jsnums.toFixnum(i));
})),
(new types.StructMutatorProc(aStructType,
name+'-set!',
3,
false,
false,
function(x, i, v) {
check(x, aStructType.predicate, name+'-set!', 'struct:'+name, 1, arguments);
check(i, isNatural, name+'-set!', 'non-negative exact integer', 2, arguments);
var numFields = aStructType.numberOfFields;
if ( jsnums.greaterThanOrEqual(i, numFields) ) {
var msg = (name+'-set!: slot index for <struct'+name+'> not in ' +
'[0, ' + (numFields-1) + ']: ' + i);
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
aStructType.mutator(x, jsnums.toFixnum(i), v)
})) ]);
};
//////////////////////////////////////////////////////////////////////
var isNumber = jsnums.isSchemeNumber;
var isReal = jsnums.isReal;
var isRational = jsnums.isRational;
var isComplex = isNumber;
var isInteger = jsnums.isInteger;
var isNatural = function(x) {
return jsnums.isExact(x) && isInteger(x) && jsnums.greaterThanOrEqual(x, 0);
};
var isNonNegativeReal = function(x) {
return isReal(x) && jsnums.greaterThanOrEqual(x, 0);
};
var isSymbol = types.isSymbol;
var isChar = types.isChar;
var isString = types.isString;
var isPair = types.isPair;
var isEmpty = function(x) { return x === types.EMPTY; };
var isVector = types.isVector;
var isBox = types.isBox;
var isHash = types.isHash;
var isByteString = types.isByteString;
var isByte = function(x) {
return (isNatural(x) &&
jsnums.lessThanOrEqual(x, 255));
}
var isBoolean = function(x) {
return (x === true || x === false);
}
var isFunction = types.isFunction;
var isEqual = function(x, y) {
return types.isEqual(x, y, new types.UnionFind());
}
var isEq = function(x, y) {
return x === y;
}
var isEqv = function(x, y) {
if (isNumber(x) && isNumber(y)) {
return jsnums.eqv(x, y);
}
else if (isChar(x) && isChar(y)) {
return x.val === y.val;
}
return x === y;
}
var isAssocList = function(x) {
return isPair(x) && isPair(x.rest) && isEmpty(x.rest.rest);
};
var isCompoundEffect = function(x) {
return ( types.isEffect(x) || isListOf(x, isCompoundEffect) );
};
var isJsValue = types.isJsValue;
var isJsObject = function(x) {
return isJsValue(x) && typeof(x.val) == 'object';
};
var isJsFunction = function(x) {
return isJsValue(x) && typeof(x.val) == 'function';
};
var arrayEach = function(arr, f) {
for (var i = 0; i < arr.length; i++) {
f.call(null, arr[i], i);
}
}
var checkList = function(x, functionName, position, args) {
if ( !isList(x) ) {
helpers.throwCheckError([functionName,
'list',
helpers.ordinalize(position),
x],
position,
args);
}
}
var checkListOfLength = function(lst, n, functionName, position, args) {
if ( !isList(lst) || (length(lst) < n) ) {
helpers.throwCheckError([functionName,
'list with ' + n + ' or more elements',
helpers.ordinalize(position),
lst],
position,
args);
}
}
var checkAllSameLength = function(lists, functionName, args) {
if (lists.length == 0)
return;
var len = length(lists[0]);
arrayEach(lists,
function(lst, i) {
if (length(lst) != len) {
var argsStr = helpers.map(function(x) { return " ~s"; }, args).join('');
var msg = helpers.format(functionName + ': all lists must have the same size; arguments were:' + argsStr,
args);
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
});
}
//////////////////////////////////////////////////////////////////////
// Special moby-specific primitives
PRIMITIVES['verify-boolean-branch-value'] =
new PrimProc('verify-boolean-branch-value',
2,
false,
false,
function(x, aLoc) {
if (x !== true && x !== false) {
// FIXME: should throw structure
// make-moby-error-type:branch-value-not-boolean
// instead.
throw new Error("the value " + sys.inspect(x) + " is not boolean type at " + aLoc);
}
return x;
})
PRIMITIVES['throw-cond-exhausted-error'] =
new PrimProc('throw-cond-exhausted-error',
1,
false,
false,
function(aLoc) {
// FIXME: should throw structure
// make-moby-error-type:conditional-exhausted
// instead.
throw types.schemeError(types.incompleteExn(types.exnFail, "cond: all question results were false", []));
});
PRIMITIVES['print-values'] =
new PrimProc('print-values',
0,
true,
true,
function(state, values) {
var printed = false;
for (var i = 0; i < values.length; i++) {
if (values[i] !== types.VOID) {
if (printed) {
state.getDisplayHook()("\n");
}
state.getPrintHook()(values[i]);
printed = true;
}
}
if (printed) {
state.getDisplayHook()("\n");
}
state.v = types.VOID;
});
//////////////////////////////////////////////////////////////////////
var defaultPrint =
new PrimProc('print',
1,
false,
true,
function(state, x) {
state.getPrintHook()(helpers.toDisplayedString(x));
state.v = types.VOID;
});
PRIMITIVES['write'] =
new CasePrimitive('write',
[new PrimProc('write', 1, false, true, function(aState, x) {
aState.getPrintHook()(x);
aState.v = types.VOID;
}),
new PrimProc('write', 2, false, true, function(aState, x, port) {
throw types.internalError('write to a port not implemented yet.', false);
}) ]);
PRIMITIVES['display'] =
new CasePrimitive('display',
[new PrimProc('display', 1, false, true, function(state, x) {
state.getDisplayHook()(x);
state.v = types.VOID;
}),
new PrimProc('display', 2, false, true, function(state, x, port) {
// FIXME
throw types.internalError("display to a port not implemented yet.", false);
} )]);
PRIMITIVES['newline'] =
new CasePrimitive('newline',
[new PrimProc('newline', 0, false, true, function(state) {
state.getDisplayHook()('\n');
state.v = types.VOID;
}),
new PrimProc('newline', 1, false, false, function(port) {
// FIXME
throw types.internalError("newline to a port not implemented yet.", false);
} )]);
PRIMITIVES['current-print'] =
new PrimProc('current-print',
0,
false, false,
function() {
return defaultPrint;
});
PRIMITIVES['current-continuation-marks'] =
// FIXME: should be CasePrimitive taking either 0 or 1 arguments
new PrimProc('current-continuation-marks',
0,
false, true,
function(aState) {
aState.v = state.captureCurrentContinuationMarks(aState);
});
PRIMITIVES['continuation-mark-set?'] =
new PrimProc('continuation-mark-set?',
1,
false,
false,
types.isContinuationMarkSet);
PRIMITIVES['continuation-mark-set->list'] =
new PrimProc('continuation-mark-set->list',
2,
false,
true,
function(state, markSet, keyV) {
check(markSet,
types.isContinuationMarkSet,
'continuation-mark-set->list',
'continuation-mark-set',
1,
[markSet, keyV]);
state.v = types.list(markSet.ref(keyV));
});
PRIMITIVES['for-each'] =
new PrimProc('for-each',
2,
true, false,
function(f, firstArg, arglists) {
var allArgs = [f, firstArg].concat(arglists);
arglists.unshift(firstArg);
check(f, isFunction, 'for-each', 'procedure', 1, allArgs);
arrayEach(arglists, function(lst, i) {checkList(lst, 'for-each', i+2, allArgs);});
checkAllSameLength(arglists, 'for-each', allArgs);
check(f, procArityContains(arglists.length), 'for-each', 'procedure (arity ' + arglists.length + ')', 1, allArgs);
var forEachHelp = function(args) {
if (args[0].isEmpty()) {
return types.VOID;
}
var argsFirst = [];
var argsRest = [];
for (var i = 0; i < args.length; i++) {
argsFirst.push(args[i].first);
argsRest.push(args[i].rest);
}
return CALL(f, argsFirst,
function(result) { return forEachHelp(argsRest); });
}
return forEachHelp(arglists);
});
PRIMITIVES['make-thread-cell'] =
new CasePrimitive('make-thread-cell', [
new PrimProc("make-thread-cell",
1, false, false,
function(x) {
return new types.ThreadCell(x, false);
}
),
new PrimProc("make-thread-cell",
2, false, false,
function(x, y) {
return new types.ThreadCell(x, y);
}
)]);
PRIMITIVES['make-continuation-prompt-tag'] =
new CasePrimitive('make-continuation-prompt-tag',
[
new PrimProc("make-continuation-prompt-tag",
0, false, false,
function() {
return new types.ContinuationPromptTag();
}
),
new PrimProc("make-continuation-prompt-tag",
1, false, false,
function(x) {
check(x, isSymbol, 'make-continuation-prompt-tag',
'symbol', 1, arguments);
return new types.ContinuationPromptTag(x);
}
)]);
PRIMITIVES['call-with-continuation-prompt'] =
new PrimProc('call-with-continuation-prompt',
1,
true, true,
function(aState, proc, args) {
// First check that proc is a procedure.
var allArgs = [proc].concat(args);
check(proc, isFunction, 'call-with-continuation-prompt', 'procedure', 1, allArgs);
// Do other argument parsing stuff...
var promptTag;
var handler;
var procArgs;
if (args.length === 0) {
promptTag = types.defaultContinuationPromptTag;
handler = types.defaultContinuationPromptTagHandler;
procArgs = args.slice(0);
} else if (args.length === 1) {
promptTag = args[0];
handler = types.defaultContinuationPromptTagHandler;
procArgs = args.slice(1);
} else if (args.length >= 2) {
promptTag = args[0];
handler = args[1];
procArgs = args.slice(2);
}
// If the handler is false, default to ()
if (handler === false) {
handler = defaultCallWithContinuationPromptHandler;
}
// Add the prompt.
aState.pushControl(new control.PromptControl(aState.vstack.length,
promptTag,
handler));
// Within the context of the prompt, do the procedure application.
aState.pushControl(
new control.ApplicationControl(
new control.ConstantControl(proc),
helpers.map(function(op) {
return new control.ConstantControl(op)},
procArgs)));
});
PRIMITIVES['default-continuation-prompt-tag'] =
new PrimProc('default-continuation-prompt-tag',
0,
false, false,
function() {
return types.defaultContinuationPromptTag;
});
PRIMITIVES['continuation-prompt-tag?'] =
new PrimProc('continuation-prompt-tag?',
1,
false, false,
types.isContinuationPromptTag);
// Implements the default handler for a continuation prompt, if one isn't provided
// by call-with-continuation-prompt.
var defaultCallWithContinuationPromptHandler =
new PrimProc('default-call-with-continuation-prompt-handler',
1,
false,
true,
function(aState, abortThunk) {
// The default handler accepts a single abort thunk
// argument, and then re-installs the prompt and continues
// with the abort thunk.
// (call-with-continuation-prompt abort-thunk prompt-tag #f)
aState.pushControl(
new control.ApplicationControl(
new control.ConstantControl(PRIMITIVES['call-with-continuation-prompt']),
helpers.map(function(op) {
return new control.ConstantControl(op)},
[abortThunk, promptTag, false])));
});
PRIMITIVES['abort-current-continuation'] =
new PrimProc('abort-current-continuation',
1,
true, true,
function(aState, promptTag, args) {
control.setupAbortToPrompt(aState, promptTag, args);
});
PRIMITIVES['make-struct-type'] =
makeOptionPrimitive(
'make-struct-type',
4,
[false,
types.EMPTY,
false,
false,
types.EMPTY,
false,
false],
true,
function(userArgs,
aState,
name,
superType,
initFieldCnt,
autoFieldCnt,
autoV,
props, // FIXME: currently ignored
inspector, // FIXME: currently ignored
procSpec, // FIXME: currently ignored
immutables, // FIXME: currently ignored
guard,
constructorName // FIXME: currently ignored
) {
check(name, isSymbol, 'make-struct-type', 'symbol', 1, userArgs);
check(superType, function(x) { return x === false || types.isStructType(x); },
'make-struct-type', 'struct-type or #f', 2, userArgs);
check(initFieldCnt, isNatural, 'make-struct-type', 'exact non-negative integer', 3, userArgs);
check(autoFieldCnt, isNatural, 'make-struct-type', 'exact non-negative integer', 4, userArgs);
// TODO: check props
// TODO: check inspector
// TODO: check procSpect
checkListOf(immutables, isNatural, 'make-struct-type', 'exact non-negative integer', 9, userArgs);
check(guard, function(x) { return x === false || isFunction(x); },
'make-struct-type', 'procedure or #f', 10, userArgs);
var numberOfGuardArgs = initFieldCnt + 1 + (superType ? superType.numberOfArgs : 0);
var aStructType =
types.makeStructureType(name.toString(),
superType,
jsnums.toFixnum(initFieldCnt),
jsnums.toFixnum(autoFieldCnt),
autoV,
checkAndGetGuard('make-struct-type', guard, numberOfGuardArgs));
aState.v = getMakeStructTypeReturns(aStructType);
});
PRIMITIVES['make-struct-field-accessor'] =
makeOptionPrimitive(
'make-struct-field-accessor',
2,
[false],
false,
function(userArgs, accessor, fieldPos, fieldName) {
check(accessor, function(x) { return x instanceof types.StructAccessorProc && x.numParams > 1; },
'make-struct-field-accessor', 'accessor procedure that requires a field index', 1, userArgs);
check(fieldPos, isNatural, 'make-struct-field-accessor', 'exact non-negative integer', 2, userArgs);
check(fieldName, function(x) { return x === false || isSymbol(x); },
'make-struct-field-accessor', 'symbol or #f', 3, userArgs);
var procName = accessor.type.name + '-'
+ (fieldName ? fieldName.toString() : 'field' + fieldPos.toString());
return new types.StructAccessorProc(accessor.type, procName, 1, false, false,
function(x) {
check(x, accessor.type.predicate, procName, 'struct:'+accessor.type.name, 1);
return accessor.impl(x, fieldPos);
});
});
PRIMITIVES['make-struct-field-mutator'] =
makeOptionPrimitive(
'make-struct-field-mutator',
2,
[false],
false,
function(userArgs, mutator, fieldPos, fieldName) {
check(mutator, function(x) { return x instanceof types.StructMutatorProc && x.numParams > 1; },
'make-struct-field-mutator', 'mutator procedure that requires a field index', 1, userArgs);
check(fieldPos, isNatural, 'make-struct-field-mutator', 'exact non-negative integer', 2, userArgs);
check(fieldName, function(x) { return x === false || isSymbol(x); },
'make-struct-field-mutator', 'symbol or #f', 3, userArgs);
var procName = mutator.type.name + '-'
+ (fieldName ? fieldName.toString() : 'field' + fieldPos.toString());
return new types.StructMutatorProc(mutator.type, procName, 2, false, false,
function(x, v) {
check(x, mutator.type.predicate, procName, 'struct:'+mutator.type.name, 1, arguments);
return mutator.impl(x, fieldPos, v);
});
});
PRIMITIVES['struct-type?'] =
new PrimProc('struct-type?', 1, false, false, types.isStructType);
PRIMITIVES['struct-constructor-procedure?'] =
new PrimProc('struct-constructor-procedure?', 1, false, false,
function(x) {
return x instanceof types.StructConstructorProc; });
PRIMITIVES['struct-predicate-procedure?'] =
new PrimProc('struct-predicate-procedure?', 1, false, false,
function(x) {
return x instanceof types.StructPredicateProc; });
PRIMITIVES['struct-accessor-procedure?'] =
new PrimProc('struct-accessor-procedure?', 1, false, false,
function(x) {
return x instanceof types.StructAccessorProc; });
PRIMITIVES['struct-mutator-procedure?'] =
new PrimProc('struct-mutator-procedure?', 1, false, false,
function(x) {
return (x instanceof types.StructMutatorProc); });
PRIMITIVES['procedure-arity'] = new PrimProc('procedure-arity', 1, false, false, procedureArity);
PRIMITIVES['procedure-arity-includes?'] =
new PrimProc('procedure-arity-includes?',
2,
false,
false,
function(proc, k) {
check(proc, isFunction, 'procedure-arity-includes?', 'procedure', 1, [proc, k]);
check(k, isNatural, 'procedure-arity-includes?', 'exact non-negative integer', 2, [proc, k]);
return helpers.procArityContains(k)(proc);
});
PRIMITIVES['make-arity-at-least'] =
new PrimProc('make-arity-at-least',
1,
false,
false,
types.arityAtLeast);
PRIMITIVES['arity-at-least?'] =
new PrimProc('arity-at-least?',
1,
false, false,
function(x) {
return types.isArityAtLeast(x);
});
PRIMITIVES['arity-at-least-value'] =
new PrimProc('arity-at-least-value',
1,
false, false,
function(x) {
check(x, types.isArityAtLeast, 'arity-at-least-value',
'arity-at-least', 1, [x]);
return types.arityAtLeastValue(x);
});
PRIMITIVES['apply'] =
new PrimProc('apply',
2,
true, false,
function(f, firstArg, args) {
var allArgs = [f, firstArg].concat(args);
check(f, isFunction, 'apply', 'procedure', 1, allArgs);
args.unshift(firstArg);
var lastArg = args.pop();
checkList(lastArg, 'apply', args.length+2, allArgs);
var args = args.concat(helpers.schemeListToArray(lastArg));
return CALL(f, args, id);
});
PRIMITIVES['values'] =
new PrimProc('values',
0,
true, false,
function(args) {
if (args.length === 1) {
return args[0];
}
return new types.ValuesWrapper(args);
});
PRIMITIVES['call-with-values'] =
new PrimProc('call-with-values',
2,
false, false,
function(g, r) {
check(g, procArityContains(0), 'call-with-values', 'procedure (arity 0)', 1, arguments);
check(r, isFunction, 'call-with-values', 'procedure', 2, arguments);
return CALL(g, [],
function(res) {
return callWithValues(r, res);
});
});
PRIMITIVES['compose'] =
new PrimProc('compose',
0,
true, false,
function(procs) {
arrayEach(procs, function(p, i) {check(p, isFunction, 'compose', 'procedure', i+1, procs);});
if (procs.length == 0) {
return PRIMITIVES['values'];
}
var funList = types.list(procs).reverse();
var composeHelp = function(x, fList) {
if ( fList.isEmpty() ) {
return x;
}
return CALL(new PrimProc('', 1, false, false,
function(args) {
return callWithValues(fList.first, args);
}),
[x],
function(result) {
return composeHelp(result, fList.rest);
});
}
return new PrimProc('', 0, true, false,
function(args) {
if (args.length === 1) {
return composeHelp(args[0], funList);
}
return composeHelp(new types.ValuesWrapper(args), funList);
});
});
PRIMITIVES['current-inexact-milliseconds'] =
new PrimProc('current-inexact-milliseconds',
0,
false, false,
function() {
return jsnums.makeFloat((new Date()).valueOf());
});
PRIMITIVES['current-seconds'] =
new PrimProc('current-seconds',
0,
false, false,
function() {
return Math.floor( (new Date()).getTime() / 1000 );
});
PRIMITIVES['current-inspector'] =
new PrimProc('current-inspector',
0,
false, false,
function() {
return false;
});
PRIMITIVES['not'] =
new PrimProc('not',
1,
false, false,
function(x) {
return x === false;
});
PRIMITIVES['void'] =
new PrimProc('void', 0, true, false,
function(args) {
return types.VOID;
});
PRIMITIVES['random'] =
new CasePrimitive('random',
[new PrimProc('random', 0, false, false,
function() {return types.floatpoint(Math.random());}),
new PrimProc('random', 1, false, false,
function(n) {
check(n, isNatural, 'random', 'non-negative exact integer', 1, arguments);
return Math.floor(Math.random() * jsnums.toFixnum(n));
}) ]);
PRIMITIVES['sleep'] =
new CasePrimitive('sleep',
[new PrimProc('sleep', 0, false, false, function() { return types.VOID; }),
new PrimProc('sleep',
1,
false, false,
function(secs) {
check(secs, isNonNegativeReal, 'sleep', 'non-negative real number', 1);
var millisecs = jsnums.toFixnum( jsnums.multiply(secs, 1000) );
return PAUSE(function(caller, success, fail) {
setTimeout(function() { success(types.VOID); },
millisecs);
});
}) ]);
PRIMITIVES['identity'] = new PrimProc('identity', 1, false, false, id);
PRIMITIVES['raise'] =
new PrimProc('raise',
1,
false,
false,
raise);
PRIMITIVES['error'] =
new PrimProc('error',
1,
true, false,
function(arg1, args) {
var allArgs = [arg1].concat(args);
check(arg1, function(x) {return isSymbol(x) || isString(x);},
'error', 'symbol or string', 1, allArgs);
if ( isSymbol(arg1) ) {
if ( args.length === 0 ) {
raise( types.incompleteExn(types.exnFail, "error: " + arg1.val, []) );
}
var formatStr = args.shift();
check(formatStr, isString, 'error', 'string', 2, allArgs);
args.unshift(arg1);
raise( types.incompleteExn(types.exnFail, helpers.format('~s: '+formatStr.toString(), args), []) );
}
else {
var msgBuffer = [arg1.toString()];
for (var i = 0; i < args.length; i++) {
msgBuffer.push( helpers.toDisplayedString(args[i]) );
}
raise( types.incompleteExn(types.exnFail, msgBuffer.join(''), []) );
}
});
PRIMITIVES['make-exn'] = new PrimProc('make-exn', 2, false, false, types.exn);
PRIMITIVES['exn-message'] =
new PrimProc('exn-message',
1,
false, false,
function(exn) {
check(exn, types.isExn, 'exn-message', 'exn', 1, [exn]);
return types.exnMessage(exn);
});
PRIMITIVES['exn-continuation-marks'] =
new PrimProc('exn-continuation-marks',
1,
false, false,
function(exn) {
check(exn, types.isExn, 'exn-continuation-marks', 'exn', 1, [exn]);
return types.exnContMarks(exn);
});
PRIMITIVES['make-exn:fail'] = new PrimProc('make-exn:fail', 2, false, false, types.exnFail);
PRIMITIVES['make-exn:fail:contract'] = new PrimProc('make-exn:fail:contract', 2, false, false, types.exnFailContract);
PRIMITIVES['make-exn:fail:contract:arity'] =
new PrimProc('make-exn:fail:contract:arity',
2,
false,
false,
types.exnFailContractArity);
PRIMITIVES['make-exn:fail:contract:variable'] =
new PrimProc('make-exn:fail:contract:variable',
3,
false,
false,
types.exnFailContractVariable);
PRIMITIVES['make-exn:fail:contract:divide-by-zero'] =
new PrimProc('make-exn:fail:contract:divide-by-zero',
2,
false,
false,
types.exnFailContractDivisionByZero);
PRIMITIVES['exn?'] =
new PrimProc('exn?',
1,
false,
false,
types.isExn);
PRIMITIVES['exn:fail?'] =
new PrimProc('exn:fail?',
1,
false,
false,
types.isExnFail);
PRIMITIVES['exn:fail:contract?'] =
new PrimProc('exn:fail:contract?',
1,
false,
false,
types.isExnFailContract);
PRIMITIVES['exn:fail:contract:arity?'] =
new PrimProc('exn:fail:contract:arity?',
1,
false,
false,
types.isExnFailContractArity);
PRIMITIVES['exn:fail:contract:variable?'] =
new PrimProc('exn:fail:contract:variable?',
1,
false,
false,
types.isExnFailContractVariable);
PRIMITIVES['exn:fail:contract:divide-by-zero?'] =
new PrimProc('exn:fail:contract:divide-by-zero?',
1,
false,
false,
types.isExnFailContractDivisionByZero);
/***********************
*** Math Primitives ***
***********************/
PRIMITIVES['*'] =
new PrimProc('*',
0,
true, false,
function(args) {
arrayEach(args, function(x, i) {check(x, isNumber, '*', 'number', i+1, args);});
var result = types.rational(1);
for(var i = 0; i < args.length; i++) {
result = jsnums.multiply(args[i], result);
}
return result;
});
PRIMITIVES['-'] =
new PrimProc("-",
1,
true, false,
function(x, args) {
var allArgs = [x].concat(args);
check(x, isNumber, '-', 'number', 1, allArgs);
arrayEach(args, function(y, i) {check(y, isNumber, '-', 'number', i+2, allArgs);});
if (args.length == 0) {
return jsnums.subtract(0, x);
}
var result = x;
for (var i = 0; i < args.length; i++) {
result = jsnums.subtract(result, args[i]);
}
return result;
});
PRIMITIVES['+'] =
new PrimProc("+",
0,
true, false,
function(args) {
arrayEach(args, function(x, i) {check(x, isNumber, '+', 'number', i+1, args);});
if (args.length == 0) {
return 0;
}
var result = args[0];
for (var i = 1; i < args.length; i++) {
result = jsnums.add(result, args[i]);
}
return result;
});
PRIMITIVES['='] =
new PrimProc("=",
2,
true, false,
function(x, y, args) {
args.unshift(y);
args.unshift(x);
arrayEach(args, function(z, i) {check(z, isNumber, '=', 'number', i+1, args);});
return compare(args, jsnums.equals);
});
PRIMITIVES['=~'] =
new PrimProc('=~',
3,
false, false,
function(x, y, range) {
check(x, isReal, '=~', 'real', 1, arguments);
check(y, isReal, '=~', 'real', 2, arguments);
check(range, isNonNegativeReal, '=~', 'non-negative-real', 3, arguments);
return jsnums.lessThanOrEqual(jsnums.abs(jsnums.subtract(x, y)), range);
});
PRIMITIVES['/'] =
new PrimProc('/',
1,
true, false,
function(x, args) {
var allArgs = [x].concat(args);
check(x, isNumber, '/', 'number', 1, allArgs);
arrayEach(args, function(y, i) {check(y, isNumber, '/', 'number', i+2, allArgs);});
if (args.length == 0) {
if ( jsnums.eqv(x, 0) ) {
raise( types.incompleteExn(types.exnFailContractDivisionByZero, '/: division by zero', []) );
}
return jsnums.divide(1, x);
}
var res = x;
for (var i = 0; i < args.length; i++) {
if ( jsnums.eqv(args[i], 0) ) {
raise( types.incompleteExn(types.exnFailContractDivisionByZero, '/: division by zero', []) );
}
res = jsnums.divide(res, args[i]);
}
return res;
});
PRIMITIVES['sub1'] =
new PrimProc("sub1",
1,
false, false,
sub1);
PRIMITIVES['add1'] =
new PrimProc("add1",
1,
false, false,
add1);
PRIMITIVES['<'] =
new PrimProc('<',
2,
true, false,
function(x, y, args) {
args.unshift(y);
args.unshift(x);
arrayEach(args, function(z, i) {check(z, isNumber, '<', 'number', i+1, args);});
return compare(args, jsnums.lessThan);
});
PRIMITIVES['>'] =
new PrimProc('>',
2,
true, false,
function(x, y, args) {
args.unshift(y);
args.unshift(x);
arrayEach(args, function(z, i) {check(z, isNumber, '>', 'number', i+1, args);});
return compare(args, jsnums.greaterThan);
});
PRIMITIVES['<='] =
new PrimProc('<=',
2,
true, false,
function(x, y, args) {
args.unshift(y);
args.unshift(x);
arrayEach(args, function(z, i) {check(z, isNumber, '<=', 'number', i+1, args);});
return compare(args, jsnums.lessThanOrEqual);
});
PRIMITIVES['>='] =
new PrimProc('>=',
2,
true, false,
function(x, y, args) {
args.unshift(y);
args.unshift(x);
arrayEach(args, function(z, i) {check(z, isNumber, '>=', 'number', i+1, args);});
return compare(args, jsnums.greaterThanOrEqual);
});
PRIMITIVES['abs'] =
new PrimProc('abs',
1,
false, false,
function(x) {
check(x, isReal, 'abs', 'real', 1);
return jsnums.abs(x);
});
PRIMITIVES['quotient'] =
new PrimProc('quotient',
2,
false, false,
function(x, y) {
check(x, isInteger, 'quotient', 'integer', 1, arguments);
check(y, isInteger, 'quotient', 'integer', 2, arguments);
return jsnums.quotient(x, y);
});
PRIMITIVES['remainder'] =
new PrimProc('remainder',
2,
false, false,
function(x, y) {
check(x, isInteger, 'remainder', 'integer', 1, arguments);
check(y, isInteger, 'remainder', 'integer', 2, arguments);
return jsnums.remainder(x, y);
});
PRIMITIVES['modulo'] =
new PrimProc('modulo',
2,
false, false,
function(x, y) {
check(x, isInteger, 'modulo', 'integer', 1, arguments);
check(y, isInteger, 'modulo', 'integer', 2, arguments);
return jsnums.modulo(x, y);
});
PRIMITIVES['max'] =
new PrimProc('max',
1,
true, false,
function(x, args) {
args.unshift(x);
// check(x, isReal, 'max', 'real', 1, allArgs);
arrayEach(args, function(y, i) {check(y, isReal, 'max', 'real', i+1, args);});
var curMax = x;
for (var i = 1; i < args.length; i++) {
if ( jsnums.greaterThan(args[i], curMax) ) {
curMax = args[i];
}
}
return curMax;
});
PRIMITIVES['min'] =
new PrimProc('min',
1,
true, false,
function(x, args) {
args.unshift(x);
// check(x, isReal, 'min', 'real', 1);
arrayEach(args, function(y, i) {check(y, isReal, 'min', 'real', i+1, args);});
var curMin = x;
for (var i = 1; i < args.length; i++) {
if ( jsnums.lessThan(args[i], curMin) ) {
curMin = args[i];
}
}
return curMin;
});
PRIMITIVES['gcd'] =
new PrimProc('gcd',
1,
true, false,
function(x, args) {
var allArgs = [x].concat(args);
check(x, isInteger, 'gcd', 'integer', 1, allArgs);
arrayEach(args, function(y, i) {check(y, isInteger, 'gcd', 'integer', i+2, allArgs);});
return jsnums.gcd(x, args);
});
PRIMITIVES['lcm'] =
new PrimProc('lcm',
1,
true, false,
function(x, args) {
var allArgs = [x].concat(args);
check(x, isInteger, 'lcm', 'integer', 1, allArgs);
arrayEach(args, function(y, i) {check(y, isInteger, 'lcm', 'integer', i+2, allArgs);});
return jsnums.lcm(x, args);
});
PRIMITIVES['floor'] =
new PrimProc('floor',
1,
false, false,
function(x) {
check(x, isReal, 'floor', 'real', 1);
return jsnums.floor(x);
});
PRIMITIVES['ceiling'] =
new PrimProc('ceiling',
1,
false, false,
function(x) {
check(x, isReal, 'ceiling', 'real', 1);
return jsnums.ceiling(x);
});
PRIMITIVES['round'] =
new PrimProc('round',
1,
false, false,
function(x) {
check(x, isReal, 'round', 'real', 1);
return jsnums.round(x);
});
PRIMITIVES['truncate'] =
new PrimProc('truncate',
1,
false, false,
function(x) {
check(x, isReal, 'truncate', 'real', 1);
if (jsnums.lessThan(x, 0)) {
return jsnums.ceiling(x);
} else {
return jsnums.floor(x);
}
});
PRIMITIVES['numerator'] =
new PrimProc('numerator',
1,
false, false,
function(x) {
check(x, isRational, 'numerator', 'rational number', 1);
return jsnums.numerator(x);
});
PRIMITIVES['denominator'] =
new PrimProc('denominator',
1,
false, false,
function(x) {
check(x, isRational, 'denominator', 'rational number', 1);
return jsnums.denominator(x);
});
PRIMITIVES['expt'] =
new PrimProc("expt",
2,
false, false,
function(x, y) {
check(x, isNumber, 'expt', 'number', 1, arguments);
check(y, isNumber, 'expt', 'number', 2, arguments);
return jsnums.expt(x, y);
});
PRIMITIVES['exp'] =
new PrimProc('exp',
1,
false, false,
function(x) {
check(x, isNumber, 'exp', 'number', 1);
return jsnums.exp(x);
});
PRIMITIVES['log'] =
new PrimProc('log',
1,
false, false,
function(x) {
check(x, isNumber, 'log', 'number', 1);
return jsnums.log(x);
});
PRIMITIVES['sin'] =
new PrimProc('sin',
1,
false, false,
function(x) {
check(x, isNumber, 'sin', 'number', 1);
return jsnums.sin(x);
});
PRIMITIVES['cos'] =
new PrimProc('cos',
1,
false, false,
function(x) {
check(x, isNumber, 'cos', 'number', 1);
return jsnums.cos(x);
});
PRIMITIVES['tan'] =
new PrimProc('tan',
1,
false, false,
function(x) {
check(x, isNumber, 'tan', 'number', 1);
return jsnums.tan(x);
});
PRIMITIVES['asin'] =
new PrimProc('asin',
1,
false, false,
function(x) {
check(x, isNumber, 'asin', 'number', 1);
return jsnums.asin(x);
});
PRIMITIVES['acos'] =
new PrimProc('acos',
1,
false, false,
function(x) {
check(x, isNumber, 'acos', 'number', 1);
return jsnums.acos(x);
});
PRIMITIVES['atan'] =
new CasePrimitive('atan',
[new PrimProc('atan',
1,
false, false,
function(x) {
check(x, isNumber, 'atan', 'number', 1);
return jsnums.atan(x);
}),
new PrimProc('atan',
2,
false, false,
function(x, y) {
check(x, isReal, 'atan', 'number', 1);
check(y, isReal, 'atan', 'number', 1);
return jsnums.makeFloat(
Math.atan2(jsnums.toFixnum(x),
jsnums.toFixnum(y)));
})]);
PRIMITIVES['sinh'] =
new PrimProc('sinh',
1,
false, false,
function(x) {
check(x, isNumber, 'sinh', 'number', 1);
return jsnums.sinh(x);
});
PRIMITIVES['cosh'] =
new PrimProc('cosh',
1,
false, false,
function(x) {
check(x, isNumber, 'cosh', 'number', 1);
return jsnums.cosh(x);
});
PRIMITIVES['sqr'] =
new PrimProc('sqr',
1,
false, false,
function(x) {
check(x, isNumber, 'sqr', 'number', 1);
return jsnums.sqr(x);
});
PRIMITIVES['sqrt'] =
new PrimProc('sqrt',
1,
false, false,
function(x) {
check(x, isNumber, 'sqrt', 'number', 1);
return jsnums.sqrt(x);
});
PRIMITIVES['integer-sqrt'] =
new PrimProc('integer-sqrt',
1,
false, false,
function(x) {
check(x, isInteger, 'integer-sqrt', 'integer', 1);
return jsnums.integerSqrt(x);
});
PRIMITIVES['make-rectangular'] =
new PrimProc('make-rectangular',
2,
false, false,
function(x, y) {
check(x, isReal, 'make-rectangular', 'real', 1, arguments);
check(y, isReal, 'make-rectangular', 'real', 2, arguments);
return types.complex(x, y);
});
PRIMITIVES['make-polar'] =
new PrimProc('make-polar',
2,
false, false,
function(x, y) {
check(x, isReal, 'make-polar', 'real', 1, arguments);
check(x, isReal, 'make-polar', 'real', 2, arguments);
return jsnums.makeComplexPolar(x, y);
});
PRIMITIVES['real-part'] =
new PrimProc('real-part',
1,
false, false,
function(x) {
check(x, isNumber, 'real-part', 'number', 1);
return jsnums.realPart(x);
});
PRIMITIVES['imag-part'] =
new PrimProc('imag-part',
1,
false, false,
function(x) {
check(x, isNumber, 'imag-part', 'number', 1);
return jsnums.imaginaryPart(x);
});
PRIMITIVES['angle'] =
new PrimProc('angle',
1,
false, false,
function(x) {
check(x, isNumber, 'angle', 'number', 1);
return jsnums.angle(x);
});
PRIMITIVES['magnitude'] =
new PrimProc('magnitude',
1,
false, false,
function(x) {
check(x, isNumber, 'magnitude', 'number', 1);
return jsnums.magnitude(x);
});
PRIMITIVES['conjugate'] =
new PrimProc('conjugate',
1,
false, false,
function(x) {
check(x, isNumber, 'conjugate', 'number', 1);
return jsnums.conjugate(x);
});
PRIMITIVES['sgn'] =
new PrimProc('sgn',
1,
false, false,
function(x) {
check(x, isReal, 'sgn', 'real number', 1);
if (jsnums.isInexact(x)) {
if ( jsnums.greaterThan(x, 0) ) {
return jsnums.makeFloat(1);
} else if ( jsnums.lessThan(x, 0) ) {
return jsnums.makeFloat(-1);
} else {
return jsnums.makeFloat(0);
}
} else {
if ( jsnums.greaterThan(x, 0) ) {
return 1;
} else if ( jsnums.lessThan(x, 0) ) {
return -1;
} else {
return 0;
}
}
});
PRIMITIVES['inexact->exact'] =
new PrimProc('inexact->exact',
1,
false, false,
function (x) {
check(x, isNumber, 'inexact->exact', 'number', 1);
try {
return jsnums.toExact(x);
} catch(e) {
raise( types.exnFailContract('inexact->exact: no exact representation for '
+ helpers.toDisplayedString(x),
false) );
}
});
PRIMITIVES['exact->inexact'] =
new PrimProc('exact->inexact',
1,
false, false,
function (x) {
check(x, isNumber, 'exact->inexact', 'number', 1);
return jsnums.toInexact(x);
});
PRIMITIVES['number->string'] =
new PrimProc('number->string',
1,
false, false,
function(x) {
check(x, isNumber, 'number->string', 'number', 1);
return types.string(x.toString());
});
PRIMITIVES['string->number'] =
new PrimProc('string->number',
1,
false, false,
function(str) {
check(str, isString, 'string->number', 'string', 1);
return jsnums.fromString(str.toString());
});
PRIMITIVES['xml->s-exp'] =
new PrimProc('xml->s-exp',
1,
false, false,
function(str) {
check(str, isString, 'xml->s-exp', 'string', 1);
str = str.toString();
if (str.length == 0) {
return types.string('');
}
var xmlDoc;
try {
//Internet Explorer
xmlDoc = new ActiveXObject("Microsoft.XMLDOM");
xmlDoc.async = "false";
xmlDoc.loadXML(s);
// FIXME: check parse errors
}
catch(e) {
var parser = new DOMParser();
xmlDoc = parser.parseFromString(s, "text/xml");
// FIXME: check parse errors
}
var parseAttributes = function(attrs) {
var result = types.EMPTY;
for (var i = 0; i < attrs.length; i++) {
var keyValue = types.cons(types.symbol(attrs.item(i).nodeName),
types.cons(attrs.item(i).nodeValue,
types.EMPTY));
result = types.cons(keyValue, result);
}
return types.cons(types.symbol("@"), result).reverse();
};
var parse = function(node) {
if (node.nodeType == Node.ELEMENT_NODE) {
var result = types.EMPTY;
var child = node.firstChild;
while (child != null) {
var nextResult = parse(child);
if (isString(nextResult) &&
!result.isEmpty() &&
isString(result.first)) {
result = types.cons(result.first + nextResult,
result.rest);
} else {
result = types.cons(nextResult, result);
}
child = child.nextSibling;
}
result = result.reverse();
result = types.cons(parseAttributes(node.attributes),
result);
result = types.cons(
types.symbol(node.nodeName),
result);
return result;
} else if (node.nodeType == Node.TEXT_NODE) {
return node.textContent;
} else if (node.nodeType == Node.CDATA_SECTION_NODE) {
return node.data;
} else {
return types.EMPTY;
}
};
var result = parse(xmlDoc.firstChild);
return result;
});
/******************
*** Predicates ***
******************/
PRIMITIVES['procedure?'] = new PrimProc('procedure?', 1, false, false, isFunction);
PRIMITIVES['pair?'] = new PrimProc('pair?', 1, false, false, isPair);
PRIMITIVES['cons?'] = new PrimProc('cons?', 1, false, false, isPair);
PRIMITIVES['empty?'] = new PrimProc('empty?', 1, false, false, isEmpty);
PRIMITIVES['null?'] = new PrimProc('null?', 1, false, false, isEmpty);
PRIMITIVES['undefined?'] = new PrimProc('undefined?', 1, false, false, function(x) { return x === types.UNDEFINED; });
PRIMITIVES['void?'] = new PrimProc('void?', 1, false, false, function(x) { return x === types.VOID; });
PRIMITIVES['immutable?'] = new PrimProc('immutable?', 1, false, false, isImmutable);
PRIMITIVES['symbol?'] = new PrimProc('symbol?', 1, false, false, isSymbol);
PRIMITIVES['string?'] = new PrimProc('string?', 1, false, false, isString);
PRIMITIVES['char?'] = new PrimProc('char?', 1, false, false, isChar);
PRIMITIVES['boolean?'] = new PrimProc('boolean?', 1, false, false, isBoolean);
PRIMITIVES['vector?'] = new PrimProc('vector?', 1, false, false, isVector);
PRIMITIVES['struct?'] = new PrimProc('struct?', 1, false, false, types.isStruct);
PRIMITIVES['eof-object?'] = new PrimProc('eof-object?', 1, false, false, function(x) { return x === types.EOF; });
PRIMITIVES['posn?'] = new PrimProc('posn?', 1, false, false, types.isPosn);
PRIMITIVES['bytes?'] = new PrimProc('bytes?', 1, false, false, isByteString);
PRIMITIVES['byte?'] = new PrimProc('byte?', 1, false, false, isByte);
PRIMITIVES['number?'] = new PrimProc('number?', 1, false, false, isNumber);
PRIMITIVES['complex?'] = new PrimProc('complex?', 1, false, false, isComplex);
PRIMITIVES['real?'] = new PrimProc('real?', 1, false, false, isReal);
PRIMITIVES['rational?'] = new PrimProc('rational?', 1, false, false, isRational);
PRIMITIVES['integer?'] = new PrimProc('integer?', 1, false, false, isInteger);
PRIMITIVES['exact?'] =
new PrimProc('exact?', 1, false, false,
function(x) {
check(x, isNumber, 'exact?', 'number', 1);
return jsnums.isExact(x);
});
PRIMITIVES['inexact?'] =
new PrimProc('inexact?', 1, false, false,
function(x) {
check(x, isNumber, 'inexact?', 'number', 1);
return jsnums.isInexact(x);
});
PRIMITIVES['odd?'] =
new PrimProc('odd?',
1,
false, false,
function(x) {
check(x, isInteger, 'odd?', 'integer', 1);
return jsnums.equals(jsnums.modulo(x, 2), 1);
});
PRIMITIVES['even?'] =
new PrimProc('even?',
1,
false, false,
function(x) {
check(x, isInteger, 'even?', 'integer', 1);
return jsnums.equals(jsnums.modulo(x, 2), 0);
});
PRIMITIVES['zero?'] =
new PrimProc("zero?",
1,
false, false,
function(x) {
return jsnums.equals(0, x)
});
PRIMITIVES['positive?'] =
new PrimProc('positive?',
1,
false, false,
function(x) {
check(x, isReal, 'positive?', 'real', 1);
return jsnums.greaterThan(x, 0);
});
PRIMITIVES['negative?'] =
new PrimProc('negative?',
1,
false, false,
function(x) {
check(x, isReal, 'negative?', 'real', 1);
return jsnums.lessThan(x, 0);
});
PRIMITIVES['box?'] = new PrimProc('box?', 1, false, false, isBox);
PRIMITIVES['hash?'] = new PrimProc('hash?', 1, false, false, isHash);
PRIMITIVES['eq?'] = new PrimProc('eq?', 2, false, false, isEq);
PRIMITIVES['eqv?'] = new PrimProc('eqv?', 2, false, false, isEqv);
PRIMITIVES['equal?'] = new PrimProc('equal?', 2, false, false, isEqual);
PRIMITIVES['equal~?'] =
new PrimProc('equal~?',
3,
false, false,
function(x, y, range) {
check(range, isNonNegativeReal, 'equal~?', 'non-negative-real', 3, arguments);
return (isEqual(x, y) ||
(isReal(x) && isReal(y) &&
jsnums.lessThanOrEqual(jsnums.abs(jsnums.subtract(x, y)), range)));
});
PRIMITIVES['false?'] = new PrimProc('false?', 1, false, false, function(x) { return x === false; });
PRIMITIVES['boolean=?'] =
new PrimProc('boolean=?',
2,
false, false,
function(x, y) {
check(x, isBoolean, 'boolean=?', 'boolean', 1, arguments);
check(y, isBoolean, 'boolean=?', 'boolean', 2, arguments);
return x === y;
});
PRIMITIVES['symbol=?'] =
new PrimProc('symbol=?',
2,
false, false,
function(x, y) {
check(x, isSymbol, 'symbol=?', 'symbol', 1, arguments);
check(y, isSymbol, 'symbol=?', 'symbol', 2, arguments);
return isEqual(x, y);
});
PRIMITIVES['js-value?'] = new PrimProc('js-value?', 1, false, false, isJsValue);
PRIMITIVES['js-object?'] = new PrimProc('js-object?', 1, false, false, isJsObject);
PRIMITIVES['js-function?'] = new PrimProc('js-function?', 1, false, false, isJsFunction);
/***********************
*** List Primitives ***
***********************/
PRIMITIVES['cons'] =
new PrimProc('cons',
2,
false, false,
function(f, r) {
// checkList(r, "cons", 2);
return types.cons(f, r);
});
PRIMITIVES['car'] =
new PrimProc('car',
1,
false, false,
function(lst) {
check(lst, isPair, 'car', 'pair', 1);
return lst.first;
});
PRIMITIVES['cdr'] =
new PrimProc('cdr',
1,
false, false,
function (lst) {
check(lst, isPair, 'cdr', 'pair', 1);
return lst.rest;
});
PRIMITIVES['caar'] =
new PrimProc('caar',
1,
false, false,
function(lst) {
check(lst, function(x) { return (isPair(x) && isPair(x.first)); },
'caar', 'caarable value', 1);
return lst.first.first;
});
PRIMITIVES['cadr'] =
new PrimProc('cadr',
1,
false, false,
function(lst) {
check(lst, function(x) { return isPair(x) && isPair(x.rest); },
'cadr', 'cadrable value', 1);
return lst.rest.first;
});
PRIMITIVES['cdar'] =
new PrimProc('cdar',
1,
false, false,
function(lst) {
check(lst, function(x) { return isPair(x) && isPair(x.first); },
'cdar', 'cdarable value', 1);
return lst.first.rest;
});
PRIMITIVES['cddr'] =
new PrimProc('cddr',
1,
false, false,
function(lst) {
check(lst, function(x) { return isPair(x) && isPair(x.rest); },
'cddr', 'cddrable value', 1);
return lst.rest.rest;
});
PRIMITIVES['caaar'] =
new PrimProc('caaar',
1,
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
isPair(x.first) &&
isPair(x.first.first) ); },
'caaar', 'caaarable value', 1);
return lst.first.first.first;
});
PRIMITIVES['caadr'] =
new PrimProc('caadr',
1,
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
isPair(x.rest) &&
isPair(x.rest.first) ); },
'caadr', 'caadrable value', 1);
return lst.rest.first.first;
});
PRIMITIVES['cadar'] =
new PrimProc('cadar',
1,
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
isPair(x.first) &&
isPair(x.first.rest) ); },
'cadar', 'cadarable value', 1);
return lst.first.rest.first;
});
PRIMITIVES['cdaar'] =
new PrimProc('cdaar',
1,
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
isPair(x.first) &&
isPair(x.first.first) ); },
'cdaar', 'cdaarable value', 1);
return lst.first.first.rest;
});
PRIMITIVES['cdadr'] =
new PrimProc('cdadr',
1,
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
isPair(x.rest) &&
isPair(x.rest.first) ); },
'cdadr', 'cdadrable value', 1);
return lst.rest.first.rest;
});
PRIMITIVES['cddar'] =
new PrimProc('cddar',
1,
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
isPair(x.first) &&
isPair(x.first.rest) ); },
'cddar', 'cddarable value', 1);
return lst.first.rest.rest;
});
PRIMITIVES['caddr'] =
new PrimProc('caddr',
1,
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
isPair(x.rest) &&
isPair(x.rest.rest) ); },
'caddr', 'caddrable value', 1);
return lst.rest.rest.first;
});
PRIMITIVES['cdddr'] =
new PrimProc('cdddr',
1,
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
isPair(x.rest) &&
isPair(x.rest.rest) ); },
'cdddr', 'cdddrable value', 1);
return lst.rest.rest.rest;
});
PRIMITIVES['cadddr'] =
new PrimProc('cadddr',
1,
false, false,
function(lst) {
check(lst, function(x) { return ( isPair(x) &&
isPair(x.rest) &&
isPair(x.rest.rest) &&
isPair(x.rest.rest.rest) ); },
'cadddr', 'cadddrable value', 1);
return lst.rest.rest.rest.first;
});
PRIMITIVES['rest'] =
new PrimProc('rest',
1,
false, false,
function(lst) {
check(lst, function(x) { return isList(x) && !isEmpty(x); },
'rest', 'non-empty list', 1);
return lst.rest;
});
PRIMITIVES['first'] =
new PrimProc('first',
1,
false, false,
function(lst) {
check(lst, function(x) { return isList(x) && !isEmpty(x); },
'first', 'non-empty list', 1);
return lst.first;
});
PRIMITIVES['second'] =
new PrimProc('second',
1,
false, false,
function(lst) {
checkListOfLength(lst, 2, 'second', 1);
return lst.rest.first;
});
PRIMITIVES['third'] =
new PrimProc('third',
1,
false, false,
function(lst) {
checkListOfLength(lst, 3, 'third', 1);
return lst.rest.rest.first;
});
PRIMITIVES['fourth'] =
new PrimProc('fourth',
1,
false, false,
function(lst) {
checkListOfLength(lst, 4, 'fourth', 1);
return lst.rest.rest.rest.first;
});
PRIMITIVES['fifth'] =
new PrimProc('fifth',
1,
false, false,
function(lst) {
checkListOfLength(lst, 5, 'fifth', 1);
return lst.rest.rest.rest.rest.first;
});
PRIMITIVES['sixth'] =
new PrimProc('sixth',
1,
false, false,
function(lst) {
checkListOfLength(lst, 6, 'sixth', 1);
return lst.rest.rest.rest.rest.rest.first;
});
PRIMITIVES['seventh'] =
new PrimProc(
'seventh',
1,
false, false,
function(lst) {
checkListOfLength(lst, 7, 'seventh', 1);
return lst.rest.rest.rest.rest.rest.rest.first;
});
PRIMITIVES['eighth'] =
new PrimProc('eighth',
1,
false, false,
function(lst) {
checkListOfLength(lst, 8, 'eighth', 1);
return lst.rest.rest.rest.rest.rest.rest.rest.first;
});
PRIMITIVES['length'] =
new PrimProc('length',
1,
false, false,
function(lst) {
return jsnums.makeRational(length(lst));
});
PRIMITIVES['list?'] = new PrimProc('list?', 1, false, false, isList);
PRIMITIVES['list'] =
new PrimProc('list',
0,
true, false,
types.list);
PRIMITIVES['list*'] =
new PrimProc('list*',
1,
true, false,
function(anItem, otherItems) {
if (otherItems.length == 0) {
return anItem;
}
var allArgs = [anItem].concat(otherItems);
var result = allArgs[allArgs.length - 1];
for (var i = allArgs.length - 2 ; i >= 0; i--) {
result = types.cons(allArgs[i], result);
}
return result;
// var lastListItem = otherItems.pop();
// checkList(lastListItem, 'list*', otherItems.length+2, allArgs);
// otherItems.unshift(anItem);
// return append([types.list(otherItems), lastListItem]);
});
PRIMITIVES['list-ref'] =
new PrimProc('list-ref',
2,
false, false,
function(origList, num) {
check(num, isNatural, 'list-ref', 'non-negative exact integer', 2, arguments);
var lst = origList;
var n = jsnums.toFixnum(num);
for (var i = 0; i < n; i++) {
// According to the documentation of list-ref, we don't actually
// check the whole thing as a list. We rather do it as we walk
// along the cons chain.
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('list-ref: index ' + n +
' is too large for list (not a proper list): ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
if (lst.isEmpty()) {
var msg = ('list-ref: index ' + n +
' is too large for list: ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
lst = lst.rest;
}
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('list-ref: index ' + n +
' is too large for list (not a proper list): ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
return lst.first;
});
PRIMITIVES['list-tail'] =
new PrimProc('list-tail',
2,
false, false,
function(origList, num) {
check(num, isNatural, 'list-tail', 'non-negative exact integer', 2, arguments);
var lst = origList;
var n = jsnums.toFixnum(num);
for (var i = 0; i < n; i++) {
// According to the documentation of list-tail, we don't actually
// check the whole thing as a list. We rather do it as we walk
// along the cons chain.
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('list-tail: index ' + n +
' is too large for list (not a proper list): ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
if (lst.isEmpty()) {
var msg = ('list-tail: index ' + n +
' is too large for list: ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
lst = lst.rest;
}
return lst;
});
PRIMITIVES['append'] =
new PrimProc('append',
0,
true, false,
append);
PRIMITIVES['reverse'] =
new PrimProc('reverse',
1,
false, false,
function(lst) {
checkList(lst, 'reverse', 1);
return lst.reverse();
});
PRIMITIVES['map'] =
new PrimProc('map',
2,
true, false,
function(f, lst, arglists) {
var allArgs = [f, lst].concat(arglists);
arglists.unshift(lst);
check(f, isFunction, 'map', 'procedure', 1, allArgs);
arrayEach(arglists, function(x, i) {checkList(x, 'map', i+2, allArgs);});
checkAllSameLength(arglists, 'map', allArgs);
check(f, procArityContains(arglists.length), 'map', 'procedure (arity ' + arglists.length + ')', 1, allArgs);
var mapHelp = function(f, args, acc) {
if (args[0].isEmpty()) {
return acc.reverse();
}
var argsFirst = [];
var argsRest = [];
for (var i = 0; i < args.length; i++) {
argsFirst.push(args[i].first);
argsRest.push(args[i].rest);
}
var result = CALL(f, argsFirst,
function(result) {
return onSingleResult(result,
function(result) {
return mapHelp(f, argsRest, types.cons(result, acc));
});
});
return result;
}
return mapHelp(f, arglists, types.EMPTY);
});
PRIMITIVES['andmap'] =
new PrimProc('andmap',
2,
true, false,
function(f, lst, arglists) {
var allArgs = [f, lst].concat(arglists);
arglists.unshift(lst);
check(f, isFunction, 'andmap', 'procedure', 1, allArgs);
arrayEach(arglists, function(x, i) {checkList(x, 'andmap', i+2, allArgs);});
checkAllSameLength(arglists, 'andmap', allArgs);
check(f, procArityContains(arglists.length), 'andmap', 'procedure (arity ' + arglists.length + ')', 1, allArgs);
var andmapHelp = function(f, args) {
if ( args[0].isEmpty() ) {
return true;
}
var argsFirst = [];
var argsRest = [];
for (var i = 0; i < args.length; i++) {
argsFirst.push(args[i].first);
argsRest.push(args[i].rest);
}
return CALL(f, argsFirst,
function(result) {
if (argsRest[0].isEmpty()) {
return result;
}
return onSingleResult(result,
function(result) {
return result && andmapHelp(f, argsRest);
});
});
}
return andmapHelp(f, arglists);
});
PRIMITIVES['ormap'] =
new PrimProc('ormap',
2,
true, false,
function(f, lst, arglists) {
var allArgs = [f, lst].concat(arglists);
arglists.unshift(lst);
check(f, isFunction, 'ormap', 'procedure', 1, allArgs);
arrayEach(arglists, function(x, i) {checkList(x, 'ormap', i+2, allArgs);});
checkAllSameLength(arglists, 'ormap', allArgs);
check(f, procArityContains(arglists.length), 'ormap', 'procedure (arity ' + arglists.length + ')', 1, allArgs);
var ormapHelp = function(f, args) {
if ( args[0].isEmpty() ) {
return false;
}
var argsFirst = [];
var argsRest = [];
for (var i = 0; i < args.length; i++) {
argsFirst.push(args[i].first);
argsRest.push(args[i].rest);
}
return CALL(f, argsFirst,
function(result) {
if (argsRest[0].isEmpty()) {
return result;
}
return onSingleResult(
result,
function(result) {
return result || ormapHelp(f, argsRest);
});
});
}
return ormapHelp(f, arglists);
});
PRIMITIVES['memq'] =
new PrimProc('memq',
2,
false, false,
function(item, origList) {
var lst = origList;
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('memq: not a proper list: ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
while ( !lst.isEmpty() ) {
if ( isEq(item, lst.first) ) {
return lst;
}
lst = lst.rest;
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('memq: not a proper list: ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
}
return false;
});
PRIMITIVES['memv'] =
new PrimProc('memv',
2,
false, false,
function(item, origList) {
var lst = origList;
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('memv: not a proper list: ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
while ( !lst.isEmpty() ) {
if ( isEqv(item, lst.first) ) {
return lst;
}
lst = lst.rest;
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('memv: not a proper list: ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
}
return false;
});
PRIMITIVES['member'] =
new PrimProc('member',
2,
false, false,
function(item, origList) {
var lst = origList;
//checkList(lst, 'member', 2, arguments);
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('member: not a proper list: ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
while ( !lst.isEmpty() ) {
if ( isEqual(item, lst.first) ) {
return lst;
}
lst = lst.rest;
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('member: not a proper list: ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
}
return false;
});
PRIMITIVES['memf'] =
new PrimProc('memf',
2,
false, false,
function(f, initList) {
check(f, isFunction, 'memf', 'procedure', 1, arguments);
checkList(initList, 'memf', 2, arguments);
var memfHelp = function(lst) {
if ( lst.isEmpty() ) {
return false;
}
return CALL(f, [lst.first],
function(result) {
if (result) {
return lst;
}
return memfHelp(lst.rest);
});
}
return memfHelp(initList);
});
PRIMITIVES['assq'] =
new PrimProc('assq',
2,
false, false,
function(item, origList) {
var lst = origList;
// checkListOf(lst, isPair, 'assq', 'pair', 2, arguments);
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('assq: not a proper list: ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
while ( !lst.isEmpty() ) {
if (! isPair(lst.first)) {
var msg = ('assq: non-pair found in list: ' +
helpers.toDisplayedString(lst.first) +' in ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
if ( isEq(item, lst.first.first) ) {
return lst.first;
}
lst = lst.rest;
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('assq: not a proper list: ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
}
return false;
});
PRIMITIVES['assv'] =
new PrimProc('assv',
2,
false, false,
function(item, origList) {
//checkListOf(lst, isPair, 'assv', 'pair', 2, arguments);
var lst = origList;
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('assv: not a proper list: ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
while ( !lst.isEmpty() ) {
if (! isPair(lst.first)) {
var msg = ('assv: non-pair found in list: ' +
helpers.toDisplayedString(lst.first) +' in ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
if ( isEqv(item, lst.first.first) ) {
return lst.first;
}
lst = lst.rest;
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('assv: not a proper list: ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
}
return false;
});
PRIMITIVES['assoc'] =
new PrimProc('assoc',
2,
false, false,
function(item, origList) {
var lst = origList;
//checkListOf(lst, isPair, 'assoc', 'pair', 2, arguments);
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('assoc: not a proper list: ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
while ( !lst.isEmpty() ) {
if (! isPair(lst.first)) {
var msg = ('assoc: non-pair found in list: ' +
helpers.toDisplayedString(lst.first) +' in ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
if ( isEqual(item, lst.first.first) ) {
return lst.first;
}
lst = lst.rest;
if (! isPair(lst) && lst !== types.EMPTY) {
var msg = ('assoc: not a proper list: ' +
helpers.toDisplayedString(origList));
raise( types.incompleteExn(types.exnFailContract,
msg,
[]) );
}
}
return false;
});
PRIMITIVES['remove'] =
new PrimProc('remove',
2,
false, false,
function(item, lst) {
checkList(lst, 'remove', 2, arguments);
var originalLst = lst;
var result = types.EMPTY;
while ( !lst.isEmpty() ) {
if ( isEqual(item, lst.first) ) {
return append([result.reverse(), lst.rest]);
} else {
result = types.cons(lst.first, result);
lst = lst.rest;
}
}
return originalLst;
});
PRIMITIVES['filter'] =
new PrimProc('filter',
2,
false, false,
function(f, lst) {
check(f, procArityContains(1), 'filter', 'procedure (arity 1)', 1, arguments);
checkList(lst, 'filter', 2);
var filterHelp = function(f, lst, acc) {
if ( lst.isEmpty() ) {
return acc.reverse();
}
return CALL(f, [lst.first],
function(result) {
if (result) {
return filterHelp(f, lst.rest,
types.cons(lst.first, acc));
}
else {
return filterHelp(f, lst.rest, acc);
}
});
}
return filterHelp(f, lst, types.EMPTY);
});
PRIMITIVES['foldl'] =
new PrimProc('foldl',
3,
true, false,
function(f, initAcc, lst, arglists) {
arglists.unshift(lst);
var allArgs = [f, initAcc].concat(arglists);
check(f, isFunction, 'foldl', 'procedure', 1, allArgs);
arrayEach(arglists, function(x, i) {checkList(x, 'foldl', i+3, allArgs);});
checkAllSameLength(arglists, 'foldl', allArgs);
return foldHelp(f, initAcc, arglists);
});
PRIMITIVES['foldr'] =
new PrimProc('foldr',
3,
true, false,
function(f, initAcc, lst, arglists) {
arglists.unshift(lst);
var allArgs = [f, initAcc].concat(arglists);
check(f, isFunction, 'foldr', 'procedure', 1, allArgs);
arrayEach(arglists, function(x, i) {checkList(x, 'foldr', i+3, allArgs);});
checkAllSameLength(arglists, 'foldr', allArgs);
for (var i = 0; i < arglists.length; i++) {
arglists[i] = arglists[i].reverse();
}
return foldHelp(f, initAcc, arglists);
});
PRIMITIVES['quicksort'] = new PrimProc('quicksort', 2, false, false, quicksort('quicksort'));
PRIMITIVES['sort'] = new PrimProc('sort', 2, false, false, quicksort('sort'));
PRIMITIVES['argmax'] =
new PrimProc('argmax',
2,
false, false,
function(f, initList) {
var args = arguments
check(f, isFunction, 'argmax', 'procedure', 1, args);
check(initList, isPair, 'argmax', 'non-empty list', 2, args);
var argmaxHelp = function(lst, curMaxVal, curMaxElt) {
if ( lst.isEmpty() ) {
return curMaxElt;
}
return CALL(f, [lst.first],
function(result) {
check(result, isReal, 'argmax',
'procedure that returns real numbers', 1, args);
if (jsnums.greaterThan(result, curMaxVal)) {
return argmaxHelp(lst.rest, result, lst.first);
}
else {
return argmaxHelp(lst.rest, curMaxVal, curMaxElt);
}
});
}
return CALL(f, [initList.first],
function(result) {
check(result, isReal, 'argmax', 'procedure that returns real numbers', 1, args);
return argmaxHelp(initList.rest, result, initList.first);
});
});
PRIMITIVES['argmin'] =
new PrimProc('argmin',
2,
false, false,
function(f, initList) {
var args = arguments;
check(f, isFunction, 'argmin', 'procedure', 1, args);
check(initList, isPair, 'argmin', 'non-empty list', 2, args);
var argminHelp = function(lst, curMaxVal, curMaxElt) {
if ( lst.isEmpty() ) {
return curMaxElt;
}
return CALL(f, [lst.first],
function(result) {
check(result, isReal, 'argmin',
'procedure that returns real numbers', 1, args);
if (jsnums.lessThan(result, curMaxVal)) {
return argminHelp(lst.rest, result, lst.first);
}
else {
return argminHelp(lst.rest, curMaxVal, curMaxElt);
}
});
}
return CALL(f, [initList.first],
function(result) {
check(result, isReal, 'argmin', 'procedure that returns real numbers', 1, args);
return argminHelp(initList.rest, result, initList.first);
});
});
PRIMITIVES['build-list'] =
new PrimProc('build-list',
2,
false, false,
function(num, f) {
check(num, isNatural, 'build-list', 'non-negative exact integer', 1, arguments);
check(f, isFunction, 'build-list', 'procedure', 2, arguments);
var buildListHelp = function(n, acc) {
if ( jsnums.greaterThanOrEqual(n, num) ) {
return acc.reverse();
}
return CALL(f, [n],
function (result) {
return buildListHelp(n+1, types.cons(result, acc));
});
}
return buildListHelp(0, types.EMPTY);
});
/**********************
*** Box Primitives ***
**********************/
PRIMITIVES['box'] = new PrimProc('box', 1, false, false, types.box);
PRIMITIVES['box-immutable'] = new PrimProc('box-immutable', 1, false, false, types.boxImmutable);
PRIMITIVES['unbox'] =
new PrimProc('unbox',
1,
false, false,
function(box) {
check(box, isBox, 'unbox', 'box', 1);
return box.ref();
});
PRIMITIVES['set-box!'] =
new PrimProc('set-box!',
2,
false, false,
function(box, newVal) {
check(box, function(x) { return isBox(x) && x.mutable; }, 'set-box!', 'mutable box', 1, arguments);
box.set(newVal);
return types.VOID;
});
/****************************
*** Hashtable Primitives ***
****************************/
PRIMITIVES['make-hash'] =
new CasePrimitive('make-hash',
[new PrimProc('make-hash', 0, false, false, function() { return types.hash(types.EMPTY); }),
new PrimProc('make-hash',
1,
false, false,
function(lst) {
checkListOf(lst, isPair, 'make-hash', 'list of pairs', 1);
return types.hash(lst);
}) ]);
PRIMITIVES['make-hasheq'] =
new CasePrimitive('make-hasheq',
[new PrimProc('make-hasheq', 0, false, false, function() { return types.hashEq(types.EMPTY); }),
new PrimProc('make-hasheq',
1,
false, false,
function(lst) {
checkListOf(lst, isPair, 'make-hasheq', 'list of pairs', 1);
return types.hashEq(lst);
}) ]);
PRIMITIVES['hash-set!'] =
new PrimProc('hash-set!',
3,
false, false,
function(obj, key, val) {
check(obj, isHash, 'hash-set!', 'hash', 1, arguments);
obj.hash.put(key, val);
return types.VOID;
});
PRIMITIVES['hash-ref'] =
new CasePrimitive('hash-ref',
[new PrimProc('hash-ref',
2,
false, false,
function(obj, key) {
check(obj, isHash, 'hash-ref', 'hash', 1, arguments);
if ( !obj.hash.containsKey(key) ) {
var msg = 'hash-ref: no value found for key: ' + helpers.toDisplayedString(key);
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
return obj.hash.get(key);
}),
new PrimProc('hash-ref',
3,
false, false,
function(obj, key, defaultVal) {
check(obj, isHash, 'hash-ref', 'hash', 1, arguments);
if (obj.hash.containsKey(key)) {
return obj.hash.get(key);
}
else {
if (isFunction(defaultVal)) {
return CALL(defaultVal, [], id);
}
return defaultVal;
}
}) ]);
PRIMITIVES['hash-remove!'] =
new PrimProc('hash-remove',
2,
false, false,
function(obj, key) {
check(obj, isHash, 'hash-remove!', 'hash', 1, arguments);
obj.hash.remove(key);
return types.VOID;
});
PRIMITIVES['hash-map'] =
new PrimProc('hash-map',
2,
false, false,
function(ht, f) {
check(ht, isHash, 'hash-map', 'hash', 1, arguments);
check(f, isFunction, 'hash-map', 'procedure', 2, arguments);
var keys = ht.hash.keys();
var hashMapHelp = function(i, acc) {
if (i >= keys.length) {
return acc;
}
var val = ht.hash.get(keys[i]);
return CALL(f, [keys[i], val],
function(result) {
return hashMapHelp(i+1, types.cons(result, acc));
});
}
return hashMapHelp(0, types.EMPTY);
});
PRIMITIVES['hash-for-each'] =
new PrimProc('hash-for-each',
2,
false, false,
function(ht, f) {
check(ht, isHash, 'hash-for-each', 'hash', 1, arguments);
check(f, isFunction, 'hash-for-each', 'procedure', 2, arguments);
var keys = ht.hash.keys();
var hashForEachHelp = function(i) {
if (i >= keys.length) {
return types.VOID;
}
var val = ht.hash.get(keys[i]);
return CALL(f, [keys[i], val],
function(result) {
return hashForEachHelp(i+1);
});
}
return hashForEachHelp(0);
});
/*************************
*** String Primitives ***
*************************/
var makeStringImpl = function(n, c) {
check(n, isNatural, 'make-string', 'non-negative exact integer', 1, arguments);
check(c, isChar, 'make-string', 'char', 2, arguments);
var ret = [];
for (var i = 0; jsnums.lessThan(i, n); i++) {
ret.push(c.val);
}
return types.string(ret);
};
PRIMITIVES['make-string'] =
new CasePrimitive(
'make-string',
[new PrimProc('make-string',
2,
false, false,
makeStringImpl),
new PrimProc('make-string',
1,
false, false,
function(n) {
return makeStringImpl(n, types.character(String.fromCharCode(0)));
})]);
PRIMITIVES['replicate'] =
new PrimProc('replicate',
2,
false, false,
function(n, str) {
check(n, isNatural, 'replicate', 'non-negative exact integer', 1, arguments);
check(str, isString, 'replicate', 'string', 2, arguments);
var ret = "";
var primStr = str.toString();
for (var i = 0; jsnums.lessThan(i, n); i++) {
ret += primStr;
}
return types.string(ret);
});
PRIMITIVES['string'] =
new PrimProc('string',
0,
true, false,
function(chars) {
arrayEach(chars, function(c, i) {check(c, isChar, 'string', 'char', i+1, chars);});
var ret = [];
for (var i = 0; i < chars.length; i++) {
ret.push(chars[i].val);
}
return types.string(ret);
});
PRIMITIVES['string-length'] =
new PrimProc('string-length', 1, false, false,
function(str) {
check(str, isString, 'string-length', 'string', 1);
return str.toString().length;
});
PRIMITIVES['string-ref'] =
new PrimProc('string-ref',
2,
false, false,
function(str, num) {
check(str, isString, 'string-ref', 'string', 1, arguments);
check(num, isNatural, 'string-ref', 'non-negative exact integer', 2, arguments);
str = str.toString();
var n = jsnums.toFixnum(num);
if (n >= str.length) {
var msg = ('string-ref: index ' + n + ' out of range ' +
'[0, ' + (str.length-1) + '] for string: ' +
helpers.toDisplayedString(str));
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
return types.character(str.charAt(n));
});
PRIMITIVES['string=?'] =
new PrimProc('string=?',
2,
true, false,
function(str1, str2, strs) {
strs.unshift(str2);
strs.unshift(str1);
arrayEach(strs, function(str, i) {check(str, isString, 'string=?', 'string', i+1, strs);});
return compare(strs, function(strA, strB) {return strA.toString() === strB.toString();});
});
PRIMITIVES['string-ci=?'] =
new PrimProc('string-ci=?',
2,
true, false,
function(str1, str2, strs) {
strs.unshift(str2);
strs.unshift(str1);
for(var i = 0; i < strs.length; i++) {
check(strs[i], isString, 'string-ci=?', 'string', i+1, strs);
strs[i] = strs[i].toString().toLowerCase();
}
return compare(strs, function(strA, strB) {return strA === strB;});
});
PRIMITIVES['string<?'] =
new PrimProc('string<?',
2,
true, false,
function(str1, str2, strs) {
strs.unshift(str2);
strs.unshift(str1);
arrayEach(strs, function(str, i) {check(str, isString, 'string<?', 'string', i+1, strs);});
return compare(strs, function(strA, strB) {return strA.toString() < strB.toString();});
});
PRIMITIVES['string>?'] =
new PrimProc('string>?',
2,
true, false,
function(str1, str2, strs) {
strs.unshift(str2);
strs.unshift(str1);
arrayEach(strs, function(str, i) {check(str, isString, 'string>?', 'string', i+1, strs);});
return compare(strs, function(strA, strB) {return strA.toString() > strB.toString();});
});
PRIMITIVES['string<=?'] =
new PrimProc('string<=?',
2,
true, false,
function(str1, str2, strs) {
strs.unshift(str2);
strs.unshift(str1);
arrayEach(strs, function(str, i) {check(str, isString, 'string<=?', 'string', i+1, strs);});
return compare(strs, function(strA, strB) {return strA.toString() <= strB.toString();});
});
PRIMITIVES['string>=?'] =
new PrimProc('string>=?',
2,
true, false,
function(str1, str2, strs) {
strs.unshift(str2);
strs.unshift(str1);
arrayEach(strs, function(str, i) {check(str, isString, 'string>=?', 'string', i+1, strs);});
return compare(strs, function(strA, strB) {return strA.toString() >= strB.toString();});
});
PRIMITIVES['string-ci<?'] =
new PrimProc('string-ci<?',
2,
true, false,
function(str1, str2, strs) {
strs.unshift(str2);
strs.unshift(str1);
for (var i = 0; i < strs.length; i++) {
check(strs[i], isString, 'string-ci<?', 'string', i+1, strs);
strs[i] = strs[i].toString().toLowerCase();
}
return compare(strs, function(strA, strB) {return strA < strB;});
});
PRIMITIVES['string-ci>?'] =
new PrimProc('string-ci>?',
2,
true, false,
function(str1, str2, strs) {
strs.unshift(str2);
strs.unshift(str1);
for (var i = 0; i < strs.length; i++) {
check(strs[i], isString, 'string-ci>?', 'string', i+1, strs);
strs[i] = strs[i].toString().toLowerCase();
}
return compare(strs, function(strA, strB) {return strA > strB;});
});
PRIMITIVES['string-ci<=?'] =
new PrimProc('string-ci<=?',
2,
true, false,
function(str1, str2, strs) {
strs.unshift(str2);
strs.unshift(str1);
for (var i = 0; i < strs.length; i++) {
check(strs[i], isString, 'string-ci<=?', 'string', i+1, strs);
strs[i] = strs[i].toString().toLowerCase();
}
return compare(strs, function(strA, strB) {return strA <= strB;});
});
PRIMITIVES['string-ci>=?'] =
new PrimProc('string-ci>=?',
2,
true, false,
function(str1, str2, strs) {
strs.unshift(str2);
strs.unshift(str1);
for (var i = 0; i < strs.length; i++) {
check(strs[i], isString, 'string-ci>=?', 'string', i+1, strs);
strs[i] = strs[i].toString().toLowerCase();
}
return compare(strs, function(strA, strB) {return strA >= strB;});
});
PRIMITIVES['substring'] =
new CasePrimitive('substring',
[new PrimProc('substring',
2,
false, false,
function(str, theStart) {
check(str, isString, 'substring', 'string', 1, arguments);
check(theStart, isNatural, 'substring', 'non-negative exact integer', 2, arguments);
str = str.toString();
var start = jsnums.toFixnum(theStart);
if (start > str.length) {
var msg = ('substring: starting index ' + start + ' out of range ' +
'[0, ' + str.length + '] for string: ' + helpers.toDisplayedString(str));
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
else {
return types.string( str.substring(jsnums.toFixnum(start)) );
}
}),
new PrimProc('substring',
3,
false, false,
function(str, theStart, theEnd) {
check(str, isString, 'substring', 'string', 1, arguments);
check(theStart, isNatural, 'substring', 'non-negative exact integer', 2, arguments);
check(theEnd, isNatural, 'substring', 'non-negative exact integer', 3, arguments);
str = str.toString();
var start = jsnums.toFixnum(theStart);
var end = jsnums.toFixnum(theEnd);
if (start > str.length) {
var msg = ('substring: starting index ' + start + ' out of range ' +
'[0, ' + str.length + '] for string: ' + helpers.toDisplayedString(str));
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
if (end < start || end > str.length) {
var msg = ('substring: ending index ' + end + ' out of range ' + '[' + start +
', ' + str.length + '] for string: ' + helpers.toDisplayedString(str));
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
return types.string( str.substring(start, end) );
}) ]);
PRIMITIVES['string-append'] =
new PrimProc("string-append",
0,
true, false,
function(args) {
arrayEach(args,
function(str, i) {
check(str, isString, 'string-append', 'string', i+1, args);
});
for (var i = 0; i < args.length; i++) {
args[i] = args[i].toString();
}
return types.string(args.join(""));
});
PRIMITIVES['string->list'] =
new PrimProc('string->list',
1,
false, false,
function(str) {
check(str, isString, 'string->list', 'string', 1);
str = str.toString();
var lst = types.EMPTY;
for (var i = str.length-1; i >= 0; i--) {
lst = types.cons(types.character(str.charAt(i)), lst);
}
return lst;
});
PRIMITIVES['list->string'] =
new PrimProc('list->string',
1,
false, false,
function(lst) {
checkListOf(lst, isChar, 'list->string', 'char', 1);
var ret = [];
while( !lst.isEmpty() ) {
ret.push(lst.first.val);
lst = lst.rest;
}
return types.string(ret);
});
PRIMITIVES['string-copy'] =
new PrimProc('string-copy',
1,
false, false,
function(str) {
check(str, isString, 'string-copy', 'string', 1);
return types.string(str.toString());
});
PRIMITIVES['string->symbol'] =
new PrimProc('string->symbol',
1,
false, false,
function(str) {
check(str, isString, 'string->symbol', 'string', 1);
return types.symbol(str.toString());
});
PRIMITIVES['symbol->string'] =
new PrimProc('symbol->string',
1,
false, false,
function(symb) {
check(symb, isSymbol, 'symbol->string', 'symbol', 1);
return types.string(symb.toString());
});
PRIMITIVES['format'] =
new PrimProc('format', 1, true, false,
function(formatStr, args) {
check(formatStr, isString, 'format', 'string', 1, [formatStr].concat(args));
formatStr = formatStr.toString();
return types.string( helpers.format(formatStr, args, 'format') );
});
PRIMITIVES['printf'] =
new PrimProc('printf', 1, true, true,
function(state, formatStr, args) {
check(formatStr, isString, 'printf', 'string', 1, [formatStr].concat(args));
formatStr = formatStr.toString();
var msg = helpers.format(formatStr, args, 'printf');
state.getDisplayHook()(msg);
state.v = types.VOID;
});
PRIMITIVES['string->int'] =
new PrimProc('string->int',
1,
false, false,
function(str) {
check(str, function(s) {return isString(s) && s.length == 1;},
'string->int', '1-letter string', 1);
str = str.toString();
return str.charCodeAt(0);
});
PRIMITIVES['int->string'] =
new PrimProc('int->string',
1,
false, false,
function(num) {
check(num, function(x) {
if ( !isInteger(x) ) {
return false;
}
var n = jsnums.toFixnum(x);
return ((n >= 0 && n < 55296) ||
(n > 57343 && n <= 1114111));
},
'int->string',
'exact integer in [0,55295] or [57344,1114111]',
1);
return types.string( String.fromCharCode(jsnums.toFixnum(num)) );
});
PRIMITIVES['explode'] =
new PrimProc('explode',
1,
false, false,
function(str) {
check(str, isString, 'explode', 'string', 1);
str = str.toString();
var ret = types.EMPTY;
for (var i = str.length-1; i >= 0; i--) {
ret = types.cons( types.string(str.charAt(i)), ret );
}
return ret;
});
PRIMITIVES['implode'] =
new PrimProc('implode',
1,
false, false,
function(lst) {
checkListOf(lst, function(x) { return isString(x) && x.length == 1; },
'implode', 'list of 1-letter strings', 1);
var ret = [];
while ( !lst.isEmpty() ) {
ret.push( lst.first.toString() );
lst = lst.rest;
}
return types.string(ret);
});
PRIMITIVES['string-alphabetic?'] =
new PrimProc('string-alphabetic?',
1,
false, false,
function(str) {
check(str, isString, 'string-alphabetic?', 'string', 1);
str = str.toString();
return isAlphabeticString(str);
});
PRIMITIVES['string-ith'] =
new PrimProc('string-ith',
2,
false, false,
function(str, num) {
check(str, isString, 'string-ith', 'string', 1, arguments);
check(num, function(x) { return isNatural(x) && jsnums.lessThan(x, str.length); }, 'string-ith',
'exact integer in [0, length of the given string minus 1 (' + (str.length-1) + ')]', 2, arguments);
str = str.toString();
return types.string( str.charAt(jsnums.toFixnum(num)) );
});
PRIMITIVES['string-lower-case?'] =
new PrimProc('string-lower-case?',
1,
false, false,
function(str) {
check(str, isString, 'string-lower-case?', 'string', 1);
var primStr = str.toString();
return isAlphabeticString(str) && primStr.toLowerCase() === primStr;
});
PRIMITIVES['string-numeric?'] =
new PrimProc('string-numeric?',
1,
false, false,
function(str) {
check(str, isString, 'string-numeric?', 'string', 1);
str = str.toString();
return isNumericString(str);
});
PRIMITIVES['string-upper-case?'] =
new PrimProc('string-upper-case?',
1,
false, false,
function(str) {
check(str, isString, 'string-upper-case?', 'string', 1);
var primStr = str.toString();
return isAlphabeticString(str) && primStr.toUpperCase() === primStr;
});
PRIMITIVES['string-whitespace?'] =
new PrimProc('string-whitespace?',
1,
false, false,
function(str) {
check(str, isString, 'string-whitespace?', 'string', 1);
str = str.toString();
return isWhitespaceString(str);
});
PRIMITIVES['build-string'] =
new PrimProc('build-string',
2,
false, false,
function(num, f) {
check(num, isNatural, 'build-string', 'non-negative exact integer', 1, arguments);
check(f, isFunction, 'build-string', 'procedure', 2, arguments);
var buildStringHelp = function(n, acc) {
if ( jsnums.greaterThanOrEqual(n, num) ) {
return types.string(acc);
}
return CALL(f, [n],
function(res) {
check(res, isChar, 'build-string',
'procedure that returns a char', 2);
acc.push(res.val)
return buildStringHelp(n+1, acc);
});
}
return buildStringHelp(0, []);
});
PRIMITIVES['string->immutable-string'] =
new PrimProc('string->immutable-string',
1,
false, false,
function(str) {
check(str, isString, 'string->immutable-string', 'string', 1);
return str.toString();
});
PRIMITIVES['string-set!'] =
new PrimProc('string-set!',
3,
false, false,
function(str, k, c) {
check(str, function(x) { return isMutableString(x); },
'string-set!', 'mutable string', 1, arguments);
check(k, isNatural, 'string-set!', 'non-negative exact integer', 2, arguments);
check(c, isChar, 'string-set!', 'char', 3, arguments);
if ( jsnums.greaterThanOrEqual(k, str.length) ) {
var msg = ('string-set!: index ' + k + ' out of range ' +
'[0, ' + (str.length-1) + '] for string: ' +
helpers.toDisplayedString(str));
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
str.set(jsnums.toFixnum(k), c.val);
return types.VOID;
});
PRIMITIVES['string-fill!'] =
new PrimProc('string-fill!',
2,
false, false,
function(str, c) {
check(str, function(x) { return isMutableString(x); },
'string-fill!', 'mutable string', 1, arguments);
check(c, isChar, 'string-fill!', 'char', 2, arguments);
for (var i = 0; i < str.length; i++) {
str.set(i, c.val);
}
return types.VOID;
});
//////////////////////////////////////////////////////////////////////
// Immutable cyclic data
PRIMITIVES['make-reader-graph'] =
new PrimProc('make-reader-graph', 1, false, false,
function(x) {
var result = types.readerGraph(x, types.makeLowLevelEqHash(), 0);
return result;
});
PRIMITIVES['make-placeholder'] =
new PrimProc('make-placeholder', 1, false, false,
function(x) { return types.placeholder(x); });
PRIMITIVES['placeholder-set!'] =
new PrimProc('placeholder-set!', 2, false, false,
function(pl, x) {
check(pl, types.isPlaceholder,
"placeholder-set!", "placeholder", 1);
pl.set(x);
return types.VOID;
});
PRIMITIVES['placeholder-get'] =
new PrimProc('placeholder-get', 1, false, false,
function(pl) {
check(pl, types.isPlaceholder,
"placeholder-get", "placeholder", 1);
return pl.get();
});
//////////////////////////////////////////////////////////////////////
/******************************
*** Byte String Primitives ***
******************************/
PRIMITIVES['make-bytes'] =
new CasePrimitive('make-bytes',
[new PrimProc('make-bytes',
1,
false, false,
function(k) {
check(k, isNatural, 'make-bytes', 'non-negative exact integer', 1);
var ret = [];
for (var i = 0; i < jsnums.toFixnum(k); i++) {
ret.push(0);
}
return types.bytes(ret, true);
}),
new PrimProc('make-bytes',
2,
false, false,
function(k, b) {
check(k, isNatural, 'make-bytes', 'non-negative exact integer', 1, arguments);
check(b, isByte, 'make-bytes', 'byte', 2, arguments);
var ret = [];
for (var i = 0; i < jsnums.toFixnum(k); i++) {
ret.push(b);
}
return types.bytes(ret, true);
}) ]);
PRIMITIVES['bytes'] =
new PrimProc('bytes',
0,
true, false,
function(args) {
arrayEach(args, function(b, i) {check(b, isByte, 'bytes', 'byte', i+1, args);});
return types.bytes(args, true);
});
PRIMITIVES['bytes->immutable-bytes'] =
new PrimProc('bytes->immutable-bytes',
1,
false, false,
function(bstr) {
check(bstr, isByteString, 'bytes->immutable-bytes', 'byte string', 1);
if ( bstr.mutable ) {
return bstr.copy(false);
}
else {
return bstr;
}
});
PRIMITIVES['bytes-length'] =
new PrimProc('bytes-length',
1,
false, false,
function(bstr) {
check(bstr, isByteString, 'bytes-length', 'byte string', 1);
return bstr.length();
});
PRIMITIVES['bytes-ref'] =
new PrimProc('bytes-ref',
2,
false, false,
function(bstr, num) {
check(bstr, isByteString, 'bytes-ref', 'byte string', 1, arguments);
check(num, isNatural, 'bytes-ref', 'non-negative exact integer', 2, arguments);
var n = jsnums.toFixnum(num);
if ( n >= bstr.length() ) {
var msg = ('bytes-ref: index ' + n + ' out of range ' +
'[0, ' + (bstr.length-1) + '] for byte-string: ' +
helpers.toDisplayedString(bstr));
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
return bstr.get(n);
});
PRIMITIVES['bytes-set!'] =
new PrimProc('bytes-set!',
3,
false, false,
function(bstr, num, b) {
check(bstr, function(x) { return isByteString(x) && x.mutable; },
'bytes-set!', 'mutable byte string', 1, arguments);
check(num, isNatural, 'bytes-set!', 'non-negative exact integer', 2, arguments);
check(b, isByte, 'bytes-set!', 'byte', 3, arguments);
var n = jsnums.toFixnum(num);
if ( n >= bstr.length() ) {
var msg = ('bytes-set!: index ' + n + ' out of range ' +
'[0, ' + (bstr.length-1) + '] for byte-string: ' +
helpers.toDisplayedString(bstr));
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
bstr.set(n, b);
return types.VOID;
});
PRIMITIVES['subbytes'] =
new CasePrimitive('subbytes',
[new PrimProc('subbytes',
2,
false, false,
function(bstr, theStart) {
check(bstr, isByteString, 'subbytes', 'bytes string', 1, arguments);
check(theStart, isNatural, 'subbytes', 'non-negative exact integer', 2, arguments);
var start = jsnums.toFixnum(theStart);
if (start > bstr.length()) {
var msg = ('subbytes: starting index ' + start + ' out of range ' +
'[0, ' + bstr.length + '] for byte-string: ' +
helpers.toDisplayedString(bstr));
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
else {
return bstr.subbytes(jsnums.toFixnum(start));
}
}),
new PrimProc('subbytes',
3,
false, false,
function(bstr, theStart, theEnd) {
check(bstr, isByteString, 'subbytes', 'byte string', 1, arguments);
check(theStart, isNatural, 'subbytes', 'non-negative exact integer', 2, arguments);
check(theEnd, isNatural, 'subbytes', 'non-negative exact integer', 3, arguments);
var start = jsnums.toFixnum(theStart);
var end = jsnums.toFixnum(theEnd);
if (start > bstr.length()) {
var msg = ('subbytes: starting index ' + start + ' out of range ' +
'[0, ' + bstr.length() + '] for byte-string: ' +
helpers.toDisplayedString(bstr));
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
if (end < start || end > bstr.length()) {
var msg = ('subbytes: ending index ' + end + ' out of range ' + '[' + start +
', ' + bstr.length() + '] for byte-string: ' +
helpers.toDisplayedString(bstr));
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
else {
return bstr.subbytes(start, end);
}
}) ]);
PRIMITIVES['bytes-copy'] =
new PrimProc('bytes-copy',
1,
false, false,
function(bstr) {
check(bstr, isByteString, 'bytes-copy', 'byte string', 1);
return bstr.copy(true);
});
PRIMITIVES['bytes-fill!'] =
new PrimProc('bytes-fill!',
2,
false, false,
function(bstr, b) {
check(bstr, function(x) { return isByteString(x) && x.mutable; },
'bytes-fill!', 'mutable byte string', 1, arguments);
check(b, isByte, 'bytes-fill!', 'byte', 2, arguments);
for (var i = 0; i < bstr.length(); i++) {
bstr.set(i, b);
}
return types.VOID;
});
PRIMITIVES['bytes-append'] =
new PrimProc('bytes-append',
0,
true, false,
function(args) {
arrayEach(args, function(x, i) { check(x, isByteString, 'bytes-append', 'byte string', i+1, args); });
var ret = [];
for (var i = 0; i < args.length; i++) {
ret = ret.concat(args[i].bytes);
}
return types.bytes(ret, true);
});
PRIMITIVES['bytes->list'] =
new PrimProc('bytes->list',
1,
false, false,
function(bstr) {
check(bstr, isByteString, 'bytes->list', 'byte string', 1);
var ret = types.EMPTY;
for (var i = bstr.length()-1; i >= 0; i--) {
ret = types.cons(bstr.get(i), ret);
}
return ret;
});
PRIMITIVES['list->bytes'] =
new PrimProc('list->bytes',
1,
false, false,
function(lst) {
checkListOf(lst, isByte, 'list->bytes', 'byte', 1);
var ret = [];
while ( !lst.isEmpty() ) {
ret.push(lst.first);
lst = lst.rest;
}
return types.bytes(ret, true);
});
PRIMITIVES['bytes=?'] =
new PrimProc('bytes=?',
2,
true, false,
function(bstr1, bstr2, bstrs) {
bstrs.unshift(bstr2);
bstrs.unshift(bstr1);
arrayEach(bstrs, function(x, i) { check(x, isByteString, 'bytes=?', 'byte string', i+1, bstrs); });
return compare(bstrs, function(bstrA, bstrB) { return bstrA.toString() === bstrB.toString(); });
});
PRIMITIVES['bytes<?'] =
new PrimProc('bytes<?',
2,
true, false,
function(bstr1, bstr2, bstrs) {
bstrs.unshift(bstr2);
bstrs.unshift(bstr1);
arrayEach(bstrs, function(x, i) { check(x, isByteString, 'bytes<?', 'byte string', i+1, bstrs); });
return compare(bstrs, function(bstrA, bstrB) { return bstrA.toString() < bstrB.toString(); });
});
PRIMITIVES['bytes>?'] =
new PrimProc('bytes>?',
2,
true, false,
function(bstr1, bstr2, bstrs) {
bstrs.unshift(bstr2);
bstrs.unshift(bstr1);
arrayEach(bstrs, function(x, i) { check(x, isByteString, 'bytes>?', 'byte string', i+1, bstrs); });
return compare(bstrs, function(bstrA, bstrB) { return bstrA.toString() > bstrB.toString(); });
});
/*************************
*** Vector Primitives ***
*************************/
var makeVectorImpl = function(size, content) {
check(size, isNatural, 'make-vector', 'non-negative exact integer', 1, arguments);
var s = jsnums.toFixnum(size);
var ret = [];
for (var i = 0; i < s; i++) {
ret.push(content);
}
return types.vector(ret);
};
PRIMITIVES['make-vector'] = new CasePrimitive
("make-vector",
[new PrimProc('make-vector',
2,
false, false,
makeVectorImpl),
new PrimProc('make-vector',
1,
false, false,
function(size) { return makeVectorImpl(size, jsnums.fromFixnum(0)); })]);
PRIMITIVES['vector'] =
new PrimProc('vector',
0,
true, false,
function(args) {
return types.vector(args);
});
PRIMITIVES['vector-length'] =
new PrimProc('vector-length',
1,
false, false,
function(vec) {
check(vec, isVector, 'vector-length', 'vector', 1);
return vec.length();
});
PRIMITIVES['vector-ref'] =
new PrimProc('vector-ref',
2,
false, false,
function(vec, index) {
check(vec, isVector, 'vector-ref', 'vector', 1, arguments);
check(index, isNatural, 'vector-ref', 'non-negative exact integer', 2, arguments);
var i = jsnums.toFixnum(index);
if (i >= vec.length()) {
var msg = ('vector-ref: index ' + i + ' out of range ' +
'[0, ' + (vec.length()-1) + '] for vector: ' +
helpers.toDisplayedString(vec));
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
return vec.ref(i);
});
PRIMITIVES['vector-set!'] =
new PrimProc('vector-set!',
3,
false, false,
function(vec, index, val) {
check(vec, isVector, 'vector-set!', 'vector', 1, arguments);
check(index, isNatural, 'vector-set!', 'non-negative exact integer', 2, arguments);
var i = jsnums.toFixnum(index);
if (i >= vec.length()) {
var msg = ('vector-set!: index ' + i + ' out of range ' +
'[0, ' + (vec.length()-1) + '] for vector: ' +
helpers.toDisplayedString(vec));
raise( types.incompleteExn(types.exnFailContract, msg, []) );
}
vec.set(i, val);
return types.VOID;
});
PRIMITIVES['vector->list'] =
new PrimProc('vector->list',
1,
false, false,
function(vec) {
check(vec, isVector, 'vector->list', 'vector', 1);
return vec.toList();
});
PRIMITIVES['list->vector'] =
new PrimProc('list->vector',
1,
false, false,
function(lst) {
checkList(lst, 'list->vector', 1);
return types.vector( helpers.schemeListToArray(lst) );
});
PRIMITIVES['build-vector'] =
new PrimProc('build-vector',
2,
false, false,
function(num, f) {
check(num, isNatural, 'build-vector', 'non-negative exact integer', 1, arguments);
check(f, isFunction, 'build-vector', 'procedure', 2, arguments);
var buildVectorHelp = function(n, acc) {
if ( jsnums.greaterThanOrEqual(n, num) ) {
return types.vector(acc);
}
return CALL(f, [n],
function (result) {
acc.push(result)
return buildVectorHelp(n+1, acc);
});
}
return buildVectorHelp(0, []);
});
/***********************
*** Char Primitives ***
***********************/
PRIMITIVES['char=?'] =
new PrimProc('char=?',
2,
true, false,
function(char1, char2, chars) {
chars.unshift(char2);
chars.unshift(char1);
arrayEach(chars, function(c, i) {check(c, isChar, 'char=?', 'char', i+1, chars);});
return compare(chars, function(c1, c2) {return c1.val === c2.val;});
});
PRIMITIVES['char<?'] =
new PrimProc('char<?',
2,
true, false,
function(char1, char2, chars) {
chars.unshift(char2);
chars.unshift(char1);
arrayEach(chars, function(c, i) {check(c, isChar, 'char<?', 'char', i+1, chars);});
return compare(chars, function(c1, c2) {return c1.val < c2.val;});
});
PRIMITIVES['char>?'] =
new PrimProc('char>?',
2,
true, false,
function(char1, char2, chars) {
chars.unshift(char2);
chars.unshift(char1);
arrayEach(chars, function(c, i) {check(c, isChar, 'char>?', 'char', i+1, chars);});
return compare(chars, function(c1, c2) {return c1.val > c2.val;});
});
PRIMITIVES['char<=?'] =
new PrimProc('char<=?',
2,
true, false,
function(char1, char2, chars) {
chars.unshift(char2);
chars.unshift(char1);
arrayEach(chars, function(c, i) {check(c, isChar, 'char<=?', 'char', i+1, chars);});
return compare(chars, function(c1, c2) {return c1.val <= c2.val;});
});
PRIMITIVES['char>=?'] =
new PrimProc('char>=?',
2,
true, false,
function(char1, char2, chars) {
chars.unshift(char2);
chars.unshift(char1);
arrayEach(chars, function(c, i) {check(c, isChar, 'char>=?', 'char', i+1, chars);});
return compare(chars, function(c1, c2) {return c1.val >= c2.val;});
});
PRIMITIVES['char-ci=?'] =
new PrimProc('char-ci=?',
2,
true, false,
function(char1, char2, chars) {
chars.unshift(char2);
chars.unshift(char1);
arrayEach(chars, function(c, i) {check(c, isChar, 'char-ci=?', 'char', i+1, chars);});
return compare(chars,
function(c1, c2) {
return c1.val.toLowerCase() === c2.val.toLowerCase();
});
});
PRIMITIVES['char-ci<?'] =
new PrimProc('char-ci<?',
2,
true, false,
function(char1, char2, chars) {
chars.unshift(char2);
chars.unshift(char1);
arrayEach(chars, function(c, i) {check(c, isChar, 'char-ci<?', 'char', i+1, chars);});
return compare(chars,
function(c1, c2) {
return c1.val.toLowerCase() < c2.val.toLowerCase();
});
});
PRIMITIVES['char-ci>?'] =
new PrimProc('char-ci>?',
2,
true, false,
function(char1, char2, chars) {
chars.unshift(char2);
chars.unshift(char1);
arrayEach(chars, function(c, i) {check(c, isChar, 'char-ci>?', 'char', i+1, chars);});
return compare(chars,
function(c1, c2) {
return c1.val.toLowerCase() > c2.val.toLowerCase();
});
});
PRIMITIVES['char-ci<=?'] =
new PrimProc('char-ci<=?',
2,
true, false,
function(char1, char2, chars) {
chars.unshift(char2);
chars.unshift(char1);
arrayEach(chars, function(c, i) {check(c, isChar, 'char-ci<=?', 'char', i+1, chars);});
return compare(chars,
function(c1, c2) {
return c1.val.toLowerCase() <= c2.val.toLowerCase();
});
});
PRIMITIVES['char-ci>=?'] =
new PrimProc('char-ci>=?',
2,
true, false,
function(char1, char2, chars) {
chars.unshift(char2);
chars.unshift(char1);
arrayEach(chars, function(c, i) {check(c, isChar, 'char-ci>=?', 'char', i+1, chars);});
return compare(chars,
function(c1, c2) {
return c1.val.toLowerCase() >= c2.val.toLowerCase();
});
});
PRIMITIVES['char-alphabetic?'] =
new PrimProc('char-alphabetic?',
1,
false, false,
function(c) {
check(c, isChar, 'char-alphabetic?', 'char', 1);
return isAlphabeticString(c.val);
});
PRIMITIVES['char-numeric?'] =
new PrimProc('char-numeric?',
1,
false, false,
function(c) {
check(c, isChar, 'char-numeric?', 'char', 1);
return (c.val >= '0' && c.val <= '9');
});
PRIMITIVES['char-whitespace?'] =
new PrimProc('char-whitespace?',
1,
false, false,
function(c) {
check(c, isChar, 'char-whitespace?', 'char', 1);
return isWhitespaceString(c.val);
});
PRIMITIVES['char-upper-case?'] =
new PrimProc('char-upper-case?',
1,
false, false,
function(c) {
check(c, isChar, 'char-upper-case?', 'char', 1);
return (isAlphabeticString(c.val) && c.val.toUpperCase() === c.val);
});
PRIMITIVES['char-lower-case?'] =
new PrimProc('char-lower-case?',
1,
false, false,
function(c) {
check(c, isChar, 'char-lower-case?', 'char', 1);
return (isAlphabeticString(c.val) && c.val.toLowerCase() === c.val);
});
PRIMITIVES['char->integer'] =
new PrimProc('char->integer',
1,
false, false,
function(c) {
check(c, isChar, 'char->integer', 'char', 1);
return c.val.charCodeAt(0);
});
PRIMITIVES['integer->char'] =
new PrimProc('integer->char',
1,
false, false,
function(num) {
check(num, function(x) {
if ( !isNatural(x) ) {
return false;
}
var n = jsnums.toFixnum(x);
return ((n >= 0 && n < 55296) ||
(n > 57343 && n <= 1114111));
},
'integer->char',
'exact integer in [0,#x10FFFF], not in [#xD800,#xDFFF]',
1);
return types.character( String.fromCharCode(jsnums.toFixnum(num)) );
});
PRIMITIVES['char-upcase'] =
new PrimProc('char-upcase',
1,
false, false,
function(c) {
check(c, isChar, 'char-upcase', 'char', 1);
return types.character( c.val.toUpperCase() );
});
PRIMITIVES['char-downcase'] =
new PrimProc('char-downcase',
1,
false, false,
function(c) {
check(c, isChar, 'char-downcase', 'char', 1);
return types.character( c.val.toLowerCase() );
});
var callCCPrim = new types.PrimProc('call/cc',
1,
false, true,
function(aState, f) {
var continuationClosure =
state.captureContinuationClosure(aState);
aState.pushValue(continuationClosure);
aState.v = f;
aState.pushControl(
new control.CallControl(1));
});
PRIMITIVES['call/cc'] = callCCPrim;
PRIMITIVES['call-with-current-continuation'] = callCCPrim;
//////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////
var GENSYM_COUNTER = 0;
var gensymImpl = function(x) {
check(x,
function(x) { return isString(x) || isSymbol(x) },
'gensym', 'symbol or string',
1);
return types.symbol(x.toString() + '' + (GENSYM_COUNTER++));
};
PRIMITIVES['gensym'] =
new CasePrimitive(
'gensym',
[new PrimProc('gensym',
1,
false,
false,
gensymImpl),
new PrimProc('gensym',
0,
false,
false,
function() { return gensymImpl('g') })]);
/***************************
*** Primitive Constants ***
***************************/
PRIMITIVES['eof'] = types.EOF;
PRIMITIVES['e'] = jsnums.e;
PRIMITIVES['empty'] = types.EMPTY;
PRIMITIVES['false'] = false;
PRIMITIVES['true'] = true;
PRIMITIVES['pi'] = jsnums.pi;
PRIMITIVES['null'] = types.EMPTY;
//////////////////////////////////////////////////////////////////////
/** Parameters **/
var PARAMZ = {};
PARAMZ['exception-handler-key'] = types.exceptionHandlerKey;
///////////////////////////////////////////////////////////////
// getPrimitive: string (string | undefined) -> scheme-value
primitives.getPrimitive = function(name, resolvedModuleName) {
if (resolvedModuleName === undefined) {
return PRIMITIVES[name];
}
if (resolvedModuleName === types.symbol("moby/kernel")) {
return PRIMITIVES[name];
}
if (resolvedModuleName === types.symbol("moby/paramz")) {
return PARAMZ[name];
}
if (types.isEqual(resolvedModuleName,
types.list([types.symbol("quote"), types.symbol("#%kernel")]))) {
return PRIMITIVES[name];
}
if (types.isEqual(resolvedModuleName,
types.list([types.symbol("quote"), types.symbol("#%paramz")]))) {
return PARAMZ[name];
}
// FIXME: if we get to this point, this should be treated as an internal error...
return PRIMITIVES[name];
};
primitives.isPrimitive = function(x) {
return x instanceof PrimProc;
};
scope.link.announceReady('primitives');
})(this['plt']);