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 2, 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
  30 pmt_base::~pmt_base()
  31 {
  32   // nop -- out of line virtual destructor
  33 }
  34
  35 ////////////////////////////////////////////////////////////////////////////
  36 //                         Exceptions
  37 ////////////////////////////////////////////////////////////////////////////
  38
  39 pmt_exception::pmt_exception(const std::string &msg, pmt_t obj)
  40   : logic_error(msg + ": " + pmt_write_string(obj))
  41 {
  42 }
  43
  44 pmt_wrong_type::pmt_wrong_type(const std::string &msg, pmt_t obj)
  45   : pmt_exception(msg + ": wrong_type ", obj)
  46 {
  47 }
  48
  49 pmt_out_of_range::pmt_out_of_range(const std::string &msg, pmt_t obj)
  50   : pmt_exception(msg + ": out of range ", obj)
  51 {
  52 }
  53
  54 pmt_notimplemented::pmt_notimplemented(const std::string &msg, pmt_t obj)
  55   : pmt_exception(msg + ": notimplemented ", obj)
  56 {
  57 }
  58
  59 ////////////////////////////////////////////////////////////////////////////
  60 //                          Dynamic Casts
  61 ////////////////////////////////////////////////////////////////////////////
  62
  63 static pmt_symbol *
  64 _symbol(pmt_t x)
  65 {
  66   return dynamic_cast<pmt_symbol*>(x.get());
  67 }
  68
  69 static pmt_integer *
  70 _integer(pmt_t x)
  71 {
  72   return dynamic_cast<pmt_integer*>(x.get());
  73 }
  74
  75 static pmt_real *
  76 _real(pmt_t x)
  77 {
  78   return dynamic_cast<pmt_real*>(x.get());
  79 }
  80
  81 static pmt_complex *
  82 _complex(pmt_t x)
  83 {
  84   return dynamic_cast<pmt_complex*>(x.get());
  85 }
  86
  87 static pmt_pair *
  88 _pair(pmt_t x)
  89 {
  90   return dynamic_cast<pmt_pair*>(x.get());
  91 }
  92
  93 static pmt_vector *
  94 _vector(pmt_t x)
  95 {
  96   return dynamic_cast<pmt_vector*>(x.get());
  97 }
  98
  99 static pmt_uniform_vector *
 100 _uniform_vector(pmt_t x)
 101 {
 102   return dynamic_cast<pmt_uniform_vector*>(x.get());
 103 }
 104
 105 static pmt_dict *
 106 _dict(pmt_t x)
 107 {
 108   return dynamic_cast<pmt_dict*>(x.get());
 109 }
 110
 111 ////////////////////////////////////////////////////////////////////////////
 112 //                           Booleans
 113 ////////////////////////////////////////////////////////////////////////////
 114
 115 const pmt_t PMT_BOOL_T = pmt_t(new pmt_bool());         // singleton
 116 const pmt_t PMT_BOOL_F = pmt_t(new pmt_bool());         // singleton
 117
 118 pmt_bool::pmt_bool(){}
 119
 120 bool
 121 pmt_is_true(pmt_t obj)
 122 {
 123   return obj != PMT_BOOL_F;
 124 }
 125
 126 bool
 127 pmt_is_false(pmt_t obj)
 128 {
 129   return obj == PMT_BOOL_F;
 130 }
 131
 132 bool
 133 pmt_is_bool(pmt_t obj)
 134 {
 135   return obj->is_bool();
 136 }
 137
 138 pmt_t
 139 pmt_from_bool(bool val)
 140 {
 141   return val ? PMT_BOOL_T : PMT_BOOL_F;
 142 }
 143
 144 bool
 145 pmt_to_bool(pmt_t val)
 146 {
 147   if (val == PMT_BOOL_T)
 148     return true;
 149   if (val == PMT_BOOL_F)
 150     return false;
 151   throw pmt_wrong_type("pmt_to_bool", val);
 152 }
 153
 154 ////////////////////////////////////////////////////////////////////////////
 155 //                             Symbols
 156 ////////////////////////////////////////////////////////////////////////////
 157
 158 static const unsigned int SYMBOL_HASH_TABLE_SIZE = 701;
 159 static std::vector<pmt_t> s_symbol_hash_table(SYMBOL_HASH_TABLE_SIZE);
 160
 161 pmt_symbol::pmt_symbol(const std::string &name) : d_name(name){}
 162
 163
 164 static unsigned int
 165 hash_string(const std::string &s)
 166 {
 167   unsigned int h = 0;
 168   unsigned int g = 0;
 169
 170   for (std::string::const_iterator p = s.begin(); p != s.end(); p++){
 171     h = (h << 4) + (*p & 0xff);
 172     g = h & 0xf0000000;
 173     if (g){
 174       h = h ^ (g >> 24);
 175       h = h ^ g;
 176     }
 177   }
 178   return h;
 179 }
 180
 181 bool
 182 pmt_is_symbol(pmt_t obj)
 183 {
 184   return obj->is_symbol();
 185 }
 186
 187 pmt_t
 188 pmt_string_to_symbol(const std::string &name)
 189 {
 190   unsigned hash = hash_string(name) % SYMBOL_HASH_TABLE_SIZE;
 191
 192   // Does a symbol with this name already exist?
 193   for (pmt_t sym = s_symbol_hash_table[hash]; sym; sym = _symbol(sym)->next()){
 194     if (name == _symbol(sym)->name())
 195       return sym;               // Yes.  Return it
 196   }
 197
 198   // Nope.  Make a new one.
 199   pmt_t sym = pmt_t(new pmt_symbol(name));
 200   _symbol(sym)->set_next(s_symbol_hash_table[hash]);
 201   s_symbol_hash_table[hash] = sym;
 202   return sym;
 203 }
 204
 205 // alias...
 206 pmt_t
 207 pmt_intern(const std::string &name)
 208 {
 209   return pmt_string_to_symbol(name);
 210 }
 211
 212 const std::string
 213 pmt_symbol_to_string(pmt_t sym)
 214 {
 215   if (!sym->is_symbol())
 216     throw pmt_wrong_type("pmt_symbol_to_string", sym);
 217
 218   return _symbol(sym)->name();
 219 }
 220
 221
 222
 223 ////////////////////////////////////////////////////////////////////////////
 224 //                             Number
 225 ////////////////////////////////////////////////////////////////////////////
 226
 227 bool
 228 pmt_is_number(pmt_t x)
 229 {
 230   return x->is_number();
 231 }
 232
 233 ////////////////////////////////////////////////////////////////////////////
 234 //                             Integer
 235 ////////////////////////////////////////////////////////////////////////////
 236
 237 pmt_integer::pmt_integer(long value) : d_value(value) {}
 238
 239 bool
 240 pmt_is_integer(pmt_t x)
 241 {
 242   return x->is_integer();
 243 }
 244
 245
 246 pmt_t
 247 pmt_from_long(long x)
 248 {
 249   return pmt_t(new pmt_integer(x));
 250 }
 251
 252 long
 253 pmt_to_long(pmt_t x)
 254 {
 255   if (x->is_integer())
 256     return _integer(x)->value();
 257
 258   throw pmt_wrong_type("pmt_to_long", x);
 259 }
 260
 261 ////////////////////////////////////////////////////////////////////////////
 262 //                              Real
 263 ////////////////////////////////////////////////////////////////////////////
 264
 265 pmt_real::pmt_real(double value) : d_value(value) {}
 266
 267 bool
 268 pmt_is_real(pmt_t x)
 269 {
 270   return x->is_real();
 271 }
 272
 273 pmt_t
 274 pmt_from_double(double x)
 275 {
 276   return pmt_t(new pmt_real(x));
 277 }
 278
 279 double
 280 pmt_to_double(pmt_t x)
 281 {
 282   if (x->is_real())
 283     return _real(x)->value();
 284   if (x->is_integer())
 285     return _integer(x)->value();
 286
 287   throw pmt_wrong_type("pmt_to_double", x);
 288 }
 289
 290 ////////////////////////////////////////////////////////////////////////////
 291 //                              Complex
 292 ////////////////////////////////////////////////////////////////////////////
 293
 294 pmt_complex::pmt_complex(std::complex<double> value) : d_value(value) {}
 295
 296 bool
 297 pmt_is_complex(pmt_t x)
 298 {
 299   return x->is_complex();
 300 }
 301
 302 pmt_t
 303 pmt_make_rectangular(double re, double im)
 304 {
 305   return pmt_t(new pmt_complex(std::complex<double>(re, im)));
 306 }
 307
 308 std::complex<double>
 309 pmt_to_complex(pmt_t x)
 310 {
 311   if (x->is_complex())
 312     return _complex(x)->value();
 313   if (x->is_real())
 314     return _real(x)->value();
 315   if (x->is_integer())
 316     return _integer(x)->value();
 317
 318   throw pmt_wrong_type("pmt_to_complex", x);
 319 }
 320
 321 ////////////////////////////////////////////////////////////////////////////
 322 //                              Pairs
 323 ////////////////////////////////////////////////////////////////////////////
 324
 325 const pmt_t PMT_NIL = pmt_t(new pmt_null());            // singleton
 326
 327 pmt_null::pmt_null() {}
 328 pmt_pair::pmt_pair(pmt_t car, pmt_t cdr) : d_car(car), d_cdr(cdr) {}
 329
 330 bool
 331 pmt_is_null(pmt_t x)
 332 {
 333   return x == PMT_NIL;
 334 }
 335
 336 bool
 337 pmt_is_pair(pmt_t obj)
 338 {
 339   return obj->is_pair();
 340 }
 341
 342 pmt_t
 343 pmt_cons(pmt_t x, pmt_t y)
 344 {
 345   return pmt_t(new pmt_pair(x, y));
 346 }
 347
 348 pmt_t
 349 pmt_car(pmt_t pair)
 350 {
 351   if (pair->is_pair())
 352     return _pair(pair)->car();
 353
 354   throw pmt_wrong_type("pmt_car", pair);
 355 }
 356
 357 pmt_t
 358 pmt_cdr(pmt_t pair)
 359 {
 360   if (pair->is_pair())
 361     return _pair(pair)->cdr();
 362
 363   throw pmt_wrong_type("pmt_cdr", pair);
 364 }
 365
 366 void
 367 pmt_set_car(pmt_t pair, pmt_t obj)
 368 {
 369   if (pair->is_pair())
 370     _pair(pair)->set_car(obj);
 371   else
 372     throw pmt_wrong_type("pmt_set_car", pair);
 373 }
 374
 375 void
 376 pmt_set_cdr(pmt_t pair, pmt_t obj)
 377 {
 378   if (pair->is_pair())
 379     _pair(pair)->set_cdr(obj);
 380   else
 381     throw pmt_wrong_type("pmt_set_cdr", pair);
 382 }
 383
 384 ////////////////////////////////////////////////////////////////////////////
 385 //                             Vectors
 386 ////////////////////////////////////////////////////////////////////////////
 387
 388 pmt_vector::pmt_vector(size_t len, pmt_t fill)
 389   : d_v(len)
 390 {
 391   for (size_t i = 0; i < len; i++)
 392     d_v[i] = fill;
 393 }
 394
 395 pmt_t
 396 pmt_vector::ref(size_t k) const
 397 {
 398   if (k >= length())
 399     throw pmt_out_of_range("pmt_vector_ref", pmt_from_long(k));
 400   return d_v[k];
 401 }
 402
 403 void
 404 pmt_vector::set(size_t k, pmt_t obj)
 405 {
 406   if (k >= length())
 407     throw pmt_out_of_range("pmt_vector_set", pmt_from_long(k));
 408   d_v[k] = obj;
 409 }
 410
 411 void
 412 pmt_vector::fill(pmt_t obj)
 413 {
 414   for (size_t i = 0; i < length(); i++)
 415     d_v[i] = obj;
 416 }
 417
 418 bool
 419 pmt_is_vector(pmt_t obj)
 420 {
 421   return obj->is_vector();
 422 }
 423
 424 pmt_t
 425 pmt_make_vector(size_t k, pmt_t fill)
 426 {
 427   return pmt_t(new pmt_vector(k, fill));
 428 }
 429
 430 pmt_t
 431 pmt_vector_ref(pmt_t vector, size_t k)
 432 {
 433   if (!vector->is_vector())
 434     throw pmt_wrong_type("pmt_vector_ref", vector);
 435   return _vector(vector)->ref(k);
 436 }
 437
 438 void
 439 pmt_vector_set(pmt_t vector, size_t k, pmt_t obj)
 440 {
 441   if (!vector->is_vector())
 442     throw pmt_wrong_type("pmt_vector_set", vector);
 443   _vector(vector)->set(k, obj);
 444 }
 445
 446 void
 447 pmt_vector_fill(pmt_t vector, pmt_t obj)
 448 {
 449   if (!vector->is_vector())
 450     throw pmt_wrong_type("pmt_vector_set", vector);
 451   _vector(vector)->fill(obj);
 452 }
 453
 454 ////////////////////////////////////////////////////////////////////////////
 455 //                       Uniform Numeric Vectors
 456 ////////////////////////////////////////////////////////////////////////////
 457
 458 bool
 459 pmt_is_uniform_vector(pmt_t x)
 460 {
 461   return x->is_uniform_vector();
 462 }
 463
 464 const void *
 465 pmt_uniform_vector_elements(pmt_t vector, size_t &len)
 466 {
 467   if (!vector->is_uniform_vector())
 468     throw pmt_wrong_type("pmt_uniform_vector_elements", vector);
 469   return _uniform_vector(vector)->uniform_elements(len);
 470 }
 471
 472 void *
 473 pmt_uniform_vector_writeable_elements(pmt_t vector, size_t &len)
 474 {
 475   if (!vector->is_uniform_vector())
 476     throw pmt_wrong_type("pmt_uniform_vector_writeable_elements", vector);
 477   return _uniform_vector(vector)->uniform_writeable_elements(len);
 478 }
 479
 480 ////////////////////////////////////////////////////////////////////////////
 481 //                            Dictionaries
 482 ////////////////////////////////////////////////////////////////////////////
 483
 484 pmt_dict::pmt_dict()
 485   : d_alist(PMT_NIL)
 486 {
 487 }
 488
 489 void
 490 pmt_dict::set(pmt_t key, pmt_t value)
 491 {
 492   pmt_t p = pmt_assv(key, d_alist);     // look for (key . value) pair
 493   if (pmt_is_pair(p)){                  // found existing pair...
 494     pmt_set_cdr(p, value);              // overrwrite cdr with new value
 495   }
 496   else {                                // not in the dict
 497     d_alist = pmt_cons(pmt_cons(key, value), d_alist);  // add new (key . value) pair
 498   }
 499 }
 500
 501 pmt_t
 502 pmt_dict::ref(pmt_t key, pmt_t not_found) const
 503 {
 504   pmt_t p = pmt_assv(key, d_alist);     // look for (key . value) pair
 505   if (pmt_is_pair(p))
 506     return pmt_cdr(p);
 507   else
 508     return not_found;
 509 }
 510
 511 bool
 512 pmt_dict::has_key(pmt_t key) const
 513 {
 514   return pmt_is_pair(pmt_assv(key, d_alist));
 515 }
 516
 517 pmt_t
 518 pmt_dict::items() const
 519 {
 520   return d_alist;
 521 }
 522
 523 pmt_t
 524 pmt_dict::keys() const
 525 {
 526   return pmt_map(pmt_car, d_alist);
 527 }
 528
 529 pmt_t
 530 pmt_dict::values() const
 531 {
 532   return pmt_map(pmt_cdr, d_alist);
 533 }
 534
 535 bool
 536 pmt_is_dict(pmt_t obj)
 537 {
 538   return obj->is_dict();
 539 }
 540
 541 pmt_t
 542 pmt_make_dict()
 543 {
 544   return pmt_t(new pmt_dict());
 545 }
 546
 547 void
 548 pmt_dict_set(pmt_t dict, pmt_t key, pmt_t value)
 549 {
 550   if (!dict->is_dict())
 551     throw pmt_wrong_type("pmt_dict_set", dict);
 552
 553   _dict(dict)->set(key, value);
 554 }
 555
 556 bool
 557 pmt_dict_has_key(pmt_t dict, pmt_t key)
 558 {
 559   if (!dict->is_dict())
 560     throw pmt_wrong_type("pmt_dict_has_key", dict);
 561
 562   return _dict(dict)->has_key(key);
 563 }
 564
 565 pmt_t
 566 pmt_dict_ref(pmt_t dict, pmt_t key, pmt_t not_found)
 567 {
 568   if (!dict->is_dict())
 569     throw pmt_wrong_type("pmt_dict_ref", dict);
 570
 571   return _dict(dict)->ref(key, not_found);
 572 }
 573
 574 pmt_t
 575 pmt_dict_items(pmt_t dict)
 576 {
 577   if (!dict->is_dict())
 578     throw pmt_wrong_type("pmt_dict_items", dict);
 579
 580   return _dict(dict)->items();
 581 }
 582
 583 pmt_t
 584 pmt_dict_keys(pmt_t dict)
 585 {
 586   if (!dict->is_dict())
 587     throw pmt_wrong_type("pmt_dict_keys", dict);
 588
 589   return _dict(dict)->keys();
 590 }
 591
 592 pmt_t
 593 pmt_dict_values(pmt_t dict)
 594 {
 595   if (!dict->is_dict())
 596     throw pmt_wrong_type("pmt_dict_values", dict);
 597
 598   return _dict(dict)->values();
 599 }
 600
 601 ////////////////////////////////////////////////////////////////////////////
 602 //                          General Functions
 603 ////////////////////////////////////////////////////////////////////////////
 604
 605 bool
 606 pmt_eq(pmt_t x, pmt_t y)
 607 {
 608   return x == y;
 609 }
 610
 611 bool
 612 pmt_eqv(pmt_t x, pmt_t y)
 613 {
 614   if (x == y)
 615     return true;
 616
 617   if (x->is_integer() && y->is_integer())
 618     return _integer(x)->value() == _integer(y)->value();
 619
 620   if (x->is_real() && y->is_real())
 621     return _real(x)->value() == _real(y)->value();
 622
 623   if (x->is_complex() && y->is_complex())
 624     return _complex(x)->value() == _complex(y)->value();
 625
 626   return false;
 627 }
 628
 629 bool
 630 pmt_equal(pmt_t x, pmt_t y)
 631 {
 632   if (pmt_eqv(x, y))
 633     return true;
 634
 635   if (x->is_pair() && y->is_pair())
 636     return pmt_equal(pmt_car(x), pmt_car(y)) && pmt_equal(pmt_cdr(x), pmt_cdr(y));
 637
 638   if (x->is_vector() && y->is_vector()){
 639     pmt_vector *xv = _vector(x);
 640     pmt_vector *yv = _vector(y);
 641     if (xv->length() != yv->length())
 642       return false;
 643
 644     for (unsigned i = 0; i < xv->length(); i++)
 645       if (!pmt_equal(xv->_ref(i), yv->_ref(i)))
 646         return false;
 647
 648     return true;
 649   }
 650
 651   if (x->is_uniform_vector() && y->is_uniform_vector()){
 652     pmt_uniform_vector *xv = _uniform_vector(x);
 653     pmt_uniform_vector *yv = _uniform_vector(y);
 654     if (xv->length() != yv->length())
 655       return false;
 656
 657     size_t len_x, len_y;
 658     if (memcmp(xv->uniform_elements(len_x),
 659                yv->uniform_elements(len_y),
 660                len_x) == 0)
 661       return true;
 662
 663     return true;
 664   }
 665
 666   // FIXME add other cases here...
 667
 668   return false;
 669 }
 670
 671 size_t
 672 pmt_length(pmt_t x)
 673 {
 674   if (x->is_vector())
 675     return _vector(x)->length();
 676
 677   if (x->is_uniform_vector())
 678     return _uniform_vector(x)->length();
 679
 680   // FIXME list length
 681   // FIXME dictionary length (number of entries)
 682
 683   throw pmt_wrong_type("pmt_length", x);
 684 }
 685
 686 pmt_t
 687 pmt_assq(pmt_t obj, pmt_t alist)
 688 {
 689   while (pmt_is_pair(alist)){
 690     pmt_t p = pmt_car(alist);
 691     if (!pmt_is_pair(p))        // malformed alist
 692       return PMT_BOOL_F;
 693
 694     if (pmt_eq(obj, pmt_car(p)))
 695       return p;
 696
 697     alist = pmt_cdr(alist);
 698   }
 699   return PMT_BOOL_F;
 700 }
 701
 702 pmt_t
 703 pmt_assv(pmt_t obj, pmt_t alist)
 704 {
 705   while (pmt_is_pair(alist)){
 706     pmt_t p = pmt_car(alist);
 707     if (!pmt_is_pair(p))        // malformed alist
 708       return PMT_BOOL_F;
 709
 710     if (pmt_eqv(obj, pmt_car(p)))
 711       return p;
 712
 713     alist = pmt_cdr(alist);
 714   }
 715   return PMT_BOOL_F;
 716 }
 717
 718 pmt_t
 719 pmt_assoc(pmt_t obj, pmt_t alist)
 720 {
 721   while (pmt_is_pair(alist)){
 722     pmt_t p = pmt_car(alist);
 723     if (!pmt_is_pair(p))        // malformed alist
 724       return PMT_BOOL_F;
 725
 726     if (pmt_equal(obj, pmt_car(p)))
 727       return p;
 728
 729     alist = pmt_cdr(alist);
 730   }
 731   return PMT_BOOL_F;
 732 }
 733
 734 pmt_t
 735 pmt_map(pmt_t proc(pmt_t), pmt_t list)
 736 {
 737   pmt_t r = PMT_NIL;
 738
 739   while(pmt_is_pair(list)){
 740     r = pmt_cons(proc(pmt_car(list)), r);
 741     list = pmt_cdr(list);
 742   }
 743
 744   return pmt_reverse_x(r);
 745 }
 746
 747 pmt_t
 748 pmt_reverse(pmt_t listx)
 749 {
 750   pmt_t list = listx;
 751   pmt_t r = PMT_NIL;
 752
 753   while(pmt_is_pair(list)){
 754     r = pmt_cons(pmt_car(list), r);
 755     list = pmt_cdr(list);
 756   }
 757   if (pmt_is_null(list))
 758     return r;
 759   else
 760     throw pmt_wrong_type("pmt_reverse", listx);
 761 }
 762
 763 pmt_t
 764 pmt_reverse_x(pmt_t list)
 765 {
 766   // FIXME do it destructively
 767   return pmt_reverse(list);
 768 }
 769
 770 pmt_t
 771 pmt_nth(size_t n, pmt_t list)
 772 {
 773   pmt_t t = pmt_nthcdr(n, list);
 774   if (pmt_is_pair(t))
 775     return pmt_car(t);
 776   else
 777     return PMT_NIL;
 778 }
 779
 780 pmt_t
 781 pmt_nthcdr(size_t n, pmt_t list)
 782 {
 783   if (!(pmt_is_null(list) || pmt_is_pair(list)))
 784     throw pmt_wrong_type("pmt_nthcdr", list);
 785
 786   while (n > 0){
 787     if (pmt_is_pair(list)){
 788       list = pmt_cdr(list);
 789       n--;
 790       continue;
 791     }
 792     if (pmt_is_null(list))
 793       return PMT_NIL;
 794     else
 795       throw pmt_wrong_type("pmt_nthcdr: not a LIST", list);
 796   }
 797   return list;
 798 }
 799
 800 pmt_t
 801 pmt_memq(pmt_t obj, pmt_t list)
 802 {
 803   while (pmt_is_pair(list)){
 804     if (pmt_eq(obj, pmt_car(list)))
 805       return list;
 806     list = pmt_cdr(list);
 807   }
 808   return PMT_BOOL_F;
 809 }
 810
 811 pmt_t
 812 pmt_memv(pmt_t obj, pmt_t list)
 813 {
 814   while (pmt_is_pair(list)){
 815     if (pmt_eqv(obj, pmt_car(list)))
 816       return list;
 817     list = pmt_cdr(list);
 818   }
 819   return PMT_BOOL_F;
 820 }
 821
 822 pmt_t
 823 pmt_member(pmt_t obj, pmt_t list)
 824 {
 825   while (pmt_is_pair(list)){
 826     if (pmt_equal(obj, pmt_car(list)))
 827       return list;
 828     list = pmt_cdr(list);
 829   }
 830   return PMT_BOOL_F;
 831 }
 832
 833 bool
 834 pmt_subsetp(pmt_t list1, pmt_t list2)
 835 {
 836   while (pmt_is_pair(list1)){
 837     pmt_t p = pmt_car(list1);
 838     if (pmt_is_false(pmt_memv(p, list2)))
 839       return false;
 840     list1 = pmt_cdr(list1);
 841   }
 842   return true;
 843 }
 844
 845 pmt_t
 846 pmt_list1(pmt_t x1)
 847 {
 848   return pmt_cons(x1, PMT_NIL);
 849 }
 850
 851 pmt_t
 852 pmt_list2(pmt_t x1, pmt_t x2)
 853 {
 854   return pmt_cons(x1, pmt_cons(x2, PMT_NIL));
 855 }
 856
 857 pmt_t
 858 pmt_list3(pmt_t x1, pmt_t x2, pmt_t x3)
 859 {
 860   return pmt_cons(x1, pmt_cons(x2, pmt_cons(x3, PMT_NIL)));
 861 }
 862
 863 pmt_t
 864 pmt_list4(pmt_t x1, pmt_t x2, pmt_t x3, pmt_t x4)
 865 {
 866   return pmt_cons(x1, pmt_cons(x2, pmt_cons(x3, pmt_cons(x4, PMT_NIL))));
 867 }