+SCM_SYNTAX (s_letstar, "let*", scm_makmmacro, scm_m_letstar);
+SCM_GLOBAL_SYMBOL (scm_sym_letstar, s_letstar);
+
+/* (let* ((v1 i1) (v2 i2) ...) body) with variables v1 .. vk and initializers
+ * i1 .. ik is transformed into the form (#@let* (v1 i1 v2 i2 ...) body*). */
+SCM
+scm_m_letstar (SCM xorig, SCM env SCM_UNUSED)
+{
+ SCM bindings;
+ SCM x = SCM_CDR (xorig);
+ SCM vars = SCM_EOL;
+ SCM *varloc = &vars;
+
+ SCM_ASSYNT (SCM_CONSP (x), scm_s_bindings, s_letstar);
+
+ bindings = SCM_CAR (x);
+ SCM_ASSYNT (scm_ilength (bindings) >= 0, scm_s_bindings, s_letstar);
+ while (!SCM_NULLP (bindings))
+ {
+ SCM binding = SCM_CAR (bindings);
+ SCM_ASSYNT (scm_ilength (binding) == 2, scm_s_bindings, s_letstar);
+ SCM_ASSYNT (SCM_SYMBOLP (SCM_CAR (binding)), scm_s_variable, s_letstar);
+ *varloc = scm_list_2 (SCM_CAR (binding), SCM_CADR (binding));
+ varloc = SCM_CDRLOC (SCM_CDR (*varloc));
+ bindings = SCM_CDR (bindings);
+ }
+
+ return scm_cons2 (SCM_IM_LETSTAR, vars,
+ scm_m_body (SCM_IM_LETSTAR, SCM_CDR (x), s_letstar));
+}
+
+
+SCM_SYNTAX(s_letrec, "letrec", scm_makmmacro, scm_m_letrec);
+SCM_GLOBAL_SYMBOL(scm_sym_letrec, s_letrec);
+
+SCM
+scm_m_letrec (SCM xorig, SCM env)
+{
+ SCM x = SCM_CDR (xorig);
+ SCM_ASSYNT (SCM_CONSP (x), scm_s_bindings, s_letrec);
+
+ if (SCM_NULLP (SCM_CAR (x)))
+ {
+ /* null binding, let* faster */
+ SCM body = scm_m_body (SCM_IM_LETREC, SCM_CDR (x), s_letrec);
+ return scm_m_letstar (scm_cons2 (SCM_CAR (xorig), SCM_EOL, body), env);
+ }
+ else
+ {
+ SCM rvars, inits, body;
+ transform_bindings (SCM_CAR (x), &rvars, &inits, "letrec");
+ body = scm_m_body (SCM_IM_LETREC, SCM_CDR (x), "letrec");
+ return scm_cons2 (SCM_IM_LETREC, rvars, scm_cons (inits, body));
+ }
+}
+
+
+SCM_SYNTAX (s_or, "or", scm_makmmacro, scm_m_or);
+SCM_GLOBAL_SYMBOL (scm_sym_or, s_or);
+
+SCM
+scm_m_or (SCM xorig, SCM env SCM_UNUSED)
+{
+ long len = scm_ilength (SCM_CDR (xorig));
+ SCM_ASSYNT (len >= 0, scm_s_test, s_or);
+ if (len >= 1)
+ return scm_cons (SCM_IM_OR, SCM_CDR (xorig));
+ else
+ return SCM_BOOL_F;
+}
+
+
+SCM_SYNTAX (s_quasiquote, "quasiquote", scm_makacro, scm_m_quasiquote);
+SCM_GLOBAL_SYMBOL (scm_sym_quasiquote, s_quasiquote);
+
+/* Internal function to handle a quasiquotation: 'form' is the parameter in
+ * the call (quasiquotation form), 'env' is the environment where unquoted
+ * expressions will be evaluated, and 'depth' is the current quasiquotation
+ * nesting level and is known to be greater than zero. */
+static SCM
+iqq (SCM form, SCM env, unsigned long int depth)
+{
+ if (SCM_CONSP (form))
+ {
+ SCM tmp = SCM_CAR (form);
+ if (SCM_EQ_P (tmp, scm_sym_quasiquote))
+ {
+ SCM args = SCM_CDR (form);
+ SCM_ASSYNT (scm_ilength (args) == 1, scm_s_expression, s_quasiquote);
+ return scm_list_2 (tmp, iqq (SCM_CAR (args), env, depth + 1));
+ }
+ else if (SCM_EQ_P (tmp, scm_sym_unquote))
+ {
+ SCM args = SCM_CDR (form);
+ SCM_ASSYNT (scm_ilength (args) == 1, scm_s_expression, s_quasiquote);
+ if (depth - 1 == 0)
+ return scm_eval_car (args, env);
+ else
+ return scm_list_2 (tmp, iqq (SCM_CAR (args), env, depth - 1));
+ }
+ else if (SCM_CONSP (tmp)
+ && SCM_EQ_P (SCM_CAR (tmp), scm_sym_uq_splicing))
+ {
+ SCM args = SCM_CDR (tmp);
+ SCM_ASSYNT (scm_ilength (args) == 1, scm_s_expression, s_quasiquote);
+ if (depth - 1 == 0)
+ {
+ SCM list = scm_eval_car (args, env);
+ SCM rest = SCM_CDR (form);
+ SCM_ASSYNT (scm_ilength (list) >= 0, s_splicing, s_quasiquote);
+ return scm_append (scm_list_2 (list, iqq (rest, env, depth)));
+ }
+ else
+ return scm_cons (iqq (SCM_CAR (form), env, depth - 1),
+ iqq (SCM_CDR (form), env, depth));
+ }
+ else
+ return scm_cons (iqq (SCM_CAR (form), env, depth),
+ iqq (SCM_CDR (form), env, depth));
+ }
+ else if (SCM_VECTORP (form))
+ {
+ size_t i = SCM_VECTOR_LENGTH (form);
+ SCM const *const data = SCM_VELTS (form);
+ SCM tmp = SCM_EOL;
+ while (i != 0)
+ tmp = scm_cons (data[--i], tmp);
+ scm_remember_upto_here_1 (form);
+ return scm_vector (iqq (tmp, env, depth));
+ }
+ else
+ return form;
+}
+
+SCM
+scm_m_quasiquote (SCM xorig, SCM env)
+{
+ SCM x = SCM_CDR (xorig);
+ SCM_ASSYNT (scm_ilength (x) == 1, scm_s_expression, s_quasiquote);
+ return iqq (SCM_CAR (x), env, 1);
+}
+
+
+SCM_SYNTAX (s_quote, "quote", scm_makmmacro, scm_m_quote);
+SCM_GLOBAL_SYMBOL (scm_sym_quote, s_quote);
+
+SCM
+scm_m_quote (SCM xorig, SCM env SCM_UNUSED)
+{
+ SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, scm_s_expression, s_quote);
+ return scm_cons (SCM_IM_QUOTE, SCM_CDR (xorig));
+}
+
+
+/* Will go into the RnRS module when Guile is factorized.
+SCM_SYNTAX (s_set_x, "set!", scm_makmmacro, scm_m_set_x); */
+static const char s_set_x[] = "set!";
+SCM_GLOBAL_SYMBOL (scm_sym_set_x, s_set_x);
+
+SCM
+scm_m_set_x (SCM xorig, SCM env SCM_UNUSED)
+{
+ SCM x = SCM_CDR (xorig);
+ SCM_ASSYNT (scm_ilength (x) == 2, scm_s_expression, s_set_x);
+ SCM_ASSYNT (SCM_SYMBOLP (SCM_CAR (x)), scm_s_variable, s_set_x);
+ return scm_cons (SCM_IM_SET_X, x);
+}
+
+
+/* Start of the memoizers for non-R5RS builtin macros. */
+
+
+SCM_SYNTAX (s_atapply, "@apply", scm_makmmacro, scm_m_apply);