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" |
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. |
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 |
|
|