sym.c

A very small LISP implementation with several packages and demo programs.

   while (isCell(x = cdr(x))) {
      data(c2) = EVAL(car(x));
      if (isSym(data(c1)))
         Touch(ex,data(c1));
      val(data(c1)) = cons(data(c2), val(data(c1)));
   }
   drop(c1);
   return data(c2);
}

// (push1 'var 'any ..) -> any
any doPush1(any ex) {
   any x;
   cell c1, c2;

   x = cdr(ex),  Push(c1, EVAL(car(x)));
   NeedVar(ex,data(c1));
   CheckVar(ex,data(c1));
   x = cdr(x),  Push(c2, EVAL(car(x)));
   if (!member(data(c2), val(data(c1)))) {
      if (isSym(data(c1)))
         Touch(ex,data(c1));
      val(data(c1)) = cons(data(c2), val(data(c1)));
   }
   while (isCell(x = cdr(x)))
      if (!member(data(c2) = EVAL(car(x)), val(data(c1)))) {
         if (isSym(data(c1)))
            Touch(ex,data(c1));
         val(data(c1)) = cons(data(c2), val(data(c1)));
      }
   drop(c1);
   return data(c2);
}

// (pop 'var) -> any
any doPop(any ex) {
   any x, y;

   x = cdr(ex),  x = EVAL(car(x));
   NeedVar(ex,x);
   CheckVar(ex,x);
   if (isSym(x))
      Touch(ex,x);
   if (!isCell(y = val(x)))
      return y;
   val(x) = cdr(y);
   return car(y);
}

// (cut 'cnt 'var) -> lst
any doCut(any ex) {
   long n;
   any x, y;
   cell c1, c2;

   if ((n = evCnt(ex, x = cdr(ex))) <= 0)
      return Nil;
   x = cdr(x),  Push(c1, EVAL(car(x)));
   NeedVar(ex,data(c1));
   CheckVar(ex,data(c1));
   if (isCell(val(data(c1)))) {
      if (isSym(data(c1)))
         Touch(ex,data(c1));
      Push(c2, y = cons(car(val(data(c1))), Nil));
      while (isCell(val(data(c1)) = cdr(val(data(c1)))) && --n)
         y = cdr(y) = cons(car(val(data(c1))), Nil);
      drop(c1);
      return data(c2);
   }
   return val(Pop(c1));
}

// (del 'any 'var) -> any
any doDel(any ex) {
   any x, y;
   cell c1, c2, c3;

   x = cdr(ex),  Push(c1, EVAL(car(x)));
   x = cdr(x),  Push(c2, EVAL(car(x)));
   NeedVar(ex,data(c2));
   CheckVar(ex,data(c2));
   if (isCell(x = val(data(c2)))) {
      if (equal(data(c1), car(x))) {
         if (isSym(data(c2)))
            Touch(ex,data(c2));
         drop(c1);
         return val(data(c2)) = cdr(x);
      }
      Push(c3, y = cons(car(x), Nil));
      while (isCell(x = cdr(x))) {
         if (equal(data(c1), car(x))) {
            cdr(y) = cdr(x);
            if (isSym(data(c2)))
               Touch(ex,data(c2));
            drop(c1);
            return val(data(c2)) = data(c3);
         }
         y = cdr(y) = cons(car(x), Nil);
      }
   }
   drop(c1);
   return val(data(c2));
}

// (queue 'var 'any) -> any
any doQueue(any ex) {
   any x, y;
   cell c1;

   x = cdr(ex),  Push(c1, EVAL(car(x)));
   NeedVar(ex,data(c1));
   CheckVar(ex,data(c1));
   x = cdr(x),  x = EVAL(car(x));
   if (isSym(data(c1)))
      Touch(ex,data(c1));
   if (!isCell(y = val(data(c1))))
      val(data(c1)) = cons(x,Nil);
   else {
      while (isCell(cdr(y)))
         y = cdr(y);
      cdr(y) = cons(x,Nil);
   }
   drop(c1);
   return x;
}

// (fifo 'var ['any ..]) -> any
any doFifo(any ex) {
   any x, y, z;
   cell c1;

   x = cdr(ex),  Push(c1, EVAL(car(x)));
   NeedVar(ex,data(c1));
   CheckVar(ex,data(c1));
   if (isCell(x = cdr(x))) {
      y = EVAL(car(x));
      if (isSym(data(c1)))
         Touch(ex,data(c1));
      if (isCell(z = val(data(c1))))
         val(data(c1)) = z = cdr(z) = cons(y,cdr(z));
      else
         cdr(z) = z = val(data(c1)) = cons(y,Nil);
      while (isCell(x = cdr(x))) {
         if (isSym(data(c1)))
            Touch(ex,data(c1));
         val(data(c1)) = z = cdr(z) = cons(y = EVAL(car(x)), cdr(z));
      }
   }
   else if (!isCell(z = val(data(c1))))
      y = Nil;
   else {
      if (isSym(data(c1)))
         Touch(ex,data(c1));
      if (z == cdr(z)) {
         y = car(z);
         val(data(c1)) = Nil;
      }
      else {
         y = cadr(z);
         cdr(z) = cddr(z);
      }
   }
   drop(c1);
   return y;
}

