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

Diff of /stack/symbols.c

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

revision 1.5 by masse, Fri Aug 8 14:20:49 2003 UTC revision 1.6 by masse, Mon Aug 11 14:31:48 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    if(env->head->type==empty) {    switch(check_args(env, port, empty)) {
14      printerr("Too Few Arguments");    case 1:
15      env->err= 1;      printerr(env, "Too Few Arguments");
16      return;      return;
17    }    case 2:
18        printerr(env, "Bad Argument Type");
   if(CAR(env->head)->type!=port) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
19      return;      return;
20      default:
21        break;
22    }    }
23    
24    if(fprintf(CAR(env->head)->content.p, "\n") < 0){    if(fprintf(CAR(env->head)->content.p, "\n") < 0){
# Line 33  extern void nlport(environment *env) Line 32  extern void nlport(environment *env)
32  /* Gets the type of a value */  /* Gets the type of a value */
33  extern void type(environment *env)  extern void type(environment *env)
34  {  {
35    if(env->head->type==empty) {  
36      printerr("Too Few Arguments");    switch(check_args(env, unknown, empty)) {
37      env->err= 1;    case 1:
38        printerr(env, "Too Few Arguments");
39        return;
40      case 2:
41        printerr(env, "Bad Argument Type");
42      return;      return;
43      default:
44        break;
45    }    }
46    
47    switch(CAR(env->head)->type){    switch(CAR(env->head)->type){
48    case empty:    case empty:
49      push_sym(env, "empty");      push_sym(env, "empty");
50      break;      break;
51      case unknown:
52        push_sym(env, "unknown");
53        break;
54    case integer:    case integer:
55      push_sym(env, "integer");      push_sym(env, "integer");
56      break;      break;
# Line 73  extern void type(environment *env) Line 81  extern void type(environment *env)
81  /* Print the top element of the stack but don't discard it */  /* Print the top element of the stack but don't discard it */
82  extern void print_(environment *env)  extern void print_(environment *env)
83  {  {
84    if(env->head->type==empty) {  
85      printerr("Too Few Arguments");    switch(check_args(env, unknown, empty)) {
86      env->err= 1;    case 1:
87        printerr(env, "Too Few Arguments");
88        return;
89      case 2:
90        printerr(env, "Bad Argument Type");
91      return;      return;
92      default:
93        break;
94    }    }
95    
96    print_val(env, CAR(env->head), 0, NULL, stdout);    print_val(env, CAR(env->head), 0, NULL, stdout);
97    if(env->err) return;    if(env->err) return;
98    nl(env);    nl(env);
# Line 95  extern void print(environment *env) Line 110  extern void print(environment *env)
110     discard it. */     discard it. */
111  extern void princ_(environment *env)  extern void princ_(environment *env)
112  {  {
113    if(env->head->type==empty) {  
114      printerr("Too Few Arguments");    switch(check_args(env, unknown, empty)) {
115      env->err= 1;    case 1:
116        printerr(env, "Too Few Arguments");
117        return;
118      case 2:
119        printerr(env, "Bad Argument Type");
120      return;      return;
121      default:
122        break;
123    }    }
124    
125    print_val(env, CAR(env->head), 1, NULL, stdout);    print_val(env, CAR(env->head), 1, NULL, stdout);
126  }  }
127    
# Line 114  extern void princ(environment *env) Line 136  extern void princ(environment *env)
136  /* Print a value to a port, but don't discard it */  /* Print a value to a port, but don't discard it */
137  extern void printport_(environment *env)  extern void printport_(environment *env)
138  {  {
   if(env->head->type==empty ||  CDR(env->head)->type == empty) {  
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
139    
140    if(CAR(env->head)->type!=port) {    switch(check_args(env, port, unknown, empty)) {
141      printerr("Bad Argument Type");    case 1:
142      env->err= 2;      printerr(env, "Too Few Arguments");
143      return;      return;
144      case 2:
145        printerr(env, "Bad Argument Type");
146        return;
147      default:
148        break;
149    }    }
150    
151    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);
# Line 142  extern void printport(environment *env) Line 164  extern void printport(environment *env)
164  /* Print, without quotes, to a port, a value, but don't discard it. */  /* Print, without quotes, to a port, a value, but don't discard it. */
165  extern void princport_(environment *env)  extern void princport_(environment *env)
166  {  {
   if(env->head->type==empty ||  CDR(env->head)->type == empty) {  
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
167    
168    if(CAR(env->head)->type!=port) {    switch(check_args(env, port, unknown, empty)) {
169      printerr("Bad Argument Type");    case 1:
170      env->err= 2;      printerr(env, "Too Few Arguments");
171      return;      return;
172      case 2:
173        printerr(env, "Bad Argument Type");
174        return;
175      default:
176        break;
177    }    }
178    
179    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);
# Line 170  extern void princport(environment *env) Line 192  extern void princport(environment *env)
192  extern void rot(environment *env)  extern void rot(environment *env)
193  {  {
194    value *temp= env->head;    value *temp= env->head;
195      
196    if(env->head->type == empty || CDR(env->head)->type == empty    switch(check_args(env, unknown, unknown, unknown, empty)) {
197       || CDR(CDR(env->head))->type == empty) {    case 1:
198      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
199      env->err= 1;      return;
200      case 2:
201        printerr(env, "Bad Argument Type");
202      return;      return;
203      default:
204        break;
205    }    }
206        
207    env->head= CDR(CDR(env->head));    env->head= CDR(CDR(env->head));
# Line 188  extern void expand(environment *env) Line 214  extern void expand(environment *env)
214  {  {
215    value *temp, *new_head;    value *temp, *new_head;
216    
217    /* Is top element a list? */    switch(check_args(env, tcons, empty)) {
218    if(env->head->type==empty) {    case 1:
219      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
220      return;      return;
221    }    case 2:
222        printerr(env, "Bad Argument Type");
   if(CAR(env->head)->type!=tcons) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
223      return;      return;
224      default:
225        break;
226    }    }
227    
228    rev(env);    rev(env);
# Line 211  extern void expand(environment *env) Line 235  extern void expand(environment *env)
235    
236    toss(env);    toss(env);
237    
238      /// XXX
239    /* Find the end of the list */    /* Find the end of the list */
240    while(CDR(temp)->type != empty) {    while(CDR(temp)->type != empty) {
241      if (CDR(temp)->type == tcons)      if (CDR(temp)->type == tcons)
242        temp= CDR(temp);        temp= CDR(temp);
243      else {      else {
244        printerr("Bad Argument Type"); /* Improper list */        printerr(env, "Bad Argument Type"); /* Improper list */
245        env->err= 2;        env->err= 2;
246        return;        return;
247      }      }
# Line 233  extern void eq(environment *env) Line 258  extern void eq(environment *env)
258  {  {
259    void *left, *right;    void *left, *right;
260    
261    if(env->head->type==empty || CDR(env->head)->type==empty) {    switch(check_args(env, unknown, unknown, empty)) {
262      printerr("Too Few Arguments");    case 1:
263      env->err= 1;      printerr(env, "Too Few Arguments");
264        return;
265      case 2:
266        printerr(env, "Bad Argument Type");
267      return;      return;
268      default:
269        break;
270    }    }
271    
272    left= CAR(env->head)->content.ptr;    left= CAR(env->head)->content.ptr;
# Line 251  extern void not(environment *env) Line 281  extern void not(environment *env)
281  {  {
282    int val;    int val;
283    
284    if(env->head->type==empty) {    switch(check_args(env, integer, empty)) {
285      printerr("Too Few Arguments");    case 1:
286      env->err= 1;      printerr(env, "Too Few Arguments");
287      return;      return;
288    }    case 2:
289        printerr(env, "Bad Argument Type");
   if(CAR(env->head)->type!=integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
290      return;      return;
291      default:
292        break;
293    }    }
294    
295    val= CAR(env->head)->content.i;    val= CAR(env->head)->content.i;
# Line 281  extern void def(environment *env) Line 310  extern void def(environment *env)
310    symbol *sym;    symbol *sym;
311    
312    /* 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 */
313    if(env->head->type==empty || CDR(env->head)->type==empty) {    switch(check_args(env, symb, unknown, empty)) {
314      printerr("Too Few Arguments");    case 1:
315      env->err= 1;      printerr(env, "Too Few Arguments");
316      return;      return;
317    }    case 2:
318        printerr(env, "Bad Argument Type");
   if(CAR(env->head)->type!=symb) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
319      return;      return;
320      default:
321        break;
322    }    }
323    
324    /* long names are a pain */    /* long names are a pain */
# Line 313  extern void forget(environment *env) Line 341  extern void forget(environment *env)
341  {  {
342    char* sym_id;    char* sym_id;
343    
344    if(env->head->type==empty) {    switch(check_args(env, symb, empty)) {
345      printerr("Too Few Arguments");    case 1:
346      env->err= 1;      printerr(env, "Too Few Arguments");
347      return;      return;
348    }    case 2:
349          printerr(env, "Bad Argument Type");
   if(CAR(env->head)->type!=symb) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
350      return;      return;
351      default:
352        break;
353    }    }
354    
355    sym_id= CAR(env->head)->content.sym->id;    sym_id= CAR(env->head)->content.sym->id;
# Line 346  extern void sx_2b(environment *env) Line 373  extern void sx_2b(environment *env)
373    char* new_string;    char* new_string;
374    value *a_val, *b_val;    value *a_val, *b_val;
375    
376    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, unknown, unknown, empty)==1) {
377      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
378      return;      return;
379    }    }
380    
381    if(CAR(env->head)->type==string    if(check_args(env, string, string, empty)==0) {
      && CAR(CDR(env->head))->type==string) {  
382      a_val= CAR(env->head);      a_val= CAR(env->head);
383      b_val= CAR(CDR(env->head));      b_val= CAR(CDR(env->head));
384      protect(a_val); protect(b_val);      protect(a_val); protect(b_val);
# Line 371  extern void sx_2b(environment *env) Line 396  extern void sx_2b(environment *env)
396      return;      return;
397    }    }
398        
399    if(CAR(env->head)->type==integer    if(check_args(env, integer, integer, empty)==0) {
      && CAR(CDR(env->head))->type==integer) {  
400      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
401      toss(env); if(env->err) return;      toss(env); if(env->err) return;
402      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 382  extern void sx_2b(environment *env) Line 406  extern void sx_2b(environment *env)
406      return;      return;
407    }    }
408    
409    if(CAR(env->head)->type==tfloat    if(check_args(env, tfloat, tfloat, empty)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
410      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
411      toss(env); if(env->err) return;      toss(env); if(env->err) return;
412      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 393  extern void sx_2b(environment *env) Line 416  extern void sx_2b(environment *env)
416      return;      return;
417    }    }
418    
419    if(CAR(env->head)->type==tfloat    if(check_args(env, tfloat, integer, empty)==0) {
      && CAR(CDR(env->head))->type==integer) {  
420      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
421      toss(env); if(env->err) return;      toss(env); if(env->err) return;
422      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 404  extern void sx_2b(environment *env) Line 426  extern void sx_2b(environment *env)
426      return;      return;
427    }    }
428    
429    if(CAR(env->head)->type==integer    if(check_args(env, integer, tfloat, empty)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
430      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
431      toss(env); if(env->err) return;      toss(env); if(env->err) return;
432      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 415  extern void sx_2b(environment *env) Line 436  extern void sx_2b(environment *env)
436      return;      return;
437    }    }
438    
439    printerr("Bad Argument Type");    printerr(env, "Bad Argument Type");
440    env->err=2;    env->err=2;
441  }  }
442    
# Line 425  extern void sx_2d(environment *env) Line 446  extern void sx_2d(environment *env)
446    int a, b;    int a, b;
447    float fa, fb;    float fa, fb;
448    
449    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, unknown, unknown, empty)==1) {
450      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err=1;  
451      return;      return;
452    }    }
453      
454    if(CAR(env->head)->type==integer    if(check_args(env, integer, integer, empty)==0) {
      && CAR(CDR(env->head))->type==integer) {  
455      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
456      toss(env); if(env->err) return;      toss(env); if(env->err) return;
457      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 442  extern void sx_2d(environment *env) Line 461  extern void sx_2d(environment *env)
461      return;      return;
462    }    }
463    
464    if(CAR(env->head)->type==tfloat    if(check_args(env, tfloat, tfloat, empty)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
465      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
466      toss(env); if(env->err) return;      toss(env); if(env->err) return;
467      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 453  extern void sx_2d(environment *env) Line 471  extern void sx_2d(environment *env)
471      return;      return;
472    }    }
473    
474    if(CAR(env->head)->type==tfloat    if(check_args(env, tfloat, integer, empty)==0) {
      && CAR(CDR(env->head))->type==integer) {  
475      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
476      toss(env); if(env->err) return;      toss(env); if(env->err) return;
477      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 464  extern void sx_2d(environment *env) Line 481  extern void sx_2d(environment *env)
481      return;      return;
482    }    }
483    
484    if(CAR(env->head)->type==integer    if(check_args(env, integer, tfloat, empty)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
485      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
486      toss(env); if(env->err) return;      toss(env); if(env->err) return;
487      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 475  extern void sx_2d(environment *env) Line 491  extern void sx_2d(environment *env)
491      return;      return;
492    }    }
493    
494    printerr("Bad Argument Type");    printerr(env, "Bad Argument Type");
495    env->err=2;    env->err=2;
496  }  }
497    
# Line 485  extern void sx_3e(environment *env) Line 501  extern void sx_3e(environment *env)
501    int a, b;    int a, b;
502    float fa, fb;    float fa, fb;
503    
504    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, unknown, unknown, empty)==1) {
505      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
506      return;      return;
507    }    }
508      
509    if(CAR(env->head)->type==integer    if(check_args(env, integer, integer, empty)==0) {
      && CAR(CDR(env->head))->type==integer) {  
510      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
511      toss(env); if(env->err) return;      toss(env); if(env->err) return;
512      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 502  extern void sx_3e(environment *env) Line 516  extern void sx_3e(environment *env)
516      return;      return;
517    }    }
518    
519    if(CAR(env->head)->type==tfloat    if(check_args(env, tfloat, tfloat, empty)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
520      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
521      toss(env); if(env->err) return;      toss(env); if(env->err) return;
522      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 513  extern void sx_3e(environment *env) Line 526  extern void sx_3e(environment *env)
526      return;      return;
527    }    }
528    
529    if(CAR(env->head)->type==tfloat    if(check_args(env, tfloat, integer, empty)==0) {
      && CAR(CDR(env->head))->type==integer) {  
530      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
531      toss(env); if(env->err) return;      toss(env); if(env->err) return;
532      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 524  extern void sx_3e(environment *env) Line 536  extern void sx_3e(environment *env)
536      return;      return;
537    }    }
538    
539    if(CAR(env->head)->type==integer    if(check_args(env, integer, tfloat, empty)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
540      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
541      toss(env); if(env->err) return;      toss(env); if(env->err) return;
542      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 535  extern void sx_3e(environment *env) Line 546  extern void sx_3e(environment *env)
546      return;      return;
547    }    }
548    
549    printerr("Bad Argument Type");    printerr(env, "Bad Argument Type");
550    env->err= 2;    env->err= 2;
551  }  }
552    
# Line 563  extern void sx_3e3d(environment *env) Line 574  extern void sx_3e3d(environment *env)
574  /* "dup"; duplicates an item on the stack */  /* "dup"; duplicates an item on the stack */
575  extern void sx_647570(environment *env)  extern void sx_647570(environment *env)
576  {  {
577    if(env->head->type==empty) {    switch(check_args(env, unknown, empty)) {
578      printerr("Too Few Arguments");    case 1:
579      env->err= 1;      printerr(env, "Too Few Arguments");
580        return;
581      case 2:
582        printerr(env, "Bad Argument Type");
583      return;      return;
584      default:
585        break;
586    }    }
587    
588    push_val(env, copy_val(env, CAR(env->head)));    push_val(env, copy_val(env, CAR(env->head)));
589  }  }
590    
# Line 576  extern void sx_6966(environment *env) Line 593  extern void sx_6966(environment *env)
593  {  {
594    int truth;    int truth;
595    
596    if(env->head->type==empty || CDR(env->head)->type==empty) {    switch(check_args(env, unknown, integer, empty)) {
597      printerr("Too Few Arguments");    case 1:
598      env->err= 1;      printerr(env, "Too Few Arguments");
599      return;      return;
600    }    case 2:
601        printerr(env, "Bad Argument Type");
   if(CAR(CDR(env->head))->type != integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
602      return;      return;
603      default:
604        break;
605    }    }
606      
607    swap(env);    swap(env);
608    if(env->err) return;    if(env->err) return;
609        
# Line 607  extern void ifelse(environment *env) Line 623  extern void ifelse(environment *env)
623  {  {
624    int truth;    int truth;
625    
626    if(env->head->type==empty || CDR(env->head)->type==empty    switch(check_args(env, unknown, unknown, integer, empty)) {
627       || CDR(CDR(env->head))->type==empty) {    case 1:
628      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
629      return;      return;
630    }    case 2:
631        printerr(env, "Bad Argument Type");
   if(CAR(CDR(CDR(env->head)))->type!=integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
632      return;      return;
633      default:
634        break;
635    }    }
636      
637    rot(env);    rot(env);
638    if(env->err) return;    if(env->err) return;
639        
# Line 641  extern void ifelse(environment *env) Line 655  extern void ifelse(environment *env)
655  /* "else" */  /* "else" */
656  extern void sx_656c7365(environment *env)  extern void sx_656c7365(environment *env)
657  {  {
658    if(env->head->type==empty || CDR(env->head)->type==empty  
659       || CDR(CDR(env->head))->type==empty || CDR(CDR(CDR(env->head)))->type==empty    switch(check_args(env,
660       || CDR(CDR(CDR(CDR(env->head))))->type==empty) {                      unknown, symb, unknown, symb, integer,
661      printerr("Too Few Arguments");                      empty)) {
662      env->err= 1;    case 1:
663        printerr(env, "Too Few Arguments");
664        return;
665      case 2:
666        printerr(env, "Bad Argument Type");
667      return;      return;
668      default:
669        break;
670    }    }
671    
672      /// XXX
673    
674    if(CAR(CDR(env->head))->type!=symb    if(CAR(CDR(env->head))->type!=symb
675       || strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0       || strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0
676       || CAR(CDR(CDR(CDR(env->head))))->type!=symb       || CAR(CDR(CDR(CDR(env->head))))->type!=symb
677       || strcmp(CAR(CDR(CDR(CDR(env->head))))->content.sym->id, "if")!=0) {       || strcmp(CAR(CDR(CDR(CDR(env->head))))->content.sym->id, "if")!=0) {
678      printerr("Bad Argument Type");      printerr(env, "Bad Argument Type");
679      env->err= 2;      env->err= 2;
680      return;      return;
681    }    }
# Line 664  extern void sx_656c7365(environment *env Line 686  extern void sx_656c7365(environment *env
686    
687  extern void then(environment *env)  extern void then(environment *env)
688  {  {
689    if(env->head->type==empty || CDR(env->head)->type==empty    
690       || CDR(CDR(env->head))->type==empty) {    switch(check_args(env, unknown, symb, integer, empty)) {
691      printerr("Too Few Arguments");    case 1:
692      env->err= 1;      printerr(env, "Too Few Arguments");
693      return;      return;
694      case 2:
695        printerr(env, "Bad Argument Type");
696        return;
697      default:
698        break;
699    }    }
700    
701      /// XXX
702    
703    if(CAR(CDR(env->head))->type!=symb    if(CAR(CDR(env->head))->type!=symb
704       || strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) {       || strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) {
705      printerr("Bad Argument Type");      printerr(env, "Bad Argument Type");
706      env->err= 2;      env->err= 2;
707      return;      return;
708    }    }
# Line 688  extern void sx_7768696c65(environment *e Line 717  extern void sx_7768696c65(environment *e
717    int truth;    int truth;
718    value *loop, *test;    value *loop, *test;
719    
720    if(env->head->type==empty || CDR(env->head)->type==empty) {    switch(check_args(env, unknown, integer, empty)) {
721      printerr("Too Few Arguments");    case 1:
722      env->err= 1;      printerr(env, "Too Few Arguments");
723        return;
724      case 2:
725        printerr(env, "Bad Argument Type");
726      return;      return;
727      default:
728        break;
729    }    }
730    
731    loop= CAR(env->head);    loop= CAR(env->head);
# Line 705  extern void sx_7768696c65(environment *e Line 739  extern void sx_7768696c65(environment *e
739    do {    do {
740      push_val(env, test);      push_val(env, test);
741      eval(env);      eval(env);
742    
743        /// XXX
744            
745      if(CAR(env->head)->type != integer) {      if(CAR(env->head)->type != integer) {
746        printerr("Bad Argument Type");        printerr(env, "Bad Argument Type");
747        env->err= 2;        env->err= 2;
748        return;        return;
749      }      }
# Line 734  extern void sx_666f72(environment *env) Line 770  extern void sx_666f72(environment *env)
770    value *loop;    value *loop;
771    int foo1, foo2;    int foo1, foo2;
772    
773    if(env->head->type==empty || CDR(env->head)->type==empty    switch(check_args(env, unknown, integer, integer, empty)) {
774       || CDR(CDR(env->head))->type==empty) {    case 1:
775      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
776      return;      return;
777    }    case 2:
778        printerr(env, "Bad Argument Type");
   if(CAR(CDR(env->head))->type!=integer  
      || CAR(CDR(CDR(env->head)))->type!=integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
779      return;      return;
780      default:
781        break;
782    }    }
783    
784    loop= CAR(env->head);    loop= CAR(env->head);
# Line 782  extern void foreach(environment *env) Line 815  extern void foreach(environment *env)
815  {    {  
816    value *loop, *foo;    value *loop, *foo;
817    value *iterator;    value *iterator;
     
   if(env->head->type==empty || CDR(env->head)->type==empty) {  
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
818    
819    if(CAR(CDR(env->head))->type!=tcons) {    switch(check_args(env, unknown, tcons, empty)) {
820      printerr("Bad Argument Type");    case 1:
821      env->err= 2;      printerr(env, "Too Few Arguments");
822        return;
823      case 2:
824        printerr(env, "Bad Argument Type");
825      return;      return;
826      default:
827        break;
828    }    }
829      
830    loop= CAR(env->head);    loop= CAR(env->head);
831    protect(loop);    protect(loop);
832    toss(env); if(env->err) return;    toss(env); if(env->err) return;
# Line 809  extern void foreach(environment *env) Line 841  extern void foreach(environment *env)
841      push_val(env, CAR(iterator));      push_val(env, CAR(iterator));
842      push_val(env, loop);      push_val(env, loop);
843      eval(env); if(env->err) return;      eval(env); if(env->err) return;
844    
845        /// XXX
846      if (iterator->type == tcons){      if (iterator->type == tcons){
847        iterator= CDR(iterator);        iterator= CDR(iterator);
848      } else {      } else {
849        printerr("Bad Argument Type"); /* Improper list */        printerr(env, "Bad Argument Type"); /* Improper list */
850        env->err= 2;        env->err= 2;
851        break;        break;
852      }      }
# Line 826  extern void to(environment *env) Line 860  extern void to(environment *env)
860    int ending, start, i;    int ending, start, i;
861    value *iterator, *temp, *end;    value *iterator, *temp, *end;
862    
863    end= new_val(env);    switch(check_args(env, integer, integer, empty)) {
864      case 1:
865    if(env->head->type==empty || CDR(env->head)->type==empty) {      printerr(env, "Too Few Arguments");
     printerr("Too Few Arguments");  
     env->err= 1;  
866      return;      return;
867    }    case 2:
868        printerr(env, "Bad Argument Type");
   if(CAR(env->head)->type!=integer  
      || CAR(CDR(env->head))->type!=integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
869      return;      return;
870      default:
871        break;
872    }    }
873    
874      end= new_val(env);
875    
876    ending= CAR(env->head)->content.i;    ending= CAR(env->head)->content.i;
877    toss(env); if(env->err) return;    toss(env); if(env->err) return;
878    start= CAR(env->head)->content.i;    start= CAR(env->head)->content.i;
# Line 894  extern void readlineport(environment *en Line 926  extern void readlineport(environment *en
926  {  {
927    FILE *stream;    FILE *stream;
928    
929    if(env->head->type==empty) {    switch(check_args(env, port, empty)) {
930      printerr("Too Few Arguments");    case 1:
931      env->err= 1;      printerr(env, "Too Few Arguments");
932      return;      return;
933    }    case 2:
934        printerr(env, "Bad Argument Type");
   if(CAR(env->head)->type!=port) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
935      return;      return;
936      default:
937        break;
938    }    }
939    
940    stream=CAR(env->head)->content.p;    stream=CAR(env->head)->content.p;
# Line 924  extern void readport(environment *env) Line 955  extern void readport(environment *env)
955  {  {
956    FILE *stream;    FILE *stream;
957    
958    if(env->head->type==empty) {    switch(check_args(env, port, empty)) {
959      printerr("Too Few Arguments");    case 1:
960      env->err= 1;      printerr(env, "Too Few Arguments");
961      return;      return;
962    }    case 2:
963        printerr(env, "Bad Argument Type");
   if(CAR(env->head)->type!=port) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
964      return;      return;
965      default:
966        break;
967    }    }
968    
969    stream=CAR(env->head)->content.p;    stream=CAR(env->head)->content.p;
# Line 948  extern void beep(environment *env) Line 978  extern void beep(environment *env)
978  {  {
979    int freq, dur, period, ticks;    int freq, dur, period, ticks;
980    
981    if(env->head->type==empty || CDR(env->head)->type==empty) {    switch(check_args(env, integer, integer, empty)) {
982      printerr("Too Few Arguments");    case 1:
983      env->err= 1;      printerr(env, "Too Few Arguments");
984      return;      return;
985    }    case 2:
986        printerr(env, "Bad Argument Type");
   if(CAR(env->head)->type!=integer  
      || CAR(CDR(env->head))->type!=integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
987      return;      return;
988      default:
989        break;
990    }    }
991    
992    dur= CAR(env->head)->content.i;    dur= CAR(env->head)->content.i;
# Line 993  extern void sx_77616974(environment *env Line 1021  extern void sx_77616974(environment *env
1021  {  {
1022    int dur;    int dur;
1023    
1024    if(env->head->type==empty) {    switch(check_args(env, integer, empty)) {
1025      printerr("Too Few Arguments");    case 1:
1026      env->err= 1;      printerr(env, "Too Few Arguments");
1027      return;      return;
1028    }    case 2:
1029        printerr(env, "Bad Argument Type");
   if(CAR(env->head)->type!=integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
1030      return;      return;
1031      default:
1032        break;
1033    }    }
1034    
1035    dur= CAR(env->head)->content.i;    dur= CAR(env->head)->content.i;
# Line 1011  extern void sx_77616974(environment *env Line 1038  extern void sx_77616974(environment *env
1038    usleep(dur);    usleep(dur);
1039  }  }
1040    
1041    /// XXXXXX
1042    
1043    
1044  /* "*" */  /* "*" */
1045  extern void sx_2a(environment *env)  extern void sx_2a(environment *env)
1046  {  {
# Line 1018  extern void sx_2a(environment *env) Line 1048  extern void sx_2a(environment *env)
1048    float fa, fb;    float fa, fb;
1049    
1050    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1051      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
1052      env->err= 1;      env->err= 1;
1053      return;      return;
1054    }    }
# Line 1067  extern void sx_2a(environment *env) Line 1097  extern void sx_2a(environment *env)
1097      return;      return;
1098    }    }
1099    
1100    printerr("Bad Argument Type");    printerr(env, "Bad Argument Type");
1101    env->err= 2;    env->err= 2;
1102  }  }
1103    
# Line 1078  extern void sx_2f(environment *env) Line 1108  extern void sx_2f(environment *env)
1108    float fa, fb;    float fa, fb;
1109    
1110    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1111      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
1112      env->err= 1;      env->err= 1;
1113      return;      return;
1114    }    }
# Line 1127  extern void sx_2f(environment *env) Line 1157  extern void sx_2f(environment *env)
1157      return;      return;
1158    }    }
1159    
1160    printerr("Bad Argument Type");    printerr(env, "Bad Argument Type");
1161    env->err= 2;    env->err= 2;
1162  }  }
1163    
# Line 1137  extern void mod(environment *env) Line 1167  extern void mod(environment *env)
1167    int a, b;    int a, b;
1168    
1169    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1170      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
1171      env->err= 1;      env->err= 1;
1172      return;      return;
1173    }    }
# Line 1153  extern void mod(environment *env) Line 1183  extern void mod(environment *env)
1183      return;      return;
1184    }    }
1185    
1186    printerr("Bad Argument Type");    printerr(env, "Bad Argument Type");
1187    env->err= 2;    env->err= 2;
1188  }  }
1189    
# Line 1163  extern void sx_646976(environment *env) Line 1193  extern void sx_646976(environment *env)
1193    int a, b;    int a, b;
1194        
1195    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1196      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
1197      env->err= 1;      env->err= 1;
1198      return;      return;
1199    }    }
# Line 1179  extern void sx_646976(environment *env) Line 1209  extern void sx_646976(environment *env)
1209      return;      return;
1210    }    }
1211    
1212    printerr("Bad Argument Type");    printerr(env, "Bad Argument Type");
1213    env->err= 2;    env->err= 2;
1214  }  }
1215    
1216  extern void setcar(environment *env)  extern void setcar(environment *env)
1217  {  {
1218    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1219      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
1220      env->err= 1;      env->err= 1;
1221      return;      return;
1222    }    }
1223    
1224    if(CDR(env->head)->type!=tcons) {    if(CDR(env->head)->type!=tcons) {
1225      printerr("Bad Argument Type");      printerr(env, "Bad Argument Type");
1226      env->err= 2;      env->err= 2;
1227      return;      return;
1228    }    }
# Line 1204  extern void setcar(environment *env) Line 1234  extern void setcar(environment *env)
1234  extern void setcdr(environment *env)  extern void setcdr(environment *env)
1235  {  {
1236    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1237      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
1238      env->err= 1;      env->err= 1;
1239      return;      return;
1240    }    }
1241    
1242    if(CDR(env->head)->type!=tcons) {    if(CDR(env->head)->type!=tcons) {
1243      printerr("Bad Argument Type");      printerr(env, "Bad Argument Type");
1244      env->err= 2;      env->err= 2;
1245      return;      return;
1246    }    }
# Line 1222  extern void setcdr(environment *env) Line 1252  extern void setcdr(environment *env)
1252  extern void car(environment *env)  extern void car(environment *env)
1253  {  {
1254    if(env->head->type==empty) {    if(env->head->type==empty) {
1255      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
1256      env->err= 1;      env->err= 1;
1257      return;      return;
1258    }    }
1259    
1260    if(CAR(env->head)->type!=tcons) {    if(CAR(env->head)->type!=tcons) {
1261      printerr("Bad Argument Type");      printerr(env, "Bad Argument Type");
1262      env->err= 2;      env->err= 2;
1263      return;      return;
1264    }    }
# Line 1239  extern void car(environment *env) Line 1269  extern void car(environment *env)
1269  extern void cdr(environment *env)  extern void cdr(environment *env)
1270  {  {
1271    if(env->head->type==empty) {    if(env->head->type==empty) {
1272      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
1273      env->err= 1;      env->err= 1;
1274      return;      return;
1275    }    }
1276    
1277    if(CAR(env->head)->type!=tcons) {    if(CAR(env->head)->type!=tcons) {
1278      printerr("Bad Argument Type");      printerr(env, "Bad Argument Type");
1279      env->err= 2;      env->err= 2;
1280      return;      return;
1281    }    }
# Line 1258  extern void cons(environment *env) Line 1288  extern void cons(environment *env)
1288    value *val;    value *val;
1289    
1290    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1291      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
1292      env->err= 1;      env->err= 1;
1293      return;      return;
1294    }    }
# Line 1290  void assocgen(environment *env, funcp eq Line 1320  void assocgen(environment *env, funcp eq
1320    /* 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
1321       list */       list */
1322    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1323      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
1324      env->err= 1;      env->err= 1;
1325      return;      return;
1326    }    }
1327    
1328    if(CAR(env->head)->type!=tcons) {    if(CAR(env->head)->type!=tcons) {
1329      printerr("Bad Argument Type");      printerr(env, "Bad Argument Type");
1330      env->err= 2;      env->err= 2;
1331      return;      return;
1332    }    }
# Line 1306  void assocgen(environment *env, funcp eq Line 1336  void assocgen(environment *env, funcp eq
1336    
1337    while(item->type == tcons){    while(item->type == tcons){
1338      if(CAR(item)->type != tcons){      if(CAR(item)->type != tcons){
1339        printerr("Bad Argument Type");        printerr(env, "Bad Argument Type");
1340        env->err= 2;        env->err= 2;
1341        return;        return;
1342      }      }
# Line 1316  void assocgen(environment *env, funcp eq Line 1346  void assocgen(environment *env, funcp eq
1346    
1347      /* Check the result of 'eqfunc' */      /* Check the result of 'eqfunc' */
1348      if(env->head->type==empty) {      if(env->head->type==empty) {
1349        printerr("Too Few Arguments");        printerr(env, "Too Few Arguments");
1350        env->err= 1;        env->err= 1;
1351      return;      return;
1352      }      }
1353      if(CAR(env->head)->type!=integer) {      if(CAR(env->head)->type!=integer) {
1354        printerr("Bad Argument Type");        printerr(env, "Bad Argument Type");
1355        env->err= 2;        env->err= 2;
1356        return;        return;
1357      }      }
# Line 1333  void assocgen(environment *env, funcp eq Line 1363  void assocgen(environment *env, funcp eq
1363      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1364    
1365      if(item->type!=tcons) {      if(item->type!=tcons) {
1366        printerr("Bad Argument Type");        printerr(env, "Bad Argument Type");
1367        env->err= 2;        env->err= 2;
1368        return;        return;
1369      }      }
# Line 1377  extern void sx_6f70656e(environment *env Line 1407  extern void sx_6f70656e(environment *env
1407    FILE *stream;    FILE *stream;
1408    
1409    if(env->head->type == empty || CDR(env->head)->type == empty) {    if(env->head->type == empty || CDR(env->head)->type == empty) {
1410      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
1411      env->err=1;      env->err=1;
1412      return;      return;
1413    }    }
1414    
1415    if(CAR(env->head)->type != string    if(CAR(env->head)->type != string
1416       || CAR(CDR(env->head))->type != string) {       || CAR(CDR(env->head))->type != string) {
1417      printerr("Bad Argument Type");      printerr(env, "Bad Argument Type");
1418      env->err= 2;      env->err= 2;
1419      return;      return;
1420    }    }
# Line 1417  extern void sx_636c6f7365(environment *e Line 1447  extern void sx_636c6f7365(environment *e
1447    int ret;    int ret;
1448    
1449    if(env->head->type == empty) {    if(env->head->type == empty) {
1450      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
1451      env->err=1;      env->err=1;
1452      return;      return;
1453    }    }
1454    
1455    if(CAR(env->head)->type != port) {    if(CAR(env->head)->type != port) {
1456      printerr("Bad Argument Type");      printerr(env, "Bad Argument Type");
1457      env->err= 2;      env->err= 2;
1458      return;      return;
1459    }    }
# Line 1444  extern void mangle(environment *env) Line 1474  extern void mangle(environment *env)
1474    char *new_string;    char *new_string;
1475    
1476    if(env->head->type==empty) {    if(env->head->type==empty) {
1477      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
1478      env->err= 1;      env->err= 1;
1479      return;      return;
1480    }    }
1481    
1482    if(CAR(env->head)->type!=string) {    if(CAR(env->head)->type!=string) {
1483      printerr("Bad Argument Type");      printerr(env, "Bad Argument Type");
1484      env->err= 2;      env->err= 2;
1485      return;      return;
1486    }    }
# Line 1474  extern void sx_77616974706964(environmen Line 1504  extern void sx_77616974706964(environmen
1504  {  {
1505    
1506    if(env->head->type==empty) {    if(env->head->type==empty) {
1507      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
1508      env->err= 1;      env->err= 1;
1509      return;      return;
1510    }    }
1511    
1512    if(CAR(env->head)->type!=integer) {    if(CAR(env->head)->type!=integer) {
1513      printerr("Bad Argument Type");      printerr(env, "Bad Argument Type");
1514      env->err= 2;      env->err= 2;
1515      return;      return;
1516    }    }
# Line 1494  extern void sx_77616974706964(environmen Line 1524  extern void sx_77616974706964(environmen
1524  extern void toss(environment *env)  extern void toss(environment *env)
1525  {  {
1526    if(env->head->type==empty) {    if(env->head->type==empty) {
1527      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
1528      env->err= 1;      env->err= 1;
1529      return;      return;
1530    }    }
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26