git.gag.com Git - debian/gnuradio/blob - pmt/src/lib/pmt.cc

   1 /* -*- c++ -*- */
   2 /*
   3  * Copyright 2006 Free Software Foundation, Inc.
   4  *
   5  * This file is part of GNU Radio
   6  *
   7  * GNU Radio is free software; you can redistribute it and/or modify
   8  * it under the terms of the GNU General Public License as published by
   9  * the Free Software Foundation; either version 3, or (at your option)
  10  * any later version.
  11  *
  12  * GNU Radio is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with GNU Radio; see the file COPYING.  If not, write to
  19  * the Free Software Foundation, Inc., 51 Franklin Street,
  20  * Boston, MA 02110-1301, USA.
  21  */
  22
  23 #ifdef HAVE_CONFIG_H
  24 #include <config.h>
  25 #endif
  26 #include <vector>
  27 #include <pmt.h>
  28 #include "pmt_int.h"
  29 #include <stdio.h>
  30 #include <pmt_pool.h>
  31
  32 static const int CACHE_LINE_SIZE = 64;          // good guess
  33
  34 # if (PMT_LOCAL_ALLOCATOR)
  35
  36 static pmt_pool global_pmt_pool(sizeof(pmt_pair), CACHE_LINE_SIZE);
  37
  38 void *
  39 pmt_base::operator new(size_t size)
  40 {
  41   void *p = global_pmt_pool.malloc();
  42
  43   // fprintf(stderr, "pmt_base::new p = %p\n", p);
  44   assert((reinterpret_cast<intptr_t>(p) & (CACHE_LINE_SIZE - 1)) == 0);
  45   return p;
  46 }
  47
  48 void
  49 pmt_base::operator delete(void *p, size_t size)
  50 {
  51   global_pmt_pool.free(p);
  52 }
  53
  54 #endif
  55
  56
  57 pmt_base::~pmt_base()
  58 {
  59   // nop -- out of line virtual destructor
  60 }
  61
  62 ////////////////////////////////////////////////////////////////////////////
  63 //                         Exceptions
  64 ////////////////////////////////////////////////////////////////////////////
  65
  66 pmt_exception::pmt_exception(const std::string &msg, pmt_t obj)
  67   : logic_error(msg + ": " + pmt_write_string(obj))
  68 {
  69 }
  70
  71 pmt_wrong_type::pmt_wrong_type(const std::string &msg, pmt_t obj)
  72   : pmt_exception(msg + ": wrong_type ", obj)
  73 {
  74 }
  75
  76 pmt_out_of_range::pmt_out_of_range(const std::string &msg, pmt_t obj)
  77   : pmt_exception(msg + ": out of range ", obj)
  78 {
  79 }
  80
  81 pmt_notimplemented::pmt_notimplemented(const std::string &msg, pmt_t obj)
  82   : pmt_exception(msg + ": notimplemented ", obj)
  83 {
  84 }
  85
  86 ////////////////////////////////////////////////////////////////////////////
  87 //                          Dynamic Casts
  88 ////////////////////////////////////////////////////////////////////////////
  89
  90 static pmt_symbol *
  91 _symbol(pmt_t x)
  92 {
  93   return dynamic_cast<pmt_symbol*>(x.get());
  94 }
  95
  96 static pmt_integer *
  97 _integer(pmt_t x)
  98 {
  99   return dynamic_cast<pmt_integer*>(x.get());
 100 }
 101
 102 static pmt_real *
 103 _real(pmt_t x)
 104 {
 105   return dynamic_cast<pmt_real*>(x.get());
 106 }
 107
 108 static pmt_complex *
 109 _complex(pmt_t x)
 110 {
 111   return dynamic_cast<pmt_complex*>(x.get());
 112 }
 113
 114 static pmt_pair *
 115 _pair(pmt_t x)
 116 {
 117   return dynamic_cast<pmt_pair*>(x.get());
 118 }
 119
 120 static pmt_vector *
 121 _vector(pmt_t x)
 122 {
 123   return dynamic_cast<pmt_vector*>(x.get());
 124 }
 125
 126 static pmt_uniform_vector *
 127 _uniform_vector(pmt_t x)
 128 {
 129   return dynamic_cast<pmt_uniform_vector*>(x.get());
 130 }
 131
 132 static pmt_dict *
 133 _dict(pmt_t x)
 134 {
 135   return dynamic_cast<pmt_dict*>(x.get());
 136 }
 137
 138 static pmt_any *
 139 _any(pmt_t x)
 140 {
 141   return dynamic_cast<pmt_any*>(x.get());
 142 }
 143
 144 ////////////////////////////////////////////////////////////////////////////
 145 //                           Globals
 146 ////////////////////////////////////////////////////////////////////////////
 147
 148 const pmt_t PMT_T = pmt_t(new pmt_bool());              // singleton
 149 const pmt_t PMT_F = pmt_t(new pmt_bool());              // singleton
 150 const pmt_t PMT_NIL = pmt_t(new pmt_null());            // singleton
 151 const pmt_t PMT_EOF = pmt_cons(PMT_NIL, PMT_NIL);       // singleton
 152
 153 ////////////////////////////////////////////////////////////////////////////
 154 //                           Booleans
 155 ////////////////////////////////////////////////////////////////////////////
 156
 157 pmt_bool::pmt_bool(){}
 158
 159 bool
 160 pmt_is_true(pmt_t obj)
 161 {
 162   return obj != PMT_F;
 163 }
 164
 165 bool
 166 pmt_is_false(pmt_t obj)
 167 {
 168   return obj == PMT_F;
 169 }
 170
 171 bool
 172 pmt_is_bool(pmt_t obj)
 173 {
 174   return obj->is_bool();
 175 }
 176
 177 pmt_t
 178 pmt_from_bool(bool val)
 179 {
 180   return val ? PMT_T : PMT_F;
 181 }
 182
 183 bool
 184 pmt_to_bool(pmt_t val)
 185 {
 186   if (val == PMT_T)
 187     return true;
 188   if (val == PMT_F)
 189     return false;
 190   throw pmt_wrong_type("pmt_to_bool", val);
 191 }
 192
 193 ////////////////////////////////////////////////////////////////////////////
 194 //                             Symbols
 195 ////////////////////////////////////////////////////////////////////////////
 196
 197 static const unsigned int SYMBOL_HASH_TABLE_SIZE = 701;
 198 static std::vector<pmt_t> s_symbol_hash_table(SYMBOL_HASH_TABLE_SIZE);
 199
 200 pmt_symbol::pmt_symbol(const std::string &name) : d_name(name){}
 201
 202
 203 static unsigned int
 204 hash_string(const std::string &s)
 205 {
 206   unsigned int h = 0;
 207   unsigned int g = 0;
 208
 209   for (std::string::const_iterator p = s.begin(); p != s.end(); ++p){
 210     h = (h << 4) + (*p & 0xff);
 211     g = h & 0xf0000000;
 212     if (g){
 213       h = h ^ (g >> 24);
 214       h = h ^ g;
 215     }
 216   }
 217   return h;
 218 }
 219
 220 bool
 221 pmt_is_symbol(pmt_t obj)
 222 {
 223   return obj->is_symbol();
 224 }
 225
 226 pmt_t
 227 pmt_string_to_symbol(const std::string &name)
 228 {
 229   unsigned hash = hash_string(name) % SYMBOL_HASH_TABLE_SIZE;
 230
 231   // Does a symbol with this name already exist?
 232   for (pmt_t sym = s_symbol_hash_table[hash]; sym; sym = _symbol(sym)->next()){
 233     if (name == _symbol(sym)->name())
 234       return sym;               // Yes.  Return it
 235   }
 236
 237   // Nope.  Make a new one.
 238   pmt_t sym = pmt_t(new pmt_symbol(name));
 239   _symbol(sym)->set_next(s_symbol_hash_table[hash]);
 240   s_symbol_hash_table[hash] = sym;
 241   return sym;
 242 }
 243
 244 // alias...
 245 pmt_t
 246 pmt_intern(const std::string &name)
 247 {
 248   return pmt_string_to_symbol(name);
 249 }
 250
 251 const std::string
 252 pmt_symbol_to_string(pmt_t sym)
 253 {
 254   if (!sym->is_symbol())
 255     throw pmt_wrong_type("pmt_symbol_to_string", sym);
 256
 257   return _symbol(sym)->name();
 258 }
 259
 260
 261
 262 ////////////////////////////////////////////////////////////////////////////
 263 //                             Number
 264 ////////////////////////////////////////////////////////////////////////////
 265
 266 bool
 267 pmt_is_number(pmt_t x)
 268 {
 269   return x->is_number();
 270 }
 271
 272 ////////////////////////////////////////////////////////////////////////////
 273 //                             Integer
 274 ////////////////////////////////////////////////////////////////////////////
 275
 276 pmt_integer::pmt_integer(long value) : d_value(value) {}
 277
 278 bool
 279 pmt_is_integer(pmt_t x)
 280 {
 281   return x->is_integer();
 282 }
 283
 284
 285 pmt_t
 286 pmt_from_long(long x)
 287 {
 288   return pmt_t(new pmt_integer(x));
 289 }
 290
 291 long
 292 pmt_to_long(pmt_t x)
 293 {
 294   if (x->is_integer())
 295     return _integer(x)->value();
 296
 297   throw pmt_wrong_type("pmt_to_long", x);
 298 }
 299
 300 ////////////////////////////////////////////////////////////////////////////
 301 //                              Real
 302 ////////////////////////////////////////////////////////////////////////////
 303
 304 pmt_real::pmt_real(double value) : d_value(value) {}
 305
 306 bool
 307 pmt_is_real(pmt_t x)
 308 {
 309   return x->is_real();
 310 }
 311
 312 pmt_t
 313 pmt_from_double(double x)
 314 {
 315   return pmt_t(new pmt_real(x));
 316 }
 317
 318 double
 319 pmt_to_double(pmt_t x)
 320 {
 321   if (x->is_real())
 322     return _real(x)->value();
 323   if (x->is_integer())
 324     return _integer(x)->value();
 325
 326   throw pmt_wrong_type("pmt_to_double", x);
 327 }
 328
 329 ////////////////////////////////////////////////////////////////////////////
 330 //                              Complex
 331 ////////////////////////////////////////////////////////////////////////////
 332
 333 pmt_complex::pmt_complex(std::complex<double> value) : d_value(value) {}
 334
 335 bool
 336 pmt_is_complex(pmt_t x)
 337 {
 338   return x->is_complex();
 339 }
 340
 341 pmt_t
 342 pmt_make_rectangular(double re, double im)
 343 {
 344   return pmt_t(new pmt_complex(std::complex<double>(re, im)));
 345 }
 346
 347 std::complex<double>
 348 pmt_to_complex(pmt_t x)
 349 {
 350   if (x->is_complex())
 351     return _complex(x)->value();
 352   if (x->is_real())
 353     return _real(x)->value();
 354   if (x->is_integer())
 355     return _integer(x)->value();
 356
 357   throw pmt_wrong_type("pmt_to_complex", x);
 358 }
 359
 360 ////////////////////////////////////////////////////////////////////////////
 361 //                              Pairs
 362 ////////////////////////////////////////////////////////////////////////////
 363
 364 pmt_null::pmt_null() {}
 365 pmt_pair::pmt_pair(pmt_t car, pmt_t cdr) : d_car(car), d_cdr(cdr) {}
 366
 367 bool
 368 pmt_is_null(pmt_t x)
 369 {
 370   return x == PMT_NIL;
 371 }
 372
 373 bool
 374 pmt_is_pair(pmt_t obj)
 375 {
 376   return obj->is_pair();
 377 }
 378
 379 pmt_t
 380 pmt_cons(pmt_t x, pmt_t y)
 381 {
 382   return pmt_t(new pmt_pair(x, y));
 383 }
 384
 385 pmt_t
 386 pmt_car(pmt_t pair)
 387 {
 388   if (pair->is_pair())
 389     return _pair(pair)->car();
 390
 391   throw pmt_wrong_type("pmt_car", pair);
 392 }
 393
 394 pmt_t
 395 pmt_cdr(pmt_t pair)
 396 {
 397   if (pair->is_pair())
 398     return _pair(pair)->cdr();
 399
 400   throw pmt_wrong_type("pmt_cdr", pair);
 401 }
 402
 403 void
 404 pmt_set_car(pmt_t pair, pmt_t obj)
 405 {
 406   if (pair->is_pair())
 407     _pair(pair)->set_car(obj);
 408   else
 409     throw pmt_wrong_type("pmt_set_car", pair);
 410 }
 411
 412 void
 413 pmt_set_cdr(pmt_t pair, pmt_t obj)
 414 {
 415   if (pair->is_pair())
 416     _pair(pair)->set_cdr(obj);
 417   else
 418     throw pmt_wrong_type("pmt_set_cdr", pair);
 419 }
 420
 421 ////////////////////////////////////////////////////////////////////////////
 422 //                             Vectors
 423 ////////////////////////////////////////////////////////////////////////////
 424
 425 pmt_vector::pmt_vector(size_t len, pmt_t fill)
 426   : d_v(len)
 427 {
 428   for (size_t i = 0; i < len; i++)
 429     d_v[i] = fill;
 430 }
 431
 432 pmt_t
 433 pmt_vector::ref(size_t k) const
 434 {
 435   if (k >= length())
 436     throw pmt_out_of_range("pmt_vector_ref", pmt_from_long(k));
 437   return d_v[k];
 438 }
 439
 440 void
 441 pmt_vector::set(size_t k, pmt_t obj)
 442 {
 443   if (k >= length())
 444     throw pmt_out_of_range("pmt_vector_set", pmt_from_long(k));
 445   d_v[k] = obj;
 446 }
 447
 448 void
 449 pmt_vector::fill(pmt_t obj)
 450 {
 451   for (size_t i = 0; i < length(); i++)
 452     d_v[i] = obj;
 453 }
 454
 455 bool
 456 pmt_is_vector(pmt_t obj)
 457 {
 458   return obj->is_vector();
 459 }
 460
 461 pmt_t
 462 pmt_make_vector(size_t k, pmt_t fill)
 463 {
 464   return pmt_t(new pmt_vector(k, fill));
 465 }
 466
 467 pmt_t
 468 pmt_vector_ref(pmt_t vector, size_t k)
 469 {
 470   if (!vector->is_vector())
 471     throw pmt_wrong_type("pmt_vector_ref", vector);
 472   return _vector(vector)->ref(k);
 473 }
 474
 475 void
 476 pmt_vector_set(pmt_t vector, size_t k, pmt_t obj)
 477 {
 478   if (!vector->is_vector())
 479     throw pmt_wrong_type("pmt_vector_set", vector);
 480   _vector(vector)->set(k, obj);
 481 }
 482
 483 void
 484 pmt_vector_fill(pmt_t vector, pmt_t obj)
 485 {
 486   if (!vector->is_vector())
 487     throw pmt_wrong_type("pmt_vector_set", vector);
 488   _vector(vector)->fill(obj);
 489 }
 490
 491 ////////////////////////////////////////////////////////////////////////////
 492 //                       Uniform Numeric Vectors
 493 ////////////////////////////////////////////////////////////////////////////
 494
 495 bool
 496 pmt_is_uniform_vector(pmt_t x)
 497 {
 498   return x->is_uniform_vector();
 499 }
 500
 501 const void *
 502 pmt_uniform_vector_elements(pmt_t vector, size_t &len)
 503 {
 504   if (!vector->is_uniform_vector())
 505     throw pmt_wrong_type("pmt_uniform_vector_elements", vector);
 506   return _uniform_vector(vector)->uniform_elements(len);
 507 }
 508
 509 void *
 510 pmt_uniform_vector_writeable_elements(pmt_t vector, size_t &len)
 511 {
 512   if (!vector->is_uniform_vector())
 513     throw pmt_wrong_type("pmt_uniform_vector_writeable_elements", vector);
 514   return _uniform_vector(vector)->uniform_writeable_elements(len);
 515 }
 516
 517 ////////////////////////////////////////////////////////////////////////////
 518 //                            Dictionaries
 519 ////////////////////////////////////////////////////////////////////////////
 520
 521 pmt_dict::pmt_dict()
 522   : d_alist(PMT_NIL)
 523 {
 524 }
 525
 526 void
 527 pmt_dict::set(pmt_t key, pmt_t value)
 528 {
 529   pmt_t p = pmt_assv(key, d_alist);     // look for (key . value) pair
 530   if (pmt_is_pair(p)){                  // found existing pair...
 531     pmt_set_cdr(p, value);              // overrwrite cdr with new value
 532   }
 533   else {                                // not in the dict
 534     d_alist = pmt_cons(pmt_cons(key, value), d_alist);  // add new (key . value) pair
 535   }
 536 }
 537
 538 pmt_t
 539 pmt_dict::ref(pmt_t key, pmt_t not_found) const
 540 {
 541   pmt_t p = pmt_assv(key, d_alist);     // look for (key . value) pair
 542   if (pmt_is_pair(p))
 543     return pmt_cdr(p);
 544   else
 545     return not_found;
 546 }
 547
 548 bool
 549 pmt_dict::has_key(pmt_t key) const
 550 {
 551   return pmt_is_pair(pmt_assv(key, d_alist));
 552 }
 553
 554 pmt_t
 555 pmt_dict::items() const
 556 {
 557   return d_alist;
 558 }
 559
 560 pmt_t
 561 pmt_dict::keys() const
 562 {
 563   return pmt_map(pmt_car, d_alist);
 564 }
 565
 566 pmt_t
 567 pmt_dict::values() const
 568 {
 569   return pmt_map(pmt_cdr, d_alist);
 570 }
 571
 572 bool
 573 pmt_is_dict(pmt_t obj)
 574 {
 575   return obj->is_dict();
 576 }
 577
 578 pmt_t
 579 pmt_make_dict()
 580 {
 581   return pmt_t(new pmt_dict());
 582 }
 583
 584 void
 585 pmt_dict_set(pmt_t dict, pmt_t key, pmt_t value)
 586 {
 587   if (!dict->is_dict())
 588     throw pmt_wrong_type("pmt_dict_set", dict);
 589
 590   _dict(dict)->set(key, value);
 591 }
 592
 593 bool
 594 pmt_dict_has_key(pmt_t dict, pmt_t key)
 595 {
 596   if (!dict->is_dict())
 597     throw pmt_wrong_type("pmt_dict_has_key", dict);
 598
 599   return _dict(dict)->has_key(key);
 600 }
 601
 602 pmt_t
 603 pmt_dict_ref(pmt_t dict, pmt_t key, pmt_t not_found)
 604 {
 605   if (!dict->is_dict())
 606     throw pmt_wrong_type("pmt_dict_ref", dict);
 607
 608   return _dict(dict)->ref(key, not_found);
 609 }
 610
 611 pmt_t
 612 pmt_dict_items(pmt_t dict)
 613 {
 614   if (!dict->is_dict())
 615     throw pmt_wrong_type("pmt_dict_items", dict);
 616
 617   return _dict(dict)->items();
 618 }
 619
 620 pmt_t
 621 pmt_dict_keys(pmt_t dict)
 622 {
 623   if (!dict->is_dict())
 624     throw pmt_wrong_type("pmt_dict_keys", dict);
 625
 626   return _dict(dict)->keys();
 627 }
 628
 629 pmt_t
 630 pmt_dict_values(pmt_t dict)
 631 {
 632   if (!dict->is_dict())
 633     throw pmt_wrong_type("pmt_dict_values", dict);
 634
 635   return _dict(dict)->values();
 636 }
 637
 638 ////////////////////////////////////////////////////////////////////////////
 639 //                                 Any
 640 ////////////////////////////////////////////////////////////////////////////
 641
 642 pmt_any::pmt_any(const boost::any &any) : d_any(any) {}
 643
 644 bool
 645 pmt_is_any(pmt_t obj)
 646 {
 647   return obj->is_any();
 648 }
 649
 650 pmt_t
 651 pmt_make_any(const boost::any &any)
 652 {
 653   return pmt_t(new pmt_any(any));
 654 }
 655
 656 boost::any
 657 pmt_any_ref(pmt_t obj)
 658 {
 659   if (!obj->is_any())
 660     throw pmt_wrong_type("pmt_any_ref", obj);
 661   return _any(obj)->ref();
 662 }
 663
 664 void
 665 pmt_any_set(pmt_t obj, const boost::any &any)
 666 {
 667   if (!obj->is_any())
 668     throw pmt_wrong_type("pmt_any_set", obj);
 669   _any(obj)->set(any);
 670 }
 671
 672 ////////////////////////////////////////////////////////////////////////////
 673 //                          General Functions
 674 ////////////////////////////////////////////////////////////////////////////
 675
 676 bool
 677 pmt_eq(pmt_t x, pmt_t y)
 678 {
 679   return x == y;
 680 }
 681
 682 bool
 683 pmt_eqv(pmt_t x, pmt_t y)
 684 {
 685   if (x == y)
 686     return true;
 687
 688   if (x->is_integer() && y->is_integer())
 689     return _integer(x)->value() == _integer(y)->value();
 690
 691   if (x->is_real() && y->is_real())
 692     return _real(x)->value() == _real(y)->value();
 693
 694   if (x->is_complex() && y->is_complex())
 695     return _complex(x)->value() == _complex(y)->value();
 696
 697   return false;
 698 }
 699
 700 bool
 701 pmt_equal(pmt_t x, pmt_t y)
 702 {
 703   if (pmt_eqv(x, y))
 704     return true;
 705
 706   if (x->is_pair() && y->is_pair())
 707     return pmt_equal(pmt_car(x), pmt_car(y)) && pmt_equal(pmt_cdr(x), pmt_cdr(y));
 708
 709   if (x->is_vector() && y->is_vector()){
 710     pmt_vector *xv = _vector(x);
 711     pmt_vector *yv = _vector(y);
 712     if (xv->length() != yv->length())
 713       return false;
 714
 715     for (unsigned i = 0; i < xv->length(); i++)
 716       if (!pmt_equal(xv->_ref(i), yv->_ref(i)))
 717         return false;
 718
 719     return true;
 720   }
 721
 722   if (x->is_uniform_vector() && y->is_uniform_vector()){
 723     pmt_uniform_vector *xv = _uniform_vector(x);
 724     pmt_uniform_vector *yv = _uniform_vector(y);
 725     if (xv->length() != yv->length())
 726       return false;
 727
 728     size_t len_x, len_y;
 729     if (memcmp(xv->uniform_elements(len_x),
 730                yv->uniform_elements(len_y),
 731                len_x) == 0)
 732       return true;
 733
 734     return true;
 735   }
 736
 737   // FIXME add other cases here...
 738
 739   return false;
 740 }
 741
 742 size_t
 743 pmt_length(pmt_t x)
 744 {
 745   if (x->is_vector())
 746     return _vector(x)->length();
 747
 748   if (x->is_uniform_vector())
 749     return _uniform_vector(x)->length();
 750
 751   // FIXME list length
 752   // FIXME dictionary length (number of entries)
 753
 754   throw pmt_wrong_type("pmt_length", x);
 755 }
 756
 757 pmt_t
 758 pmt_assq(pmt_t obj, pmt_t alist)
 759 {
 760   while (pmt_is_pair(alist)){
 761     pmt_t p = pmt_car(alist);
 762     if (!pmt_is_pair(p))        // malformed alist
 763       return PMT_F;
 764
 765     if (pmt_eq(obj, pmt_car(p)))
 766       return p;
 767
 768     alist = pmt_cdr(alist);
 769   }
 770   return PMT_F;
 771 }
 772
 773 pmt_t
 774 pmt_assv(pmt_t obj, pmt_t alist)
 775 {
 776   while (pmt_is_pair(alist)){
 777     pmt_t p = pmt_car(alist);
 778     if (!pmt_is_pair(p))        // malformed alist
 779       return PMT_F;
 780
 781     if (pmt_eqv(obj, pmt_car(p)))
 782       return p;
 783
 784     alist = pmt_cdr(alist);
 785   }
 786   return PMT_F;
 787 }
 788
 789 pmt_t
 790 pmt_assoc(pmt_t obj, pmt_t alist)
 791 {
 792   while (pmt_is_pair(alist)){
 793     pmt_t p = pmt_car(alist);
 794     if (!pmt_is_pair(p))        // malformed alist
 795       return PMT_F;
 796
 797     if (pmt_equal(obj, pmt_car(p)))
 798       return p;
 799
 800     alist = pmt_cdr(alist);
 801   }
 802   return PMT_F;
 803 }
 804
 805 pmt_t
 806 pmt_map(pmt_t proc(pmt_t), pmt_t list)
 807 {
 808   pmt_t r = PMT_NIL;
 809
 810   while(pmt_is_pair(list)){
 811     r = pmt_cons(proc(pmt_car(list)), r);
 812     list = pmt_cdr(list);
 813   }
 814
 815   return pmt_reverse_x(r);
 816 }
 817
 818 pmt_t
 819 pmt_reverse(pmt_t listx)
 820 {
 821   pmt_t list = listx;
 822   pmt_t r = PMT_NIL;
 823
 824   while(pmt_is_pair(list)){
 825     r = pmt_cons(pmt_car(list), r);
 826     list = pmt_cdr(list);
 827   }
 828   if (pmt_is_null(list))
 829     return r;
 830   else
 831     throw pmt_wrong_type("pmt_reverse", listx);
 832 }
 833
 834 pmt_t
 835 pmt_reverse_x(pmt_t list)
 836 {
 837   // FIXME do it destructively
 838   return pmt_reverse(list);
 839 }
 840
 841 pmt_t
 842 pmt_nth(size_t n, pmt_t list)
 843 {
 844   pmt_t t = pmt_nthcdr(n, list);
 845   if (pmt_is_pair(t))
 846     return pmt_car(t);
 847   else
 848     return PMT_NIL;
 849 }
 850
 851 pmt_t
 852 pmt_nthcdr(size_t n, pmt_t list)
 853 {
 854   if (!(pmt_is_null(list) || pmt_is_pair(list)))
 855     throw pmt_wrong_type("pmt_nthcdr", list);
 856
 857   while (n > 0){
 858     if (pmt_is_pair(list)){
 859       list = pmt_cdr(list);
 860       n--;
 861       continue;
 862     }
 863     if (pmt_is_null(list))
 864       return PMT_NIL;
 865     else
 866       throw pmt_wrong_type("pmt_nthcdr: not a LIST", list);
 867   }
 868   return list;
 869 }
 870
 871 pmt_t
 872 pmt_memq(pmt_t obj, pmt_t list)
 873 {
 874   while (pmt_is_pair(list)){
 875     if (pmt_eq(obj, pmt_car(list)))
 876       return list;
 877     list = pmt_cdr(list);
 878   }
 879   return PMT_F;
 880 }
 881
 882 pmt_t
 883 pmt_memv(pmt_t obj, pmt_t list)
 884 {
 885   while (pmt_is_pair(list)){
 886     if (pmt_eqv(obj, pmt_car(list)))
 887       return list;
 888     list = pmt_cdr(list);
 889   }
 890   return PMT_F;
 891 }
 892
 893 pmt_t
 894 pmt_member(pmt_t obj, pmt_t list)
 895 {
 896   while (pmt_is_pair(list)){
 897     if (pmt_equal(obj, pmt_car(list)))
 898       return list;
 899     list = pmt_cdr(list);
 900   }
 901   return PMT_F;
 902 }
 903
 904 bool
 905 pmt_subsetp(pmt_t list1, pmt_t list2)
 906 {
 907   while (pmt_is_pair(list1)){
 908     pmt_t p = pmt_car(list1);
 909     if (pmt_is_false(pmt_memv(p, list2)))
 910       return false;
 911     list1 = pmt_cdr(list1);
 912   }
 913   return true;
 914 }
 915
 916 pmt_t
 917 pmt_list1(pmt_t x1)
 918 {
 919   return pmt_cons(x1, PMT_NIL);
 920 }
 921
 922 pmt_t
 923 pmt_list2(pmt_t x1, pmt_t x2)
 924 {
 925   return pmt_cons(x1, pmt_cons(x2, PMT_NIL));
 926 }
 927
 928 pmt_t
 929 pmt_list3(pmt_t x1, pmt_t x2, pmt_t x3)
 930 {
 931   return pmt_cons(x1, pmt_cons(x2, pmt_cons(x3, PMT_NIL)));
 932 }
 933
 934 pmt_t
 935 pmt_list4(pmt_t x1, pmt_t x2, pmt_t x3, pmt_t x4)
 936 {
 937   return pmt_cons(x1, pmt_cons(x2, pmt_cons(x3, pmt_cons(x4, PMT_NIL))));
 938 }
 939
 940 pmt_t
 941 pmt_caar(pmt_t pair)
 942 {
 943   return (pmt_car(pmt_car(pair)));
 944 }
 945
 946 pmt_t
 947 pmt_cadr(pmt_t pair)
 948 {
 949   return pmt_car(pmt_cdr(pair));
 950 }
 951
 952 pmt_t
 953 pmt_cdar(pmt_t pair)
 954 {
 955   return pmt_cdr(pmt_car(pair));
 956 }
 957
 958 pmt_t
 959 pmt_cddr(pmt_t pair)
 960 {
 961   return pmt_cdr(pmt_cdr(pair));
 962 }
 963
 964 pmt_t
 965 pmt_caddr(pmt_t pair)
 966 {
 967   return pmt_car(pmt_cdr(pmt_cdr(pair)));
 968 }
 969
 970 pmt_t
 971 pmt_cadddr(pmt_t pair)
 972 {
 973   return pmt_car(pmt_cdr(pmt_cdr(pmt_cdr(pair))));
 974 }
 975
 976 bool
 977 pmt_is_eof_object(pmt_t obj)
 978 {
 979   return pmt_eq(obj, PMT_EOF);
 980 }
 981
 982 void
 983 pmt_dump_sizeof()
 984 {
 985   printf("sizeof(pmt_t)              = %3zd\n", sizeof(pmt_t));
 986   printf("sizeof(pmt_base)           = %3zd\n", sizeof(pmt_base));
 987   printf("sizeof(pmt_bool)           = %3zd\n", sizeof(pmt_bool));
 988   printf("sizeof(pmt_symbol)         = %3zd\n", sizeof(pmt_symbol));
 989   printf("sizeof(pmt_integer)        = %3zd\n", sizeof(pmt_integer));
 990   printf("sizeof(pmt_real)           = %3zd\n", sizeof(pmt_real));
 991   printf("sizeof(pmt_complex)        = %3zd\n", sizeof(pmt_complex));
 992   printf("sizeof(pmt_null)           = %3zd\n", sizeof(pmt_null));
 993   printf("sizeof(pmt_pair)           = %3zd\n", sizeof(pmt_pair));
 994   printf("sizeof(pmt_vector)         = %3zd\n", sizeof(pmt_vector));
 995   printf("sizeof(pmt_dict)           = %3zd\n", sizeof(pmt_dict));
 996   printf("sizeof(pmt_uniform_vector) = %3zd\n", sizeof(pmt_uniform_vector));
 997 }