Branch data     Line data    Source code

       1                 :            : #include <stdlib.h>
       2                 :            : #include <stdio.h>
       3                 :            : #include <stdarg.h>
       4                 :            : #include <string.h>
       5                 :            : #include <assert.h>
       6                 :            : #include <sys/types.h>
       7                 :            : #include "flisp.h"
       8                 :            : #include "equalhash.h"
       9                 :            : 
      10                 :            : #ifdef __cplusplus
      11                 :            : extern "C" {
      12                 :            : #endif
      13                 :            : 
      14                 :          0 : void print_htable(fl_context_t *fl_ctx, value_t v, ios_t *f)
      15                 :            : {
      16                 :          0 :     htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(v));
      17                 :            :     size_t i;
      18                 :          0 :     int first=1;
      19                 :          0 :     fl_print_str(fl_ctx, "#table(", f);
      20         [ #  # ]:          0 :     for(i=0; i < h->size; i+=2) {
      21         [ #  # ]:          0 :         if (h->table[i+1] != HT_NOTFOUND) {
      22         [ #  # ]:          0 :             if (!first) fl_print_str(fl_ctx, "  ", f);
      23                 :          0 :             fl_print_child(fl_ctx, f, (value_t)h->table[i]);
      24                 :          0 :             fl_print_chr(fl_ctx, ' ', f);
      25                 :          0 :             fl_print_child(fl_ctx, f, (value_t)h->table[i+1]);
      26                 :          0 :             first = 0;
      27                 :            :         }
      28                 :            :     }
      29                 :          0 :     fl_print_chr(fl_ctx, ')', f);
      30                 :          0 : }
      31                 :            : 
      32                 :          0 : void print_traverse_htable(fl_context_t *fl_ctx, value_t self)
      33                 :            : {
      34                 :          0 :     htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(self));
      35                 :            :     size_t i;
      36         [ #  # ]:          0 :     for(i=0; i < h->size; i+=2) {
      37         [ #  # ]:          0 :         if (h->table[i+1] != HT_NOTFOUND) {
      38                 :          0 :             print_traverse(fl_ctx, (value_t)h->table[i]);
      39                 :          0 :             print_traverse(fl_ctx, (value_t)h->table[i+1]);
      40                 :            :         }
      41                 :            :     }
      42                 :          0 : }
      43                 :            : 
      44                 :      39816 : void free_htable(fl_context_t *fl_ctx, value_t self)
      45                 :            : {
      46                 :            :     (void)fl_ctx;
      47                 :      39816 :     htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(self));
      48                 :      39816 :     htable_free(h);
      49                 :      39816 : }
      50                 :            : 
      51                 :     155446 : void relocate_htable(fl_context_t *fl_ctx, value_t oldv, value_t newv)
      52                 :            : {
      53                 :     155446 :     htable_t *oldh = (htable_t*)cv_data((cvalue_t*)ptr(oldv));
      54                 :     155446 :     htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(newv));
      55         [ +  + ]:     155446 :     if (oldh->table == &oldh->_space[0])
      56                 :      43212 :         h->table = &h->_space[0];
      57                 :            :     size_t i;
      58         [ +  + ]:  254730000 :     for(i=0; i < h->size; i++) {
      59         [ +  + ]:  254574000 :         if (h->table[i] != HT_NOTFOUND)
      60                 :   79423800 :             h->table[i] = (void*)relocate_lispvalue(fl_ctx, (value_t)h->table[i]);
      61                 :            :     }
      62                 :     155446 : }
      63                 :            : 
      64                 :   62149000 : static int ishashtable(fl_context_t *fl_ctx, value_t v)
      65                 :            : {
      66   [ +  -  +  - ]:   62149000 :     return iscvalue(v) && cv_class((cvalue_t*)ptr(v)) == fl_ctx->tabletype;
      67                 :            : }
      68                 :            : 
      69                 :          0 : value_t fl_tablep(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
      70                 :            : {
      71                 :          0 :     argcount(fl_ctx, "table?", nargs, 1);
      72         [ #  # ]:          0 :     return ishashtable(fl_ctx, args[0]) ? fl_ctx->T : fl_ctx->F;
      73                 :            : }
      74                 :            : 
      75                 :   62149000 : static htable_t *totable(fl_context_t *fl_ctx, value_t v, char *fname)
      76                 :            : {
      77         [ -  + ]:   62149000 :     if (!ishashtable(fl_ctx, v))
      78                 :          0 :         type_error(fl_ctx, fname, "table", v);
      79                 :   62149000 :     return (htable_t*)cv_data((cvalue_t*)ptr(v));
      80                 :            : }
      81                 :            : 
      82                 :    6553940 : value_t fl_table(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
      83                 :            : {
      84                 :    6553940 :     size_t cnt = (size_t)nargs;
      85         [ -  + ]:    6553940 :     if (cnt & 1)
      86                 :          0 :         lerror(fl_ctx, fl_ctx->ArgError, "table: arguments must come in pairs");
      87                 :            :     value_t nt;
      88                 :            :     // prevent small tables from being added to finalizer list
      89         [ +  + ]:    6553940 :     if (cnt <= HT_N_INLINE) {
      90                 :    6553180 :         fl_ctx->table_vtable.finalize = NULL;
      91                 :    6553180 :         nt = cvalue(fl_ctx, fl_ctx->tabletype, sizeof(htable_t));
      92                 :    6553180 :         fl_ctx->table_vtable.finalize = free_htable;
      93                 :            :     }
      94                 :            :     else {
      95                 :        750 :         nt = cvalue(fl_ctx, fl_ctx->tabletype, 2*sizeof(void*));
      96                 :            :     }
      97                 :    6553940 :     htable_t *h = (htable_t*)cv_data((cvalue_t*)ptr(nt));
      98                 :    6553940 :     htable_new(h, cnt/2);
      99                 :            :     uint32_t i;
     100                 :    6553940 :     value_t k=fl_ctx->NIL, arg=fl_ctx->NIL;
     101         [ +  + ]:    7086140 :     FOR_ARGS(i,0,arg,args) {
     102         [ +  + ]:     532200 :         if (i&1)
     103                 :     266100 :             equalhash_put_r(h, (void*)k, (void*)arg, (void*)fl_ctx);
     104                 :            :         else
     105                 :     266100 :             k = arg;
     106                 :            :     }
     107                 :    6553940 :     return nt;
     108                 :            : }
     109                 :            : 
     110                 :            : // (put! table key value)
     111                 :    8011960 : value_t fl_table_put(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
     112                 :            : {
     113                 :    8011960 :     argcount(fl_ctx, "put!", nargs, 3);
     114                 :    8011960 :     htable_t *h = totable(fl_ctx, args[0], "put!");
     115                 :    8011960 :     void **table0 = h->table;
     116                 :    8011960 :     equalhash_put_r(h, (void*)args[1], (void*)args[2], (void*)fl_ctx);
     117                 :            :     // register finalizer if we outgrew inline space
     118   [ +  +  +  + ]:    8011960 :     if (table0 == &h->_space[0] && h->table != &h->_space[0]) {
     119                 :      44778 :         cvalue_t *cv = (cvalue_t*)ptr(args[0]);
     120                 :      44778 :         add_finalizer(fl_ctx, cv);
     121                 :      44778 :         cv->len = 2*sizeof(void*);
     122                 :            :     }
     123                 :    8011960 :     return args[0];
     124                 :            : }
     125                 :            : 
     126                 :          0 : static void key_error(fl_context_t *fl_ctx, char *fname, value_t key)
     127                 :            : {
     128                 :          0 :     lerrorf(fl_ctx, fl_list2(fl_ctx, fl_ctx->KeyError, key), "%s: key not found", fname);
     129                 :            : }
     130                 :            : 
     131                 :            : // (get table key [default])
     132                 :   19172620 : value_t fl_table_get(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
     133                 :            : {
     134         [ +  + ]:   19172620 :     if (nargs != 3)
     135                 :     832448 :         argcount(fl_ctx, "get", nargs, 2);
     136                 :   19172620 :     htable_t *h = totable(fl_ctx, args[0], "get");
     137                 :   19172620 :     value_t v = (value_t)equalhash_get_r(h, (void*)args[1], (void*)fl_ctx);
     138         [ +  + ]:   19172620 :     if (v == (value_t)HT_NOTFOUND) {
     139         [ +  - ]:    6757580 :         if (nargs == 3)
     140                 :    6757580 :             return args[2];
     141                 :          0 :         key_error(fl_ctx, "get", args[1]);
     142                 :            :     }
     143                 :   12415040 :     return v;
     144                 :            : }
     145                 :            : 
     146                 :            : // (has? table key)
     147                 :   33178400 : value_t fl_table_has(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
     148                 :            : {
     149                 :   33178400 :     argcount(fl_ctx, "has", nargs, 2);
     150                 :   33178400 :     htable_t *h = totable(fl_ctx, args[0], "has");
     151         [ +  + ]:   33178400 :     return equalhash_has_r(h, (void*)args[1], (void*)fl_ctx) ? fl_ctx->T : fl_ctx->F;
     152                 :            : }
     153                 :            : 
     154                 :            : // (del! table key)
     155                 :      91534 : value_t fl_table_del(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
     156                 :            : {
     157                 :      91534 :     argcount(fl_ctx, "del!", nargs, 2);
     158                 :      91534 :     htable_t *h = totable(fl_ctx, args[0], "del!");
     159         [ -  + ]:      91534 :     if (!equalhash_remove_r(h, (void*)args[1], (void*)fl_ctx))
     160                 :          0 :         key_error(fl_ctx, "del!", args[1]);
     161                 :      91534 :     return args[0];
     162                 :            : }
     163                 :            : 
     164                 :    1694406 : value_t fl_table_foldl(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
     165                 :            : {
     166                 :    1694406 :     argcount(fl_ctx, "table.foldl", nargs, 3);
     167                 :    1694406 :     value_t f=args[0], zero=args[1], t=args[2];
     168                 :    1694406 :     htable_t *h = totable(fl_ctx, t, "table.foldl");
     169                 :    1694406 :     size_t i, n = h->size;
     170                 :    1694406 :     void **table = h->table;
     171                 :    1694406 :     fl_gc_handle(fl_ctx, &f);
     172                 :    1694406 :     fl_gc_handle(fl_ctx, &zero);
     173                 :    1694406 :     fl_gc_handle(fl_ctx, &t);
     174         [ +  + ]:   28934600 :     for(i=0; i < n; i+=2) {
     175         [ +  + ]:   27240200 :         if (table[i+1] != HT_NOTFOUND) {
     176                 :    1794540 :             zero = fl_applyn(fl_ctx, 3, f,
     177                 :     897270 :                              (value_t)table[i],
     178                 :     897270 :                              (value_t)table[i+1],
     179                 :            :                              zero);
     180                 :            :             // reload pointer
     181                 :     897270 :             h = (htable_t*)cv_data((cvalue_t*)ptr(t));
     182         [ -  + ]:     897270 :             if (h->size != n)
     183                 :          0 :                 lerror(fl_ctx, fl_ctx->EnumerationError, "table.foldl: table modified");
     184                 :     897270 :             table = h->table;
     185                 :            :         }
     186                 :            :     }
     187                 :    1694406 :     fl_free_gc_handles(fl_ctx, 3);
     188                 :    1694406 :     return zero;
     189                 :            : }
     190                 :            : 
     191                 :            : static const builtinspec_t tablefunc_info[] = {
     192                 :            :     { "table", fl_table },
     193                 :            :     { "table?", fl_tablep },
     194                 :            :     { "put!", fl_table_put },
     195                 :            :     { "get", fl_table_get },
     196                 :            :     { "has?", fl_table_has },
     197                 :            :     { "del!", fl_table_del },
     198                 :            :     { "table.foldl", fl_table_foldl },
     199                 :            :     { NULL, NULL }
     200                 :            : };
     201                 :            : 
     202                 :         30 : void table_init(fl_context_t *fl_ctx)
     203                 :            : {
     204                 :         30 :     fl_ctx->table_vtable.print = print_htable;
     205                 :         30 :     fl_ctx->table_vtable.relocate = relocate_htable;
     206                 :         30 :     fl_ctx->table_vtable.finalize = free_htable;
     207                 :         30 :     fl_ctx->table_vtable.print_traverse = print_traverse_htable;
     208                 :            : 
     209                 :         30 :     fl_ctx->tablesym = symbol(fl_ctx, "table");
     210                 :         60 :     fl_ctx->tabletype = define_opaque_type(fl_ctx->tablesym, sizeof(htable_t),
     211                 :         30 :                                            &fl_ctx->table_vtable, NULL);
     212                 :         30 :     assign_global_builtins(fl_ctx, tablefunc_info);
     213                 :         30 : }
     214                 :            : 
     215                 :            : #ifdef __cplusplus
     216                 :            : }
     217                 :            : #endif