/[cvs]/stack/symbols.c
ViewVC logotype

Diff of /stack/symbols.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by masse, Mon Aug 4 11:23:43 2003 UTC revision 1.4 by masse, Tue Aug 5 09:09:51 2003 UTC
# Line 1  Line 1 
 #include <stdio.h>  
1  #include "stack.h"  #include "stack.h"
2    
3  /* Print newline. */  /* Print newline. */
# Line 294  extern void def(environment *env) Line 293  extern void def(environment *env)
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));
# Line 360  extern void sx_2b(environment *env) Line 359  extern void sx_2b(environment *env)
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);
# Line 1282  extern void cons(environment *env) Line 1281  extern void cons(environment *env)
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)
# Line 1367  extern void sx_636c6f7365(environment *e Line 1438  extern void sx_636c6f7365(environment *e
1438    
1439    toss(env);    toss(env);
1440  }  }
1441    
1442    extern void mangle(environment *env)
1443    {
1444      char *new_string;
1445    
1446      if(env->head->type==empty) {
1447        printerr("Too Few Arguments");
1448        env->err= 1;
1449        return;
1450      }
1451    
1452      if(CAR(env->head)->type!=string) {
1453        printerr("Bad Argument Type");
1454        env->err= 2;
1455        return;
1456      }
1457    
1458      new_string= mangle_str(CAR(env->head)->content.string);
1459    
1460      toss(env);
1461      if(env->err) return;
1462    
1463      push_cstring(env, new_string);
1464    }
1465    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26