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

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

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

revision 1.319 by dirk, Thu Sep 18 20:55:40 2003 UTC revision 1.320 by dirk, Fri Oct 10 21:49:27 2003 UTC
# Line 60  char *alloca (); Line 60  char *alloca ();
60  #include "libguile/eq.h"  #include "libguile/eq.h"
61  #include "libguile/continuations.h"  #include "libguile/continuations.h"
62  #include "libguile/futures.h"  #include "libguile/futures.h"
63    #include "libguile/strings.h"
64  #include "libguile/throw.h"  #include "libguile/throw.h"
65  #include "libguile/smob.h"  #include "libguile/smob.h"
66  #include "libguile/macros.h"  #include "libguile/macros.h"
# Line 85  char *alloca (); Line 86  char *alloca ();
86    
87    
88    
89    /* {Syntax Errors}
90     *
91     * This section defines the message strings for the syntax errors that can be
92     * detected during memoization and the functions and macros that shall be
93     * called by the memoizer code to signal syntax errors.  */
94    
95    
96    /* Syntax errors that can be detected during memoization: */
97    
98    /* Circular or improper lists do not form valid scheme expressions.  If a
99     * circular list or an improper list is detected in a place where a scheme
100     * expression is expected, a 'Bad expression' error is signalled.  */
101    static const char s_bad_expression[] = "Bad expression";
102    
103    
104    /* Signal a syntax error.  We distinguish between the form that caused the
105     * error and the enclosing expression.  The error message will print out as
106     * shown in the following pattern.  The file name and line number are only
107     * given when they can be determined from the erroneous form or from the
108     * enclosing expression.
109     *
110     * <filename>: In procedure memoization:
111     * <filename>: In file <name>, line <nr>: <error-message> in <expression>.  */
112    
113    SCM_SYMBOL (syntax_error_key, "syntax-error");
114    
115    /* The prototype is needed to indicate that the function does not return.  */
116    static void
117    syntax_error (const char* const, const SCM, const SCM) SCM_NORETURN;
118    
119    static void
120    syntax_error (const char* const msg, const SCM form, const SCM expr)
121    {
122      const SCM msg_string = scm_makfrom0str (msg);
123      SCM filename = SCM_BOOL_F;
124      SCM linenr = SCM_BOOL_F;
125      const char *format;
126      SCM args;
127    
128      if (SCM_CONSP (form))
129        {
130          filename = scm_source_property (form, scm_sym_filename);
131          linenr = scm_source_property (form, scm_sym_line);
132        }
133    
134      if (SCM_FALSEP (filename) && SCM_FALSEP (linenr) && SCM_CONSP (expr))
135        {
136          filename = scm_source_property (expr, scm_sym_filename);
137          linenr = scm_source_property (expr, scm_sym_line);
138        }
139    
140      if (!SCM_UNBNDP (expr))
141        {
142          if (!SCM_FALSEP (filename))
143            {
144              format = "In file ~S, line ~S: ~A ~S in expression ~S.";
145              args = scm_list_5 (filename, linenr, msg_string, form, expr);
146            }
147          else if (!SCM_FALSEP (linenr))
148            {
149              format = "In line ~S: ~A ~S in expression ~S.";
150              args = scm_list_4 (linenr, msg_string, form, expr);
151            }
152          else
153            {
154              format = "~A ~S in expression ~S.";
155              args = scm_list_3 (msg_string, form, expr);
156            }
157        }
158      else
159        {
160          if (!SCM_FALSEP (filename))
161            {
162              format = "In file ~S, line ~S: ~A ~S.";
163              args = scm_list_4 (filename, linenr, msg_string, form);
164            }
165          else if (!SCM_FALSEP (linenr))
166            {
167              format = "In line ~S: ~A ~S.";
168              args = scm_list_3 (linenr, msg_string, form);
169            }
170          else
171            {
172              format = "~A ~S.";
173              args = scm_list_2 (msg_string, form);
174            }
175        }
176    
177      scm_error (syntax_error_key, "memoization", format, args, SCM_BOOL_F);
178    }
179    
180    
181    /* Shortcut macros to simplify syntax error handling. */
182    #define ASSERT_SYNTAX(cond, message, form) \
183      { if (!(cond)) syntax_error (message, form, SCM_UNDEFINED); }
184    #define ASSERT_SYNTAX_2(cond, message, form, expr) \
185      { if (!(cond)) syntax_error (message, form, expr); }
186    
187    
188    
189  /* {Ilocs}  /* {Ilocs}
190   *   *
191   * Ilocs are memoized references to variables in local environment frames.   * Ilocs are memoized references to variables in local environment frames.
# Line 528  SCM_SYNTAX (s_and, "and", scm_i_makbimac Line 629  SCM_SYNTAX (s_and, "and", scm_i_makbimac
629  SCM_GLOBAL_SYMBOL (scm_sym_and, s_and);  SCM_GLOBAL_SYMBOL (scm_sym_and, s_and);
630    
631  SCM  SCM
632  scm_m_and (SCM xorig, SCM env SCM_UNUSED)  scm_m_and (SCM expr, SCM env SCM_UNUSED)
633  {  {
634    long len = scm_ilength (SCM_CDR (xorig));    const SCM cdr_expr = SCM_CDR (expr);
635    SCM_ASSYNT (len >= 0, s_test, s_and);    const long length = scm_ilength (cdr_expr);
636    if (len >= 1)  
637      return scm_cons (SCM_IM_AND, SCM_CDR (xorig));    ASSERT_SYNTAX (length >= 0, s_bad_expression, expr);
638    
639      if (length == 0)
640        {
641          /* Special case:  (and) is replaced by #t. */
642          return SCM_BOOL_T;
643        }
644    else    else
645      return SCM_BOOL_T;      {
646          SCM_SETCAR (expr, SCM_IM_AND);
647          return expr;
648        }
649  }  }
650    
651    

Legend:
Removed from v.1.319  
changed lines
  Added in v.1.320

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