chr_support.c

   1 #include <SWI-Prolog.h>
   2 #include <stdlib.h>
   3 #include <ctype.h>
   4
   5
   6 /*
   7         lookup_ht(HT,Key,Values) :-
   8                 term_hash(Key,Hash),
   9                 HT = ht(Capacity,_,Table),
  10                 Index is (Hash mod Capacity) + 1,
  11                 arg(Index,Table,Bucket),
  12                 nonvar(Bucket),
  13                 ( Bucket = K-Vs ->
  14                     K == Key,
  15                     Values = Vs
  16                 ;
  17                     lookup(Bucket,Key,Values)
  18                 ).
  19
  20         lookup([K - V | KVs],Key,Value) :-
  21                 ( K = Key ->
  22                         V = Value
  23                 ;
  24                         lookup(KVs,Key,Value)
  25                 ).
  26 */
  27 static foreign_t
  28 pl_lookup_ht1(term_t ht, term_t pl_hash, term_t key, term_t values)
  29 {
  30   int capacity;
  31   int hash;
  32   int index;
  33
  34   term_t pl_capacity = PL_new_term_ref();
  35   term_t table       = PL_new_term_ref();
  36   term_t bucket      = PL_new_term_ref();
  37
  38   /* HT = ht(Capacity,_,Table) */
  39   PL_get_arg(1, ht, pl_capacity);
  40   PL_get_integer(pl_capacity, &capacity);
  41   PL_get_arg(3, ht, table);
  42
  43   /* Index is (Hash mod Capacity) + 1 */
  44   PL_get_integer(pl_hash, &hash);
  45   index = (hash % capacity) + 1;
  46
  47   /* arg(Index,Table,Bucket) */
  48   PL_get_arg(index, table, bucket);
  49
  50   /* nonvar(Bucket) */
  51   if (PL_is_variable(bucket)) PL_fail;
  52
  53   if (PL_is_list(bucket)) {
  54         term_t pair          = PL_new_term_ref();
  55         term_t k             = PL_new_term_ref();
  56         term_t vs            = PL_new_term_ref();
  57         while (PL_get_list(bucket, pair,bucket)) {
  58                 PL_get_arg(1, pair, k);
  59                 if ( PL_compare(k,key) == 0 ) {
  60                         /* Values = Vs */
  61                         PL_get_arg(2, pair, vs);
  62                         return PL_unify(values,vs);
  63                 }
  64         }
  65         PL_fail;
  66   } else {
  67         term_t k             = PL_new_term_ref();
  68         term_t vs            = PL_new_term_ref();
  69         PL_get_arg(1, bucket, k);
  70         /* K == Key */
  71         if ( PL_compare(k,key) == 0 ) {
  72                 /* Values = Vs */
  73                 PL_get_arg(2, bucket, vs);
  74                 return PL_unify(values,vs);
  75         } else {
  76                 PL_fail;
  77         }
  78   }
  79 }
  80
  81 static foreign_t
  82 pl_memberchk_eq(term_t element, term_t maybe_list)
  83 {
  84
  85   term_t head = PL_new_term_ref();              /* variable for the elements */
  86   term_t list = PL_copy_term_ref(maybe_list);   /* copy as we need to write */
  87
  88   while( PL_get_list(list, head, list) )
  89   { if ( PL_compare(element,head) == 0 )
  90      PL_succeed ;
  91   }
  92
  93   PL_fail;
  94
  95 }
  96
  97         /* INSTALL */
  98
  99 install_t
 100 install_chr_support()
 101 {
 102   PL_register_foreign("memberchk_eq",2, pl_memberchk_eq, 0);
 103   PL_register_foreign("lookup_ht1",4, pl_lookup_ht1, 0);
 104 }
 105