OBJ
builtin_set(OBJ env, OBJ argList) {
OBJ varName, expr;
if (!ISCONS(argList)) {
js_error("(set!) expects 2 arguments:", argList);
}
varName = CAR(argList);
argList = CDR(argList);
if (!ISCONS(argList)) {
js_error("(set!) expects 2 arguments:", argList);
}
expr = CAR(argList);
argList = CDR(argList);
if (argList != js_nil) {
js_error("(set!) expects 2 arguments:", argList);
}
if (!ISSYMBOL(varName)) {
js_error("(set!) non symbol variable name:", varName);
}
if (expr == js_nil) {
environmentSet(env, varName, expr);
return js_void;
}
OBJ evaledExpr = js_eval(env, expr);
environmentSet(env, varName, evaledExpr);
return js_void;
}
VOIDPTRFUNC
CP_builtin_set() {
OBJ env = ARG(0);
OBJ argList = ARG(1);
OBJ varName, expr;
VOIDPTRFUNC CP_builtin_set2();
if (!ISCONS(argList)) {
js_error("(set!) expects 2 arguments:", argList);
}
varName = CAR(argList);
argList = CDR(argList);
if (!ISCONS(argList)) {
js_error("(set!) expects 2 arguments:", argList);
}
expr = CAR(argList);
argList = CDR(argList);
if (argList != js_nil) {
js_error("(set!) expects 2 arguments:", argList);
}
if (!ISSYMBOL(varName)) {
js_error("(set!) non symbol variable name:", varName);
}
if (expr == js_nil) {
environmentSet(env, varName, expr);
RETURN (js_void);
}
CREATE_LOCALS(1);
SET_LOCAL(0, varName);
ASSERT(env != NULL, "bad env");
CALL2(CP_js_eval, env, expr, CP_builtin_set2);
// not reached
}
OBJ
builtin_if(OBJ env, OBJ argList){
OBJ condExpr, ifExpr, elseExpr, condValue;
int numArgs = length(argList);
if( numArgs == 2){
// case 1: else-less if -> (if cond <expr>)
elseExpr = js_nil;
} else if( numArgs == 3){
// case 2: regular if -> (if cond <ifExpr> <elseExpr>)
elseExpr = CAR( CDR( CDR( argList )));
} else {
js_error("(if): expects 2 or 3 arguments", js_nil);
}
condExpr = CAR(argList);
ifExpr = CAR( CDR(argList));
condValue = js_eval(env, condExpr);
if (condValue == js_true){
return (js_eval(env, ifExpr));
}
if (condValue == js_false){
return (js_eval(env,elseExpr));
}
// TO-DO implement #t #f rules for all kind of OBJs
js_error("(if): non-boolean condition value", condValue);
// NOT REACHED
return js_nil;
}
OBJ
builtin_include(int numArgs){
if( numArgs != 1){
js_error("(include): expects 1 argument", js_nil);
}
OBJ arg1 = POP();
char *fileName;
FILE *theFile;
if( !ISSTRING(arg1) ){
js_error("(include): string arg expected:", arg1);
}
fileName = STRINGVAL(arg1);
theFile = fopen(fileName, "r");
if( theFile == NULL){
js_error("(include): cannot open file:", arg1);
}
OBJ inputStream = newFileStream(theFile);
#ifdef DEBUG
if( PRINT_INCLUDE->state){
printIndent(indentLevelForInclude);
fprintf(stdout, "<include file:" YEL " %s" RESET" >\n", fileName);
indentLevelForInclude++;
}
if( CONTINUATION_PASSING->state){
enterTrampoline1(inputStream);
}
else{
OBJ expr = js_read(inputStream);
OBJ result;
while( expr != js_eof){
result = js_eval(globalEnvironment, expr);
if(PRINT_INCLUDE->state){
printIndent(indentLevelForInclude);
js_print(stdout, result,1);
printf("\n");
}
expr = js_read(inputStream);
}
}
if( PRINT_INCLUDE->state){
indentLevelForInclude--;
printIndent(indentLevelForInclude);
fprintf(stdout, "<EOF:" YEL " %s" RESET" >\n", fileName);
}
#else
enterTrampoline1(inputStream);
#endif
fclose( inputStream->u.fileStream.file );
free( inputStream);
return js_void;
}
VOIDPTRFUNC
CP_builtin_define(){
OBJ env = ARG(0);
OBJ argList = ARG(1);
if( !ISCONS(argList) ){
js_error("(define): expects at least 2 arguments", js_nil);
}
OBJ arg1 = CAR(argList);
argList = CDR(argList);
if( !ISCONS(argList) ){
js_error("(define): expects at least 2 arguments", js_nil);
}
// case 1: define SYMBOL -> (define symbol expression)
if( ISSYMBOL(arg1)) {
OBJ arg2 = CAR(argList);
argList = CDR(argList);
VOIDPTRFUNC CP_builtin_define2();
if( argList != js_nil ){
js_error("(define): this form expects exactly 2 arguments", js_nil);
}
CREATE_LOCALS(1);
SET_LOCAL(0, arg1);
//printJStack(__FILE__,__LINE__,__FUNCTION__);
DEBUGCODE(PRINT_STACK->state, printJStack(__FILE__,__LINE__,__FUNCTION__) );
CALL2(CP_js_eval, env, arg2, CP_builtin_define2);
}
// case 2: define CONS ( function ) -> (define (name args*) (body*) )
if( ISCONS(arg1)){
OBJ name = CAR(arg1);
if( ISSYMBOL(name) ){
OBJ formalArgList = CDR(arg1);
OBJ bodyList = argList;
OBJ newUDF;
newUDF = newUserDefinedFunction("anonymous lambda", formalArgList, bodyList);
newUDF->u.userDefinedFunction.numLocals = count_defines(bodyList);
newUDF->u.userDefinedFunction.home = env;
environmentPut(env, name, newUDF);
//printJStack(__FILE__,__LINE__,__FUNCTION__);
DEBUGCODE(PRINT_STACK->state, printJStack(__FILE__,__LINE__,__FUNCTION__) );
RETURN(js_void);
}
}
error("define form unimplemented", __FILE__, __LINE__);
// NOT REACHED
return NULL;
}
OBJ
builtin_cdr(int numArgs){
if(numArgs != 1){
POPN(numArgs);
js_error("(cdr): expects 1 argument", js_nil);
}
OBJ theArg = POP();
if(!ISCONS(theArg)){
js_error("(cdr): non-cons argument", theArg);
}
return CDR(theArg);
}
OBJ
builtin_set_cdr(int numArgs){
if(numArgs != 2){
POPN(numArgs);
js_error("(set-cdr!): expects 2 argument", js_nil);
}
OBJ newCdr = POP();
OBJ theCons = POP();
if(!ISCONS(theCons)){
js_error("(set-cdr!): non-cons argument", theCons);
}
SET_CDR(theCons, newCdr);
return js_void;
}
void
js_function_error(char* msg, OBJ arg, int expected, int given){
char msgBuffer[512];
snprintf(msgBuffer, sizeof(msgBuffer), msg, expected, given);
js_error(msgBuffer, arg);
}
VOIDPTRFUNC
CP_builtin_if(){
OBJ env = ARG(0);
OBJ argList = ARG(1);
OBJ condExpr, ifExpr, elseExpr = NULL;
int numArgs = length(argList);
if( numArgs == 2){
// case 1: else-less if -> (if cond <expr>)
elseExpr = js_nil;
} else if( numArgs == 3){
// case 2: regular if -> (if cond <ifExpr> <elseExpr>)
elseExpr = CAR( CDR( CDR( argList )));
} else {
js_error("(if): expects 2 or 3 arguments", js_nil);
}
condExpr = CAR(argList);
ifExpr = CAR( CDR(argList));
CREATE_LOCALS(2);
SET_LOCAL(0, ifExpr);
SET_LOCAL(1, elseExpr);
DEBUGCODE(PRINT_STACK->state, printJStack(__FILE__,__LINE__,__FUNCTION__) );
CALL2(CP_js_eval, env, condExpr, CP_builtin_if2);
}
void js_replace(js_State* J, int idx)
{
idx = idx < 0 ? TOP + idx : BOT + idx;
if (idx < BOT || idx >= TOP)
js_error(J, "stack error!");
STACK[idx] = STACK[--TOP];
}
OBJ
builtin_quote(OBJ env, OBJ argList){
if( (!ISCONS(argList)) || ( CDR(argList) != js_nil) ){
js_error("(quote): expects exactly 1 argument", js_nil);
}
return CAR(argList);
}
void js_pop(js_State *J, int n)
{
TOP -= n;
if (TOP < BOT) {
TOP = BOT;
js_error(J, "stack underflow!");
}
}
OBJ
readNumber(OBJ inStream, char firstChar, int isNegative){
//printf(YEL "\nreadNumber>" RESET);
/*
* TO-DO refactor!
*/
jscheme_int64 *iVal = NULL;
char ch;
OBJ retVal;
// substract the ASCII value of '0' from char to get the actual value between 0 and 9.
jscheme_int64 start = (jscheme_int64) firstChar - '0';
if(isNegative) start *= -1;
iVal = &start;
while( isDigit( ch = nextChar(inStream) )){
//iVal = iVal * 10 + ( (int)ch - '0');
jscheme_int64 ch_val = (jscheme_int64) ch - '0';
if(isNegative){
int mul = __builtin_smull_overflow(*iVal, 10, iVal);
int sub = __builtin_ssubl_overflow(*iVal, ch_val, iVal);
if( mul || sub ){
if(thisIsTheEnd(inStream)){
prompt_on();
}
js_error("readNumber: integer underflow", newInteger(*iVal));
}
}else{
int mul = __builtin_smull_overflow(*iVal, 10, iVal);
int add = __builtin_saddl_overflow(*iVal, ch_val, iVal);
if( mul || add ){
if(thisIsTheEnd(inStream)){
prompt_on();
}
js_error("readNumber: integer overflow", newInteger(*iVal));
}
}
}
unreadChar(inStream, ch);
retVal = newInteger( *iVal );
return retVal;
}
static void jsR_pushtrace(js_State *J, const char *name, const char *file, int line)
{
if (++J->tracetop == JS_ENVLIMIT)
js_error(J, "call stack overflow");
J->trace[J->tracetop].name = name;
J->trace[J->tracetop].file = file;
J->trace[J->tracetop].line = line;
}
void js_loadfile(js_State *J, const char *filename)
{
FILE *f;
char *s;
int n, t;
f = fopen(filename, "rb");
if (!f) {
js_error(J, "cannot open file: '%s'", filename);
}
if (fseek(f, 0, SEEK_END) < 0) {
fclose(f);
js_error(J, "cannot seek in file: '%s'", filename);
}
n = ftell(f);
fseek(f, 0, SEEK_SET);
s = js_malloc(J, n + 1); /* add space for string terminator */
if (!s) {
fclose(f);
js_error(J, "cannot allocate storage for file contents: '%s'", filename);
}
t = fread(s, 1, n, f);
if (t != n) {
js_free(J, s);
fclose(f);
js_error(J, "cannot read data from file: '%s'", filename);
}
s[n] = 0; /* zero-terminate string containing file data */
if (js_try(J)) {
js_free(J, s);
fclose(f);
js_throw(J);
}
js_loadstring(J, filename, s);
js_free(J, s);
fclose(f);
js_endtry(J);
}
OBJ
builtin_consP(int numArgs){
if(numArgs != 1){
POPN(numArgs);
js_error("(cons?): expects 1 argument", js_nil);
}
OBJ theArg = POP();
return( ISCONS(theArg) ? js_true : js_false);
}
void js_remove(js_State *J, int idx)
{
idx = idx < 0 ? TOP + idx : BOT + idx;
if (idx < BOT || idx >= TOP)
js_error(J, "stack error!");
for (;idx < TOP - 1; ++idx)
STACK[idx] = STACK[idx+1];
--TOP;
}
OBJ
builtin_minus(int numArgs){
OBJ theArg;
switch (numArgs){
case 0:
js_error("(-): at least one arg expected", js_nil);
/* NOT REACHED */
case 1:
theArg = POP();
if( !ISINTEGER(theArg)){
js_error("(-): non-integer argument", theArg);
}
return newInteger( -INTVAL(theArg) );
default:
theArg = NTH_ARG(numArgs, 0);
if( !ISINTEGER(theArg)){
POPN(numArgs);
js_error("(-): non-integer argument", theArg);
}
jscheme_int64 *difference = NULL;
jscheme_int64 start = INTVAL(theArg);
difference = &start;
for(int i = 1; i < numArgs; i++){
OBJ nextArg = NTH_ARG(numArgs, i);
if( !ISINTEGER(nextArg)){
POPN(numArgs);
js_error("(-): non-integer argument", theArg);
}
if(__builtin_ssubl_overflow(*difference, INTVAL(nextArg), difference)){
// clean stack
POPN(numArgs);
js_error("(-): integer overflow", newInteger(*difference));
};
}
POPN(numArgs);
return newInteger(*difference);
}
/* NOT REACHED */
return js_nil;
}
static OBJ
builtin_displayOrWrite(int numArgs, int DisplayMode){
if(numArgs > 1){
js_error("(display or write): expects 1 argument", js_nil);
}
OBJ arg = POP();
js_print(stdout, arg, DisplayMode);
return js_void;
}
OBJ
builtin_lambda(OBJ env, OBJ argList){
if( !ISCONS(argList) ){
js_error("(lambda): expects at least 2 arguments", js_nil);
}
OBJ lambdaArgList = CAR(argList);
if( ! (lambdaArgList == js_nil || ISCONS(lambdaArgList) )){
js_error("(lambda): invalid argument list", lambdaArgList);
}
OBJ bodyList = CDR(argList);
OBJ newUDF = newUserDefinedFunction( "anonymous lambda", lambdaArgList, bodyList);
newUDF->u.userDefinedFunction.numLocals = count_defines(bodyList);
newUDF->u.userDefinedFunction.home = env;
return newUDF;
}
static
void
call(v8::FunctionCallbackInfo<v8::Value> const& args) {
std::cout << "ctor called" << std::endl;
if ( ! args.IsConstructCall()) {
js_error("constructor called without 'new'");
//throw_error_already_set();
return; // XXX better throw...
}
}
void js_savetry(js_State *J, js_Instruction *pc)
{
if (J->trytop == JS_TRYLIMIT)
js_error(J, "try: exception stack overflow");
J->trybuf[J->trytop].E = J->E;
J->trybuf[J->trytop].envtop = J->envtop;
J->trybuf[J->trytop].tracetop = J->tracetop;
J->trybuf[J->trytop].top = J->top;
J->trybuf[J->trytop].bot = J->bot;
J->trybuf[J->trytop].pc = pc;
}
OBJ
builtin_cons(int numArgs){
if(numArgs != 2){
POPN(numArgs);
js_error("(cons): expects 2 arguments", js_nil);
}
OBJ arg2 = POP();
OBJ arg1 = POP();
return newCons(arg1, arg2);
}
static void jsB_readline(js_State *J)
{
char line[256];
int n;
if (!fgets(line, sizeof line, stdin))
js_error(J, "cannot read line from stdin");
n = strlen(line);
if (n > 0 && line[n-1] == '\n')
line[n-1] = 0;
js_pushstring(J, line);
}
OBJ
builtin_times(int numArgs){
jscheme_int64 *product= NULL;
jscheme_int64 start = 1;
product = &start;
for(int i = 0; i < numArgs; i++){
OBJ theArg = POP();
if( !ISINTEGER(theArg)){
POPN((numArgs - 1) - i);
js_error("(*): non-integer argument", theArg);
}
if(__builtin_smull_overflow(*product,INTVAL(theArg),product)){
// clean stack
POPN((numArgs - 1) - i);
js_error("(*): integer overflow", newInteger(*product));
}
}
return newInteger(*product);
}
bool
handle_exception_impl(boost::function0<void> f) {
try {
if (detail::exception_handler::chain) {
return detail::exception_handler::chain->handle(f);
}
f();
return false;
} catch (error_already_set const& ex) {
// javascript error already set.
} catch(const std::bad_alloc&) {
js_error("memory allocation failed");
} catch(const boost::bad_numeric_cast& x) {
js_range_error(x.what());
} catch(const std::out_of_range& x) {
js_range_error(x.what());
} catch (...) {
js_error("unknown c++ exception");
}
return true;
}
VOIDPTRFUNC
CP_builtin_quote(){
// OBJ env = ARG(0);
OBJ argList = ARG(1);
//printJStack(__FILE__,__LINE__,__FUNCTION__);
DEBUGCODE(PRINT_STACK->state, printJStack(__FILE__,__LINE__,__FUNCTION__) );
if( (!ISCONS(argList)) || ( CDR(argList) != js_nil) ){
js_error("(quote): expects exactly 1 argument", js_nil);
}
RETURN( CAR(argList));
}
OBJ
builtin_plus(int numArgs){
jscheme_int64 start = 0;
jscheme_int64 *sum = NULL;
sum = &start;
int i;
for(i = 0; i < numArgs; i++){
OBJ theArg = POP();
if( !ISINTEGER(theArg)){
POPN((numArgs - 1) - i);
js_error("(+): non-integer argument", theArg);
}
if(__builtin_saddl_overflow( *sum, INTVAL(theArg), sum)){
// clean evalStack
POPN((numArgs - 1) - i);
js_error("(+): integer overflow", newInteger(*sum));
};
}
return newInteger(*sum);
}
VOIDPTRFUNC
CP_builtin_lambda(){
OBJ env = ARG(0);
OBJ argList = ARG(1);
//printJStack(__FILE__,__LINE__,__FUNCTION__);
DEBUGCODE(PRINT_STACK->state, printJStack(__FILE__,__LINE__,__FUNCTION__) );
if( !ISCONS(argList) ){
js_error("(lambda): expects at least 2 arguments", js_nil);
}
OBJ lambdaArgList = CAR(argList);
if( ! (lambdaArgList == js_nil || ISCONS(lambdaArgList) )){
js_error("(lambda): invalid argument list", lambdaArgList);
}
OBJ bodyList = CDR(argList);
OBJ newUDF = newUserDefinedFunction( "anonymous lambda", lambdaArgList, bodyList);
newUDF->u.userDefinedFunction.numLocals = count_defines(bodyList);
newUDF->u.userDefinedFunction.home = env;
RETURN(newUDF);
}
OBJ
builtin_gThanNrP(int numArgs){
if(numArgs != 2){
POPN(numArgs);
js_error("(>): expects 2 arguments", js_nil);
}
OBJ arg2 = POP();
OBJ arg1 = POP();
if(ISINTEGER(arg1)){
if(ISINTEGER(arg2)){
if( INTVAL(arg1) > INTVAL(arg2)) return js_true;
return js_false;
}else{
js_error("(>): non-integer argument", arg2);
}
}else{
js_error("(>): non-integer argument", arg1);
}
// NOT REACHED
return NULL;
}