home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / wl_list.c < prev    next >
C/C++ Source or Header  |  1995-07-03  |  17KB  |  688 lines
  1. /* Copyright 1989 GROUPE BULL -- See license conditions in file COPYRIGHT
  2.  * Copyright 1989 Massachusetts Institute of Technology
  3.  */
  4. /*********************\
  5. *               *
  6. *  WOOL_OBJECT  List  *
  7. *  BODY              *
  8. *               *
  9. \*********************/
  10.  
  11. #include "EXTERN.h"
  12. #include <stdio.h>
  13. #include "wool.h"
  14. #include "wl_number.h"
  15. #include "wl_atom.h"
  16. #include "wl_name.h"
  17. #include "wl_coll.h"
  18. #include "wl_func.h"
  19. #include "INTERN.h"
  20. #include "wl_list.h"
  21.  
  22. /*
  23.  * Constructor:
  24.  * used mainly in parser, called by WLList_make
  25.  */
  26.  
  27. WOOL_List 
  28. WLList_make(col)
  29. WOOL_Collection col;
  30. {
  31.     if (col -> size) {
  32.     WOOL_List       object = (WOOL_List)
  33.     Malloc(sizeof(struct _WOOL_List) +
  34.            ((col -> size -1) * sizeof(WOOL_OBJECT)));
  35.  
  36.     zrt_put(object);
  37.     object -> type = WLList;
  38.     copy_n_objects(col -> list, object -> list, col -> size);
  39.     object -> size = col -> size;
  40.     return object;
  41.     } else {            /* a list of size 0 is just NIL */
  42.     return (WOOL_List) NIL;
  43.     }
  44. }
  45.  
  46. /* makes a list with size slots, to be filled by the C programmer */
  47.  
  48. WOOL_List
  49. wool_list_make(size)
  50. int    size;
  51. {
  52.      WOOL_List       wl_list;
  53.  
  54.     wl_list = (WOOL_List) Malloc(sizeof(struct _WOOL_List) +
  55.                                  (size -1) * sizeof(WOOL_OBJECT));
  56.     zrt_put(wl_list);
  57.     wl_list -> type = WLList;
  58.     wl_list -> size = size;
  59.     return wl_list;
  60. }
  61.  
  62. /* makes a list of argc, argv WOOL_OBJECTS */
  63.  
  64. WOOL_List
  65. wool_list_make_from_evaluated_array(argc, argv)
  66. int argc;
  67. WOOL_OBJECT     argv[];
  68. {
  69.     WOOL_List       wl_list;
  70.     int             i;
  71.  
  72.     wl_list = (WOOL_List) Malloc(sizeof(struct _WOOL_List) +
  73.                  (argc - 1) * sizeof(WOOL_OBJECT));
  74.     zrt_put(wl_list);
  75.     wl_list -> type = WLList;
  76.     wl_list -> size = argc;
  77.     for (i = 0; i < argc; i++)
  78.     increase_reference(wl_list -> list[i] =
  79.                WOOL_send(WOOL_eval, argv[i], (argv[i])));
  80.     return wl_list;
  81. }
  82.  
  83. /* externally callable list-make:
  84.  * (list-make n elements...)
  85.  */
  86.  
  87. WOOL_OBJECT
  88. wool_list_make_from_wool(argc, argv)
  89. int argc;
  90. WOOL_OBJECT     argv[];
  91. {
  92.     WOOL_List       wl_list;
  93.     int             i;
  94.  
  95.     if (argc < 1)
  96.     wool_error(BAD_NUMBER_OF_ARGS, argc);
  97.     must_be_number(argv[0], 0);
  98.     if (((WOOL_Number) argv[0]) -> number) {
  99.         wl_list = wool_list_make(((WOOL_Number) argv[0]) -> number);
  100.         if (argc == 1)
  101.             for (i = 0; i < wl_list -> size; i++)
  102.                 increase_reference(wl_list -> list[i] = NIL);
  103.         else
  104.             for (i = 0; i < wl_list -> size; i++)
  105.               increase_reference(wl_list -> list[i] =
  106.                                  argv[(i % (argc - 1)) + 1]);
  107.         return (WOOL_OBJECT) wl_list;
  108.     } else {
  109.         return NIL;
  110.     }
  111. }
  112.  
  113. /*
  114.  * WLList_eval:
  115.  * the heart of the interpreter:
  116.  * evaluating a list is calling the function associated with car by
  117.  * sending WOOL_execute to the CAR, with the list of parameters.
  118.  */
  119.  
  120. WOOL_OBJECT 
  121. WLList_eval(obj)
  122. WOOL_List obj;
  123. {
  124.     WOOL_OBJECT     result;
  125.  
  126.     calling_function_push(obj);
  127. #ifdef USER_DEBUG
  128.     if (wool_tracing_on) {
  129.     wool_tracing_level++;
  130.     wool_put_spaces(wool_tracing_level);
  131.     wool_puts("-> ");
  132.     wool_print(obj);
  133.     wool_puts("\n");
  134.     if (wool_tracing_on_EXPR) {
  135.         wool_tracing_on = 0;
  136.         eval(wool_tracing_on_EXPR);
  137.         wool_tracing_on = 1;
  138.     }
  139.     result = WOOL_send(WOOL_execute, (*(obj -> list)),
  140.                (*(obj -> list), obj));
  141.     if (wool_tracing_on_EXPR) {
  142.         wool_tracing_on = 0;
  143.         eval(wool_tracing_on_EXPR);
  144.         if (wool_still_tracing)
  145.         wool_tracing_on = 1;
  146.         else
  147.         wool_still_tracing = 1;
  148.     }
  149.     wool_put_spaces(wool_tracing_level);
  150.     wool_puts("<- ");
  151.     wool_print(result);
  152.     wool_puts("\n");
  153.     wool_tracing_level--;
  154.     } else
  155. #endif /* USER_DEBUG */
  156.     {
  157. #ifdef DEBUG            /* stack overflow check */
  158.     if ((calling_function_current - calling_function_stack) >= 10000) {
  159.         printf("Stack size is %d!\n", (calling_function_current 
  160.                        - calling_function_stack)); 
  161.         stop_if_in_dbx(); 
  162.     }
  163. #endif /* DEBUG */
  164.     result = WOOL_send(WOOL_execute, (*(obj -> list)),
  165.                (*(obj -> list), obj));
  166.     }
  167.     calling_function_pop();
  168.     return result;
  169. }
  170.  
  171. /*
  172.  * WLList_print:
  173.  * classical: "(a b c d)"
  174.  */
  175.  
  176. WOOL_OBJECT 
  177. WLList_print(obj)
  178. WOOL_List       obj;
  179. {
  180.     int             i;
  181.     WOOL_OBJECT    *p = obj -> list;
  182.  
  183.     wool_putchar('(');
  184.     if(++wool_print_level <= wool_max_print_level) {
  185.     for (i = 0; i < obj -> size; i++, p++) {
  186.         if (i)
  187.         wool_putchar(' ');
  188.         WOOL_send(WOOL_print, *p, (*p));
  189.     }
  190.     }else{
  191.     wool_puts("...");
  192.     }
  193.     wool_print_level--;
  194.     wool_putchar(')');
  195.     return (WOOL_OBJECT) obj;
  196. }
  197.  
  198. /*
  199.  * freeing a list decreases the reference count of all the elements before
  200.  * freeing itself!
  201.  */
  202.  
  203. WOOL_OBJECT 
  204. WLList_free(obj)
  205. WOOL_List       obj;
  206. {
  207.     WOOL_OBJECT *last = obj -> list + obj -> size, *list = obj -> list;
  208.  
  209.     while (list < last) {
  210.     decrease_reference(*list);
  211.     list++;
  212.     }
  213.     Free(obj);
  214.     return NULL;
  215. }
  216.  
  217. /*
  218.  * executing a list is evaluating it and sending execute to the result
  219.  */
  220.  
  221. WOOL_OBJECT
  222. WLList_execute(obj, list)
  223. WOOL_List  obj;
  224. WOOL_List list;
  225. {
  226.     WOOL_OBJECT     eval = WLList_eval(obj);
  227.  
  228.     if (eval -> type != WLList) {
  229.     return WOOL_send(WOOL_execute, eval, (eval, list));
  230.     } else {
  231.     return (wool_error(UNDEFINED_FUNCTION, obj));
  232.     }
  233. }
  234.  
  235. /*
  236.  * equality of two lists is equality of their elements
  237.  */
  238.  
  239. WOOL_OBJECT
  240. WLList_equal(l1, l2)
  241. WOOL_List l1,l2;
  242. {
  243.     int             i;
  244.  
  245.     if ((l2 -> type != l1 -> type)
  246.     || (l2 -> size != l1 -> size))
  247.     return NIL;
  248.     for (i = 0; i < l1 -> size; i++) {
  249.     if (WOOL_send(WOOL_equal, l1 -> list[i],
  250.               (l1 -> list[i], l2 -> list[i])) == NIL)
  251.         return NIL;
  252.     }
  253.     return (WOOL_OBJECT) l1;
  254. }
  255.  
  256. WOOL_OBJECT *
  257. wool_flatten_pairlist(argc, argv)
  258. int    argc;
  259. WOOL_List *argv;
  260. {
  261.     WOOL_OBJECT    *list =
  262.     (WOOL_OBJECT *) Malloc(sizeof(WOOL_OBJECT) * 2 * argc);
  263.     int             i;
  264.  
  265.     for (i = 0; i < argc; i++) {
  266.     if ((argv[i] -> type != WLList) || (argv[i] -> size != 2))
  267.         return (WOOL_OBJECT *) wool_error(BAD_LOCAL_SYNTAX, "");
  268.     list[i * 2] = argv[i] -> list[0];
  269.     list[i * 2 + 1] = argv[i] -> list[1];
  270.     }
  271.     return list;
  272. }
  273.     
  274.  
  275. /*****************************\
  276. *                   *
  277. * List manipulation routines  *
  278. *                   *
  279. \*****************************/
  280.  
  281. /*
  282.  * returns sublist ifrom... ito
  283.  * (sublist from to list)
  284.  * from included, to excluded
  285.  */
  286.  
  287. WOOL_OBJECT
  288. WLList_sub(argc, argv)
  289. int argc;
  290. WOOL_List argv[];
  291. {
  292.     WOOL_List newlist;
  293.     int             from, to, i;
  294.  
  295.     if (argc != 3)
  296.     wool_error(BAD_NUMBER_OF_ARGS, argc);
  297.     must_be_number(argv[0], 0);
  298.     must_be_number(argv[1], 1);
  299.     must_be_or_nil(WLList, argv[2], 2);
  300.     from = ((WOOL_Number) argv[0]) -> number;
  301.     to = ((WOOL_Number) argv[1]) -> number;
  302.     if (from >= to)
  303.     return NIL;
  304.     newlist = wool_list_make(to - from);
  305.     for (i = 0; i < newlist -> size; i++)
  306.     if (i + from < argv[2] -> size) {
  307.         increase_reference(newlist -> list[i] =
  308.                    argv[2] -> list[i + from]);
  309.     } else {
  310.         increase_reference(newlist -> list[i] = NIL);
  311.     }
  312.     return (WOOL_OBJECT) newlist;
  313. }
  314.  
  315.  
  316. WOOL_OBJECT
  317. WLList_concat(argc,argv)
  318. int argc;
  319. WOOL_List       argv[];
  320. {
  321.     WOOL_List newlist;
  322.     int             i, newsize = 0, size;
  323.  
  324.     for (i = 0; i < argc; i++) {
  325.     must_be_or_nil(WLList, argv[i], i);
  326.     newsize += ((argv[i] == (WOOL_List) NIL) ? 0 : argv[i] -> size);
  327.     }
  328.     if (!newsize)
  329.     return NIL;
  330.     newlist = wool_list_make(newsize);
  331.     newsize = 0;
  332.     for (i = 0; i < argc; i++) {
  333.     if (size = ((argv[i] == (WOOL_List) NIL) ? 0 : argv[i] -> size))
  334.         copy_n_objects(argv[i] -> list, &(newlist -> list)[newsize],
  335.                size);
  336.     newsize += size;
  337.     }
  338.     return (WOOL_OBJECT) newlist;
  339. }
  340.  
  341. WOOL_List
  342. WLList_physically_append(list, key, value)
  343. WOOL_List     list;
  344. WOOL_OBJECT    key;
  345. WOOL_OBJECT    value;
  346. {
  347.     WOOL_List   old_list = list;
  348.  
  349.     if (key -> type == WLNumber) {
  350.     list = (WOOL_List) Realloc(list, sizeof(struct _WOOL_List) +
  351.               list -> size * sizeof(WOOL_OBJECT));
  352.     } else {
  353.     list = (WOOL_List) Realloc(list, sizeof(struct _WOOL_List) +
  354.               (list -> size + 1) * sizeof(WOOL_OBJECT));
  355.     increase_reference(list -> list[list -> size] = key);
  356.     list -> size ++;
  357.     }
  358.     increase_reference(list -> list[list -> size] = value);
  359.     list -> size ++;
  360.     if (list != old_list && !(REF(list) & 1)) {    /* old list was in zrt! */
  361.     zrt_replace_element(old_list, list);
  362.     }
  363.     return list;
  364. }
  365.     
  366.  
  367. int
  368. WLList_length(list)
  369. WOOL_List       list;
  370. {
  371.     if (list == (WOOL_List) NIL)
  372.     return 0;
  373.     else
  374.     return list -> size;
  375. }
  376.  
  377. /*
  378.  * (# n list) gives n-th element (nil if out bounds) returns obj
  379.  * (# n list obj) sets n-th element (increasing size if needed) returns
  380.  *     newlist
  381.  * referencing via an atom is like giving the n tof the position after atom
  382.  * list can also be an atom or a wob
  383.  */
  384.  
  385. #ifdef GWM
  386. #include "EXTERN.h"
  387. #include "gwm.h"        /* TO_DO remove and treat as method */
  388. #endif /* GWM */
  389.  
  390. WOOL_OBJECT
  391. WLList_nth(argc, argv)
  392. int        argc;
  393. WOOL_List    argv[];
  394. {
  395.     WOOL_List newlist, list;
  396.     int             size, newsize, i;
  397.     int             position, symbolic = 0;
  398.  
  399.     if (argc < 2 || argc > 3)
  400.     return wool_error(BAD_NUMBER_OF_ARGS, argc);
  401.     if (argv[1] -> type == WLList || argv[1] == (WOOL_List) NIL) {
  402.       list = argv[1];
  403. #ifdef GWM
  404.     } else if (argv[1] -> type == WLNumber) { /* WOB */
  405.     if (!WobIsValid(((WOOL_Number) argv[1]) -> number)
  406.         || !((Wob) ((WOOL_Number) argv[1])->number) -> property)
  407.         return NIL;
  408.       list = (WOOL_List)
  409.     ((Wob) ((WOOL_Number) argv[1]) -> number) -> property;
  410. #endif /* GWM */
  411.     } else if (argv[1] -> type == WLAtom || argv[1] -> type == WLName) {
  412.     list = (WOOL_List) WOOL_send(WOOL_eval, argv[1], (argv[1]));
  413.     must_be_or_nil(WLList, list, 1);
  414.     } else {
  415.     bad_argument(argv[1], 1, "list or pointer to list");
  416.     }
  417.  
  418.     size = (list == (WOOL_List) NIL ? 0 : list -> size);
  419.     if (argv[0] -> type == WLNumber)
  420.     position = ((WOOL_Number) argv[0]) -> number;
  421.     else {
  422.     symbolic = 1;
  423.     position = size + 1;
  424.     for (i = 0; i < size; i++) {
  425.         if (argv[0] == (WOOL_List) list -> list[i]) {
  426.         position = i + 1;
  427.         break;
  428.         }
  429.     }
  430.     }
  431.  
  432.     if (argc == 2) {        /* GET */
  433.     if (position < 0 || position >= size)
  434.         return NIL;
  435.     else
  436.         return (list) -> list[position];
  437.  
  438.     } else {            /* SET */
  439.     newsize = Max(size, position + 1);
  440.     newlist = wool_list_make(newsize);
  441.     if (size)
  442.         copy_n_objects(&(list -> list)[0], newlist -> list, size);
  443.     if (newsize > size) {
  444.         for (i = size; i < newsize - symbolic; i++)
  445.         increase_reference(newlist -> list[i] = NIL);
  446.     } else {
  447.         decrease_reference(newlist -> list[position]);
  448.     }
  449.     if (symbolic) {
  450.         if (size < position)
  451.         increase_reference(newlist -> list[position - 1] =
  452.                    (WOOL_OBJECT) argv[0]);
  453.         increase_reference(newlist -> list[position] =
  454.                    (WOOL_OBJECT) argv[2]);
  455.     } else {
  456.         increase_reference(newlist -> list[position] =
  457.                    (WOOL_OBJECT) argv[2]);
  458.     }
  459.     return (WOOL_OBJECT) newlist;
  460.     }
  461. }
  462.  
  463. /* physical replacement of an element of a list
  464.  * succeeds only if there is room, else returns ()
  465.  * returns list
  466.  */
  467.  
  468. WOOL_OBJECT
  469. WLList_replace_nth(argc, argv)
  470. int        argc;
  471. WOOL_List    argv[];
  472. {
  473.     int             size, i;
  474.     int             position = 0;
  475.     WOOL_List        list, *list_ptr;
  476.  
  477.     if (argc != 3)
  478.     return wool_error(BAD_NUMBER_OF_ARGS, argc);
  479.     if (argv[1] -> type == WLList || argv[1] == (WOOL_List) NIL) {
  480.     list = argv[1];
  481.     list_ptr = NULL;
  482. #ifdef GWM
  483.     } else if (argv[1] -> type == WLNumber) {/* WOB */
  484.     if (!WobIsValid(((WOOL_Number) argv[1]) -> number)
  485.         || !((Wob) ((WOOL_Number) argv[1])->number) -> property)
  486.         return NIL;
  487.     list_ptr = (WOOL_List*)&
  488.              ((Wob) ((WOOL_Number) argv[1])->number) -> property;
  489.     list = *list_ptr;
  490.     must_be_or_nil(WLList, list, 1);
  491. #endif /* GWM */
  492.     } else if (argv[1] -> type == WLAtom) {
  493.     list_ptr = (WOOL_List*)& ((WOOL_Atom) argv[1])->c_val;
  494.     list = *list_ptr;
  495.     must_be_or_nil(WLList, list, 1);
  496.     } else if (argv[1] -> type == WLName) {
  497.     list_ptr = (WOOL_List *) WLName_slot(argv[1]);
  498.     list = *list_ptr;
  499.     must_be_or_nil(WLList, list, 1);
  500.     } else {
  501.     bad_argument(argv[1], 1, "list or pointer to list");
  502.     }
  503.  
  504.     size = (list == (WOOL_List) NIL ? 0 : list -> size);
  505.     if (argv[0] -> type == WLNumber)
  506.     position = Max(0, ((WOOL_Number) argv[0]) -> number);
  507.     else {
  508.     position = size + 1;
  509.     for (i = 0; i < size; i++) {
  510.         if (argv[0] == (WOOL_List) list -> list[i]) {
  511.         position = i + 1;
  512.         break;
  513.         }
  514.     }
  515.     }
  516.  
  517.     if (position >= size) {    /* increase size */
  518.     if (list_ptr) {
  519.         if (REF(list) >= 4) {/* 2 or more objs point to it */
  520.         decrease_reference(list);
  521.         increase_reference(*list_ptr = list =
  522.                    (WOOL_List) WLList_nth(argc, argv));
  523.         } else {        /* pointed by one object */
  524.         *list_ptr = list =
  525.           WLList_physically_append(list, argv[0], argv[2]);
  526.         }
  527.     } else {        /* cannot resize a non-pointed to list */
  528.         wool_error("Could not modify %s\n", "list");
  529.     }
  530.     } else {            /* replace an existing element */
  531.     if (list_ptr && REF(list) >= 4) { /* duplicate first */
  532.         decrease_reference(list);
  533.         increase_reference(*list_ptr = list =
  534.                    (WOOL_List) WLList_nth(argc, argv));
  535.     } else {        /* physical modif */
  536.         decrease_reference(list -> list[position]);
  537.         increase_reference(list -> list[position]
  538.                    = (WOOL_OBJECT) argv[2]);
  539.     }
  540.     }
  541.     return (WOOL_OBJECT) list;
  542. }
  543.  
  544. /* physical deletion of an element of a list
  545.  * succeeds only if there is room, else returns ()
  546.  * returns list
  547.  */
  548.  
  549. WOOL_OBJECT
  550. WLList_delete_nth(key, wl_list)
  551. WOOL_OBJECT     key;
  552. WOOL_List    wl_list;
  553. {
  554.     int             size, i;
  555.     int             position = 0;
  556.     WOOL_List        list, *list_ptr;
  557.  
  558.     if (wl_list -> type == WLList || wl_list == (WOOL_List) NIL) {
  559.     list = wl_list;
  560.     list_ptr = NULL;
  561. #ifdef GWM
  562.     } else if (wl_list -> type == WLNumber) {/* WOB */
  563.     if (!WobIsValid(((WOOL_Number) wl_list) -> number)
  564.         || !((Wob) ((WOOL_Number) wl_list)->number) -> property)
  565.         return NIL;
  566.     list_ptr = (WOOL_List*)&
  567.             ((Wob) ((WOOL_Number) wl_list) -> number) -> property;
  568.     list = *list_ptr;
  569.     must_be_or_nil(WLList, list, 1);
  570. #endif /* GWM */
  571.     } else if (wl_list -> type == WLAtom) {
  572.     list_ptr = (WOOL_List*) & ((WOOL_Atom) wl_list) -> c_val;
  573.     list = *list_ptr;
  574.     must_be_or_nil(WLList, list, 1);
  575.     } else if (wl_list -> type == WLName) {
  576.     list_ptr = (WOOL_List *) WLName_slot(wl_list);
  577.     list = *list_ptr;
  578.     must_be_or_nil(WLList, list, 1);
  579.     } else {
  580.     bad_argument(wl_list, 1, "list or pointer to list");
  581.     }
  582.  
  583.     size = (list == (WOOL_List) NIL ? 0 : list -> size);
  584.     if (key -> type == WLNumber)
  585.     position = Max(0, ((WOOL_Number) key) -> number);
  586.     else {
  587.     position = size + 1;
  588.     for (i = 0; i < size; i++) {
  589.         if (key == list -> list[i]) {
  590.         position = i + 1;
  591.         break;
  592.         }
  593.     }
  594.     }
  595.  
  596.     if (position < size) {    /* increase size */
  597.     if (list_ptr && REF(list) >= 4) { /* duplicate first */
  598.         decrease_reference(list);
  599.         increase_reference(*list_ptr = list =
  600.                    (WOOL_List) WLList_copy(list));
  601.     }
  602.                 /* delete elements */
  603.     {
  604.         int i;
  605.         int number = (key -> type == WLNumber ? 1 : 2);
  606.  
  607.         decrease_reference(list -> list[position - number + 1]);
  608.         list -> size -= number;
  609.         for (i = position - number + 1; i < list -> size; i++)
  610.             list -> list[i] = list -> list[i + number];
  611.     }
  612.     }
  613.     if (list -> size)
  614.         return (WOOL_OBJECT) list;
  615.     else
  616.         return NIL;
  617. }
  618.  
  619. /* the quicksort of a list
  620.  */
  621.  
  622. static WOOL_List WLList_qsort_compare_call;
  623. #ifdef PROTOTYPES
  624. /* correct typing for the actual call to qsort */
  625. typedef int (*WLListQsortCompareFuncType) (const void *, const void *);
  626. #endif
  627.  
  628. int
  629. WLList_qsort_compare_func(o1, o2)
  630. WOOL_OBJECT    *o1, *o2;
  631. {
  632.     WOOL_Number wl_num;
  633.  
  634.     WLList_qsort_compare_call -> list[1] = *o1;
  635.     WLList_qsort_compare_call -> list[2] = *o2;
  636.     wl_num = (WOOL_Number) WOOL_send(WOOL_execute,
  637.         (WLList_qsort_compare_call -> list[0]),
  638.     (WLList_qsort_compare_call -> list[0], WLList_qsort_compare_call));
  639.  
  640.     if (wl_num -> type != WLNumber)
  641.         wool_error("sort compare function must return a number, not a %s",
  642.     ((WOOL_Atom) wl_num -> type[0]) -> p_name);
  643.     return wl_num -> number;
  644. }
  645.  
  646. WOOL_OBJECT
  647. WLList_qsort(list, compare_func)
  648. WOOL_List    list;
  649. WOOL_OBJECT    compare_func;        /* any function */
  650. {
  651.     if (list->type != WLList)
  652.     return NIL;
  653.     if (!WLList_qsort_compare_call) {
  654.     increase_reference(WLList_qsort_compare_call = wool_list_make(3));
  655.     }
  656.     WLList_qsort_compare_call -> list[0] = compare_func;
  657.     qsort((char *) list -> list, list ->size, sizeof(WOOL_OBJECT),
  658. #ifdef PROTOTYPES
  659.     (WLListQsortCompareFuncType) 
  660. #endif
  661.         WLList_qsort_compare_func);
  662.     return (WOOL_OBJECT) list;    
  663. }
  664.  
  665. /* copy of a list (but not of its elements)
  666.  */
  667.  
  668. WOOL_OBJECT
  669. WLList_copy(list)
  670. WOOL_List    list;
  671. {
  672.     if (list -> type != WLList)        /* copy of () = () */
  673.         return (WOOL_OBJECT) list;
  674.     else {                /* normal case */
  675.       WOOL_List       wl_list;
  676.       int             i;
  677.  
  678.       wl_list = (WOOL_List) Malloc(sizeof(struct _WOOL_List) +
  679.                                    (list -> size - 1) * sizeof(WOOL_OBJECT));
  680.       zrt_put(wl_list);
  681.       wl_list -> type = WLList;
  682.       wl_list -> size = list -> size;
  683.       for (i = 0; i < list -> size; i++)
  684.     increase_reference(wl_list -> list[i] = list -> list[i]);
  685.       return (WOOL_OBJECT) wl_list;
  686.   }
  687. }
  688.