home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / plbin.zip / pl / src / pl-list.c < prev    next >
C/C++ Source or Header  |  1992-05-26  |  3KB  |  136 lines
  1. /*  pl-list.c,v 1.1.1.1 1992/05/26 11:52:22 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: List manipulation predicates in C
  8. */
  9.  
  10. #include "pl-incl.h"
  11.  
  12. word
  13. pl_is_list(list)
  14. Word list;
  15. { if ( isList(*list) || isNil(*list) )
  16.     succeed;
  17.  
  18.   fail;
  19. }
  20.  
  21. word
  22. pl_proper_list(list)
  23. Word list;
  24. { if ( lengthList(list) >= 0 )
  25.     succeed;
  26.  
  27.   fail;
  28. }
  29.  
  30. word
  31. pl_length(list, l)
  32. Word list, l;
  33. { if ( isInteger(*l) )
  34.   { long n = valNum(*l);
  35.     if ( n < 0 )
  36.       fail;
  37.     while( n-- > 0 )
  38.     { TRY( unifyFunctor(list, FUNCTOR_dot2) );
  39.       list = TailList(list); deRef(list);
  40.     }
  41.     CLOSELIST(list);
  42.     succeed;
  43.   }
  44.  
  45.   if ( isVar(*l) )
  46.   { long n;
  47.   
  48.     if ( (n=lengthList(list)) >= 0 )
  49.       return unifyAtomic(l, consNum(n));
  50.     fail;            /* both variables: generate in Prolog */
  51.   }
  52.   
  53.   return warning("length/2: instantiation fault");
  54. }  
  55.  
  56.  
  57. word
  58. pl_memberchk(e, list)
  59. Word e, list;
  60. { for(;;)
  61.   { TRY( unifyFunctor(list, FUNCTOR_dot2) );
  62.     if ( pl_unify(e, HeadList(list)) == TRUE )
  63.       succeed;
  64.     list = TailList(list);
  65.     deRef(list);
  66.   }
  67. }
  68.  
  69. forwards int    qsort_compare_standard P((Word *, Word *));
  70. forwards Word    *list_to_sorted_array P((Word, int *));
  71.  
  72. static int
  73. qsort_compare_standard(p1, p2)
  74. Word *p1, *p2;
  75. { return compareStandard(*p1, *p2);
  76. }
  77.  
  78. static Word *
  79. list_to_sorted_array(list, size)
  80. Word list;
  81. int *size;
  82. { int n = lengthList(list);
  83.   Word *array, *a;
  84.  
  85.   if ( n < 0 )
  86.     fail;            /* not a proper list */
  87.   initAllocLocal();
  88.   array = (Word *)allocLocal(n * sizeof(Word));
  89.   stopAllocLocal();
  90.   for(a=array; isList(*list); a++)
  91.   { *a = HeadList(list);
  92.     deRef(*a);
  93.     list = TailList(list);
  94.     deRef(list);
  95.   }
  96.   SECURE(if (!isNil(*list)) sysError("list_to_sorted_array()"));
  97.   qsort(array, n, sizeof(Word), qsort_compare_standard);
  98.   
  99.   *size = n;
  100.   return array;
  101. }
  102.  
  103.  
  104. word
  105. pl_msort(list, sorted)
  106. Word list, sorted;
  107. { Word *array;
  108.   int n;
  109.  
  110.   if ( (array=list_to_sorted_array(list, &n)) == (Word *) NULL )
  111.     return warning("msort/1: first argument is not a proper list");
  112.   for(; n > 0; n--, array++)
  113.     APPENDLIST(sorted, *array);
  114.   CLOSELIST(sorted);
  115.   
  116.   succeed;
  117. }
  118.  
  119.  
  120. word
  121. pl_sort(list, sorted)
  122. Word list, sorted;
  123. { Word *array;
  124.   int n, size;
  125.  
  126.   if ( (array=list_to_sorted_array(list, &size)) == (Word *) NULL )
  127.     return warning("sort/1: first argument is not a proper list");
  128.   for(n = 0; n < size; n++, array++)
  129.   { if ( n == 0 || compareStandard(array[-1], array[0]) != 0 )
  130.       APPENDLIST(sorted, *array);
  131.   }
  132.   CLOSELIST(sorted);
  133.   
  134.   succeed;
  135. }
  136.