|
#include <stdio.h> |
|
1 |
#include "stack.h" |
#include "stack.h" |
2 |
|
|
3 |
/* Print newline. */ |
/* Print newline. */ |
293 |
} |
} |
294 |
|
|
295 |
/* long names are a pain */ |
/* long names are a pain */ |
296 |
sym= CAR(env->head)->content.ptr; |
sym= CAR(env->head)->content.sym; |
297 |
|
|
298 |
/* Bind the symbol to the value */ |
/* Bind the symbol to the value */ |
299 |
sym->val= CAR(CDR(env->head)); |
sym->val= CAR(CDR(env->head)); |
359 |
protect(a_val); protect(b_val); |
protect(a_val); protect(b_val); |
360 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
361 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
362 |
len= strlen(a_val->content.ptr)+strlen(b_val->content.ptr)+1; |
len= strlen(a_val->content.string)+strlen(b_val->content.string)+1; |
363 |
new_string= malloc(len); |
new_string= malloc(len); |
364 |
assert(new_string != NULL); |
assert(new_string != NULL); |
365 |
strcpy(new_string, b_val->content.ptr); |
strcpy(new_string, b_val->content.string); |
366 |
strcat(new_string, a_val->content.ptr); |
strcat(new_string, a_val->content.string); |
367 |
push_cstring(env, new_string); |
push_cstring(env, new_string); |
368 |
unprotect(a_val); unprotect(b_val); |
unprotect(a_val); unprotect(b_val); |
369 |
free(new_string); |
free(new_string); |
1281 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
1282 |
} |
} |
1283 |
|
|
1284 |
|
|
1285 |
|
/* General assoc function */ |
1286 |
|
void assocgen(environment *env, funcp eqfunc) |
1287 |
|
{ |
1288 |
|
value *key, *item; |
1289 |
|
|
1290 |
|
/* Needs two values on the stack, the top one must be an association |
1291 |
|
list */ |
1292 |
|
if(env->head->type==empty || CDR(env->head)->type==empty) { |
1293 |
|
printerr("Too Few Arguments"); |
1294 |
|
env->err= 1; |
1295 |
|
return; |
1296 |
|
} |
1297 |
|
|
1298 |
|
if(CAR(env->head)->type!=tcons) { |
1299 |
|
printerr("Bad Argument Type"); |
1300 |
|
env->err= 2; |
1301 |
|
return; |
1302 |
|
} |
1303 |
|
|
1304 |
|
key=CAR(CDR(env->head)); |
1305 |
|
item=CAR(env->head); |
1306 |
|
|
1307 |
|
while(item->type == tcons){ |
1308 |
|
if(CAR(item)->type != tcons){ |
1309 |
|
printerr("Bad Argument Type"); |
1310 |
|
env->err= 2; |
1311 |
|
return; |
1312 |
|
} |
1313 |
|
push_val(env, key); |
1314 |
|
push_val(env, CAR(CAR(item))); |
1315 |
|
eqfunc(env); if(env->err) return; |
1316 |
|
|
1317 |
|
/* Check the result of 'eqfunc' */ |
1318 |
|
if(env->head->type==empty) { |
1319 |
|
printerr("Too Few Arguments"); |
1320 |
|
env->err= 1; |
1321 |
|
return; |
1322 |
|
} |
1323 |
|
if(CAR(env->head)->type!=integer) { |
1324 |
|
printerr("Bad Argument Type"); |
1325 |
|
env->err= 2; |
1326 |
|
return; |
1327 |
|
} |
1328 |
|
|
1329 |
|
if(CAR(env->head)->content.i){ |
1330 |
|
toss(env); if(env->err) return; |
1331 |
|
break; |
1332 |
|
} |
1333 |
|
toss(env); if(env->err) return; |
1334 |
|
|
1335 |
|
if(item->type!=tcons) { |
1336 |
|
printerr("Bad Argument Type"); |
1337 |
|
env->err= 2; |
1338 |
|
return; |
1339 |
|
} |
1340 |
|
|
1341 |
|
item=CDR(item); |
1342 |
|
} |
1343 |
|
|
1344 |
|
if(item->type == tcons){ /* A match was found */ |
1345 |
|
push_val(env, CAR(item)); |
1346 |
|
} else { |
1347 |
|
push_int(env, 0); |
1348 |
|
} |
1349 |
|
swap(env); if(env->err) return; |
1350 |
|
toss(env); if(env->err) return; |
1351 |
|
swap(env); if(env->err) return; |
1352 |
|
toss(env); |
1353 |
|
} |
1354 |
|
|
1355 |
|
|
1356 |
/* 2: 3 => */ |
/* 2: 3 => */ |
1357 |
/* 1: [ [ 1 . 2 ] [ 3 . 4 ] ] => 1: [ 3 . 4 ] */ |
/* 1: [ [ 1 . 2 ] [ 3 . 4 ] ] => 1: [ 3 . 4 ] */ |
1358 |
extern void assq(environment *env) |
extern void assq(environment *env) |