lily/parse-scm.cc

   1
   2 #include "lily-guile.hh"
   3 #include "parse-scm.hh"
   4 #include "string.hh"
   5
   6
   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
  13   Need guile-1.3.4 (>1.3 anyway) for ftell on str ports -- jcn
  14 */
  15 SCM
  16 internal_ly_parse_scm (Parse_start * ps)
  17 {
  18   /*
  19
  20     This is actually pretty wasteful: we stuff the rest of the entire
  21     file down GUILE, while we usually need only a bit of it.
  22
  23     TODO: implement read_only_string_port(), (preferably in GUILE ?)
  24
  25    */
  26   SCM str = scm_makfrom0str (ps->str);
  27   SCM port = scm_mkstrport (SCM_INUM0, str, SCM_OPN | SCM_RDNG,
  28                             "ly_eval_scm_0str");
  29
  30   scm_set_port_filename_x (port, scm_makfrom0str (ps->start_location.file_string ().get_str0()));
  31   scm_set_port_line_x (port,  gh_int2scm (ps->start_location.line_number ()));
  32   scm_set_port_column_x (port,  gh_int2scm (ps->start_location.column_number()));
  33
  34   SCM from = scm_ftell (port);
  35
  36   SCM form;
  37   SCM answer = SCM_UNSPECIFIED;
  38
  39   /* Read expression from port */
  40   if (!SCM_EOF_OBJECT_P (form = scm_read (port)))
  41     answer = scm_primitive_eval (form);
  42
  43   /*
  44    After parsing
  45
  46  (begin (foo 1 2))
  47
  48    all seems fine, but after parsing
  49
  50  (foo 1 2)
  51
  52    read_buf has been advanced to read_pos - 1,
  53    so that scm_ftell returns 1, instead of #parsed chars
  54    */
  55
  56   /*
  57     urg: reset read_buf for scm_ftell
  58     shouldn't scm_read () do this for us?
  59   */
  60   scm_fill_input (port);
  61   SCM to = scm_ftell (port);
  62   ps->nchars = gh_scm2int (to) - gh_scm2int (from);
  63
  64   /* Don't close the port here; if we re-enter this function via a
  65      continuation, then the next time we enter it, we'll get an error.
  66      It's a string port anyway, so there's no advantage to closing it
  67      early.
  68
  69      scm_close_port (port);
  70   */
  71
  72   return answer;
  73 }
  74
  75
  76 SCM
  77 catch_protected_parse_body (void *p)
  78 {
  79   Parse_start *ps = (Parse_start*) p;
  80   return internal_ly_parse_scm (ps);
  81 }
  82
  83 SCM
  84 parse_handler (void * data, SCM tag, SCM args)
  85 {
  86   Parse_start* ps = (Parse_start*) data;
  87
  88   ps->start_location.error (_("GUILE signaled an error for the expression begining here"));
  89
  90   if (scm_ilength (args) > 2)
  91     scm_display_error_message (gh_cadr (args), gh_caddr(args), scm_current_error_port());
  92
  93   /*
  94     The following is a kludge; we should probably search for
  95     [a-z][0-9] (a note), and start before that.
  96    */
  97   ps->nchars = 1;
  98
  99   return SCM_EOL;
 100 }
 101
 102 /*
 103   Do some magical incantations: if not, lily will exit on the first
 104   GUILE error, leaving no location trace.
 105  */
 106
 107
 108 #if GUILE_MINOR_VERSION < 7
 109   #define READ_ERROR "misc-error"
 110   #else
 111   #define READ_ERROR "read-error"
 112 #endif
 113
 114 SCM
 115 protected_ly_parse_scm (Parse_start *ps)
 116 {
 117   return scm_internal_catch (ly_symbol2scm (READ_ERROR),
 118                              &catch_protected_parse_body,
 119                              (void*)ps,
 120                              &parse_handler, (void*)ps);
 121
 122 }
 123
 124
 125 SCM
 126 ly_parse_scm (char const* s, int *n, Input i)
 127 {
 128   Parse_start ps ;
 129   ps.str = s;
 130   ps.start_location = i;
 131
 132   SCM ans = protected_ly_parse_scm (&ps);
 133   *n = ps.nchars;
 134   return ans;
 135 }
 136