lily/parse-scm.cc

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