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
}
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;
}
cell_t *
surd_p_minus(surd_t *s, cell_t *args)
{
cell_t *tmp = args, *first;
int val = 0;
int nands = 0;
while (tmp != s->nil && ISCONS(tmp)) {
first = CAR(tmp);
if (ISFIXNUM(first)) {
if (nands > 0) {
val -= first->_value.num;
}
else {
val = first->_value.num;
}
nands++;
}
else {
fprintf(stderr, "error: attempt to add a non fixnum: %d\n", tmp->flags);
exit(1);
}
tmp = CDR(tmp);
}
if (nands == 1) {
val *= -1;
}
tmp = surd_new_cell(s);
surd_num_init(s, tmp, val);
return tmp;
return s->nil;
}
int
isDefine(OBJ expr){
if( ISCONS(expr) && (CAR(expr) == js_sym_define) ){
return 1;
}
return 0;
}
int
isLambda(OBJ expr){
if( ISCONS(expr) && (CAR(expr) == js_sym_lambda) ){
return 1;
}
return 0;
}
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);
}
cell_t *
surd_p_rest(surd_t *s, cell_t *args)
{
cell_t *arg1 = CAR(args);
if (ISCONS(arg1)) {
return CDR(arg1);
}
return s->nil;
}
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);
}
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;
}
cell_t *
surd_p_first(surd_t *s, cell_t *args)
{
cell_t *arg1;
if (args != s->nil) {
arg1 = CAR(args);
if (ISCONS(arg1)) {
return CAR(arg1);
}
}
return s->nil;
}
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);
}
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));
}
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_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;
}
cell_t *
surd_p_write(surd_t *s, cell_t *args)
{
cell_t *tmp = args, *first;
int i = 0;
while (tmp != s->nil && ISCONS(tmp)) {
first = CAR(tmp);
if (i++ > 0) {
fputc(' ', stdout);
}
surd_write(s, stdout, first);
tmp = CDR(tmp);
}
return s->nil;
}
// predicates
cell_t *
surd_p_consp(surd_t *s, cell_t *args)
{
cell_t *c;
if (surd_list_length(s, args) == 1) {
c = CAR(args);
if (ISCONS(c)) {
return c;
}
return s->nil;
}
else {
fprintf(stderr, "arity error: cons? takes 1 argument\n");
exit(1);
}
return s->nil;
}
cell_t *
surd_p_mult(surd_t *s, cell_t *args)
{
cell_t *tmp = args, *first;
int val = 1;
while (tmp != s->nil && ISCONS(tmp)) {
first = CAR(tmp);
if (ISFIXNUM(first)) {
val *= first->_value.num;
}
else {
fprintf(stderr, "error: attempt to multiply a non fixnum: %d\n", tmp->flags);
exit(1);
}
tmp = CDR(tmp);
}
tmp = surd_new_cell(s);
surd_num_init(s, tmp, val);
return tmp;
}
OBJ
builtin_define(OBJ env, OBJ argList){
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);
if( argList != js_nil ){
js_error("(define): this form expects exactly 2 arguments", js_nil);
}
OBJ value = js_eval(env, arg2);
environmentPut(env, arg1, value);
#ifdef DEBUG
// PRINT TRACE
if( EVAL_TRACE->state) {
printIndent(indentLevel);
fprintf(stdout, RED"DEFINE "RESET);
js_print(stdout, arg1,1);
fprintf(stdout, " -> ");
js_print(stdout, value,1);
if( TAG(env) == T_GLOBALENVIRONMENT ){
fprintf(stdout," in " CYN "GLOBAL" RESET " (%p)\n", env);
}
if( TAG(env) == T_LOCALENVIRONMENT ){
fprintf(stdout," in " YEL "LOCAL" RESET " (%p)\n", env);
}
}
#endif
return js_void;
}
// 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);
#ifdef DEBUG
// PRINT TRACE
if( EVAL_TRACE->state ){
printIndent(indentLevel);
fprintf(stdout, RED"DEFINE "RESET);
js_print(stdout, name,1);
fprintf(stdout, " -> ");
js_print(stdout, newUDF,1);
if( TAG(env) == T_GLOBALENVIRONMENT ){
fprintf(stdout," in " CYN "GLOBAL" RESET " (%p)\n", env);
}
if( TAG(env) == T_LOCALENVIRONMENT ){
fprintf(stdout," in " YEL "LOCAL" RESET " (%p)\n", env);
}
}
#endif
return js_void;
}
}
error("define form unimplemented", __FILE__, __LINE__);
// NOT REACHED
return js_nil;
}