1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
|
/* $Id: pl-list.c,v 1.8 1999/12/20 14:14:12 jan Exp $
Copyright (c) 1990 Jan Wielemaker. All rights reserved.
See ../LICENCE to find out about your rights.
jan@swi.psy.uva.nl
Purpose: List manipulation predicates in C
*/
#include "pl-incl.h"
word
pl_is_list(term_t list)
{ Word p = valTermRef(list);
deRef(p);
if ( isList(*p) || isNil(*p) )
succeed;
fail;
}
word
pl_proper_list(term_t list)
{ if ( lengthList(list, FALSE) >= 0 )
succeed;
fail;
}
word
pl_length(term_t list, term_t l)
{ int n;
if ( PL_get_integer(l, &n) )
{ if ( n >= 0 )
{ term_t h = PL_new_term_ref();
term_t l = PL_copy_term_ref(list);
while( n-- > 0 )
{ TRY(PL_unify_list(l, h, l));
}
return PL_unify_nil(l);
}
fail;
}
if ( PL_is_variable(l) )
{ long n;
if ( (n=lengthList(list, FALSE)) >= 0 )
return PL_unify_integer(l, n);
fail; /* both variables: generate in Prolog */
}
return warning("length/2: instantiation fault");
}
word
pl_memberchk(term_t e, term_t list)
{ term_t h = PL_new_term_ref();
term_t l = PL_copy_term_ref(list);
for(;;)
{ TRY(PL_unify_list(l, h, l));
if ( PL_unify(e, h) )
succeed;
}
}
static int
qsort_compare_standard(const void *p1, const void *p2)
{ return compareStandard((Word) p1, (Word) p2);
}
static term_t
list_to_sorted_array(term_t List, int *size)
{ int n = lengthList(List, TRUE);
term_t rval;
term_t list = PL_copy_term_ref(List);
term_t head = PL_new_term_ref();
int i;
if ( n < 0 )
fail; /* not a proper list */
rval = PL_new_term_refs(n);
for(i=0; PL_get_list(list, head, list); i++)
PL_put_term(rval+i, head);
qsort(valTermRef(rval), n, sizeof(word), qsort_compare_standard);
*size = n;
return rval;
}
word
pl_msort(term_t list, term_t sorted)
{ term_t array;
term_t l = PL_copy_term_ref(sorted);
term_t h = PL_new_term_ref();
int n, i;
if ( !(array = list_to_sorted_array(list, &n)) )
fail;
for(i=0; i < n; i++)
{ if ( !PL_unify_list(l, h, l) ||
!PL_unify(h, array+i) )
fail;
}
return PL_unify_nil(l);
}
word
pl_sort(term_t list, term_t sorted)
{ term_t array;
term_t l = PL_copy_term_ref(sorted);
term_t h = PL_new_term_ref();
int n, size;
if ( !(array=list_to_sorted_array(list, &size)) )
return warning("sort/1: first argument is not a proper list");
for(n = 0; n < size; n++)
{ if ( n == 0 || !pl_equal(array+n-1, array+n) )
{ if ( !PL_unify_list(l, h, l) ||
!PL_unify(h, array+n) )
fail;
}
}
return PL_unify_nil(l);
}
|