lily/parse-scm.cc

   1 #include <stdio.h>
   2
   3 #include "ly-module.hh"
   4 #include "lily-guile.hh"
   5 #include "parse-scm.hh"
   6 #include "string.hh"
   7 #include "source-file.hh"
   8
   9 /* Pass string to scm parser, evaluate one expression.
  10    Return result value and #chars read.
  11
  12    Thanks to Gary Houston <ghouston@freewire.co.uk>  */
  13 SCM
  14 internal_ly_parse_scm (Parse_start * ps, bool safe)
  15 {
  16   Source_file* sf =ps->start_location_.source_file_;
  17   SCM port = sf->get_port ();
  18
  19   int off = ps->start_location_.defined_str0_ - sf->to_str0();
  20
  21   scm_seek (port, scm_long2num (off), scm_long2num (SEEK_SET));
  22   SCM from = scm_ftell (port);
  23
  24   SCM form;
  25   SCM answer = SCM_UNSPECIFIED;
  26
  27   /* Read expression from port */
  28   if (!SCM_EOF_OBJECT_P (form = scm_read (port)))
  29     {
  30       if (safe)
  31         {
  32           static SCM safe_module;
  33           if (!safe_module)
  34             {
  35               safe_module = scm_primitive_eval (ly_symbol2scm ("safe-module"));
  36               if (output_format_global == PAGE_LAYOUT)
  37                 ly_import_module (safe_module, scm_c_resolve_module ("lily"));
  38             }
  39           answer = scm_eval (form, safe_module);
  40         }
  41       else
  42         answer = scm_primitive_eval (form);
  43     }
  44
  45   /* Reset read_buf for scm_ftell.
  46      Shouldn't scm_read () do this for us?  */
  47   scm_fill_input (port);
  48   SCM to = scm_ftell (port);
  49   ps->nchars = gh_scm2int (to) - gh_scm2int (from);
  50
  51   /* Don't close the port here; if we re-enter this function via a
  52      continuation, then the next time we enter it, we'll get an error.
  53      It's a string port anyway, so there's no advantage to closing it
  54      early. */
  55   // scm_close_port (port);
  56
  57   return answer;
  58 }
  59
  60 SCM
  61 catch_protected_parse_body (void *p)
  62 {
  63   Parse_start *ps = (Parse_start*) p;
  64   return internal_ly_parse_scm (ps, false);
  65 }
  66
  67 SCM
  68 safe_catch_protected_parse_body (void *p)
  69 {
  70   Parse_start *ps = (Parse_start*) p;
  71   return internal_ly_parse_scm (ps, true);
  72 }
  73
  74 SCM
  75 parse_handler (void * data, SCM tag, SCM args)
  76 {
  77   Parse_start* ps = (Parse_start*) data;
  78
  79   ps->start_location_.error (_("GUILE signaled an error for the expression beginning here"));
  80
  81   if (scm_ilength (args) > 2)
  82     scm_display_error_message (gh_cadr (args), gh_caddr (args), scm_current_error_port ());
  83
  84   /*
  85     The following is a kludge; we should probably search for
  86     [a-z][0-9] (a note), and start before that.
  87    */
  88   ps->nchars = 1;
  89
  90   return SCM_UNDEFINED;
  91 }
  92
  93 /*
  94   Do some magical incantations: if not, lily will exit on the first
  95   GUILE error, leaving no location trace.
  96  */
  97
  98
  99 #if GUILE_MINOR_VERSION < 7
 100   #define READ_ERROR "misc-error"
 101   #else
 102   #define READ_ERROR "read-error"
 103 #endif
 104
 105 SCM
 106 protected_ly_parse_scm (Parse_start *ps, bool safe)
 107 {
 108   return scm_internal_catch (ly_symbol2scm (READ_ERROR),
 109                              (safe ? &safe_catch_protected_parse_body
 110                               : catch_protected_parse_body),
 111                              (void*)ps,
 112                              &parse_handler, (void*)ps);
 113 }
 114
 115 bool  parse_protect_global  = true;
 116
 117 /*
 118   Try parsing. If failure, then return SCM_UNDEFINED.
 119  */
 120 SCM
 121 ly_parse_scm (char const* s, int *n, Input i, bool safe)
 122 {
 123
 124   Parse_start ps ;
 125   ps.str = s;
 126   ps.start_location_ = i;
 127
 128   SCM ans = parse_protect_global ? protected_ly_parse_scm (&ps, safe)
 129     : internal_ly_parse_scm (&ps, safe);
 130   *n = ps.nchars;
 131
 132   return ans;
 133 }
 134