home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / XLISP / XLISP12.ARK / XLLIST.C < prev    next >
Text File  |  1985-02-19  |  19KB  |  809 lines
  1. /* xllist - xlisp list builtin functions */
  2.  
  3. #ifdef AZTEC
  4. #include "stdio.h"
  5. #else
  6. #include <stdio.h>
  7. #endif
  8.  
  9. #include "xlisp.h"
  10.  
  11. /* external variables */
  12. extern struct node *xlstack;
  13. extern struct node *s_unbound;
  14. extern struct node *true;
  15.  
  16. /* forward declarations */
  17. FORWARD struct node *nth(),*member(),*assoc(),*afind();
  18. FORWARD struct node *delete(),*subst(),*sublis(),*map();
  19. FORWARD int eq(),equal();
  20.  
  21. /* xcar - return the car of a list */
  22. struct node *xcar(args)
  23.   struct node *args;
  24. {
  25.     struct node *list;
  26.  
  27.     /* get the list and return its car */
  28.     list = xlmatch(LIST,&args);
  29.     xllastarg(args);
  30.     return (list ? list->n_listvalue : NULL);
  31. }
  32.  
  33. /* xcaar - return the caar of a list */
  34. struct node *xcaar(args)
  35.   struct node *args;
  36. {
  37.     struct node *list;
  38.  
  39.     /* get the list and return its caar */
  40.     list = xlmatch(LIST,&args);
  41.     xllastarg(args);
  42.     if (list) list = list->n_listvalue;
  43.     return (list ? list->n_listvalue : NULL);
  44. }
  45.  
  46. /* xcadr - return the cadr of a list */
  47. struct node *xcadr(args)
  48.   struct node *args;
  49. {
  50.     struct node *list;
  51.  
  52.     /* get the list and return its cadr */
  53.     list = xlmatch(LIST,&args);
  54.     xllastarg(args);
  55.     if (list) list = list->n_listnext;
  56.     return (list ? list->n_listvalue : NULL);
  57. }
  58.  
  59. /* xcdr - return the cdr of a list */
  60. struct node *xcdr(args)
  61.   struct node *args;
  62. {
  63.     struct node *list;
  64.  
  65.     /* get the list and return its cdr */
  66.     list = xlmatch(LIST,&args);
  67.     xllastarg(args);
  68.     return (list ? list->n_listnext : NULL);
  69. }
  70.  
  71. /* xcdar - return the cdar of a list */
  72. struct node *xcdar(args)
  73.   struct node *args;
  74. {
  75.     struct node *list;
  76.  
  77.     /* get the list and return its cdar */
  78.     list = xlmatch(LIST,&args);
  79.     xllastarg(args);
  80.     if (list) list = list->n_listvalue;
  81.     return (list ? list->n_listnext : NULL);
  82. }
  83.  
  84. /* xcddr - return the cddr of a list */
  85. struct node *xcddr(args)
  86.   struct node *args;
  87. {
  88.     struct node *list;
  89.  
  90.     /* get the list and return its cddr */
  91.     list = xlmatch(LIST,&args);
  92.     xllastarg(args);
  93.     if (list) list = list->n_listnext;
  94.     return (list ? list->n_listnext : NULL);
  95. }
  96.  
  97. /* xcons - construct a new list cell */
  98. struct node *xcons(args)
  99.   struct node *args;
  100. {
  101.     struct node *arg1,*arg2,*val;
  102.  
  103.     /* get the two arguments */
  104.     arg1 = xlarg(&args);
  105.     arg2 = xlarg(&args);
  106.     xllastarg(args);
  107.  
  108.     /* construct a new list element */
  109.     val = newnode(LIST);
  110.     val->n_listvalue = arg1;
  111.     val->n_listnext  = arg2;
  112.  
  113.     /* return the list */
  114.     return (val);
  115. }
  116.  
  117. /* xlist - built a list of the arguments */
  118. struct node *xlist(args)
  119.   struct node *args;
  120. {
  121.     struct node *oldstk,arg,list,val,*last,*lptr;
  122.  
  123.     /* create a new stack frame */
  124.     oldstk = xlsave(&arg,&list,&val,NULL);
  125.  
  126.     /* initialize */
  127.     arg.n_ptr = args;
  128.  
  129.     /* evaluate and append each argument */
  130.     for (last = NULL; arg.n_ptr != NULL; last = lptr) {
  131.  
  132.     /* evaluate the next argument */
  133.     val.n_ptr = xlarg(&arg.n_ptr);
  134.  
  135.     /* append this argument to the end of the list */
  136.     lptr = newnode(LIST);
  137.     if (last == NULL)
  138.         list.n_ptr = lptr;
  139.     else
  140.         last->n_listnext = lptr;
  141.     lptr->n_listvalue = val.n_ptr;
  142.     }
  143.  
  144.     /* restore the previous stack frame */
  145.     xlstack = oldstk;
  146.  
  147.     /* return the list */
  148.     return (list.n_ptr);
  149. }
  150.  
  151. /* xappend - builtin function append */
  152. struct node *xappend(args)
  153.   struct node *args;
  154. {
  155.     struct node *oldstk,arg,list,last,val,*lptr;
  156.  
  157.     /* create a new stack frame */
  158.     oldstk = xlsave(&arg,&list,&last,&val,NULL);
  159.  
  160.     /* initialize */
  161.     arg.n_ptr = args;
  162.  
  163.     /* evaluate and append each argument */
  164.     while (arg.n_ptr != NULL) {
  165.  
  166.     /* evaluate the next argument */
  167.     list.n_ptr = xlmatch(LIST,&arg.n_ptr);
  168.  
  169.     /* append each element of this list to the result list */
  170.     while (list.n_ptr != NULL && list.n_ptr->n_type == LIST) {
  171.  
  172.         /* append this element */
  173.         lptr = newnode(LIST);
  174.         if (last.n_ptr == NULL)
  175.         val.n_ptr = lptr;
  176.         else
  177.         last.n_ptr->n_listnext = lptr;
  178.         lptr->n_listvalue = list.n_ptr->n_listvalue;
  179.  
  180.         /* save the new last element */
  181.         last.n_ptr = lptr;
  182.  
  183.         /* move to the next element */
  184.         list.n_ptr = list.n_ptr->n_listnext;
  185.     }
  186.  
  187.     /* make sure the list ended in a nil */
  188.     if (list.n_ptr != NULL)
  189.         xlfail("bad list");
  190.     }
  191.  
  192.     /* restore previous stack frame */
  193.     xlstack = oldstk;
  194.  
  195.     /* return the list */
  196.     return (val.n_ptr);
  197. }
  198.  
  199. /* xreverse - builtin function reverse */
  200. struct node *xreverse(args)
  201.   struct node *args;
  202. {
  203.     struct node *oldstk,list,val,*lptr;
  204.  
  205.     /* create a new stack frame */
  206.     oldstk = xlsave(&list,&val,NULL);
  207.  
  208.     /* get the list to reverse */
  209.     list.n_ptr = xlmatch(LIST,&args);
  210.     xllastarg(args);
  211.  
  212.     /* append each element of this list to the result list */
  213.     while (list.n_ptr != NULL && list.n_ptr->n_type == LIST) {
  214.  
  215.     /* append this element */
  216.     lptr = newnode(LIST);
  217.     lptr->n_listvalue = list.n_ptr->n_listvalue;
  218.     lptr->n_listnext = val.n_ptr;
  219.     val.n_ptr = lptr;
  220.  
  221.     /* move to the next element */
  222.     list.n_ptr = list.n_ptr->n_listnext;
  223.     }
  224.  
  225.     /* make sure the list ended in a nil */
  226.     if (list.n_ptr != NULL)
  227.     xlfail("bad list");
  228.  
  229.     /* restore previous stack frame */
  230.     xlstack = oldstk;
  231.  
  232.     /* return the list */
  233.     return (val.n_ptr);
  234. }
  235.  
  236. /* xlast - return the last cons of a list */
  237. struct node *xlast(args)
  238.   struct node *args;
  239. {
  240.     struct node *list;
  241.  
  242.     /* get the list */
  243.     list = xlmatch(LIST,&args);
  244.     xllastarg(args);
  245.  
  246.     /* find the last cons */
  247.     while (list && list->n_type == LIST && list->n_listnext)
  248.     list = list->n_listnext;
  249.  
  250.     /* make sure the list ended correctly */
  251.     if (list == NULL && list->n_type != LIST)
  252.     xlfail("bad list");
  253.  
  254.     /* return the last element */
  255.     return (list);
  256. }
  257.  
  258. /* xmember - builtin function 'member' */
  259. struct node *xmember(args)
  260.   struct node *args;
  261. {
  262.     return (member(args,equal));
  263. }
  264.  
  265. /* xmemq - builtin function 'memq' */
  266. struct node *xmemq(args)
  267.   struct node *args;
  268. {
  269.     return (member(args,eq));
  270. }
  271.  
  272. /* member - internal member function */
  273. LOCAL struct node *member(args,fcn)
  274.   struct node *args; int (*fcn)();
  275. {
  276.     struct node *x,*list;
  277.  
  278.     /* get the expression to look for and the list */
  279.     x = xlarg(&args);
  280.     list = xlmatch(LIST,&args);
  281.     xllastarg(args);
  282.  
  283.     /* look for the expression */
  284.     for (; list && list->n_type == LIST; list = list->n_listnext)
  285.     if ((*fcn)(x,list->n_listvalue))
  286.         return (list);
  287.  
  288.     /* return failure indication */
  289.     return (NULL);
  290. }
  291.  
  292. /* xassoc - builtin function 'assoc' */
  293. struct node *xassoc(args)
  294.   struct node *args;
  295. {
  296.     return (assoc(args,equal));
  297. }
  298.  
  299. /* xassq - builtin function 'assq' */
  300. struct node *xassq(args)
  301.   struct node *args;
  302. {
  303.     return (assoc(args,eq));
  304. }
  305.  
  306. /* assoc - internal assoc function */
  307. LOCAL struct node *assoc(args,fcn)
  308.   struct node *args; int (*fcn)();
  309. {
  310.     struct node *expr,*alist,*pair;
  311.  
  312.     /* get the expression to look for and the association list */
  313.     expr = xlarg(&args);
  314.     alist = xlmatch(LIST,&args);
  315.     xllastarg(args);
  316.  
  317.     /* look for the expression */
  318.     return (afind(expr,alist,fcn));
  319. }
  320.  
  321. /* afind - find a pair in an association list */
  322. LOCAL struct node *afind(expr,alist,fcn)
  323.   struct node *expr,*alist; int (*fcn)();
  324. {
  325.     struct node *pair;
  326.  
  327.     for (; alist && alist->n_type == LIST; alist = alist->n_listnext)
  328.     if ((pair = alist->n_listvalue) && pair->n_type == LIST)
  329.         if ((*fcn)(expr,pair->n_listvalue))
  330.         return (pair);
  331.     return (NULL);
  332. }
  333.  
  334. /* xsubst - substitute one expression for another */
  335. struct node *xsubst(args)
  336.   struct node *args;
  337. {
  338.     struct node *oldstk,to,from,expr,*val;
  339.  
  340.     /* create a new stack frame */
  341.     oldstk = xlsave(&to,&from,&expr,NULL);
  342.  
  343.     /* get the to value, the from value and the expression */
  344.     to.n_ptr = xlarg(&args);
  345.     from.n_ptr = xlarg(&args);
  346.     expr.n_ptr = xlarg(&args);
  347.     xllastarg(args);
  348.  
  349.     /* do the substitution */
  350.     val = subst(to.n_ptr,from.n_ptr,expr.n_ptr);
  351.  
  352.     /* restore the previous stack frame */
  353.     xlstack = oldstk;
  354.  
  355.     /* return the result */
  356.     return (val);
  357. }
  358.  
  359. /* subst - substitute one expression for another */
  360. LOCAL struct node *subst(to,from,expr)
  361.   struct node *to,*from,*expr;
  362. {
  363.     struct node *oldstk,car,cdr,*val;
  364.  
  365.     if (eq(expr,from))
  366.     val = to;
  367.     else if (expr == NULL || expr->n_type != LIST)
  368.     val = expr;
  369.     else {
  370.     oldstk = xlsave(&car,&cdr,NULL);
  371.     car.n_ptr = subst(to,from,expr->n_listvalue);
  372.     cdr.n_ptr = subst(to,from,expr->n_listnext);
  373.     val = newnode(LIST);
  374.     val->n_listvalue = car.n_ptr;
  375.     val->n_listnext = cdr.n_ptr;
  376.     xlstack = oldstk;
  377.     }
  378.     return (val);
  379. }
  380.  
  381. /* xsublis - substitute using an association list */
  382. struct node *xsublis(args)
  383.   struct node *args;
  384. {
  385.     struct node *oldstk,alist,expr,*val;
  386.  
  387.     /* create a new stack frame */
  388.     oldstk = xlsave(&alist,&expr,NULL);
  389.  
  390.     /* get the assocation list and the expression */
  391.     alist.n_ptr = xlmatch(LIST,&args);
  392.     expr.n_ptr = xlarg(&args);
  393.     xllastarg(args);
  394.  
  395.     /* do the substitution */
  396.     val = sublis(alist.n_ptr,expr.n_ptr);
  397.  
  398.     /* restore the previous stack frame */
  399.     xlstack = oldstk;
  400.  
  401.     /* return the result */
  402.     return (val);
  403. }
  404.  
  405. /* sublis - substitute using an association list */
  406. LOCAL struct node *sublis(alist,expr)
  407.   struct node *alist,*expr;
  408. {
  409.     struct node *oldstk,car,cdr,*val;
  410.  
  411.     if (val = afind(expr,alist,eq))
  412.     val = val->n_listnext;
  413.     else if (expr == NULL || expr->n_type != LIST)
  414.     val = expr;
  415.     else {
  416.     oldstk = xlsave(&car,&cdr,NULL);
  417.     car.n_ptr = sublis(alist,expr->n_listvalue);
  418.     cdr.n_ptr = sublis(alist,expr->n_listnext);
  419.     val = newnode(LIST);
  420.     val->n_listvalue = car.n_ptr;
  421.     val->n_listnext = cdr.n_ptr;
  422.     xlstack = oldstk;
  423.     }
  424.     return (val);
  425. }
  426.  
  427. /* xnth - return the nth element of a list */
  428. struct node *xnth(args)
  429.   struct node *args;
  430. {
  431.     return (nth(args,FALSE));
  432. }
  433.  
  434. /* xnthcdr - return the nth cdr of a list */
  435. struct node *xnthcdr(args)
  436.   struct node *args;
  437. {
  438.     return (nth(args,TRUE));
  439. }
  440.  
  441. /* nth - internal nth function */
  442. LOCAL struct node *nth(args,cdrflag)
  443.   struct node *args; int cdrflag;
  444. {
  445.     struct node *list;
  446.     int n;
  447.  
  448.     /* get n and the list */
  449.     if ((n = xlmatch(INT,&args)->n_int) < 0)
  450.     xlfail("invalid argument");
  451.     if ((list = xlmatch(LIST,&args)) == NULL)
  452.     xlfail("invalid argument");
  453.     xllastarg(args);
  454.  
  455.     /* find the nth element */
  456.     for (; n > 0; n--) {
  457.     list = list->n_listnext;
  458.     if (list == NULL || list->n_type != LIST)
  459.         xlfail("invalid argument");
  460.     }
  461.  
  462.     /* return the list beginning at the nth element */
  463.     return (cdrflag ? list : list->n_listvalue);
  464. }
  465.  
  466. /* xlength - return the length of a list */
  467. struct node *xlength(args)
  468.   struct node *args;
  469. {
  470.     struct node *list,*val;
  471.     int n;
  472.  
  473.     /* get the list */
  474.     list = xlmatch(LIST,&args);
  475.     xllastarg(args);
  476.  
  477.     /* find the length */
  478.     for (n = 0; list != NULL; n++)
  479.     list = list->n_listnext;
  480.  
  481.     /* create the value node */
  482.     val = newnode(INT);
  483.     val->n_int = n;
  484.  
  485.     /* return the length */
  486.     return (val);
  487. }
  488.  
  489. /* xmapcar - builtin function 'mapcar' */
  490. struct node *xmapcar(args)
  491.   struct node *args;
  492. {
  493.     return (map(args,TRUE));
  494. }
  495.  
  496. /* xmaplist - builtin function 'maplist' */
  497. struct node *xmaplist(args)
  498.   struct node *args;
  499. {
  500.     return (map(args,FALSE));
  501. }
  502.  
  503. /* map - internal mapping function */
  504. LOCAL struct node *map(args,carflag)
  505.   struct node *args; int carflag;
  506. {
  507.     struct node *oldstk,fcn,lists,arglist,val,*last,*p,*x,*y;
  508.  
  509.     /* create a new stack frame */
  510.     oldstk = xlsave(&fcn,&lists,&arglist,&val,NULL);
  511.  
  512.     /* get the function to apply */
  513.     fcn.n_ptr = xlarg(&args);
  514.  
  515.     /* make sure there is at least one argument list */
  516.     if (args == NULL)
  517.     xlfail("too few arguments");
  518.  
  519.     /* get the argument lists */
  520.     while (args) {
  521.     p = newnode(LIST);
  522.     p->n_listnext = lists.n_ptr;
  523.     lists.n_ptr = p;
  524.     p->n_listvalue = xlmatch(LIST,&args);
  525.     }
  526.  
  527.     /* if the function is a symbol, get its value */
  528.     if (fcn.n_ptr && fcn.n_ptr->n_type == SYM)
  529.     fcn.n_ptr = xleval(fcn.n_ptr);
  530.  
  531.     /* loop through each of the argument lists */
  532.     for (;;) {
  533.  
  534.     /* build an argument list from the sublists */
  535.     arglist.n_ptr = NULL;
  536.     for (x = lists.n_ptr; x && (y = x->n_listvalue); x = x->n_listnext) {
  537.         p = newnode(LIST);
  538.         p->n_listnext = arglist.n_ptr;
  539.         arglist.n_ptr = p;
  540.         p->n_listvalue = (carflag ? y->n_listvalue : y);
  541.         x->n_listvalue = y->n_listnext;
  542.     }
  543.  
  544.     /* quit if any of the lists were empty */
  545.     if (x) break;
  546.  
  547.     /* apply the function to the arguments */
  548.     p = newnode(LIST);
  549.     if (val.n_ptr)
  550.         last->n_listnext = p;
  551.     else
  552.         val.n_ptr = p;
  553.     last = p;
  554.     p->n_listvalue = xlapply(fcn.n_ptr,arglist.n_ptr);
  555.     }
  556.  
  557.     /* restore the previous stack frame */
  558.     xlstack = oldstk;
  559.  
  560.     /* return the last test expression value */
  561.     return (val.n_ptr);
  562. }
  563. /* xrplca - replace the car of a list node */
  564. struct node *xrplca(args)
  565.   struct node *args;
  566. {
  567.     struct node *list,*newcar;
  568.  
  569.     /* get the list and the new car */
  570.     if ((list = xlmatch(LIST,&args)) == NULL)
  571.     xlfail("null list");
  572.     newcar = xlarg(&args);
  573.     xllastarg(args);
  574.  
  575.     /* replace the car */
  576.     list->n_listvalue = newcar;
  577.  
  578.     /* return the list node that was modified */
  579.     return (list);
  580. }
  581.  
  582. /* xrplcd - replace the cdr of a list node */
  583. struct node *xrplcd(args)
  584.   struct node *args;
  585. {
  586.     struct node *list,*newcdr;
  587.  
  588.     /* get the list and the new cdr */
  589.     if ((list = xlmatch(LIST,&args)) == NULL)
  590.     xlfail("null list");
  591.     newcdr = xlarg(&args);
  592.     xllastarg(args);
  593.  
  594.     /* replace the cdr */
  595.     list->n_listnext = newcdr;
  596.  
  597.     /* return the list node that was modified */
  598.     return (list);
  599. }
  600.  
  601. /* xnconc - destructively append lists */
  602. struct node *xnconc(args)
  603.   struct node *args;
  604. {
  605.     struct node *list,*last,*val;
  606.  
  607.     /* concatenate each argument */
  608.     for (val = NULL; args; ) {
  609.  
  610.     /* concatenate this list */
  611.     if (list = xlmatch(LIST,&args)) {
  612.  
  613.         /* check for this being the first non-empty list */
  614.         if (val)
  615.         last->n_listnext = list;
  616.         else
  617.         val = list;
  618.  
  619.         /* find the end of the list */
  620.         while (list && list->n_type == LIST && list->n_listnext)
  621.         list = list->n_listnext;
  622.  
  623.         /* make sure the list ended correctly */
  624.         if (list == NULL || list->n_type != LIST)
  625.         xlfail("bad list");
  626.  
  627.         /* save the new last element */
  628.         last = list;
  629.     }
  630.     }
  631.  
  632.     /* return the list */
  633.     return (val);
  634. }
  635.  
  636. /* xdelete - builtin function 'delete' */
  637. struct node *xdelete(args)
  638.   struct node *args;
  639. {
  640.     return (delete(args,equal));
  641. }
  642.  
  643. /* xdelq - builtin function 'delq' */
  644. struct node *xdelq(args)
  645.   struct node *args;
  646. {
  647.     return (delete(args,eq));
  648. }
  649.  
  650. /* delete - internal delete function */
  651. LOCAL struct node *delete(args,fcn)
  652.   struct node *args; int (*fcn)();
  653. {
  654.     struct node *x,*list,*last,*val;
  655.  
  656.     /* get the expression to delete and the list */
  657.     x = xlarg(&args);
  658.     list = xlmatch(LIST,&args);
  659.     xllastarg(args);
  660.  
  661.     /* delete leading matches */
  662.     while (list && list->n_type == LIST) {
  663.     if (!(*fcn)(x,list->n_listvalue))
  664.         break;
  665.     list = list->n_listnext;
  666.     }
  667.     val = last = list;
  668.  
  669.     /* delete embedded matches */
  670.     if (list && list->n_type == LIST) {
  671.  
  672.     /* skip the first non-matching element */
  673.     list = list->n_listnext;
  674.  
  675.     /* look for embedded matches */
  676.     while (list && list->n_type == LIST) {
  677.  
  678.         /* check to see if this element should be deleted */
  679.         if ((*fcn)(x,list->n_listvalue))
  680.         last->n_listnext = list->n_listnext;
  681.         else
  682.         last = list;
  683.  
  684.         /* move to the next element */
  685.         list = list->n_listnext;
  686.      }
  687.     }
  688.  
  689.     /* make sure the list ended in a nil */
  690.     if (list != NULL)
  691.     xlfail("bad list");
  692.  
  693.     /* return the updated list */
  694.     return (val);
  695. }
  696.  
  697. /* xatom - is this an atom? */
  698. struct node *xatom(args)
  699.   struct node *args;
  700. {
  701.     struct node *arg;
  702.     return ((arg = xlarg(&args)) == NULL || arg->n_type != LIST ? true : NULL);
  703. }
  704.  
  705. /* xsymbolp - is this an symbol? */
  706. struct node *xsymbolp(args)
  707.   struct node *args;
  708. {
  709.     struct node *arg;
  710.     return ((arg = xlarg(&args)) && arg->n_type == SYM ? true : NULL);
  711. }
  712.  
  713. /* xnumberp - is this an number? */
  714. struct node *xnumberp(args)
  715.   struct node *args;
  716. {
  717.     struct node *arg;
  718.     return ((arg = xlarg(&args)) && arg->n_type == INT ? true : NULL);
  719. }
  720.  
  721. /* xboundp - is this a value bound to this symbol? */
  722. struct node *xboundp(args)
  723.   struct node *args;
  724. {
  725.     struct node *sym;
  726.     sym = xlmatch(SYM,&args);
  727.     return (sym->n_symvalue == s_unbound ? NULL : true);
  728. }
  729.  
  730. /* xnull - is this null? */
  731. struct node *xnull(args)
  732.   struct node *args;
  733. {
  734.     return (xlarg(&args) == NULL ? true : NULL);
  735. }
  736.  
  737. /* xlistp - is this a list? */
  738. struct node *xlistp(args)
  739.   struct node *args;
  740. {
  741.     struct node *arg;
  742.     return ((arg = xlarg(&args)) == NULL || arg->n_type == LIST ? true : NULL);
  743. }
  744.  
  745. /* xconsp - is this a cons? */
  746. struct node *xconsp(args)
  747.   struct node *args;
  748. {
  749.     struct node *arg;
  750.     return ((arg = xlarg(&args)) != NULL && arg->n_type == LIST ? true : NULL);
  751. }
  752.  
  753. /* xeq - are these equal? */
  754. struct node *xeq(args)
  755.   struct node *args;
  756. {
  757.     struct node *arg1,*arg2;
  758.  
  759.     /* get the two arguments */
  760.     arg1 = xlarg(&args);
  761.     arg2 = xlarg(&args);
  762.     xllastarg(args);
  763.  
  764.     /* compare the arguments */
  765.     return (eq(arg1,arg2) ? true : NULL);
  766. }
  767.  
  768. /* eq - internal eq function */
  769. LOCAL int eq(arg1,arg2)
  770.   struct node *arg1,*arg2;
  771. {
  772.     /* compare the arguments */
  773.     if (arg1 != NULL && arg1->n_type == INT &&
  774.         arg2 != NULL && arg2->n_type == INT)
  775.     return (arg1->n_int == arg2->n_int);
  776.     else
  777.     return (arg1 == arg2);
  778. }
  779.  
  780. /* xequal - are these equal? */
  781. struct node *xequal(args)
  782.   struct node *args;
  783. {
  784.     struct node *arg1,*arg2;
  785.  
  786.     /* get the two arguments */
  787.     arg1 = xlarg(&args);
  788.     arg2 = xlarg(&args);
  789.     xllastarg(args);
  790.  
  791.     /* compare the arguments */
  792.     return (equal(arg1,arg2) ? true : NULL);
  793. }
  794.  
  795. /* equal - internal equal function */
  796. LOCAL int equal(arg1,arg2)
  797.   struct node *arg1,*arg2;
  798. {
  799.     /* compare the arguments */
  800.     if (eq(arg1,arg2))
  801.     return (TRUE);
  802.     else if (arg1 && arg1->n_type == LIST &&
  803.          arg2 && arg2->n_type == LIST)
  804.     return (equal(arg1->n_listvalue,arg2->n_listvalue) &&
  805.         equal(arg1->n_listnext, arg2->n_listnext));
  806.     else
  807.     return (FALSE);
  808. }
  809.