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
 229 SCM global_lily_module;
 230
 231 void
 232 ly_init_guile ()
 233 {
 234   global_lily_module = scm_c_define_module ("lily", ly_init_ly_module, 0);
 235   scm_c_use_module ("lily");
 236 }
 237
 238 unsigned int ly_scm_hash (SCM s)
 239 {
 240   return scm_ihashv (s, ~1u);
 241 }
 242
 243
 244
 245 bool
 246 is_direction (SCM s)
 247 {
 248   if (is_number (s))
 249     {
 250       int i = ly_scm2int (s);
 251       return i>= -1 && i <= 1;
 252     }
 253   return false;
 254 }
 255
 256
 257 bool
 258 is_axis (SCM s)
 259 {
 260   if (is_number (s))
 261     {
 262       int i = ly_scm2int (s);
 263       return i== 0 || i == 1;
 264     }
 265   return false;
 266 }
 267
 268 Direction
 269 to_dir (SCM s)
 270 {
 271   return SCM_INUMP (s) ? (Direction) ly_scm2int (s) : CENTER;
 272 }
 273
 274 Interval
 275 ly_scm2interval (SCM p)
 276 {
 277   return Interval (ly_scm2double (ly_car (p)), ly_scm2double (ly_cdr (p)));
 278 }
 279
 280 Drul_array<Real>
 281 ly_scm2realdrul (SCM p)
 282 {
 283   return Drul_array<Real> (ly_scm2double (ly_car (p)),
 284                            ly_scm2double (ly_cdr (p)));
 285 }
 286
 287 SCM
 288 ly_interval2scm (Drul_array<Real> i)
 289 {
 290   return scm_cons (scm_make_real (i[LEFT]), scm_make_real (i[RIGHT]));
 291 }
 292
 293 bool
 294 to_boolean (SCM s)
 295 {
 296   return is_boolean (s) && ly_scm2bool (s);
 297 }
 298
 299 /* Appendable list L: the cdr contains the list, the car the last cons
 300    in the list.  */
 301 SCM
 302 appendable_list ()
 303 {
 304   SCM s = scm_cons (SCM_EOL, SCM_EOL);
 305   scm_set_car_x (s, s);
 306
 307   return s;
 308 }
 309
 310 void
 311 appendable_list_append (SCM l, SCM elt)
 312 {
 313   SCM newcons = scm_cons (elt, SCM_EOL);
 314
 315   scm_set_cdr_x (ly_car (l), newcons);
 316   scm_set_car_x (l, newcons);
 317 }
 318
 319
 320 SCM
 321 ly_offset2scm (Offset o)
 322 {
 323   return scm_cons (scm_make_real (o[X_AXIS]), scm_make_real (o[Y_AXIS]));
 324 }
 325
 326 Offset
 327 ly_scm2offset (SCM s)
 328 {
 329   return Offset (ly_scm2double (ly_car (s)),
 330                  ly_scm2double (ly_cdr (s)));
 331 }
 332
 333
 334 LY_DEFINE (ly_number2string, "ly:number->string",
 335            1, 0, 0, (SCM s),
 336            "Convert @var{num} to a string without generating many decimals.")
 337 {
 338   SCM_ASSERT_TYPE (is_number (s), s, SCM_ARG1, __FUNCTION__, "number");
 339
 340   char str[400];                        // ugh.
 341
 342   if (scm_exact_p (s) == SCM_BOOL_F)
 343     {
 344       Real r (ly_scm2double (s));
 345
 346       if (my_isinf (r) || my_isnan (r))
 347         {
 348           programming_error ("Infinity or NaN encountered while converting Real number; setting to zero.");
 349           r = 0.0;
 350         }
 351
 352       sprintf (str, "%08.4f", r);
 353     }
 354   else
 355     sprintf (str, "%d", ly_scm2int (s));
 356
 357   return scm_makfrom0str (str);
 358 }
 359
 360 /*
 361   Undef this to see if GUILE GC is causing too many swaps.
 362  */
 363
 364 //#define TEST_GC
 365
 366 #ifdef TEST_GC
 367 #include <libguile/gc.h>
 368
 369 static void *
 370 greet_sweep (void *dummy1, void *dummy2, void *dummy3)
 371 {
 372   fprintf (stderr, "entering sweep\n");
 373 }
 374
 375 static void *
 376 wave_sweep_goodbye (void *dummy1, void *dummy2, void *dummy3)
 377 {
 378   fprintf (stderr, "leaving sweep\n");
 379 }
 380 #endif
 381
 382
 383 LY_DEFINE (ly_version,  "ly:version", 0, 0, 0, (),
 384           "Return the current lilypond version as a list, e.g. @code{(1 3 127 uu1)}. ")
 385 {
 386   char const* vs = "\'(" MAJOR_VERSION " " MINOR_VERSION " "  PATCH_LEVEL " " MY_PATCH_LEVEL ")" ;
 387
 388   return scm_c_eval_string ((char*)vs);
 389 }
 390
 391 LY_DEFINE (ly_unit,  "ly:unit", 0, 0, 0, (),
 392           "Return the unit used for lengths as a string.")
 393 {
 394   return scm_makfrom0str (INTERNAL_UNIT);
 395 }
 396
 397
 398
 399 LY_DEFINE (is_dimension,  "ly:dimension?", 1, 0, 0, (SCM d),
 400           "Return @var{d} is a number. Used to distinguish length "
 401           "variables from normal numbers.")
 402 {
 403   return scm_number_p (d);
 404 }
 405
 406 static void
 407 init_functions ()
 408 {
 409 #ifdef TEST_GC
 410   scm_c_hook_add (&scm_before_mark_c_hook, greet_sweep, 0, 0);
 411   scm_c_hook_add (&scm_before_sweep_c_hook, wave_sweep_goodbye, 0, 0);
 412 #endif
 413 }
 414
 415 ADD_SCM_INIT_FUNC (funcs, init_functions);
 416
 417 SCM
 418 ly_deep_copy (SCM src)
 419 {
 420   if (is_pair (src))
 421     return scm_cons (ly_deep_copy (ly_car (src)), ly_deep_copy (ly_cdr (src)));
 422   else if (is_vector (src))
 423     {
 424       int len = SCM_VECTOR_LENGTH (src);
 425       SCM nv = scm_c_make_vector (len, SCM_UNDEFINED);
 426       for (int i  =0 ; i < len ; i++)
 427         {
 428           SCM si = scm_int2num (i);
 429           scm_vector_set_x (nv, si, ly_deep_copy (scm_vector_ref (src, si)));
 430         }
 431     }
 432   return src;
 433 }
 434
 435
 436
 437
 438 SCM
 439 ly_assoc_chain (SCM key, SCM achain)
 440 {
 441   if (is_pair (achain))
 442     {
 443       SCM handle = scm_assoc (key, ly_car (achain));
 444       if (is_pair (handle))
 445         return handle;
 446       else
 447         return ly_assoc_chain (key, ly_cdr (achain));
 448     }
 449   else
 450     return SCM_BOOL_F;
 451 }
 452
 453 /* looks the key up in the cdrs of the alist-keys
 454    - ignoring the car and ignoring non-pair keys.
 455    Returns first match found, i.e.
 456
 457    alist = ((1 . 10)
 458                    ((1 . 2) . 11)
 459                    ((2 . 1) . 12)
 460                    ((3 . 0) . 13)
 461                    ((4 . 1) . 14) )
 462
 463 I would like (ly_assoc_cdr 1) to return 12 - because it's the first
 464 element with the cdr of the key = 1.  In other words (alloc_cdr key)
 465 corresponds to call
 466
 467 (alloc (anything . key))
 468
 469
 470
 471 */
 472 SCM
 473 ly_assoc_cdr (SCM key, SCM alist)
 474 {
 475   if (is_pair (alist))
 476     {
 477       SCM trykey = ly_caar (alist);
 478       if (is_pair (trykey) && to_boolean (scm_equal_p (key, ly_cdr (trykey))))
 479         return ly_car (alist);
 480       else
 481         return ly_assoc_cdr (key, ly_cdr (alist));
 482     }
 483   return SCM_BOOL_F;
 484 }
 485
 486 /* LST has the form "sym1 sym2 sym3\nsym4\nsym5"
 487    i.e. \n and ' ' can be used interchangeably as separators.  */
 488 SCM
 489 parse_symbol_list (char const *lst)
 490 {
 491   char *s = strdup (lst);
 492   char *orig = s;
 493   SCM create_list = SCM_EOL;
 494
 495   char * e = s + strlen (s) - 1;
 496   while (e >= s && isspace (*e))
 497     *e-- = 0;
 498
 499   for (char * p = s; *p; p++)
 500     if (*p == '\n')
 501       *p = ' ';
 502
 503   if (!s[0])
 504     s = 0;
 505
 506   while (s)
 507     {
 508       char *next = strchr (s, ' ');
 509       if (next)
 510         *next++ = 0;
 511
 512       create_list = scm_cons (ly_symbol2scm (s), create_list);
 513       s = next;
 514     }
 515
 516   free (orig);
 517   return create_list;
 518 }
 519
 520 SCM
 521 ly_truncate_list (int k, SCM lst)
 522 {
 523   if (k == 0)
 524     lst = SCM_EOL;
 525   else
 526     {
 527       SCM s = lst;
 528       k--;
 529       for (; is_pair (s) && k--; s = ly_cdr (s))
 530         ;
 531
 532       if (is_pair (s))
 533         scm_set_cdr_x (s, SCM_EOL);
 534     }
 535   return lst;
 536 }
 537
 538 String
 539 print_scm_val (SCM val)
 540 {
 541   String realval = ly_scm2string (ly_write2scm (val));
 542   if (realval.length () > 200)
 543     realval = realval.left_string (100)
 544       + "\n :\n :\n"
 545       + realval.right_string (100);
 546   return realval;
 547 }
 548
 549 bool
 550 type_check_assignment (SCM sym, SCM val,  SCM type_symbol)
 551 {
 552   bool ok = true;
 553
 554   /*
 555     Always succeeds.
 556
 557
 558     TODO: should remove #f from allowed vals?
 559    */
 560   if (val == SCM_EOL || val == SCM_BOOL_F)
 561     return ok;
 562
 563   if (!is_symbol (sym))
 564 #if 0
 565     return false;
 566 #else
 567   /*
 568     This is used for autoBeamSettings.
 569
 570     TODO: deprecate the use of \override and \revert for
 571     autoBeamSettings?
 572
 573     or use a symbol autoBeamSettingS?
 574    */
 575   return true;
 576 #endif
 577
 578   SCM type = scm_object_property (sym, type_symbol);
 579
 580   if (type != SCM_EOL && !is_procedure (type))
 581       {
 582         warning (_f ("Can't find property type-check for `%s' (%s).",
 583                      ly_symbol2string (sym).to_str0 (),
 584                      ly_symbol2string (type_symbol).to_str0 ())
 585                  + "  " + _ ("Perhaps you made a typing error?"));
 586
 587         /* Be strict when being anal :) */
 588         if (internal_type_checking_global_b)
 589           abort ();
 590
 591         warning (_ ("Doing assignment anyway."));
 592       }
 593   else
 594     {
 595       if (val != SCM_EOL
 596           && is_procedure (type)
 597           && scm_call_1 (type, val) == SCM_BOOL_F)
 598         {
 599           SCM errport = scm_current_error_port ();
 600           ok = false;
 601           SCM typefunc = ly_scheme_function ("type-name");
 602           SCM type_name = scm_call_1 (typefunc, type);
 603
 604
 605           scm_puts (_f ("Type check for `%s' failed; value `%s' must be of type `%s'",
 606                         ly_symbol2string (sym).to_str0 (),
 607                         print_scm_val (val),
 608                         ly_scm2string (type_name).to_str0 ()).to_str0 (),
 609                     errport);
 610           scm_puts ("\n", errport);
 611         }
 612     }
 613   return ok;
 614 }
 615
 616
 617 /* some SCM abbrevs
 618
 619    zijn deze nou handig?
 620    zijn ze er al in scheme, maar heten ze anders? */
 621
 622
 623 /* Remove doubles from (sorted) list */
 624 SCM
 625 ly_unique (SCM list)
 626 {
 627   SCM unique = SCM_EOL;
 628   for (SCM i = list; is_pair (i); i = ly_cdr (i))
 629     {
 630       if (!is_pair (ly_cdr (i))
 631           || !is_equal (ly_car (i), ly_cadr (i)))
 632         unique = scm_cons (ly_car (i), unique);
 633     }
 634   return scm_reverse_x (unique, SCM_EOL);
 635 }
 636
 637
 638 static int
 639 scm_default_compare (void const *a, void const *b)
 640 {
 641   SCM pa = *(SCM*) a;
 642   SCM pb = *(SCM*) b;
 643   if (pa == pb)
 644     return 0;
 645   return pa < pb ? -1 : 1;
 646 }
 647
 648 /*  Modify LST in place: qsort it.  */
 649 SCM
 650 ly_list_qsort_uniq_x (SCM lst)
 651 {
 652   int len = scm_ilength (lst);
 653   SCM *arr = new SCM[len];
 654   int k = 0;
 655   for (SCM s = lst; SCM_NNULLP (s); s = SCM_CDR (s))
 656     arr[k++] = SCM_CAR (s);
 657
 658   assert (k == len);
 659   qsort (arr, len, sizeof (SCM), &scm_default_compare);
 660
 661   SCM *tail = &lst;
 662   for (int i = 0; i < len; i++)
 663     if (!i || arr[i] != arr[i - 1])
 664       {
 665         SCM_SETCAR (*tail, arr[i]);
 666         tail = SCM_CDRLOC (*tail);
 667       }
 668
 669   *tail = SCM_EOL;
 670   delete[] arr;
 671
 672   return lst;
 673 }
 674
 675
 676 /* tail add */
 677 SCM
 678 ly_snoc (SCM s, SCM list)
 679 {
 680   return ly_append2 (list, scm_list_n (s, SCM_UNDEFINED));
 681 }
 682
 683 /* Split list at member s, removing s.
 684    Return (BEFORE . AFTER)  */
 685 SCM
 686 ly_split_list (SCM s, SCM list)
 687 {
 688   SCM before = SCM_EOL;
 689   SCM after = list;
 690   for (; is_pair (after);)
 691     {
 692       SCM i = ly_car (after);
 693       after = ly_cdr (after);
 694       if (is_equal (i, s))
 695         break;
 696       before = scm_cons (i, before);
 697     }
 698   return scm_cons ( scm_reverse_x (before, SCM_EOL),  after);
 699
 700 }
 701
 702
 703 void
 704 taint (SCM *)
 705 {
 706   /*
 707     nop.
 708    */
 709 }
 710
 711 /*
 712   display stuff without using stack
 713  */
 714 SCM
 715 display_list (SCM s)
 716 {
 717   SCM p = scm_current_output_port ();
 718
 719   scm_puts ("(", p);
 720   for (; is_pair (s); s =ly_cdr (s))
 721     {
 722       scm_display (ly_car (s), p);
 723       scm_puts (" ", p);
 724     }
 725   scm_puts (")", p);
 726   return SCM_UNSPECIFIED;
 727 }
 728
 729 Slice
 730 int_list_to_slice (SCM l)
 731 {
 732   Slice s;
 733   s.set_empty ();
 734   for (; is_pair (l); l = ly_cdr (l))
 735     if (is_number (ly_car (l)))
 736       s.add_point (ly_scm2int (ly_car (l)));
 737   return s;
 738 }
 739
 740 /* Return I-th element, or last elt L. If I < 0, then we take the first
 741    element.
 742
 743    PRE: length (L) > 0  */
 744 SCM
 745 robust_list_ref (int i, SCM l)
 746 {
 747   while (i-- > 0 && is_pair (ly_cdr (l)))
 748     l = ly_cdr (l);
 749   return ly_car (l);
 750 }
 751
 752 Real
 753 robust_scm2double (SCM k, double x)
 754 {
 755   if (is_number (k))
 756     x = ly_scm2double (k);
 757   return x;
 758 }
 759
 760 Interval
 761 robust_scm2interval (SCM k, Drul_array<Real> v)
 762 {
 763   Interval i;
 764   i[LEFT]= v[LEFT];
 765   i[RIGHT]= v[RIGHT];
 766   if (is_number_pair (k))
 767     i = ly_scm2interval (k);
 768   return i;
 769 }
 770
 771 Drul_array<Real>
 772 robust_scm2drul (SCM k, Drul_array<Real> v)
 773 {
 774   if (is_number_pair (k))
 775     v = ly_scm2interval (k);
 776   return v;
 777 }
 778
 779 Offset
 780 robust_scm2offset (SCM k, Offset o)
 781 {
 782   if (is_number_pair (k))
 783     o = ly_scm2offset (k);
 784   return o;
 785 }
 786
 787 int
 788 robust_scm2int (SCM k, int o)
 789 {
 790   if (scm_integer_p (k) == SCM_BOOL_T)
 791     o = ly_scm2int (k);
 792   return o;
 793 }
 794
 795 SCM
 796 alist_to_hashq (SCM alist)
 797 {
 798   int i = scm_ilength (alist);
 799   if (i < 0)
 800     return scm_make_vector (scm_int2num (0), SCM_EOL);
 801
 802   SCM tab = scm_make_vector (scm_int2num (i), SCM_EOL);
 803   for (SCM s = alist; is_pair (s); s = ly_cdr (s))
 804     {
 805       SCM pt = ly_cdar (s);
 806       scm_hashq_set_x (tab, ly_caar (s), pt);
 807     }
 808   return tab;
 809 }
 810
 811 #if 1
 812 /*
 813   Debugging mem leaks:
 814  */
 815 LY_DEFINE (ly_protects, "ly:protects", 0, 0, 0, (),
 816           "Return hash of protected objects.")
 817 {
 818   return scm_protects;
 819 }
 820 #endif