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

Diff of /stack/symbols.c

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

revision 1.8 by masse, Wed Aug 13 06:12:26 2003 UTC revision 1.9 by masse, Wed Aug 13 11:58:00 2003 UTC
# Line 10  extern void nl(environment *env) Line 10  extern void nl(environment *env)
10  /* Print a newline to a port */  /* Print a newline to a port */
11  extern void nlport(environment *env)  extern void nlport(environment *env)
12  {  {
13    switch(check_args(env, port, empty)) {    if(check_args(env, port, empty))
14    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
15    
16    if(fprintf(CAR(env->head)->content.p, "\n") < 0){    if(fprintf(CAR(env->head)->content.p, "\n") < 0){
17      perror("nl");      perror("nl");
# Line 33  extern void nlport(environment *env) Line 25  extern void nlport(environment *env)
25  extern void type(environment *env)  extern void type(environment *env)
26  {  {
27    
28    switch(check_args(env, unknown, empty)) {    if(check_args(env, unknown, empty))
29    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
30    
31    switch(CAR(env->head)->type){    switch(CAR(env->head)->type){
32    case empty:    case empty:
# Line 82  extern void type(environment *env) Line 66  extern void type(environment *env)
66  extern void print_(environment *env)  extern void print_(environment *env)
67  {  {
68    
69    switch(check_args(env, unknown, empty)) {    if(check_args(env, unknown, empty))
70    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
71    
72    print_val(env, CAR(env->head), 0, NULL, stdout);    print_val(env, CAR(env->head), 0, NULL, stdout);
73    if(env->err) return;    if(env->err) return;
# Line 111  extern void print(environment *env) Line 87  extern void print(environment *env)
87  extern void princ_(environment *env)  extern void princ_(environment *env)
88  {  {
89    
90    switch(check_args(env, unknown, empty)) {    if(check_args(env, unknown, empty))
91    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
92    
93    print_val(env, CAR(env->head), 1, NULL, stdout);    print_val(env, CAR(env->head), 1, NULL, stdout);
94  }  }
# Line 137  extern void princ(environment *env) Line 105  extern void princ(environment *env)
105  extern void printport_(environment *env)  extern void printport_(environment *env)
106  {  {
107    
108    switch(check_args(env, port, unknown, empty)) {    if(check_args(env, port, unknown, empty))
109    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
110    
111    print_val(env, CAR(CDR(env->head)), 0, NULL, CAR(env->head)->content.p);    print_val(env, CAR(CDR(env->head)), 0, NULL, CAR(env->head)->content.p);
112    if(env->err) return;    if(env->err) return;
# Line 165  extern void printport(environment *env) Line 125  extern void printport(environment *env)
125  extern void princport_(environment *env)  extern void princport_(environment *env)
126  {  {
127    
128    switch(check_args(env, port, unknown, empty)) {    if(check_args(env, port, unknown, empty))
129    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
130    
131    print_val(env, CAR(CDR(env->head)), 1, NULL, CAR(env->head)->content.p);    print_val(env, CAR(CDR(env->head)), 1, NULL, CAR(env->head)->content.p);
132    toss(env); if(env->err) return;    toss(env); if(env->err) return;
# Line 193  extern void rot(environment *env) Line 145  extern void rot(environment *env)
145  {  {
146    value *temp= env->head;    value *temp= env->head;
147    
148    switch(check_args(env, unknown, unknown, unknown, empty)) {    if(check_args(env, unknown, unknown, unknown, empty))
149    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
150        
151    env->head= CDR(CDR(env->head));    env->head= CDR(CDR(env->head));
152    CDR(CDR(temp))= CDR(env->head);    CDR(CDR(temp))= CDR(env->head);
# Line 214  extern void expand(environment *env) Line 158  extern void expand(environment *env)
158  {  {
159    value *temp, *new_head;    value *temp, *new_head;
160    
161    switch(check_args(env, tcons, empty)) {    if(check_args(env, tcons, empty))
162    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
163    
164    rev(env);    rev(env);
165    
# Line 241  extern void expand(environment *env) Line 177  extern void expand(environment *env)
177      if (CDR(temp)->type == tcons)      if (CDR(temp)->type == tcons)
178        temp= CDR(temp);        temp= CDR(temp);
179      else {      else {
180        printerr(env, "Bad Argument Type"); /* Improper list */        env->err= 2; /* Improper list */
181        env->err= 2;        return printerr(env);
       return;  
182      }      }
183    }    }
184    
# Line 258  extern void eq(environment *env) Line 193  extern void eq(environment *env)
193  {  {
194    void *left, *right;    void *left, *right;
195    
196    switch(check_args(env, unknown, unknown, empty)) {    if(check_args(env, unknown, unknown, empty))
197    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
198    
199    left= CAR(env->head)->content.ptr;    left= CAR(env->head)->content.ptr;
200    right= CAR(CDR(env->head))->content.ptr;    right= CAR(CDR(env->head))->content.ptr;
# Line 281  extern void not(environment *env) Line 208  extern void not(environment *env)
208  {  {
209    int val;    int val;
210    
211    switch(check_args(env, integer, empty)) {    if(check_args(env, integer, empty))
212    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
213    
214    val= CAR(env->head)->content.i;    val= CAR(env->head)->content.i;
215    toss(env);    toss(env);
# Line 310  extern void def(environment *env) Line 229  extern void def(environment *env)
229    symbol *sym;    symbol *sym;
230    
231    /* Needs two values on the stack, the top one must be a symbol */    /* Needs two values on the stack, the top one must be a symbol */
232    switch(check_args(env, symb, unknown, empty)) {    if(check_args(env, symb, unknown, empty))
233    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
234    
235    /* long names are a pain */    /* long names are a pain */
236    sym= CAR(env->head)->content.sym;    sym= CAR(env->head)->content.sym;
# Line 341  extern void forget(environment *env) Line 252  extern void forget(environment *env)
252  {  {
253    char* sym_id;    char* sym_id;
254    
255    switch(check_args(env, symb, empty)) {    if(check_args(env, symb, empty))
256    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
257    
258    sym_id= CAR(env->head)->content.sym->id;    sym_id= CAR(env->head)->content.sym->id;
259    toss(env);    toss(env);
# Line 373  extern void sx_2b(environment *env) Line 276  extern void sx_2b(environment *env)
276    char* new_string;    char* new_string;
277    value *a_val, *b_val;    value *a_val, *b_val;
278    
279    if(check_args(env, unknown, unknown, empty)==1) {    if(check_args(env, unknown, unknown, empty))
280      printerr(env, "Too Few Arguments");      return printerr(env);
     return;  
   }  
281    
282    if(check_args(env, string, string, empty)==0) {    if(check_args(env, string, string, empty)==0) {
283      a_val= CAR(env->head);      a_val= CAR(env->head);
# Line 436  extern void sx_2b(environment *env) Line 337  extern void sx_2b(environment *env)
337      return;      return;
338    }    }
339    
340    printerr(env, "Bad Argument Type");    return printerr(env);
   env->err=2;  
341  }  }
342    
343  /* "-" */  /* "-" */
# Line 446  extern void sx_2d(environment *env) Line 346  extern void sx_2d(environment *env)
346    int a, b;    int a, b;
347    float fa, fb;    float fa, fb;
348    
349    if(check_args(env, unknown, unknown, empty)==1) {    if(check_args(env, unknown, unknown, empty))
350      printerr(env, "Too Few Arguments");      return printerr(env);
     return;  
   }  
351    
352    if(check_args(env, integer, integer, empty)==0) {    if(check_args(env, integer, integer, empty)==0) {
353      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
# Line 491  extern void sx_2d(environment *env) Line 389  extern void sx_2d(environment *env)
389      return;      return;
390    }    }
391    
392    printerr(env, "Bad Argument Type");    return printerr(env);
   env->err=2;  
393  }  }
394    
395  /* ">" */  /* ">" */
# Line 501  extern void sx_3e(environment *env) Line 398  extern void sx_3e(environment *env)
398    int a, b;    int a, b;
399    float fa, fb;    float fa, fb;
400    
401    if(check_args(env, unknown, unknown, empty)==1) {    if(check_args(env, unknown, unknown, empty))
402      printerr(env, "Too Few Arguments");      return printerr(env);
     return;  
   }  
403    
404    if(check_args(env, integer, integer, empty)==0) {    if(check_args(env, integer, integer, empty)==0) {
405      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
# Line 546  extern void sx_3e(environment *env) Line 441  extern void sx_3e(environment *env)
441      return;      return;
442    }    }
443    
444    printerr(env, "Bad Argument Type");    return printerr(env);
   env->err= 2;  
445  }  }
446    
447  /* "<" */  /* "<" */
# Line 574  extern void sx_3e3d(environment *env) Line 468  extern void sx_3e3d(environment *env)
468  /* "dup"; duplicates an item on the stack */  /* "dup"; duplicates an item on the stack */
469  extern void sx_647570(environment *env)  extern void sx_647570(environment *env)
470  {  {
471    switch(check_args(env, unknown, empty)) {    if(check_args(env, unknown, empty))
472    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
473    
474    push_val(env, copy_val(env, CAR(env->head)));    push_val(env, copy_val(env, CAR(env->head)));
475  }  }
# Line 593  extern void sx_6966(environment *env) Line 479  extern void sx_6966(environment *env)
479  {  {
480    int truth;    int truth;
481    
482    switch(check_args(env, unknown, integer, empty)) {    if(check_args(env, unknown, integer, empty))
483    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
484    
485    swap(env);    swap(env);
486    if(env->err) return;    if(env->err) return;
# Line 623  extern void ifelse(environment *env) Line 501  extern void ifelse(environment *env)
501  {  {
502    int truth;    int truth;
503    
504    switch(check_args(env, unknown, unknown, integer, empty)) {    if(check_args(env, unknown, unknown, integer, empty))
505    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
506    
507    rot(env);    rot(env);
508    if(env->err) return;    if(env->err) return;
# Line 656  extern void ifelse(environment *env) Line 526  extern void ifelse(environment *env)
526  extern void sx_656c7365(environment *env)  extern void sx_656c7365(environment *env)
527  {  {
528    
529    switch(check_args(env,    if(check_args(env, unknown, symb, unknown, symb, integer, empty))
530                      unknown, symb, unknown, symb, integer,      return printerr(env);
                     empty)) {  
   case 1:  
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
531    
532    /// XXX    /// XXX
533    
# Line 675  extern void sx_656c7365(environment *env Line 535  extern void sx_656c7365(environment *env
535       || strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0       || strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0
536       || CAR(CDR(CDR(CDR(env->head))))->type!=symb       || CAR(CDR(CDR(CDR(env->head))))->type!=symb
537       || strcmp(CAR(CDR(CDR(CDR(env->head))))->content.sym->id, "if")!=0) {       || strcmp(CAR(CDR(CDR(CDR(env->head))))->content.sym->id, "if")!=0) {
     printerr(env, "Bad Argument Type");  
538      env->err= 2;      env->err= 2;
539      return;      return printerr(env);
540    }    }
541    
542    swap(env); toss(env); rot(env); toss(env);    swap(env); toss(env); rot(env); toss(env);
# Line 687  extern void sx_656c7365(environment *env Line 546  extern void sx_656c7365(environment *env
546  extern void then(environment *env)  extern void then(environment *env)
547  {  {
548        
549    switch(check_args(env, unknown, symb, integer, empty)) {    if(check_args(env, unknown, symb, integer, empty))
550    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
551    
552    /// XXX    /// XXX
553    
554    if(CAR(CDR(env->head))->type!=symb    if(CAR(CDR(env->head))->type!=symb
555       || strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) {       || strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) {
     printerr(env, "Bad Argument Type");  
556      env->err= 2;      env->err= 2;
557      return;      return printerr(env);
558    }    }
559    
560    swap(env); toss(env);    swap(env); toss(env);
# Line 717  extern void sx_7768696c65(environment *e Line 567  extern void sx_7768696c65(environment *e
567    int truth;    int truth;
568    value *loop, *test;    value *loop, *test;
569    
570    switch(check_args(env, unknown, integer, empty)) {    if(check_args(env, unknown, integer, empty))
571    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
572    
573    loop= CAR(env->head);    loop= CAR(env->head);
574    protect(loop);    protect(loop);
# Line 743  extern void sx_7768696c65(environment *e Line 585  extern void sx_7768696c65(environment *e
585      /// XXX      /// XXX
586            
587      if(CAR(env->head)->type != integer) {      if(CAR(env->head)->type != integer) {
       printerr(env, "Bad Argument Type");  
588        env->err= 2;        env->err= 2;
589        return;        return printerr(env);
590      }      }
591            
592      truth= CAR(env->head)->content.i;      truth= CAR(env->head)->content.i;
# Line 770  extern void sx_666f72(environment *env) Line 611  extern void sx_666f72(environment *env)
611    value *loop;    value *loop;
612    int foo1, foo2;    int foo1, foo2;
613    
614    switch(check_args(env, unknown, integer, integer, empty)) {    if(check_args(env, unknown, integer, integer, empty))
615    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
616    
617    loop= CAR(env->head);    loop= CAR(env->head);
618    protect(loop);    protect(loop);
# Line 816  extern void foreach(environment *env) Line 649  extern void foreach(environment *env)
649    value *loop, *foo;    value *loop, *foo;
650    value *iterator;    value *iterator;
651    
652    switch(check_args(env, unknown, tcons, empty)) {    if(check_args(env, unknown, tcons, empty))
653    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
654        
655    loop= CAR(env->head);    loop= CAR(env->head);
656    protect(loop);    protect(loop);
# Line 846  extern void foreach(environment *env) Line 671  extern void foreach(environment *env)
671      if (iterator->type == tcons){      if (iterator->type == tcons){
672        iterator= CDR(iterator);        iterator= CDR(iterator);
673      } else {      } else {
674        printerr(env, "Bad Argument Type"); /* Improper list */        env->err= 2; /* Improper list */
       env->err= 2;  
675        break;        break;
676      }      }
677    }    }
678    unprotect(loop); unprotect(foo);    unprotect(loop); unprotect(foo);
679      
680      return printerr(env);
681  }  }
682    
683  /* "to" */  /* "to" */
# Line 860  extern void to(environment *env) Line 686  extern void to(environment *env)
686    int ending, start, i;    int ending, start, i;
687    value *iterator, *temp, *end;    value *iterator, *temp, *end;
688    
689    switch(check_args(env, integer, integer, empty)) {    if(check_args(env, integer, integer, empty))
690    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
691    
692    end= new_val(env);    end= new_val(env);
693    
# Line 926  extern void readlineport(environment *en Line 744  extern void readlineport(environment *en
744  {  {
745    FILE *stream;    FILE *stream;
746    
747    switch(check_args(env, port, empty)) {    if(check_args(env, port, empty))
748    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
749    
750    stream=CAR(env->head)->content.p;    stream=CAR(env->head)->content.p;
751    readlinestream(env, stream); if(env->err) return;    readlinestream(env, stream); if(env->err) return;
# Line 955  extern void readport(environment *env) Line 765  extern void readport(environment *env)
765  {  {
766    FILE *stream;    FILE *stream;
767    
768    switch(check_args(env, port, empty)) {    if(check_args(env, port, empty))
769    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
770    
771    stream=CAR(env->head)->content.p;    stream=CAR(env->head)->content.p;
772    readstream(env, stream); if(env->err) return;    readstream(env, stream); if(env->err) return;
# Line 978  extern void beep(environment *env) Line 780  extern void beep(environment *env)
780  {  {
781    int freq, dur, period, ticks;    int freq, dur, period, ticks;
782    
783    switch(check_args(env, integer, integer, empty)) {    if(check_args(env, integer, integer, empty))
784    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
785    
786    dur= CAR(env->head)->content.i;    dur= CAR(env->head)->content.i;
787    toss(env);    toss(env);
# Line 1021  extern void sx_77616974(environment *env Line 815  extern void sx_77616974(environment *env
815  {  {
816    int dur;    int dur;
817    
818    switch(check_args(env, integer, empty)) {    if(check_args(env, integer, empty))
819    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
820    
821    dur= CAR(env->head)->content.i;    dur= CAR(env->head)->content.i;
822    toss(env);    toss(env);
# Line 1045  extern void sx_2a(environment *env) Line 831  extern void sx_2a(environment *env)
831    int a, b;    int a, b;
832    float fa, fb;    float fa, fb;
833    
834    if(check_args(env, unknown, unknown, empty)==1) {    if(check_args(env, unknown, unknown, empty))
835      printerr(env, "Too Few Arguments");      return printerr(env);
     return;  
   }  
836    
837    if(check_args(env, integer, integer, empty)==0) {    if(check_args(env, integer, integer, empty)==0) {
838      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
# Line 1090  extern void sx_2a(environment *env) Line 874  extern void sx_2a(environment *env)
874      return;      return;
875    }    }
876    
877    printerr(env, "Bad Argument Type");    return printerr(env);
   env->err= 2;  
878  }  }
879    
880  /* "/" */  /* "/" */
# Line 1100  extern void sx_2f(environment *env) Line 883  extern void sx_2f(environment *env)
883    int a, b;    int a, b;
884    float fa, fb;    float fa, fb;
885    
886    if(check_args(env, unknown, unknown, empty)==1) {    if(check_args(env, unknown, unknown, empty))
887      printerr(env, "Too Few Arguments");      return printerr(env);
     return;  
   }  
888    
889    if(check_args(env, integer, integer, empty)==0) {    if(check_args(env, integer, integer, empty)==0) {
890      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
# Line 1145  extern void sx_2f(environment *env) Line 926  extern void sx_2f(environment *env)
926      return;      return;
927    }    }
928    
929    printerr(env, "Bad Argument Type");    return printerr(env);
   env->err= 2;  
930  }  }
931    
932  /* "mod" */  /* "mod" */
# Line 1154  extern void mod(environment *env) Line 934  extern void mod(environment *env)
934  {  {
935    int a, b;    int a, b;
936    
937    if(check_args(env, unknown, unknown, empty)==1) {    if(check_args(env, unknown, unknown, empty))
938      printerr(env, "Too Few Arguments");      return printerr(env);
     return;  
   }  
939    
940    if(check_args(env, integer, integer, empty)==0) {    if(check_args(env, integer, integer, empty)==0) {
941      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
# Line 1169  extern void mod(environment *env) Line 947  extern void mod(environment *env)
947      return;      return;
948    }    }
949    
950    printerr(env, "Bad Argument Type");    return printerr(env);
   env->err= 2;  
951  }  }
952    
953    
954  /* "div" */  /* "div" */
955  extern void sx_646976(environment *env)  extern void sx_646976(environment *env)
956  {  {
957    int a, b;    int a, b;
958    
959    if(check_args(env, unknown, unknown, empty)==1) {    if(check_args(env, integer, integer, empty))
960      printerr(env, "Too Few Arguments");      return printerr(env);
     return;  
   }  
961        
962    if(check_args(env, integer, integer, empty)==0) {    a= CAR(env->head)->content.i;
963      a= CAR(env->head)->content.i;    toss(env); if(env->err) return;
964      toss(env); if(env->err) return;    b= CAR(env->head)->content.i;
965      b= CAR(env->head)->content.i;    toss(env); if(env->err) return;
966      toss(env); if(env->err) return;    push_int(env, (int)b/a);
     push_int(env, (int)b/a);  
   
     return;  
   }  
   
   printerr(env, "Bad Argument Type");  
   env->err= 2;  
967  }  }
968    
969    
970  extern void setcar(environment *env)  extern void setcar(environment *env)
971  {  {
972    
973    switch(check_args(env, tcons, unknown, empty)) {    if(check_args(env, tcons, unknown, empty))
974    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
975    
976    CAR(CAR(CDR(env->head)))=CAR(env->head);    CAR(CAR(CDR(env->head)))=CAR(env->head);
977    toss(env);    toss(env);
# Line 1219  extern void setcar(environment *env) Line 980  extern void setcar(environment *env)
980  extern void setcdr(environment *env)  extern void setcdr(environment *env)
981  {  {
982    
983    switch(check_args(env, tcons, unknown, empty)) {    if(check_args(env, tcons, unknown, empty))
984    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
985    
986    CDR(CAR(CDR(env->head)))=CAR(env->head);    CDR(CAR(CDR(env->head)))=CAR(env->head);
987    toss(env);    toss(env);
# Line 1237  extern void setcdr(environment *env) Line 990  extern void setcdr(environment *env)
990  extern void car(environment *env)  extern void car(environment *env)
991  {  {
992    
993    switch(check_args(env, tcons, empty)) {    if(check_args(env, tcons, empty))
994    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
995    
996    CAR(env->head)=CAR(CAR(env->head));    CAR(env->head)=CAR(CAR(env->head));
997  }  }
# Line 1254  extern void car(environment *env) Line 999  extern void car(environment *env)
999  extern void cdr(environment *env)  extern void cdr(environment *env)
1000  {  {
1001    
1002    switch(check_args(env, tcons, empty)) {    if(check_args(env, tcons, empty))
1003    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
1004    
1005    CAR(env->head)=CDR(CAR(env->head));    CAR(env->head)=CDR(CAR(env->head));
1006  }  }
# Line 1272  extern void cons(environment *env) Line 1009  extern void cons(environment *env)
1009  {  {
1010    value *val;    value *val;
1011    
1012    switch(check_args(env, unknown, unknown, empty)) {    if(check_args(env, unknown, unknown, empty))
1013    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
1014    
1015    val=new_val(env);    val=new_val(env);
1016    val->content.c= malloc(sizeof(pair));    val->content.c= malloc(sizeof(pair));
# Line 1298  extern void cons(environment *env) Line 1027  extern void cons(environment *env)
1027    swap(env); if(env->err) return;    swap(env); if(env->err) return;
1028    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1029    swap(env); if(env->err) return;    swap(env); if(env->err) return;
1030    toss(env); if(env->err) return;    toss(env);
1031  }  }
1032    
1033    
# Line 1309  void assocgen(environment *env, funcp eq Line 1038  void assocgen(environment *env, funcp eq
1038    
1039    /* Needs two values on the stack, the top one must be an association    /* Needs two values on the stack, the top one must be an association
1040       list */       list */
1041    switch(check_args(env, tcons, unknown, empty)) {    if(check_args(env, tcons, unknown, empty))
1042    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
1043    
1044    key=CAR(CDR(env->head));    key=CAR(CDR(env->head));
1045    item=CAR(env->head);    item=CAR(env->head);
1046    
1047    while(item->type == tcons){    while(item->type == tcons){
1048      if(CAR(item)->type != tcons){      if(CAR(item)->type != tcons){
       printerr(env, "Bad Argument Type");  
1049        env->err= 2;        env->err= 2;
1050        return;        return printerr(env);
1051      }      }
1052    
1053      push_val(env, key);      push_val(env, key);
1054      push_val(env, CAR(CAR(item)));      push_val(env, CAR(CAR(item)));
1055      eqfunc(env); if(env->err) return;      eqfunc((void*)env); if(env->err) return;
1056    
1057      /* Check the result of 'eqfunc' */      /* Check the result of 'eqfunc' */
1058      if(env->head->type==empty) {      if(check_args(env, integer, empty))
1059        printerr(env, "Too Few Arguments");        return printerr(env);
       env->err= 1;  
     return;  
     }  
     if(CAR(env->head)->type!=integer) {  
       printerr(env, "Bad Argument Type");  
       env->err= 2;  
       return;  
     }  
1060    
1061      if(CAR(env->head)->content.i){      if(CAR(env->head)->content.i){
1062        toss(env); if(env->err) return;        toss(env); if(env->err) return;
# Line 1352  void assocgen(environment *env, funcp eq Line 1065  void assocgen(environment *env, funcp eq
1065      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1066    
1067      if(item->type!=tcons) {      if(item->type!=tcons) {
       printerr(env, "Bad Argument Type");  
1068        env->err= 2;        env->err= 2;
1069        return;        return printerr(env);
1070      }      }
1071    
1072      item=CDR(item);      item=CDR(item);
# Line 1376  void assocgen(environment *env, funcp eq Line 1088  void assocgen(environment *env, funcp eq
1088  /*  1: [ [ 1 . 2 ] [ 3 . 4 ] ]  =>  1: [ 3 . 4 ]  */  /*  1: [ [ 1 . 2 ] [ 3 . 4 ] ]  =>  1: [ 3 . 4 ]  */
1089  extern void assq(environment *env)  extern void assq(environment *env)
1090  {  {
1091    assocgen(env, eq);    assocgen(env, (void*)eq);
1092  }  }
1093    
1094    
# Line 1395  extern void sx_6f70656e(environment *env Line 1107  extern void sx_6f70656e(environment *env
1107    value *new_port;    value *new_port;
1108    FILE *stream;    FILE *stream;
1109    
1110    switch(check_args(env, string, string, empty)) {    if(check_args(env, string, string, empty))
1111    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
1112    
1113    stream=fopen(CAR(CDR(env->head))->content.ptr,    stream=fopen(CAR(CDR(env->head))->content.ptr,
1114                 CAR(env->head)->content.ptr);                 CAR(env->head)->content.ptr);
# Line 1433  extern void sx_636c6f7365(environment *e Line 1137  extern void sx_636c6f7365(environment *e
1137  {  {
1138    int ret;    int ret;
1139    
1140    switch(check_args(env, port, empty)) {    if(check_args(env, port, empty))
1141    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
1142    
1143    ret= fclose(CAR(env->head)->content.p);    ret= fclose(CAR(env->head)->content.p);
1144    
# Line 1460  extern void mangle(environment *env) Line 1156  extern void mangle(environment *env)
1156  {  {
1157    char *new_string;    char *new_string;
1158    
1159    switch(check_args(env, string, empty)) {    if(check_args(env, string, empty))
1160    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
1161    
1162    new_string= mangle_str(CAR(env->head)->content.string);    new_string= mangle_str(CAR(env->head)->content.string);
1163    
# Line 1489  extern void sx_666f726b(environment *env Line 1177  extern void sx_666f726b(environment *env
1177  extern void sx_77616974706964(environment *env)  extern void sx_77616974706964(environment *env)
1178  {  {
1179    
1180    switch(check_args(env, integer, empty)) {    if(check_args(env, integer, empty))
1181    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
1182    
1183    push_int(env, waitpid(CAR(env->head)->content.i, NULL, 0));    push_int(env, waitpid(CAR(env->head)->content.i, NULL, 0));
1184    swap(env); toss(env);    swap(env); toss(env);
# Line 1509  extern void sx_77616974706964(environmen Line 1189  extern void sx_77616974706964(environmen
1189  extern void toss(environment *env)  extern void toss(environment *env)
1190  {  {
1191    
1192    switch(check_args(env, unknown, empty)) {    if(check_args(env, unknown, empty))
1193    case 1:      return printerr(env);
     printerr(env, "Too Few Arguments");  
     return;  
   case 2:  
     printerr(env, "Bad Argument Type");  
     return;  
   default:  
     break;  
   }  
1194    
1195    env->head= CDR(env->head); /* Remove the top stack item */    env->head= CDR(env->head); /* Remove the top stack item */
1196  }  }
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26