/[guile]/guile/guile-core/libguile/read.c
ViewVC logotype

Diff of /guile/guile-core/libguile/read.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.81 by xxhanwen, Sat Jul 20 14:08:34 2002 UTC revision 1.82 by hanwen, Sun Aug 4 23:33:28 2002 UTC
# Line 75  scm_t_option scm_read_opts[] = { Line 75  scm_t_option scm_read_opts[] = {
75      "Style of keyword recognition: #f or 'prefix."}      "Style of keyword recognition: #f or 'prefix."}
76  };  };
77    
78    /*
79      Give meaningful error messages for errors
80    
81      We use the format
82    
83      MESSAGE
84      This happened in ....
85    
86      This is not standard GNU format, but the test-suite likes the real
87      message to be in front.
88    
89      Hmmm.
90    
91      Maybe this is a kludge? Perhaps we should throw (list EXPR FILENAME
92      LINENO COLUMNO), and have the exception handler sort out the error
93      message?Where does the handler live, what are the conventions for
94      the expression argument of the handler? How does this work for an
95      error message like
96    
97    Backtrace:
98    In standard input:
99       4: 0* [list ...
100    
101    standard input:4:1: While evaluating arguments to list in expression (list a b):standard input:4:1: Unbound variable: a
102    ABORT: (unbound-variable)
103    
104    
105    
106      In any case, we would have to assemble that information anyway.
107     */
108    
109    
110    #if 0
111    
112    #ifndef HAVE_SNPRINTF
113    #define snprintf  sprintf
114    /*
115      should warn about buffer overflow?
116     */
117    #endif
118    
119    #define  INPUT_ERROR(port, message, arg) {                                                                      \
120          char s[1024];\
121          int fn_found =  SCM_STRINGP (SCM_FILENAME(port));\
122          char *fn = "";\
123          if (fn_found)\
124             fn = SCM_STRING_CHARS(SCM_FILENAME(port));\
125          snprintf (s, 1024, "%s\nThis happened in %s%s%s line %d column %d", message, \
126                    fn_found ? "`" : "", \
127                    fn,\
128                    fn_found ? "'" : "", \
129                   SCM_LINUM(port) + 1, SCM_COL(port) + 1);                 \
130          SCM_MISC_ERROR(s, arg);                                                                                   \
131        }
132    #else
133    #define  INPUT_ERROR(port, message, arg) SCM_MISC_ERROR(message, arg)
134    #endif
135    
136    
137  SCM_DEFINE (scm_read_options, "read-options-interface", 0, 1, 0,  SCM_DEFINE (scm_read_options, "read-options-interface", 0, 1, 0,
138              (SCM setting),              (SCM setting),
139              "Option interface for the read options. Instead of using\n"              "Option interface for the read options. Instead of using\n"
# Line 300  scm_lreadr (SCM *tok_buf, SCM port, SCM Line 359  scm_lreadr (SCM *tok_buf, SCM port, SCM
359          ? scm_lreadrecparen (tok_buf, port, s_list, copy)          ? scm_lreadrecparen (tok_buf, port, s_list, copy)
360          : scm_lreadparen (tok_buf, port, s_list, copy);          : scm_lreadparen (tok_buf, port, s_list, copy);
361      case ')':      case ')':
362        SCM_MISC_ERROR ("unexpected \")\"", SCM_EOL);        INPUT_ERROR(port,"unexpected \")\"", SCM_EOL);
363        goto tryagain;        goto tryagain;
364            
365      case '\'':      case '\'':
# Line 430  scm_lreadr (SCM *tok_buf, SCM port, SCM Line 489  scm_lreadr (SCM *tok_buf, SCM port, SCM
489              if (scm_charnames[c]              if (scm_charnames[c]
490                  && (scm_casei_streq (scm_charnames[c], SCM_STRING_CHARS (*tok_buf))))                  && (scm_casei_streq (scm_charnames[c], SCM_STRING_CHARS (*tok_buf))))
491                return SCM_MAKE_CHAR (scm_charnums[c]);                return SCM_MAKE_CHAR (scm_charnums[c]);
492            SCM_MISC_ERROR ("unknown # object", SCM_EOL);            INPUT_ERROR (port, "unknown # object", SCM_EOL);
493    
494            /* #:SYMBOL is a syntax for keywords supported in all contexts.  */            /* #:SYMBOL is a syntax for keywords supported in all contexts.  */
495          case ':':          case ':':
# Line 460  scm_lreadr (SCM *tok_buf, SCM port, SCM Line 519  scm_lreadr (SCM *tok_buf, SCM port, SCM
519                }                }
520            }            }
521          unkshrp:          unkshrp:
522          scm_misc_error (s_scm_read, "Unknown # object: ~S",          INPUT_ERROR (port, "Unknown # object: ~S",
523                          scm_list_1 (SCM_MAKE_CHAR (c)));                       scm_list_1 (SCM_MAKE_CHAR (c)));
524          }          }
525    
526      case '"':      case '"':
# Line 469  scm_lreadr (SCM *tok_buf, SCM port, SCM Line 528  scm_lreadr (SCM *tok_buf, SCM port, SCM
528        while ('"' != (c = scm_getc (port)))        while ('"' != (c = scm_getc (port)))
529          {          {
530            if (c == EOF)            if (c == EOF)
531              SCM_MISC_ERROR ("end of file in string constant", SCM_EOL);              INPUT_ERROR (port, "end of file in string constant", SCM_EOL);
532    
533            while (j + 2 >= SCM_STRING_LENGTH (*tok_buf))            while (j + 2 >= SCM_STRING_LENGTH (*tok_buf))
534              scm_grow_tok_buf (tok_buf);              scm_grow_tok_buf (tok_buf);
# Line 531  scm_lreadr (SCM *tok_buf, SCM port, SCM Line 590  scm_lreadr (SCM *tok_buf, SCM port, SCM
590                c = SCM_STRING_CHARS (*tok_buf)[1];                c = SCM_STRING_CHARS (*tok_buf)[1];
591                goto callshrp;                goto callshrp;
592              }              }
593            SCM_MISC_ERROR ("unknown # object", SCM_EOL);            INPUT_ERROR (port, "unknown # object", SCM_EOL);
594          }          }
595        goto tok;        goto tok;
596    
# Line 662  scm_lreadparen (SCM *tok_buf, SCM port, Line 721  scm_lreadparen (SCM *tok_buf, SCM port,
721        ans = scm_lreadr (tok_buf, port, copy);        ans = scm_lreadr (tok_buf, port, copy);
722      closeit:      closeit:
723        if (')' != (c = scm_flush_ws (port, name)))        if (')' != (c = scm_flush_ws (port, name)))
724          SCM_MISC_ERROR ("missing close paren", SCM_EOL);          INPUT_ERROR (port, "missing close paren", SCM_EOL);
725        return ans;        return ans;
726      }      }
727    ans = tl = scm_cons (tmp, SCM_EOL);    ans = tl = scm_cons (tmp, SCM_EOL);
# Line 702  scm_lreadrecparen (SCM *tok_buf, SCM por Line 761  scm_lreadrecparen (SCM *tok_buf, SCM por
761      {      {
762        ans = scm_lreadr (tok_buf, port, copy);        ans = scm_lreadr (tok_buf, port, copy);
763        if (')' != (c = scm_flush_ws (port, name)))        if (')' != (c = scm_flush_ws (port, name)))
764          SCM_MISC_ERROR ("missing close paren", SCM_EOL);          INPUT_ERROR (port, "missing close paren", SCM_EOL);
765        return ans;        return ans;
766      }      }
767    /* Build the head of the list structure. */    /* Build the head of the list structure. */
# Line 726  scm_lreadrecparen (SCM *tok_buf, SCM por Line 785  scm_lreadrecparen (SCM *tok_buf, SCM por
785                                         : tmp,                                         : tmp,
786                                         SCM_EOL));                                         SCM_EOL));
787            if (')' != (c = scm_flush_ws (port, name)))            if (')' != (c = scm_flush_ws (port, name)))
788              SCM_MISC_ERROR ("missing close paren", SCM_EOL);              INPUT_ERROR (port, "missing close paren", SCM_EOL);
789            goto exit;            goto exit;
790          }          }
791    

Legend:
Removed from v.1.81  
changed lines
  Added in v.1.82

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26