home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Extensions / stack.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-06-05  |  2.6 KB  |  128 lines
  1. /*
  2.  *
  3.  * s t a c k  . c        -- Implementation of the extended type Stack
  4.  *
  5.  */
  6.  
  7. #include <stk.h>
  8.  
  9. static void mark_stack(SCM p);
  10. static void free_stack(SCM p);
  11. static void display_stack(SCM s, SCM port, int mode);
  12. static int tc_stack;
  13.  
  14. static STk_extended_scheme_type stack_type = {
  15.   "stack",        /* name */
  16.   0,            /* is_procp */
  17.   mark_stack,        /* gc_mark_fct */
  18.   free_stack,        /* gc_sweep_fct */
  19.   NULL,            /* apply_fct */
  20.   display_stack        /* display_fct */
  21. };
  22.  
  23. #define STACKP(x)    (TYPEP(x, tc_stack))
  24. #define NSTACKP(x)    (NTYPEP(x, tc_stack))
  25. #define STACK(x)    ((Stack *) EXTDATA(x))
  26.  
  27. typedef struct {
  28.   int len;
  29.   SCM values;
  30. } Stack;
  31.  
  32. static void mark_stack(SCM p)
  33. {
  34.   STk_gc_mark(STACK(p)->values);
  35. }
  36.  
  37. static void free_stack(SCM p)
  38. {
  39.   free(EXTDATA(p));
  40. }
  41.  
  42. static void display_stack(SCM s, SCM port, int mode)
  43. {
  44.   char buffer[100];
  45.   if (mode == DSP_MODE) {
  46.     /* A verbose display */
  47.     if (STACK(s)->len) {
  48.       sprintf(buffer, "Stack length = %d\nValues = ", STACK(s)->len);
  49.       Puts(buffer, FILEPTR(port));
  50.       STk_display(STACK(s)->values, port);
  51.     }
  52.     else 
  53.       Puts("Stack is empty", FILEPTR(port));
  54.   }
  55.   else { /* WRT_MODE or TK_MODE */
  56.     sprintf(buffer, "#<stack (length=%d) %ld>", STACK(s)->len, s);
  57.     Puts(buffer, FILEPTR(port));
  58.   }
  59. }
  60.  
  61. static PRIMITIVE make_stack(void)
  62. {
  63.   SCM z;
  64.  
  65.   NEWCELL(z, tc_stack);
  66.   EXTDATA(z)       = STk_must_malloc(sizeof(Stack));
  67.   STACK(z)->len    = 0;
  68.   STACK(z)->values = NIL;
  69.   return z;
  70. }
  71.  
  72. static PRIMITIVE stackp(SCM s)
  73. {
  74.   return STACKP(s)? Truth: Ntruth;
  75. }
  76.  
  77. static PRIMITIVE stack_push(SCM s, SCM val)
  78. {
  79.   Stack *sp;
  80.  
  81.   if (NSTACKP(s)) STk_err("stack-push: bad stack", s);
  82.  
  83.   sp         =  STACK(s);
  84.   sp->len   += 1;
  85.   sp->values = Cons(val, sp->values);
  86.   
  87.   return UNDEFINED;
  88. }
  89.  
  90. static PRIMITIVE stack_pop(SCM s)
  91. {
  92.   Stack *sp;
  93.   SCM res;
  94.  
  95.   if (NSTACKP(s)) STk_err("stack-pop: bad stack", s);
  96.   
  97.   sp =  STACK(s);
  98.   
  99.   if (sp->len == 0) STk_err("stack-pop: empty stack", s);
  100.   res         = CAR(sp->values);
  101.   sp->len    -= 1;
  102.   sp->values  = CDR(sp->values);
  103.  
  104.   return res;
  105. }
  106.  
  107. static PRIMITIVE stack_emptyp(SCM s)
  108. {
  109.   if (NSTACKP(s)) STk_err("stack-empty?: bad stack", s);
  110.   return (STACK(s)->len) ? Truth: Ntruth;
  111. }
  112.  
  113.  
  114. PRIMITIVE STk_init_stack(void)
  115. {
  116.   /* Register the new type */
  117.   tc_stack = STk_add_new_type(&stack_type);
  118.   
  119.   /* Declare new primitives */
  120.   STk_add_new_primitive("make-stack",     tc_subr_0,      make_stack);
  121.   STk_add_new_primitive("stack?",      tc_subr_1,      stackp);
  122.   STk_add_new_primitive("stack-push!",    tc_subr_2,      stack_push);
  123.   STk_add_new_primitive("stack-pop",      tc_subr_1,      stack_pop);
  124.   STk_add_new_primitive("stack-empty?",   tc_subr_1,      stack_emptyp);
  125.   
  126.   return UNDEFINED;
  127. }
  128.