// (idx 'var 'any 'flg) -> lst
// (idx 'var 'any) -> lst
// (idx 'var) -> lst
any doIdx(any ex) {
   any x, y, z, *p;
   int flg, n;
   cell c1, c2;

   x = cdr(ex),  Push(c1, EVAL(car(x)));
   NeedVar(ex,data(c1));
   CheckVar(ex,data(c1));
   if (!isCell(x = cdr(x))) {
      Push(c2, Nil);
      for (data(c1) = val(data(c1)), x = Nil;;) {
         while (isCell(data(c1)))
            y = data(c1),  data(c1) = cddr(y),  cddr(y) = x,  x = y;
         for (;;) {
            if (isNil(x)) {
               drop(c1);
               return data(c2);
            }
            if (isCell(x))
               break;
            y = cellPtr(x),  x = cadr(y),  cadr(y) = data(c1),  data(c1) = y;
         }
         data(c2) = cons(x, data(c2));
         car(data(c2)) = caar(data(c2));
         y = cddr(x),  cddr(x) = data(c1),  data(c1) = cadr(x),  cadr(x) = y;
         x = symPtr(x);
      }
   }
   Push(c2, EVAL(car(x)));
   flg = !isCell(cdr(x))? 0 : isNil(EVAL(cadr(x)))? -1 : +1;
   if (!isCell(x = val(data(c1)))) {
      if (flg > 0) {
         if (isSym(data(c1)))
            Touch(ex,data(c1));
         val(data(c1)) = cons(data(c2),Nil);
      }
      drop(c1);
      return Nil;
   }
   p = (any*)data(c1);
   for (;;) {
      if ((n = compare(data(c2), car(x))) == 0) {
         if (flg < 0) {
            if (isSym(data(c1)))
               Touch(ex,data(c1));
            if (!isCell(cadr(x)))
               *p = cddr(x);
            else if (!isCell(y = cddr(x)))
               *p = cadr(x);
            else if (!isCell(z = cadr(y)))
               car(x) = car(y),  cddr(x) = cddr(y);
            else {
               while (isCell(cadr(z)))
                  z = cadr(y = z);
               car(x) = car(z),  cadr(y) = cddr(z);
            }
         }
         drop(c1);
         return x;
      }
      if (!isCell(cdr(x))) {
         if (flg > 0) {
            if (isSym(data(c1)))
               Touch(ex,data(c1));
            cdr(x) = n < 0?
               cons(cons(data(c2),Nil), Nil) : cons(Nil, cons(data(c2),Nil));
         }
         drop(c1);
         return Nil;
      }
      if (n < 0) {
         if (!isCell(cadr(x))) {
            if (flg > 0) {
               if (isSym(data(c1)))
                  Touch(ex,data(c1));
               cadr(x) = cons(data(c2),Nil);
            }
            drop(c1);
            return Nil;
         }
         x = *(p = &cadr(x));
      }
      else {
         if (!isCell(cddr(x))) {
            if (flg > 0) {
               if (isSym(data(c1)))
                  Touch(ex,data(c1));
               cddr(x) = cons(data(c2),Nil);
            }
            drop(c1);
            return Nil;
         }
         x = *(p = &cddr(x));
      }
   }
}

static any From, To;
static cell LupCell;

static void lup(any x) {
   if (isCell(x)) {
      if (car(x) == T)
         lup(cadr(x));
      else if (!isCell(car(x)))
         lup(cddr(x));
      else if (compare(To, caar(x)) >= 0) {
         lup(cddr(x));
         if (compare(From, caar(x)) <= 0) {
            data(LupCell) = cons(car(x), data(LupCell));
            lup(cadr(x));
         }
      }
      else if (compare(From, caar(x)) <= 0)
         lup(cadr(x));
   }
}

// (lup 'lst 'any) -> lst
// (lup 'lst 'any 'any2) -> lst
any doLup(any x) {
   int n;
   cell c1, c2;

   x = cdr(x),  Push(c1, EVAL(car(x)));
   x = cdr(x),  Push(c2, EVAL(car(x)));
   x = cdr(x);
   if (!isNil(To = EVAL(car(x)))) {
      From = data(c2);
      Push(LupCell, Nil);
      lup(data(c1));
      drop(c1);
      return data(LupCell);
   }
   while (isCell(data(c1))) {
      if (car(data(c1)) == T)
         data(c1) = cadr(data(c1));
      else if (!isCell(car(data(c1))))
         data(c1) = cddr(data(c1));
      else if (n = compare(data(c2), caar(data(c1))))
         data(c1) = n < 0? cadr(data(c1)) : cddr(data(c1));
      else {
         drop(c1);
         return car(data(c1));
      }
   }
   drop(c1);
   return Nil;
}

any put(any x, any key, any val) {
   any y, z;

   if (isCell(y = tail1(x))) {
      if (isCell(car(y))) {
         if (key == cdar(y)) {
            if (isNil(val))
               Tail(x, cdr(y));
            else if (val == T)
               car(y) = key;