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
|
#include <SWI-Prolog.h>
#include <stdlib.h>
#include <ctype.h>
/*
lookup_ht(HT,Key,Values) :-
term_hash(Key,Hash),
HT = ht(Capacity,_,Table),
Index is (Hash mod Capacity) + 1,
arg(Index,Table,Bucket),
nonvar(Bucket),
( Bucket = K-Vs ->
K == Key,
Values = Vs
;
lookup(Bucket,Key,Values)
).
lookup([K - V | KVs],Key,Value) :-
( K = Key ->
V = Value
;
lookup(KVs,Key,Value)
).
*/
static foreign_t
pl_lookup_ht1(term_t ht, term_t pl_hash, term_t key, term_t values)
{
int capacity;
int hash;
int index;
term_t pl_capacity = PL_new_term_ref();
term_t table = PL_new_term_ref();
term_t bucket = PL_new_term_ref();
/* HT = ht(Capacity,_,Table) */
PL_get_arg(1, ht, pl_capacity);
PL_get_integer(pl_capacity, &capacity);
PL_get_arg(3, ht, table);
/* Index is (Hash mod Capacity) + 1 */
PL_get_integer(pl_hash, &hash);
index = (hash % capacity) + 1;
/* arg(Index,Table,Bucket) */
PL_get_arg(index, table, bucket);
/* nonvar(Bucket) */
if (PL_is_variable(bucket)) PL_fail;
if (PL_is_list(bucket)) {
term_t pair = PL_new_term_ref();
term_t k = PL_new_term_ref();
term_t vs = PL_new_term_ref();
while (PL_get_list(bucket, pair,bucket)) {
PL_get_arg(1, pair, k);
if ( PL_compare(k,key) == 0 ) {
/* Values = Vs */
PL_get_arg(2, pair, vs);
return PL_unify(values,vs);
}
}
PL_fail;
} else {
term_t k = PL_new_term_ref();
term_t vs = PL_new_term_ref();
PL_get_arg(1, bucket, k);
/* K == Key */
if ( PL_compare(k,key) == 0 ) {
/* Values = Vs */
PL_get_arg(2, bucket, vs);
return PL_unify(values,vs);
} else {
PL_fail;
}
}
}
static foreign_t
pl_memberchk_eq(term_t element, term_t maybe_list)
{
term_t head = PL_new_term_ref(); /* variable for the elements */
term_t list = PL_copy_term_ref(maybe_list); /* copy as we need to write */
while( PL_get_list(list, head, list) )
{ if ( PL_compare(element,head) == 0 )
PL_succeed ;
}
PL_fail;
}
/* INSTALL */
install_t
install_chr_support()
{
PL_register_foreign("memberchk_eq",2, pl_memberchk_eq, 0);
PL_register_foreign("lookup_ht1",4, pl_lookup_ht1, 0);
}
|
