lily/lily-guile.cc

   1 /*
   2   lily-guile.cc -- implement assorted guile functions
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 1998--2004 Jan Nieuwenhuizen <janneke@gnu.org>
   7
   8   Han-Wen Nienhuys <hanwen@cs.uu.nl>
   9 */
  10
  11
  12 #include <stdio.h>
  13 #include <stdlib.h>
  14 #include <math.h>   /* isinf */
  15 #include <string.h> /* strdup, strchr */
  16 #include <ctype.h>
  17
  18 #include "lily-proto.hh"
  19 #include "version.hh"
  20
  21 /* MacOS S fix:
  22    source-file.hh includes cmath which undefines isinf and isnan
  23
  24    FIXME: #ifdef MACOS_X?
  25 */
  26 inline int my_isinf (Real r) { return isinf (r); }
  27 inline int my_isnan (Real r) { return isnan (r); }
  28
  29
  30 #include "libc-extension.hh"
  31 #include "lily-guile.hh"
  32 #include "main.hh"
  33 #include "file-path.hh"
  34 #include "warn.hh"
  35 #include "direction.hh"
  36 #include "offset.hh"
  37 #include "interval.hh"
  38 #include "pitch.hh"
  39 #include "dimensions.hh"
  40 #include "source-file.hh"
  41
  42 // #define TEST_GC
  43
  44 SCM
  45 ly_last (SCM list)
  46 {
  47   return ly_car (scm_last_pair (list));
  48 }
  49
  50
  51 SCM
  52 ly_write2scm (SCM s)
  53 {
  54   SCM port = scm_mkstrport (SCM_INUM0,
  55                             scm_make_string (SCM_INUM0, SCM_UNDEFINED),
  56                             SCM_OPN | SCM_WRTNG,
  57                             "ly_write2string");
  58   //  SCM write = scm_eval_3 (ly_symbol2scm ("write"), s, SCM_EOL);
  59   SCM write = scm_primitive_eval (ly_symbol2scm ("write"));
  60
  61   // scm_apply (write, port, SCM_EOL);
  62   scm_call_2 (write, s, port);
  63   return scm_strport_to_string (port);
  64 }
  65
  66
  67 SCM
  68 ly_quote_scm (SCM s)
  69 {
  70   return scm_list_n (ly_symbol2scm ("quote"), s, SCM_UNDEFINED);
  71 }
  72
  73 String
  74 ly_symbol2string (SCM s)
  75 {
  76   assert (is_symbol (s));
  77   return String ((Byte*)SCM_STRING_CHARS (s), (int) SCM_STRING_LENGTH (s));
  78 }
  79
  80 String
  81 gulp_file_to_string (String fn)
  82 {
  83   String s = global_path.find (fn);
  84   if (s == "")
  85     {
  86       String e = _f ("can't find file: `%s'", fn);
  87       e += " ";
  88       e += _f ("(load path: `%s')", global_path.to_string ());
  89       error (e);
  90     }
  91   else if (verbose_global_b)
  92     progress_indication ("[" + s);
  93
  94   int n;
  95   char * str = gulp_file (s, &n);
  96   String result (str);
  97   delete[] str;
  98
  99   if (verbose_global_b)
 100     progress_indication ("]");
 101
 102   return result;
 103 }
 104
 105 LY_DEFINE (ly_gulp_file, "ly:gulp-file",
 106            1, 0, 0, (SCM name),
 107            "Read the file @var{name}, and return its contents in a string.  "
 108            "The file is looked up using the search path.")
 109 {
 110   SCM_ASSERT_TYPE (is_string (name), name, SCM_ARG1, __FUNCTION__, "string");
 111   return scm_makfrom0str (gulp_file_to_string (ly_scm2string (name)).to_str0 ());
 112 }
 113
 114
 115 extern "C" {
 116   // maybe gdb 5.0 becomes quicker if it doesn't do fancy C++ typing?
 117 void
 118 ly_display_scm (SCM s)
 119 {
 120   scm_display (s, scm_current_output_port ());
 121   scm_newline (scm_current_output_port ());
 122 }
 123 };
 124
 125 String
 126 ly_scm2string (SCM s)
 127 {
 128   assert (is_string (s));
 129
 130   char *p = SCM_STRING_CHARS (s);
 131   String r (p);
 132   return r;
 133 }
 134
 135 char *
 136 ly_scm2newstr (SCM str, size_t *lenp)
 137 {
 138   char *new_str;
 139   size_t len;
 140
 141   SCM_ASSERT_TYPE (is_string (str), str, SCM_ARG1, __FUNCTION__, "string");
 142
 143   len = SCM_STRING_LENGTH (str);
 144   new_str = (char *) malloc ((len + 1) * sizeof (char));
 145
 146   if (new_str == NULL)
 147     return NULL;
 148
 149   memcpy (new_str, SCM_STRING_CHARS (str), len);
 150   new_str[len] = '\0';
 151
 152   if (lenp != NULL)
 153       *lenp = len;
 154
 155   return new_str;
 156 }
 157
 158 SCM
 159 index_get_cell (SCM s, Direction d)
 160 {
 161
 162   assert (d);
 163   return (d == LEFT) ? ly_car (s) : ly_cdr (s);
 164 }
 165
 166 SCM
 167 index_set_cell (SCM s, Direction d, SCM v)
 168 {
 169   if (d == LEFT)
 170     scm_set_car_x (s, v);
 171   else if (d == RIGHT)
 172     scm_set_cdr_x (s, v);
 173   return s;
 174 }
 175
 176 LY_DEFINE (ly_warning,"ly:warn", 1, 0, 0,
 177   (SCM str), "Scheme callable function to issue the warning @code{msg}.")
 178 {
 179   SCM_ASSERT_TYPE (is_string (str), str, SCM_ARG1, __FUNCTION__, "string");
 180   progress_indication ("\n");
 181   warning ("lily-guile: " + ly_scm2string (str));
 182   return SCM_BOOL_T;
 183 }
 184
 185 LY_DEFINE (is_dir,  "ly:dir?", 1,0, 0,  (SCM s),
 186           "type predicate. A direction is @code{-1}, @code{0} or "
 187            "@code{1}, where @code{-1} represents "
 188           "left or down and @code{1} represents right or up.")
 189 {
 190   if (is_number (s))
 191     {
 192       int i = ly_scm2int (s);
 193       return (i>= -1 && i <= 1)  ? SCM_BOOL_T : SCM_BOOL_F;
 194     }
 195   return SCM_BOOL_F;
 196 }
 197
 198 bool
 199 is_number_pair (SCM p)
 200 {
 201   return is_pair (p) && is_number (ly_car (p)) && is_number (ly_cdr (p));
 202 }
 203
 204 typedef void (*Void_fptr) ();
 205 Array<Void_fptr> *scm_init_funcs_;
 206
 207 void add_scm_init_func (void (*f) ())
 208 {
 209   if (!scm_init_funcs_)
 210     scm_init_funcs_ = new Array<Void_fptr>;
 211
 212   scm_init_funcs_->push (f);
 213 }
 214
 215
 216 void
 217 ly_init_ly_module (void *)
 218 {
 219   for (int i=scm_init_funcs_->size () ; i--;)
 220     (scm_init_funcs_->elem (i)) ();
 221
 222   if (verbose_global_b)
 223     progress_indication ("\n");
 224
 225   scm_primitive_load_path (scm_makfrom0str ("lily.scm"));
 226 }
 227
 228 SCM global_lily_module;
 229
 230 void
 231 ly_c_init_guile ()
 232 {
 233   global_lily_module = scm_c_define_module ("lily", ly_init_ly_module, 0);
 234   scm_c_use_module ("lily");
 235 }
 236
 237 unsigned int ly_scm_hash (SCM s)
 238 {
 239   return scm_ihashv (s, ~1u);
 240 }
 241
 242
 243
 244 bool
 245 is_direction (SCM s)
 246 {
 247   if (is_number (s))
 248     {
 249       int i = ly_scm2int (s);
 250       return i>= -1 && i <= 1;
 251     }
 252   return false;
 253 }
 254
 255
 256 bool
 257 is_axis (SCM s)
 258 {
 259   if (is_number (s))
 260     {
 261       int i = ly_scm2int (s);
 262       return i== 0 || i == 1;
 263     }
 264   return false;
 265 }
 266
 267 Direction
 268 to_dir (SCM s)
 269 {
 270   return SCM_INUMP (s) ? (Direction) ly_scm2int (s) : CENTER;
 271 }
 272
 273 Interval
 274 ly_scm2interval (SCM p)
 275 {
 276   return Interval (ly_scm2double (ly_car (p)), ly_scm2double (ly_cdr (p)));
 277 }
 278
 279 Drul_array<Real>
 280 ly_scm2realdrul (SCM p)
 281 {
 282   return Drul_array<Real> (ly_scm2double (ly_car (p)),
 283                            ly_scm2double (ly_cdr (p)));
 284 }
 285
 286 SCM
 287 ly_interval2scm (Drul_array<Real> i)
 288 {
 289   return scm_cons (scm_make_real (i[LEFT]), scm_make_real (i[RIGHT]));
 290 }
 291
 292 bool
 293 to_boolean (SCM s)
 294 {
 295   return is_boolean (s) && ly_scm2bool (s);
 296 }
 297
 298 /* Appendable list L: the cdr contains the list, the car the last cons
 299    in the list.  */
 300 SCM
 301 appendable_list ()
 302 {
 303   SCM s = scm_cons (SCM_EOL, SCM_EOL);
 304   scm_set_car_x (s, s);
 305
 306   return s;
 307 }
 308
 309 void
 310 appendable_list_append (SCM l, SCM elt)
 311 {
 312   SCM newcons = scm_cons (elt, SCM_EOL);
 313
 314   scm_set_cdr_x (ly_car (l), newcons);
 315   scm_set_car_x (l, newcons);
 316 }
 317
 318
 319 SCM
 320 ly_offset2scm (Offset o)
 321 {
 322   return scm_cons (scm_make_real (o[X_AXIS]), scm_make_real (o[Y_AXIS]));
 323 }
 324
 325 Offset
 326 ly_scm2offset (SCM s)
 327 {
 328   return Offset (ly_scm2double (ly_car (s)),
 329                  ly_scm2double (ly_cdr (s)));
 330 }
 331
 332
 333 LY_DEFINE (ly_number2string, "ly:number->string",
 334            1, 0, 0, (SCM s),
 335            "Convert @var{num} to a string without generating many decimals.")
 336 {
 337   SCM_ASSERT_TYPE (is_number (s), s, SCM_ARG1, __FUNCTION__, "number");
 338
 339   char str[400];                        // ugh.
 340
 341   if (scm_exact_p (s) == SCM_BOOL_F)
 342     {
 343       Real r (ly_scm2double (s));
 344
 345       if (my_isinf (r) || my_isnan (r))
 346         {
 347           programming_error ("Infinity or NaN encountered while converting Real number; setting to zero.");
 348           r = 0.0;
 349         }
 350
 351       sprintf (str, "%08.4f", r);
 352     }
 353   else
 354     sprintf (str, "%d", ly_scm2int (s));
 355
 356   return scm_makfrom0str (str);
 357 }
 358
 359 /*
 360   Undef this to see if GUILE GC is causing too many swaps.
 361  */
 362
 363 //#define TEST_GC
 364
 365 #ifdef TEST_GC
 366 #include <libguile/gc.h>
 367
 368 static void *
 369 greet_sweep (void *dummy1, void *dummy2, void *dummy3)
 370 {
 371   fprintf (stderr, "entering sweep\n");
 372 }
 373
 374 static void *
 375 wave_sweep_goodbye (void *dummy1, void *dummy2, void *dummy3)
 376 {
 377   fprintf (stderr, "leaving sweep\n");
 378 }
 379 #endif
 380
 381
 382 LY_DEFINE (ly_version,  "ly:version", 0, 0, 0, (),
 383           "Return the current lilypond version as a list, e.g. @code{(1 3 127 uu1)}. ")
 384 {
 385   char const* vs = "\'(" MAJOR_VERSION " " MINOR_VERSION " "  PATCH_LEVEL " " MY_PATCH_LEVEL ")" ;
 386
 387   return scm_c_eval_string ((char*)vs);
 388 }
 389
 390 LY_DEFINE (ly_unit,  "ly:unit", 0, 0, 0, (),
 391           "Return the unit used for lengths as a string.")
 392 {
 393   return scm_makfrom0str (INTERNAL_UNIT);
 394 }
 395
 396
 397
 398 LY_DEFINE (is_dimension,  "ly:dimension?", 1, 0, 0, (SCM d),
 399           "Return @var{d} is a number. Used to distinguish length "
 400           "variables from normal numbers.")
 401 {
 402   return scm_number_p (d);
 403 }
 404
 405 static void
 406 init_functions ()
 407 {
 408 #ifdef TEST_GC
 409   scm_c_hook_add (&scm_before_mark_c_hook, greet_sweep, 0, 0);
 410   scm_c_hook_add (&scm_before_sweep_c_hook, wave_sweep_goodbye, 0, 0);
 411 #endif
 412 }
 413
 414 ADD_SCM_INIT_FUNC (funcs, init_functions);
 415
 416 SCM
 417 ly_deep_copy (SCM src)
 418 {
 419   if (is_pair (src))
 420     return scm_cons (ly_deep_copy (ly_car (src)), ly_deep_copy (ly_cdr (src)));
 421   else if (is_vector (src))
 422     {
 423       int len = SCM_VECTOR_LENGTH (src);
 424       SCM nv = scm_c_make_vector (len, SCM_UNDEFINED);
 425       for (int i  =0 ; i < len ; i++)
 426         {
 427           SCM si = scm_int2num (i);
 428           scm_vector_set_x (nv, si, ly_deep_copy (scm_vector_ref (src, si)));
 429         }
 430     }
 431   return src;
 432 }
 433
 434
 435
 436
 437 SCM
 438 ly_assoc_chain (SCM key, SCM achain)
 439 {
 440   if (is_pair (achain))
 441     {
 442       SCM handle = scm_assoc (key, ly_car (achain));
 443       if (is_pair (handle))
 444         return handle;
 445       else
 446         return ly_assoc_chain (key, ly_cdr (achain));
 447     }
 448   else
 449     return SCM_BOOL_F;
 450 }
 451
 452 /* looks the key up in the cdrs of the alist-keys
 453    - ignoring the car and ignoring non-pair keys.
 454    Returns first match found, i.e.
 455
 456    alist = ((1 . 10)
 457                    ((1 . 2) . 11)
 458                    ((2 . 1) . 12)
 459                    ((3 . 0) . 13)
 460                    ((4 . 1) . 14) )
 461
 462 I would like (ly_assoc_cdr 1) to return 12 - because it's the first
 463 element with the cdr of the key = 1.  In other words (alloc_cdr key)
 464 corresponds to call
 465
 466 (alloc (anything . key))
 467
 468
 469
 470 */
 471 SCM
 472 ly_assoc_cdr (SCM key, SCM alist)
 473 {
 474   if (is_pair (alist))
 475     {
 476       SCM trykey = ly_caar (alist);
 477       if (is_pair (trykey) && to_boolean (scm_equal_p (key, ly_cdr (trykey))))
 478         return ly_car (alist);
 479       else
 480         return ly_assoc_cdr (key, ly_cdr (alist));
 481     }
 482   return SCM_BOOL_F;
 483 }
 484
 485 /* LST has the form "sym1 sym2 sym3\nsym4\nsym5"
 486    i.e. \n and ' ' can be used interchangeably as separators.  */
 487 SCM
 488 parse_symbol_list (char const *lst)
 489 {
 490   char *s = strdup (lst);
 491   char *orig = s;
 492   SCM create_list = SCM_EOL;
 493
 494   char * e = s + strlen (s) - 1;
 495   while (e >= s && isspace (*e))
 496     *e-- = 0;
 497
 498   for (char * p = s; *p; p++)
 499     if (*p == '\n')
 500       *p = ' ';
 501
 502   if (!s[0])
 503     s = 0;
 504
 505   while (s)
 506     {
 507       char *next = strchr (s, ' ');
 508       if (next)
 509         *next++ = 0;
 510
 511       create_list = scm_cons (ly_symbol2scm (s), create_list);
 512       s = next;
 513     }
 514
 515   free (orig);
 516   return create_list;
 517 }
 518
 519 SCM
 520 ly_truncate_list (int k, SCM lst)
 521 {
 522   if (k == 0)
 523     lst = SCM_EOL;
 524   else
 525     {
 526       SCM s = lst;
 527       k--;
 528       for (; is_pair (s) && k--; s = ly_cdr (s))
 529         ;
 530
 531       if (is_pair (s))
 532         scm_set_cdr_x (s, SCM_EOL);
 533     }
 534   return lst;
 535 }
 536
 537 String
 538 print_scm_val (SCM val)
 539 {
 540   String realval = ly_scm2string (ly_write2scm (val));
 541   if (realval.length () > 200)
 542     realval = realval.left_string (100)
 543       + "\n :\n :\n"
 544       + realval.right_string (100);
 545   return realval;
 546 }
 547
 548 bool
 549 type_check_assignment (SCM sym, SCM val,  SCM type_symbol)
 550 {
 551   bool ok = true;
 552
 553   /*
 554     Always succeeds.
 555
 556
 557     TODO: should remove #f from allowed vals?
 558    */
 559   if (val == SCM_EOL || val == SCM_BOOL_F)
 560     return ok;
 561
 562   if (!is_symbol (sym))
 563 #if 0
 564     return false;
 565 #else
 566   /*
 567     This is used for autoBeamSettings.
 568
 569     TODO: deprecate the use of \override and \revert for
 570     autoBeamSettings?
 571
 572     or use a symbol autoBeamSettingS?
 573    */
 574   return true;
 575 #endif
 576
 577   SCM type = scm_object_property (sym, type_symbol);
 578
 579   if (type != SCM_EOL && !is_procedure (type))
 580       {
 581         warning (_f ("Can't find property type-check for `%s' (%s).",
 582                      ly_symbol2string (sym).to_str0 (),
 583                      ly_symbol2string (type_symbol).to_str0 ())
 584                  + "  " + _ ("Perhaps you made a typing error?"));
 585
 586         /* Be strict when being anal :) */
 587         if (internal_type_checking_global_b)
 588           abort ();
 589
 590         warning (_ ("Doing assignment anyway."));
 591       }
 592   else
 593     {
 594       if (val != SCM_EOL
 595           && is_procedure (type)
 596           && scm_call_1 (type, val) == SCM_BOOL_F)
 597         {
 598           SCM errport = scm_current_error_port ();
 599           ok = false;
 600           SCM typefunc = ly_scheme_function ("type-name");
 601           SCM type_name = scm_call_1 (typefunc, type);
 602
 603
 604           scm_puts (_f ("Type check for `%s' failed; value `%s' must be of type `%s'",
 605                         ly_symbol2string (sym).to_str0 (),
 606                         print_scm_val (val),
 607                         ly_scm2string (type_name).to_str0 ()).to_str0 (),
 608                     errport);
 609           scm_puts ("\n", errport);
 610         }
 611     }
 612   return ok;
 613 }
 614
 615
 616 /* some SCM abbrevs
 617
 618    zijn deze nou handig?
 619    zijn ze er al in scheme, maar heten ze anders? */
 620
 621
 622 /* Remove doubles from (sorted) list */
 623 SCM
 624 ly_unique (SCM list)
 625 {
 626   SCM unique = SCM_EOL;
 627   for (SCM i = list; is_pair (i); i = ly_cdr (i))
 628     {
 629       if (!is_pair (ly_cdr (i))
 630           || !is_equal (ly_car (i), ly_cadr (i)))
 631         unique = scm_cons (ly_car (i), unique);
 632     }
 633   return scm_reverse_x (unique, SCM_EOL);
 634 }
 635
 636
 637 static int
 638 scm_default_compare (void const *a, void const *b)
 639 {
 640   SCM pa = *(SCM*) a;
 641   SCM pb = *(SCM*) b;
 642   if (pa == pb)
 643     return 0;
 644   return pa < pb ? -1 : 1;
 645 }
 646
 647 /*  Modify LST in place: qsort it.  */
 648 SCM
 649 ly_list_qsort_uniq_x (SCM lst)
 650 {
 651   int len = scm_ilength (lst);
 652   SCM *arr = new SCM[len];
 653   int k = 0;
 654   for (SCM s = lst; SCM_NNULLP (s); s = SCM_CDR (s))
 655     arr[k++] = SCM_CAR (s);
 656
 657   assert (k == len);
 658   qsort (arr, len, sizeof (SCM), &scm_default_compare);
 659
 660   SCM *tail = &lst;
 661   for (int i = 0; i < len; i++)
 662     if (!i || arr[i] != arr[i - 1])
 663       {
 664         SCM_SETCAR (*tail, arr[i]);
 665         tail = SCM_CDRLOC (*tail);
 666       }
 667
 668   *tail = SCM_EOL;
 669   delete[] arr;
 670
 671   return lst;
 672 }
 673
 674
 675 /* tail add */
 676 SCM
 677 ly_snoc (SCM s, SCM list)
 678 {
 679   return ly_append2 (list, scm_list_n (s, SCM_UNDEFINED));
 680 }
 681
 682 /* Split list at member s, removing s.
 683    Return (BEFORE . AFTER)  */
 684 SCM
 685 ly_split_list (SCM s, SCM list)
 686 {
 687   SCM before = SCM_EOL;
 688   SCM after = list;
 689   for (; is_pair (after);)
 690     {
 691       SCM i = ly_car (after);
 692       after = ly_cdr (after);
 693       if (is_equal (i, s))
 694         break;
 695       before = scm_cons (i, before);
 696     }
 697   return scm_cons ( scm_reverse_x (before, SCM_EOL),  after);
 698
 699 }
 700
 701
 702 void
 703 taint (SCM *)
 704 {
 705   /*
 706     nop.
 707    */
 708 }
 709
 710 /*
 711   display stuff without using stack
 712  */
 713 SCM
 714 display_list (SCM s)
 715 {
 716   SCM p = scm_current_output_port ();
 717
 718   scm_puts ("(", p);
 719   for (; is_pair (s); s =ly_cdr (s))
 720     {
 721       scm_display (ly_car (s), p);
 722       scm_puts (" ", p);
 723     }
 724   scm_puts (")", p);
 725   return SCM_UNSPECIFIED;
 726 }
 727
 728 Slice
 729 int_list_to_slice (SCM l)
 730 {
 731   Slice s;
 732   s.set_empty ();
 733   for (; is_pair (l); l = ly_cdr (l))
 734     if (is_number (ly_car (l)))
 735       s.add_point (ly_scm2int (ly_car (l)));
 736   return s;
 737 }
 738
 739 /* Return I-th element, or last elt L. If I < 0, then we take the first
 740    element.
 741
 742    PRE: length (L) > 0  */
 743 SCM
 744 robust_list_ref (int i, SCM l)
 745 {
 746   while (i-- > 0 && is_pair (ly_cdr (l)))
 747     l = ly_cdr (l);
 748   return ly_car (l);
 749 }
 750
 751 Real
 752 robust_scm2double (SCM k, double x)
 753 {
 754   if (is_number (k))
 755     x = ly_scm2double (k);
 756   return x;
 757 }
 758
 759 Interval
 760 robust_scm2interval (SCM k, Drul_array<Real> v)
 761 {
 762   Interval i;
 763   i[LEFT]= v[LEFT];
 764   i[RIGHT]= v[RIGHT];
 765   if (is_number_pair (k))
 766     i = ly_scm2interval (k);
 767   return i;
 768 }
 769
 770 Drul_array<Real>
 771 robust_scm2drul (SCM k, Drul_array<Real> v)
 772 {
 773   if (is_number_pair (k))
 774     v = ly_scm2interval (k);
 775   return v;
 776 }
 777
 778 Offset
 779 robust_scm2offset (SCM k, Offset o)
 780 {
 781   if (is_number_pair (k))
 782     o = ly_scm2offset (k);
 783   return o;
 784 }
 785
 786 int
 787 robust_scm2int (SCM k, int o)
 788 {
 789   if (scm_integer_p (k) == SCM_BOOL_T)
 790     o = ly_scm2int (k);
 791   return o;
 792 }
 793
 794 SCM
 795 alist_to_hashq (SCM alist)
 796 {
 797   int i = scm_ilength (alist);
 798   if (i < 0)
 799     return scm_make_vector (scm_int2num (0), SCM_EOL);
 800
 801   SCM tab = scm_make_vector (scm_int2num (i), SCM_EOL);
 802   for (SCM s = alist; is_pair (s); s = ly_cdr (s))
 803     {
 804       SCM pt = ly_cdar (s);
 805       scm_hashq_set_x (tab, ly_caar (s), pt);
 806     }
 807   return tab;
 808 }
 809
 810 #if 1
 811 /*
 812   Debugging mem leaks:
 813  */
 814 LY_DEFINE (ly_protects, "ly:protects", 0, 0, 0, (),
 815           "Return hash of protected objects.")
 816 {
 817   return scm_protects;
 818 }
 819 #endif