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