Evaluator cleanup

Evaluator cleanup

[Ludovic Courtès]

Hi,

I have a patch that further "despaghettifies" the evaluator, as Han-Wen
would say.  ;-)  It adds two files, `eval-memoize.i.c' and
`eval-unmemoize.i.c', and moves memoizers in the former and unmemoizers
in the latter.  Thus, the functions that end up in these files are:

  * `eval-memoize.i.c'

    c_improper_memq, canonicalize_define, memoize_as_thunk_prototype,
    m_body, m_expand_body, scm_m_begin, scm_m_case, scm_m_cond,
    scm_m_define, scm_m_delay, scm_m_future, scm_m_do, scm_m_if,
    scm_m_lambda, check_bindings, transform_bindings, memoize_named_let,
    scm_m_let, scm_m_letrec, scm_m_letstar, scm_m_and, scm_m_or, iqq,
    scm_m_quasiquote, scm_m_quote, scm_m_set_x, scm_m_apply,
    scm_m_atbind, scm_m_cont, scm_m_at_call_with_values,
    scm_m_generalized_set_x, scm_m_atslot_ref, scm_m_atslot_set_x,
    scm_m_nil_cond, scm_m_atfop, scm_m_expand_body, scm_m_undefine,
    scm_macroexp

  * `eval-unmemoize.i.c'

    unmemoize_expression, unmemoize_exprs, unmemoize_and,
    unmemoize_begin, unmemoize_case, unmemoize_cond, unmemoize_delay,
    unmemoize_do, unmemoize_if, unmemoize_lambda, build_binding_list,
    unmemoize_let, unmemoize_letrec, unmemoize_letstar, unmemoize_or,
    unmemoize_quote, unmemoize_set_x, unmemoize_apply,
    unmemoize_atcall_cc, unmemoize_at_call_with_values,
    unmemoize_future, unmemoize_atslot_ref, unmemoize_atslot_set_x,
    unmemoize_builtin_macro, scm_i_unmemocopy_expr,
    scm_i_unmemocopy_body, scm_unmemocar

It does nothing beside this, so it should be harmless.  Ok to commit?

Thanks,
Ludovic.



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Evaluator cleanup

[Neil Jerram]

ludo@chbouib.org (Ludovic Courtès) writes:

> Hi,
>
> I have a patch that further "despaghettifies" the evaluator, as Han-Wen
> would say.  ;-)

Can you say more about how your change despaghettifies the code?  I
can see that it makes eval.c shorter - but what else?

>  It adds two files, `eval-memoize.i.c' and
> `eval-unmemoize.i.c',

Do these need to be .i.c - i.e. implying that they need to be
#included?  Can't they be normal .c files?

> and moves memoizers in the former and unmemoizers
> in the latter.

I assume the memoizer and the unmemoizer for a particular kind of
expression need to be consistent with each other - is that right?  If
so, it seems to me that putting them in separate files might increase
the likelihood of future mistakes.

Regards,
     Neil



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Evaluator cleanup

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 1267 bytes --]

Hi,

Neil Jerram <neil@ossau.uklinux.net> writes:

> Can you say more about how your change despaghettifies the code?  I
> can see that it makes eval.c shorter - but what else?

That's it.  :-)  It make `eval.c' clearer IMO ("only" 2000 lines!) by
logically separating the various pieces: the `SCM_SYNTAX' declarations
(that remain in `eval.c'), the memoizers and unmemoizers.  I've attached
the patch against `eval.c' for reference.

>>  It adds two files, `eval-memoize.i.c' and
>> `eval-unmemoize.i.c',
>
> Do these need to be .i.c - i.e. implying that they need to be
> #included?  Can't they be normal .c files?

No, because some of them are `static' (all the `unmemoize_' functions
for instance) and should remain so, and some could be subject to
inlining.

> I assume the memoizer and the unmemoizer for a particular kind of
> expression need to be consistent with each other - is that right?

Right.

> If so, it seems to me that putting them in separate files might
> increase the likelihood of future mistakes.

Not sure about this.  The alternative would be to keep both in a single
file, but that would lead to a long file with mixed
memoizing/unmemoizing logic, and with a load of helper functions for
both.  Would that be preferable?

Thanks,
Ludovic.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: The patch --]
[-- Type: text/x-patch, Size: 67652 bytes --]

--- orig/libguile/Makefile.am
+++ mod/libguile/Makefile.am
@@ -228,7 +228,8 @@
     cpp_errno.c cpp_err_symbols.in cpp_err_symbols.c		\
     cpp_sig_symbols.c cpp_sig_symbols.in cpp_cnvt.awk	\
     c-tokenize.lex version.h.in \
-    scmconfig.h.top libgettext.h
+    scmconfig.h.top libgettext.h \
+    eval.i.c eval-memoize.i.c eval-unmemoize.i.c
 #    $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES) \
 #    guile-procedures.txt guile.texi
 


--- orig/libguile/eval.c
+++ mod/libguile/eval.c
@@ -1,6 +1,6 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006
- * Free Software Foundation, Inc.
- * 
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,
+ *               2006,2007 Free Software Foundation, Inc.
+ *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
  * License as published by the Free Software Foundation; either
@@ -88,7 +88,6 @@
 
 
 static SCM unmemoize_exprs (SCM expr, SCM env);
-static SCM canonicalize_define (SCM expr);
 static SCM *scm_lookupcar1 (SCM vloc, SCM genv, int check);
 static SCM unmemoize_builtin_macro (SCM expr, SCM env);
 static void ceval_letrec_inits (SCM env, SCM init_forms, SCM **init_values_eol);
@@ -535,115 +534,6 @@
 
 SCM_SYMBOL (sym_three_question_marks, "???");
 
-static SCM
-unmemoize_expression (const SCM expr, const SCM env)
-{
-  if (SCM_ILOCP (expr))
-    {
-      SCM frame_idx;
-      unsigned long int frame_nr;
-      SCM symbol_idx;
-      unsigned long int symbol_nr;
-
-      for (frame_idx = env, frame_nr = SCM_IFRAME (expr);
-           frame_nr != 0; 
-           frame_idx = SCM_CDR (frame_idx), --frame_nr)
-        ;
-      for (symbol_idx = SCM_CAAR (frame_idx), symbol_nr = SCM_IDIST (expr);
-           symbol_nr != 0;
-           symbol_idx = SCM_CDR (symbol_idx), --symbol_nr)
-        ;
-      return SCM_ICDRP (expr) ? symbol_idx : SCM_CAR (symbol_idx);
-    }
-  else if (SCM_VARIABLEP (expr))
-    {
-      const SCM sym = scm_module_reverse_lookup (scm_env_module (env), expr);
-      return scm_is_true (sym) ? sym : sym_three_question_marks;
-    }
-  else if (scm_is_simple_vector (expr))
-    {
-      return scm_list_2 (scm_sym_quote, expr);
-    }
-  else if (!scm_is_pair (expr))
-    {
-      return expr;
-    }
-  else if (SCM_ISYMP (SCM_CAR (expr)))
-    {
-      return unmemoize_builtin_macro (expr, env);
-    }
-  else
-    {
-      return unmemoize_exprs (expr, env);
-    }
-}
-
-
-static SCM
-unmemoize_exprs (const SCM exprs, const SCM env)
-{
-  SCM r_result = SCM_EOL;
-  SCM expr_idx = exprs;
-  SCM um_expr;
-
-  /* Note that due to the current lazy memoizer we may find partially memoized
-   * code during execution.  In such code we have to expect improper lists of
-   * expressions: On the one hand, for such code syntax checks have not yet
-   * fully been performed, on the other hand, there may be even legal code
-   * like '(a . b) appear as an improper list of expressions as long as the
-   * quote expression is still in its unmemoized form.  For this reason, the
-   * following code handles improper lists of expressions until memoization
-   * and execution have been completely separated.  */
-  for (; scm_is_pair (expr_idx); expr_idx = SCM_CDR (expr_idx))
-    {
-      const SCM expr = SCM_CAR (expr_idx);
-
-      /* In partially memoized code, lists of expressions that stem from a
-       * body form may start with an ISYM if the body itself has not yet been
-       * memoized.  This isym is just an internal marker to indicate that the
-       * body still needs to be memoized.  An isym may occur at the very
-       * beginning of the body or after one or more comment strings.  It is
-       * dropped during unmemoization.  */
-      if (!SCM_ISYMP (expr))
-        {
-          um_expr = unmemoize_expression (expr, env);
-          r_result = scm_cons (um_expr, r_result);
-        }
-    }
-  um_expr = unmemoize_expression (expr_idx, env);
-  if (!scm_is_null (r_result))
-    {
-      const SCM result = scm_reverse_x (r_result, SCM_UNDEFINED);
-      SCM_SETCDR (r_result, um_expr);
-      return result;
-    }
-  else
-    {
-      return um_expr;
-    }
-}
-
-
-/* Rewrite the body (which is given as the list of expressions forming the
- * body) into its internal form.  The internal form of a body (<expr> ...) is
- * just the body itself, but prefixed with an ISYM that denotes to what kind
- * of outer construct this body belongs: (<ISYM> <expr> ...).  A lambda body
- * starts with SCM_IM_LAMBDA, for example, a body of a let starts with
- * SCM_IM_LET, etc.
- *
- * It is assumed that the calling expression has already made sure that the
- * body is a proper list.  */
-static SCM
-m_body (SCM op, SCM exprs)
-{
-  /* Don't add another ISYM if one is present already. */
-  if (SCM_ISYMP (SCM_CAR (exprs)))
-    return exprs;
-  else
-    return scm_cons (op, exprs);
-}
-
-
 /* The function m_expand_body memoizes a proper list of expressions forming a
  * body.  This function takes care of dealing with internal defines and
  * transforming them into an equivalent letrec expression.  The list of
@@ -720,127 +610,6 @@
   return 0;
 }
 
-static void
-m_expand_body (const SCM forms, const SCM env)
-{
-  /* The first body form can be skipped since it is known to be the ISYM that
-   * was prepended to the body by m_body.  */
-  SCM cdr_forms = SCM_CDR (forms);
-  SCM form_idx = cdr_forms;
-  SCM definitions = SCM_EOL;
-  SCM sequence = SCM_EOL;
-
-  /* According to R5RS, the list of body forms consists of two parts: a number
-   * (maybe zero) of definitions, followed by a non-empty sequence of
-   * expressions.  Each the definitions and the expressions may be grouped
-   * arbitrarily with begin, but it is not allowed to mix definitions and
-   * expressions.  The task of the following loop therefore is to split the
-   * list of body forms into the list of definitions and the sequence of
-   * expressions.  */ 
-  while (!scm_is_null (form_idx))
-    {
-      const SCM form = SCM_CAR (form_idx);
-      const SCM new_form = expand_user_macros (form, env);
-      if (is_system_macro_p (scm_sym_define, new_form, env))
-	{
-	  definitions = scm_cons (new_form, definitions);
-	  form_idx = SCM_CDR (form_idx);
-	}
-      else if (is_system_macro_p (scm_sym_begin, new_form, env))
-	{
-          /* We have encountered a group of forms.  This has to be either a
-           * (possibly empty) group of (possibly further grouped) definitions,
-           * or a non-empty group of (possibly further grouped)
-           * expressions.  */
-          const SCM grouped_forms = SCM_CDR (new_form);
-          unsigned int found_definition = 0;
-          unsigned int found_expression = 0;
-          SCM grouped_form_idx = grouped_forms;
-          while (!found_expression && !scm_is_null (grouped_form_idx))
-            {
-              const SCM inner_form = SCM_CAR (grouped_form_idx);
-              const SCM new_inner_form = expand_user_macros (inner_form, env);
-              if (is_system_macro_p (scm_sym_define, new_inner_form, env))
-                {
-                  found_definition = 1;
-                  definitions = scm_cons (new_inner_form, definitions);
-                  grouped_form_idx = SCM_CDR (grouped_form_idx);
-                }
-              else if (is_system_macro_p (scm_sym_begin, new_inner_form, env))
-                {
-                  const SCM inner_group = SCM_CDR (new_inner_form);
-                  grouped_form_idx
-                    = scm_append (scm_list_2 (inner_group,
-                                              SCM_CDR (grouped_form_idx)));
-                }
-              else
-                {
-                  /* The group marks the start of the expressions of the body.
-                   * We have to make sure that within the same group we have
-                   * not encountered a definition before.  */
-                  ASSERT_SYNTAX (!found_definition, s_mixed_body_forms, form);
-                  found_expression = 1;
-                  grouped_form_idx = SCM_EOL;
-                }
-            }
-
-          /* We have finished processing the group.  If we have not yet
-           * encountered an expression we continue processing the forms of the
-           * body to collect further definition forms.  Otherwise, the group
-           * marks the start of the sequence of expressions of the body.  */
-          if (!found_expression)
-            {
-              form_idx = SCM_CDR (form_idx);
-            }
-          else
-            {
-              sequence = form_idx;
-              form_idx = SCM_EOL;
-            }
-	}
-      else
-	{
-          /* We have detected a form which is no definition.  This marks the
-           * start of the sequence of expressions of the body.  */
-          sequence = form_idx;
-          form_idx = SCM_EOL;
-	}
-    }
-
-  /* FIXME: forms does not hold information about the file location.  */
-  ASSERT_SYNTAX (scm_is_pair (sequence), s_missing_body_expression, cdr_forms);
-
-  if (!scm_is_null (definitions))
-    {
-      SCM definition_idx;
-      SCM letrec_tail;
-      SCM letrec_expression;
-      SCM new_letrec_expression;
-
-      SCM bindings = SCM_EOL;
-      for (definition_idx = definitions;
-           !scm_is_null (definition_idx);
-           definition_idx = SCM_CDR (definition_idx))
-	{
-	  const SCM definition = SCM_CAR (definition_idx);
-	  const SCM canonical_definition = canonicalize_define (definition);
-	  const SCM binding = SCM_CDR (canonical_definition);
-	  bindings = scm_cons (binding, bindings);
-	};
-
-      letrec_tail = scm_cons (bindings, sequence);
-      /* FIXME: forms does not hold information about the file location.  */
-      letrec_expression = scm_cons_source (forms, scm_sym_letrec, letrec_tail);
-      new_letrec_expression = scm_m_letrec (letrec_expression, env);
-      SCM_SETCAR (forms, new_letrec_expression);
-      SCM_SETCDR (forms, SCM_EOL);
-    }
-  else
-    {
-      SCM_SETCAR (forms, SCM_CAR (sequence));
-      SCM_SETCDR (forms, SCM_CDR (sequence));
-    }
-}
 
 static SCM
 macroexp (SCM x, SCM env)
@@ -896,1652 +665,131 @@
   goto macro_tail;
 }
 
-/* Start of the memoizers for the standard R5RS builtin macros.  */
-
+\f
+/* Standard R5RS built-in macros.  */
 
 SCM_SYNTAX (s_and, "and", scm_i_makbimacro, scm_m_and);
 SCM_GLOBAL_SYMBOL (scm_sym_and, s_and);
 
-SCM
-scm_m_and (SCM expr, SCM env SCM_UNUSED)
-{
-  const SCM cdr_expr = SCM_CDR (expr);
-  const long length = scm_ilength (cdr_expr);
-
-  ASSERT_SYNTAX (length >= 0, s_bad_expression, expr);
-
-  if (length == 0)
-    {
-      /* Special case:  (and) is replaced by #t. */
-      return SCM_BOOL_T;
-    }
-  else
-    {
-      SCM_SETCAR (expr, SCM_IM_AND);
-      return expr;
-    }
-}
-
-static SCM
-unmemoize_and (const SCM expr, const SCM env)
-{
-  return scm_cons (scm_sym_and, unmemoize_exprs (SCM_CDR (expr), env));
-}
-
-
 SCM_SYNTAX (s_begin, "begin", scm_i_makbimacro, scm_m_begin);
 SCM_GLOBAL_SYMBOL (scm_sym_begin, s_begin);
 
-SCM
-scm_m_begin (SCM expr, SCM env SCM_UNUSED)
-{
-  const SCM cdr_expr = SCM_CDR (expr);
-  /* Dirk:FIXME:: An empty begin clause is not generally allowed by R5RS.
-   * That means, there should be a distinction between uses of begin where an
-   * empty clause is OK and where it is not.  */
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-
-  SCM_SETCAR (expr, SCM_IM_BEGIN);
-  return expr;
-}
-
-static SCM
-unmemoize_begin (const SCM expr, const SCM env)
-{
-  return scm_cons (scm_sym_begin, unmemoize_exprs (SCM_CDR (expr), env));
-}
-
-
 SCM_SYNTAX (s_case, "case", scm_i_makbimacro, scm_m_case);
 SCM_GLOBAL_SYMBOL (scm_sym_case, s_case);
 SCM_GLOBAL_SYMBOL (scm_sym_else, "else");
 
-SCM
-scm_m_case (SCM expr, SCM env)
-{
-  SCM clauses;
-  SCM all_labels = SCM_EOL;
-
-  /* Check, whether 'else is a literal, i. e. not bound to a value. */
-  const int else_literal_p = literal_p (scm_sym_else, env);
-
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 2, s_missing_clauses, expr);
-
-  clauses = SCM_CDR (cdr_expr);
-  while (!scm_is_null (clauses))
-    {
-      SCM labels;
-
-      const SCM clause = SCM_CAR (clauses);
-      ASSERT_SYNTAX_2 (scm_ilength (clause) >= 2, 
-		       s_bad_case_clause, clause, expr);
-
-      labels = SCM_CAR (clause);
-      if (scm_is_pair (labels))
-        {
-          ASSERT_SYNTAX_2 (scm_ilength (labels) >= 0,
-                           s_bad_case_labels, labels, expr);
-          all_labels = scm_append (scm_list_2 (labels, all_labels));
-        }
-      else if (scm_is_null (labels))
-        {
-          /* The list of labels is empty.  According to R5RS this is allowed.
-           * It means that the sequence of expressions will never be executed.
-           * Therefore, as an optimization, we could remove the whole
-           * clause.  */
-        }
-      else
-        {
-          ASSERT_SYNTAX_2 (scm_is_eq (labels, scm_sym_else) && else_literal_p,
-                           s_bad_case_labels, labels, expr);
-          ASSERT_SYNTAX_2 (scm_is_null (SCM_CDR (clauses)),
-                           s_misplaced_else_clause, clause, expr);
-        }
-
-      /* build the new clause */
-      if (scm_is_eq (labels, scm_sym_else))
-        SCM_SETCAR (clause, SCM_IM_ELSE);
-
-      clauses = SCM_CDR (clauses);
-    }
-
-  /* Check whether all case labels are distinct. */
-  for (; !scm_is_null (all_labels); all_labels = SCM_CDR (all_labels))
-    {
-      const SCM label = SCM_CAR (all_labels);
-      ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (label, SCM_CDR (all_labels))),
-                       s_duplicate_case_label, label, expr);
-    }
-
-  SCM_SETCAR (expr, SCM_IM_CASE);
-  return expr;
-}
-
-static SCM
-unmemoize_case (const SCM expr, const SCM env)
-{
-  const SCM um_key_expr = unmemoize_expression (SCM_CADR (expr), env);
-  SCM um_clauses = SCM_EOL;
-  SCM clause_idx;
-
-  for (clause_idx = SCM_CDDR (expr);
-       !scm_is_null (clause_idx);
-       clause_idx = SCM_CDR (clause_idx))
-    {
-      const SCM clause = SCM_CAR (clause_idx);
-      const SCM labels = SCM_CAR (clause);
-      const SCM exprs = SCM_CDR (clause);
-
-      const SCM um_exprs = unmemoize_exprs (exprs, env);
-      const SCM um_labels = (scm_is_eq (labels, SCM_IM_ELSE))
-        ? scm_sym_else
-        : scm_i_finite_list_copy (labels);
-      const SCM um_clause = scm_cons (um_labels, um_exprs);
+SCM_SYNTAX (s_cond, "cond", scm_i_makbimacro, scm_m_cond);
+SCM_GLOBAL_SYMBOL (scm_sym_cond, s_cond);
+SCM_GLOBAL_SYMBOL (scm_sym_arrow, "=>");
 
-      um_clauses = scm_cons (um_clause, um_clauses);
-    }
-  um_clauses = scm_reverse_x (um_clauses, SCM_UNDEFINED);
+SCM_SYNTAX (s_define, "define", scm_i_makbimacro, scm_m_define);
+SCM_GLOBAL_SYMBOL (scm_sym_define, s_define);
 
-  return scm_cons2 (scm_sym_case, um_key_expr, um_clauses);
-}
+SCM_SYNTAX (s_delay, "delay", scm_i_makbimacro, scm_m_delay);
+SCM_GLOBAL_SYMBOL (scm_sym_delay, s_delay);
 
+SCM_SYNTAX(s_do, "do", scm_i_makbimacro, scm_m_do);
+SCM_GLOBAL_SYMBOL(scm_sym_do, s_do);
 
-SCM_SYNTAX (s_cond, "cond", scm_i_makbimacro, scm_m_cond);
-SCM_GLOBAL_SYMBOL (scm_sym_cond, s_cond);
-SCM_GLOBAL_SYMBOL (scm_sym_arrow, "=>");
+SCM_SYNTAX (s_if, "if", scm_i_makbimacro, scm_m_if);
+SCM_GLOBAL_SYMBOL (scm_sym_if, s_if);
 
-SCM
-scm_m_cond (SCM expr, SCM env)
-{
-  /* Check, whether 'else or '=> is a literal, i. e. not bound to a value. */
-  const int else_literal_p = literal_p (scm_sym_else, env);
-  const int arrow_literal_p = literal_p (scm_sym_arrow, env);
+SCM_SYNTAX (s_lambda, "lambda", scm_i_makbimacro, scm_m_lambda);
+SCM_GLOBAL_SYMBOL (scm_sym_lambda, s_lambda);
 
-  const SCM clauses = SCM_CDR (expr);
-  SCM clause_idx;
+SCM_SYNTAX(s_let, "let", scm_i_makbimacro, scm_m_let);
+SCM_GLOBAL_SYMBOL(scm_sym_let, s_let);
 
-  ASSERT_SYNTAX (scm_ilength (clauses) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (clauses) >= 1, s_missing_clauses, expr);
+SCM_SYNTAX(s_letrec, "letrec", scm_i_makbimacro, scm_m_letrec);
+SCM_GLOBAL_SYMBOL(scm_sym_letrec, s_letrec);
 
-  for (clause_idx = clauses;
-       !scm_is_null (clause_idx);
-       clause_idx = SCM_CDR (clause_idx))
-    {
-      SCM test;
+SCM_SYNTAX (s_letstar, "let*", scm_i_makbimacro, scm_m_letstar);
+SCM_GLOBAL_SYMBOL (scm_sym_letstar, s_letstar);
 
-      const SCM clause = SCM_CAR (clause_idx);
-      const long length = scm_ilength (clause);
-      ASSERT_SYNTAX_2 (length >= 1, s_bad_cond_clause, clause, expr);
+SCM_SYNTAX (s_or, "or", scm_i_makbimacro, scm_m_or);
+SCM_GLOBAL_SYMBOL (scm_sym_or, s_or);
 
-      test = SCM_CAR (clause);
-      if (scm_is_eq (test, scm_sym_else) && else_literal_p)
-	{
-	  const int last_clause_p = scm_is_null (SCM_CDR (clause_idx));
-          ASSERT_SYNTAX_2 (length >= 2,
-                           s_bad_cond_clause, clause, expr);
-          ASSERT_SYNTAX_2 (last_clause_p,
-                           s_misplaced_else_clause, clause, expr);
-          SCM_SETCAR (clause, SCM_IM_ELSE);
-	}
-      else if (length >= 2
-               && scm_is_eq (SCM_CADR (clause), scm_sym_arrow)
-               && arrow_literal_p)
-        {
-          ASSERT_SYNTAX_2 (length > 2, s_missing_recipient, clause, expr);
-          ASSERT_SYNTAX_2 (length == 3, s_extra_expression, clause, expr);
-          SCM_SETCAR (SCM_CDR (clause), SCM_IM_ARROW);
-	}
-      /* SRFI 61 extended cond */
-      else if (length >= 3
-	       && scm_is_eq (SCM_CADDR (clause), scm_sym_arrow)
-	       && arrow_literal_p)
-	{
-	  ASSERT_SYNTAX_2 (length > 3, s_missing_recipient, clause, expr);
-	  ASSERT_SYNTAX_2 (length == 4, s_extra_expression, clause, expr);
-	  SCM_SETCAR (SCM_CDDR (clause), SCM_IM_ARROW);
-	}
-    }
+SCM_SYNTAX (s_quasiquote, "quasiquote", scm_makacro, scm_m_quasiquote);
+SCM_GLOBAL_SYMBOL (scm_sym_quasiquote, s_quasiquote);
+SCM_GLOBAL_SYMBOL (scm_sym_unquote, "unquote");
+SCM_GLOBAL_SYMBOL (scm_sym_uq_splicing, "unquote-splicing");
 
-  SCM_SETCAR (expr, SCM_IM_COND);
-  return expr;
-}
+SCM_SYNTAX (s_quote, "quote", scm_i_makbimacro, scm_m_quote);
+SCM_GLOBAL_SYMBOL (scm_sym_quote, s_quote);
 
-static SCM
-unmemoize_cond (const SCM expr, const SCM env)
-{
-  SCM um_clauses = SCM_EOL;
-  SCM clause_idx;
 
-  for (clause_idx = SCM_CDR (expr);
-       !scm_is_null (clause_idx);
-       clause_idx = SCM_CDR (clause_idx))
-    {
-      const SCM clause = SCM_CAR (clause_idx);
-      const SCM sequence = SCM_CDR (clause);
-      const SCM test = SCM_CAR (clause);
-      SCM um_test;
-      SCM um_sequence;
-      SCM um_clause;
+/* Will go into the RnRS module when Guile is factorized.
+SCM_SYNTAX (s_set_x, "set!", scm_i_makbimacro, scm_m_set_x); */
+static const char s_set_x[] = "set!";
+SCM_GLOBAL_SYMBOL (scm_sym_set_x, s_set_x);
 
-      if (scm_is_eq (test, SCM_IM_ELSE))
-        um_test = scm_sym_else;
-      else
-        um_test = unmemoize_expression (test, env);
+\f
+/* Non-R5RS built-in macros.  */
 
-      if (!scm_is_null (sequence) && scm_is_eq (SCM_CAR (sequence),
-					      SCM_IM_ARROW))
-        {
-          const SCM target = SCM_CADR (sequence);
-          const SCM um_target = unmemoize_expression (target, env);
-          um_sequence = scm_list_2 (scm_sym_arrow, um_target);
-        }
-      else
-        {
-          um_sequence = unmemoize_exprs (sequence, env);
-        }
+SCM_SYNTAX (s_atapply, "@apply", scm_i_makbimacro, scm_m_apply);
+SCM_GLOBAL_SYMBOL (scm_sym_atapply, s_atapply);
+SCM_GLOBAL_SYMBOL (scm_sym_apply, s_atapply + 1);
 
-      um_clause = scm_cons (um_test, um_sequence);
-      um_clauses = scm_cons (um_clause, um_clauses);
-    }
-  um_clauses = scm_reverse_x (um_clauses, SCM_UNDEFINED);
+SCM_SYNTAX (s_atbind, "@bind", scm_i_makbimacro, scm_m_atbind);
 
-  return scm_cons (scm_sym_cond, um_clauses);
-}
+SCM_SYNTAX(s_atcall_cc, "@call-with-current-continuation", scm_i_makbimacro, scm_m_cont);
+SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc, s_atcall_cc);
 
+SCM_SYNTAX (s_at_call_with_values, "@call-with-values", scm_i_makbimacro, scm_m_at_call_with_values);
+SCM_GLOBAL_SYMBOL(scm_sym_at_call_with_values, s_at_call_with_values);
 
-SCM_SYNTAX (s_define, "define", scm_i_makbimacro, scm_m_define);
-SCM_GLOBAL_SYMBOL (scm_sym_define, s_define);
+#if 0
 
-/* Guile provides an extension to R5RS' define syntax to represent function
- * currying in a compact way.  With this extension, it is allowed to write
- * (define <nested-variable> <body>), where <nested-variable> has of one of
- * the forms (<nested-variable> <formals>), (<nested-variable> . <formal>),  
- * (<variable> <formals>) or (<variable> . <formal>).  As in R5RS, <formals>
- * should be either a sequence of zero or more variables, or a sequence of one
- * or more variables followed by a space-delimited period and another
- * variable.  Each level of argument nesting wraps the <body> within another
- * lambda expression.  For example, the following forms are allowed, each one
- * followed by an equivalent, more explicit implementation.
- * Example 1:
- *   (define ((a b . c) . d) <body>)  is equivalent to
- *   (define a (lambda (b . c) (lambda d <body>)))
- * Example 2:
- *   (define (((a) b) c . d) <body>)  is equivalent to
- *   (define a (lambda () (lambda (b) (lambda (c . d) <body>))))
+/* See futures.h for a comment why futures are not enabled.
  */
-/* Dirk:FIXME:: We should provide an implementation for 'define' in the R5RS
- * module that does not implement this extension.  */
-static SCM
-canonicalize_define (const SCM expr)
-{
-  SCM body;
-  SCM variable;
 
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 2, s_missing_expression, expr);
-
-  body = SCM_CDR (cdr_expr);
-  variable = SCM_CAR (cdr_expr);
-  while (scm_is_pair (variable))
-    {
-      /* This while loop realizes function currying by variable nesting.
-       * Variable is known to be a nested-variable.  In every iteration of the
-       * loop another level of lambda expression is created, starting with the
-       * innermost one.  Note that we don't check for duplicate formals here:
-       * This will be done by the memoizer of the lambda expression.  */
-      const SCM formals = SCM_CDR (variable);
-      const SCM tail = scm_cons (formals, body);
-
-      /* Add source properties to each new lambda expression:  */
-      const SCM lambda = scm_cons_source (variable, scm_sym_lambda, tail);
+SCM_SYNTAX (s_future, "future", scm_i_makbimacro, scm_m_future);
+SCM_GLOBAL_SYMBOL (scm_sym_future, s_future);
 
-      body = scm_list_1 (lambda);
-      variable = SCM_CAR (variable);
-    }
-  ASSERT_SYNTAX_2 (scm_is_symbol (variable), s_bad_variable, variable, expr);
-  ASSERT_SYNTAX (scm_ilength (body) == 1, s_expression, expr);
+#endif
 
-  SCM_SETCAR (cdr_expr, variable);
-  SCM_SETCDR (cdr_expr, body);
-  return expr;
-}
+SCM_SYNTAX (s_gset_x, "set!", scm_i_makbimacro, scm_m_generalized_set_x);
+SCM_SYMBOL (scm_sym_setter, "setter");
 
-/* According to section 5.2.1 of R5RS we first have to make sure that the
- * variable is bound, and then perform the (set! variable expression)
- * operation.  This means, that within the expression we may already assign
- * values to variable: (define foo (begin (set! foo 1) (+ foo 1)))  */
-SCM
-scm_m_define (SCM expr, SCM env)
-{
-  ASSERT_SYNTAX (SCM_TOP_LEVEL (env), s_bad_define, expr);
 
-  {
-    const SCM canonical_definition = canonicalize_define (expr);
-    const SCM cdr_canonical_definition = SCM_CDR (canonical_definition);
-    const SCM variable = SCM_CAR (cdr_canonical_definition);
-    const SCM location
-      = scm_sym2var (variable, scm_env_top_level (env), SCM_BOOL_T);
-    const SCM value = scm_eval_car (SCM_CDR (cdr_canonical_definition), env);
+/* @slot-ref is bound privately in the (oop goops) module from goops.c.  As
+ * soon as the module system allows us to more freely create bindings in
+ * arbitrary modules during the startup phase, the code from goops.c should be
+ * moved here.  */
+SCM_SYMBOL (sym_atslot_ref, "@slot-ref");
 
-    if (SCM_REC_PROCNAMES_P)
-      {
-        SCM tmp = value;
-        while (SCM_MACROP (tmp))
-          tmp = SCM_MACRO_CODE (tmp);
-        if (scm_is_true (scm_procedure_p (tmp))
-            /* Only the first definition determines the name. */
-            && scm_is_false (scm_procedure_property (tmp, scm_sym_name)))
-          scm_set_procedure_property_x (tmp, scm_sym_name, variable);
-      }
 
-    SCM_VARIABLE_SET (location, value);
+/* @slot-set! is bound privately in the (oop goops) module from goops.c.  As
+ * soon as the module system allows us to more freely create bindings in
+ * arbitrary modules during the startup phase, the code from goops.c should be
+ * moved here.  */
+SCM_SYMBOL (sym_atslot_set_x, "@slot-set!");
 
-    return SCM_UNSPECIFIED;
-  }
-}
 
+#if SCM_ENABLE_ELISP
 
-/* This is a helper function for forms (<keyword> <expression>) that are
- * transformed into (#@<keyword> '() <memoized_expression>) in order to allow
- * for easy creation of a thunk (i. e. a closure without arguments) using the
- * ('() <memoized_expression>) tail of the memoized form.  */
-static SCM
-memoize_as_thunk_prototype (const SCM expr, const SCM env SCM_UNUSED)
-{
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) == 1, s_expression, expr);
+static const char s_defun[] = "Symbol's function definition is void";
 
-  SCM_SETCDR (expr, scm_cons (SCM_EOL, cdr_expr));
+SCM_SYNTAX (s_nil_cond, "nil-cond", scm_i_makbimacro, scm_m_nil_cond);
+SCM_SYNTAX (s_atfop, "@fop", scm_i_makbimacro, scm_m_atfop);
 
-  return expr;
-}
+#endif /* SCM_ENABLE_ELISP */
 
+#if (SCM_ENABLE_DEPRECATED == 1)
 
-SCM_SYNTAX (s_delay, "delay", scm_i_makbimacro, scm_m_delay);
-SCM_GLOBAL_SYMBOL (scm_sym_delay, s_delay);
+SCM_SYNTAX (s_undefine, "undefine", scm_makacro, scm_m_undefine);
 
-/* Promises are implemented as closures with an empty parameter list.  Thus,
- * (delay <expression>) is transformed into (#@delay '() <expression>), where
- * the empty list represents the empty parameter list.  This representation
- * allows for easy creation of the closure during evaluation.  */
-SCM
-scm_m_delay (SCM expr, SCM env)
-{
-  const SCM new_expr = memoize_as_thunk_prototype (expr, env);
-  SCM_SETCAR (new_expr, SCM_IM_DELAY);
-  return new_expr;
-}
+#endif
 
-static SCM
-unmemoize_delay (const SCM expr, const SCM env)
-{
-  const SCM thunk_expr = SCM_CADDR (expr);
-  return scm_list_2 (scm_sym_delay, unmemoize_expression (thunk_expr, env));
-}
 
+\f
+/* Memoizers and unmemoizers of the built-in macros.  */
 
-SCM_SYNTAX(s_do, "do", scm_i_makbimacro, scm_m_do);
-SCM_GLOBAL_SYMBOL(scm_sym_do, s_do);
+#include "eval-memoize.i.c"
+#include "eval-unmemoize.i.c"
 
-/* DO gets the most radically altered syntax.  The order of the vars is
- * reversed here.  During the evaluation this allows for simple consing of the
- * results of the inits and steps:
-
-   (do ((<var1> <init1> <step1>)
-        (<var2> <init2>)
-        ... )
-       (<test> <return>)
-     <body>)
-
-   ;; becomes
-
-   (#@do (<init1> <init2> ... <initn>)
-         (varn ... var2 var1)
-         (<test> <return>)
-         (<body>)
-     <step1> <step2> ... <stepn>) ;; missing steps replaced by var
- */
-SCM 
-scm_m_do (SCM expr, SCM env SCM_UNUSED)
-{
-  SCM variables = SCM_EOL;
-  SCM init_forms = SCM_EOL;
-  SCM step_forms = SCM_EOL;
-  SCM binding_idx;
-  SCM cddr_expr;
-  SCM exit_clause;
-  SCM commands;
-  SCM tail;
-
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 2, s_missing_expression, expr);
-
-  /* Collect variables, init and step forms. */
-  binding_idx = SCM_CAR (cdr_expr);
-  ASSERT_SYNTAX_2 (scm_ilength (binding_idx) >= 0,
-                   s_bad_bindings, binding_idx, expr);
-  for (; !scm_is_null (binding_idx); binding_idx = SCM_CDR (binding_idx))
-    {
-      const SCM binding = SCM_CAR (binding_idx);
-      const long length = scm_ilength (binding);
-      ASSERT_SYNTAX_2 (length == 2 || length == 3,
-                       s_bad_binding, binding, expr);
-
-      {
-        const SCM name = SCM_CAR (binding);
-        const SCM init = SCM_CADR (binding);
-        const SCM step = (length == 2) ? name : SCM_CADDR (binding);
-        ASSERT_SYNTAX_2 (scm_is_symbol (name), s_bad_variable, name, expr);
-        ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (name, variables)),
-                         s_duplicate_binding, name, expr);
-
-        variables = scm_cons (name, variables);
-        init_forms = scm_cons (init, init_forms);
-        step_forms = scm_cons (step, step_forms);
-      }
-    }
-  init_forms = scm_reverse_x (init_forms, SCM_UNDEFINED);
-  step_forms = scm_reverse_x (step_forms, SCM_UNDEFINED);
-
-  /* Memoize the test form and the exit sequence. */
-  cddr_expr = SCM_CDR (cdr_expr);
-  exit_clause = SCM_CAR (cddr_expr);
-  ASSERT_SYNTAX_2 (scm_ilength (exit_clause) >= 1,
-                   s_bad_exit_clause, exit_clause, expr);
-
-  commands = SCM_CDR (cddr_expr);
-  tail = scm_cons2 (exit_clause, commands, step_forms);
-  tail = scm_cons2 (init_forms, variables, tail);
-  SCM_SETCAR (expr, SCM_IM_DO);
-  SCM_SETCDR (expr, tail);
-  return expr;
-}
-
-static SCM
-unmemoize_do (const SCM expr, const SCM env)
-{
-  const SCM cdr_expr = SCM_CDR (expr);
-  const SCM cddr_expr = SCM_CDR (cdr_expr);
-  const SCM rnames = SCM_CAR (cddr_expr);
-  const SCM extended_env = SCM_EXTEND_ENV (rnames, SCM_EOL, env);
-  const SCM cdddr_expr = SCM_CDR (cddr_expr);
-  const SCM exit_sequence = SCM_CAR (cdddr_expr);
-  const SCM um_exit_sequence = unmemoize_exprs (exit_sequence, extended_env);
-  const SCM cddddr_expr = SCM_CDR (cdddr_expr);
-  const SCM um_body = unmemoize_exprs (SCM_CAR (cddddr_expr), extended_env);
-
-  /* build transformed binding list */
-  SCM um_names = scm_reverse (rnames);
-  SCM um_inits = unmemoize_exprs (SCM_CAR (cdr_expr), env);
-  SCM um_steps = unmemoize_exprs (SCM_CDR (cddddr_expr), extended_env);
-  SCM um_bindings = SCM_EOL;
-  while (!scm_is_null (um_names))
-    {
-      const SCM name = SCM_CAR (um_names);
-      const SCM init = SCM_CAR (um_inits);
-      SCM step = SCM_CAR (um_steps);
-      step = scm_is_eq (step, name) ? SCM_EOL : scm_list_1 (step);
-
-      um_bindings = scm_cons (scm_cons2 (name, init, step), um_bindings);
-
-      um_names = SCM_CDR (um_names);
-      um_inits = SCM_CDR (um_inits);
-      um_steps = SCM_CDR (um_steps);
-    }
-  um_bindings = scm_reverse_x (um_bindings, SCM_UNDEFINED);
-
-  return scm_cons (scm_sym_do,
-                   scm_cons2 (um_bindings, um_exit_sequence, um_body));
-}
-
-
-SCM_SYNTAX (s_if, "if", scm_i_makbimacro, scm_m_if);
-SCM_GLOBAL_SYMBOL (scm_sym_if, s_if);
-
-SCM
-scm_m_if (SCM expr, SCM env SCM_UNUSED)
-{
-  const SCM cdr_expr = SCM_CDR (expr);
-  const long length = scm_ilength (cdr_expr);
-  ASSERT_SYNTAX (length == 2 || length == 3, s_expression, expr);
-  SCM_SETCAR (expr, SCM_IM_IF);
-  return expr;
-}
-
-static SCM
-unmemoize_if (const SCM expr, const SCM env)
-{
-  const SCM cdr_expr = SCM_CDR (expr);
-  const SCM um_condition = unmemoize_expression (SCM_CAR (cdr_expr), env);
-  const SCM cddr_expr = SCM_CDR (cdr_expr);
-  const SCM um_then = unmemoize_expression (SCM_CAR (cddr_expr), env);
-  const SCM cdddr_expr = SCM_CDR (cddr_expr);
-
-  if (scm_is_null (cdddr_expr))
-    {
-      return scm_list_3 (scm_sym_if, um_condition, um_then);
-    }
-  else
-    {
-      const SCM um_else = unmemoize_expression (SCM_CAR (cdddr_expr), env);
-      return scm_list_4 (scm_sym_if, um_condition, um_then, um_else);
-    }
-}
-
-
-SCM_SYNTAX (s_lambda, "lambda", scm_i_makbimacro, scm_m_lambda);
-SCM_GLOBAL_SYMBOL (scm_sym_lambda, s_lambda);
-
-/* A helper function for memoize_lambda to support checking for duplicate
- * formal arguments: Return true if OBJ is `eq?' to one of the elements of
- * LIST or to the cdr of the last cons.  Therefore, LIST may have any of the
- * forms that a formal argument can have:
- *   <rest>, (<arg1> ...), (<arg1> ...  .  <rest>) */
-static int
-c_improper_memq (SCM obj, SCM list)
-{
-  for (; scm_is_pair (list); list = SCM_CDR (list))
-    {
-      if (scm_is_eq (SCM_CAR (list), obj))
-        return 1;
-    }
-  return scm_is_eq (list, obj);
-}
-
-SCM
-scm_m_lambda (SCM expr, SCM env SCM_UNUSED)
-{
-  SCM formals;
-  SCM formals_idx;
-  SCM cddr_expr;
-  int documentation;
-  SCM body;
-  SCM new_body;
-
-  const SCM cdr_expr = SCM_CDR (expr);
-  const long length = scm_ilength (cdr_expr);
-  ASSERT_SYNTAX (length >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (length >= 2, s_missing_expression, expr);
-
-  /* Before iterating the list of formal arguments, make sure the formals
-   * actually are given as either a symbol or a non-cyclic list.  */
-  formals = SCM_CAR (cdr_expr);
-  if (scm_is_pair (formals))
-    {
-      /* Dirk:FIXME:: We should check for a cyclic list of formals, and if
-       * detected, report a 'Bad formals' error.  */
-    }
-  else
-    {
-      ASSERT_SYNTAX_2 (scm_is_symbol (formals) || scm_is_null (formals),
-                       s_bad_formals, formals, expr);
-    }
-
-  /* Now iterate the list of formal arguments to check if all formals are
-   * symbols, and that there are no duplicates.  */
-  formals_idx = formals;
-  while (scm_is_pair (formals_idx))
-    {
-      const SCM formal = SCM_CAR (formals_idx);
-      const SCM next_idx = SCM_CDR (formals_idx);
-      ASSERT_SYNTAX_2 (scm_is_symbol (formal), s_bad_formal, formal, expr);
-      ASSERT_SYNTAX_2 (!c_improper_memq (formal, next_idx),
-                       s_duplicate_formal, formal, expr);
-      formals_idx = next_idx;
-    }
-  ASSERT_SYNTAX_2 (scm_is_null (formals_idx) || scm_is_symbol (formals_idx),
-                   s_bad_formal, formals_idx, expr);
-
-  /* Memoize the body.  Keep a potential documentation string.  */
-  /* Dirk:FIXME:: We should probably extract the documentation string to
-   * some external database.  Otherwise it will slow down execution, since
-   * the documentation string will have to be skipped with every execution
-   * of the closure.  */
-  cddr_expr = SCM_CDR (cdr_expr);
-  documentation = (length >= 3 && scm_is_string (SCM_CAR (cddr_expr)));
-  body = documentation ? SCM_CDR (cddr_expr) : cddr_expr;
-  new_body = m_body (SCM_IM_LAMBDA, body);
-
-  SCM_SETCAR (expr, SCM_IM_LAMBDA);
-  if (documentation)
-    SCM_SETCDR (cddr_expr, new_body);
-  else
-    SCM_SETCDR (cdr_expr, new_body);
-  return expr;
-}
-
-static SCM
-unmemoize_lambda (const SCM expr, const SCM env)
-{
-  const SCM formals = SCM_CADR (expr);
-  const SCM body = SCM_CDDR (expr);
-
-  const SCM new_env = SCM_EXTEND_ENV (formals, SCM_EOL, env);
-  const SCM um_formals = scm_i_finite_list_copy (formals);
-  const SCM um_body = unmemoize_exprs (body, new_env);
-
-  return scm_cons2 (scm_sym_lambda, um_formals, um_body);
-}
-
-
-/* Check if the format of the bindings is ((<symbol> <init-form>) ...).  */
-static void
-check_bindings (const SCM bindings, const SCM expr)
-{
-  SCM binding_idx;
-
-  ASSERT_SYNTAX_2 (scm_ilength (bindings) >= 0,
-                   s_bad_bindings, bindings, expr);
-
-  binding_idx = bindings;
-  for (; !scm_is_null (binding_idx); binding_idx = SCM_CDR (binding_idx))
-    {
-      SCM name;         /* const */
-
-      const SCM binding = SCM_CAR (binding_idx);
-      ASSERT_SYNTAX_2 (scm_ilength (binding) == 2,
-                       s_bad_binding, binding, expr);
-
-      name = SCM_CAR (binding);
-      ASSERT_SYNTAX_2 (scm_is_symbol (name), s_bad_variable, name, expr);
-    }
-}
-
-
-/* The bindings, which must have the format ((v1 i1) (v2 i2) ... (vn in)), are
- * transformed to the lists (vn ... v2 v1) and (i1 i2 ... in).  That is, the
- * variables are returned in a list with their order reversed, and the init
- * forms are returned in a list in the same order as they are given in the
- * bindings.  If a duplicate variable name is detected, an error is
- * signalled.  */
-static void
-transform_bindings (
-  const SCM bindings, const SCM expr,
-  SCM *const rvarptr, SCM *const initptr )
-{
-  SCM rvariables = SCM_EOL;
-  SCM rinits = SCM_EOL;
-  SCM binding_idx = bindings;
-  for (; !scm_is_null (binding_idx); binding_idx = SCM_CDR (binding_idx))
-    {
-      const SCM binding = SCM_CAR (binding_idx);
-      const SCM cdr_binding = SCM_CDR (binding);
-      const SCM name = SCM_CAR (binding);
-      ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (name, rvariables)),
-                       s_duplicate_binding, name, expr);
-      rvariables = scm_cons (name, rvariables);
-      rinits = scm_cons (SCM_CAR (cdr_binding), rinits);
-    }
-  *rvarptr = rvariables;
-  *initptr = scm_reverse_x (rinits, SCM_UNDEFINED);
-}
-
-
-SCM_SYNTAX(s_let, "let", scm_i_makbimacro, scm_m_let);
-SCM_GLOBAL_SYMBOL(scm_sym_let, s_let);
-
-/* This function is a helper function for memoize_let.  It transforms
- * (let name ((var init) ...) body ...) into
- * ((letrec ((name (lambda (var ...) body ...))) name) init ...)
- * and memoizes the expression.  It is assumed that the caller has checked
- * that name is a symbol and that there are bindings and a body.  */
-static SCM
-memoize_named_let (const SCM expr, const SCM env SCM_UNUSED)
-{
-  SCM rvariables;
-  SCM variables;
-  SCM inits;
-
-  const SCM cdr_expr = SCM_CDR (expr);
-  const SCM name = SCM_CAR (cdr_expr);
-  const SCM cddr_expr = SCM_CDR (cdr_expr);
-  const SCM bindings = SCM_CAR (cddr_expr);
-  check_bindings (bindings, expr);
-
-  transform_bindings (bindings, expr, &rvariables, &inits);
-  variables = scm_reverse_x (rvariables, SCM_UNDEFINED);
-
-  {
-    const SCM let_body = SCM_CDR (cddr_expr);
-    const SCM lambda_body = m_body (SCM_IM_LET, let_body);
-    const SCM lambda_tail = scm_cons (variables, lambda_body);
-    const SCM lambda_form = scm_cons_source (expr, scm_sym_lambda, lambda_tail);
-
-    const SCM rvar = scm_list_1 (name);
-    const SCM init = scm_list_1 (lambda_form);
-    const SCM body = m_body (SCM_IM_LET, scm_list_1 (name));
-    const SCM letrec_tail = scm_cons (rvar, scm_cons (init, body));
-    const SCM letrec_form = scm_cons_source (expr, SCM_IM_LETREC, letrec_tail);
-    return scm_cons_source (expr, letrec_form, inits);
-  }
-}
-
-/* (let ((v1 i1) (v2 i2) ...) body) with variables v1 .. vn and initializers
- * i1 .. in is transformed to (#@let (vn ... v2 v1) (i1 i2 ...) body).  */
-SCM
-scm_m_let (SCM expr, SCM env)
-{
-  SCM bindings;
-
-  const SCM cdr_expr = SCM_CDR (expr);
-  const long length = scm_ilength (cdr_expr);
-  ASSERT_SYNTAX (length >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (length >= 2, s_missing_expression, expr);
-
-  bindings = SCM_CAR (cdr_expr);
-  if (scm_is_symbol (bindings))
-    {
-      ASSERT_SYNTAX (length >= 3, s_missing_expression, expr);
-      return memoize_named_let (expr, env);
-    }
-
-  check_bindings (bindings, expr);
-  if (scm_is_null (bindings) || scm_is_null (SCM_CDR (bindings)))
-    {
-      /* Special case: no bindings or single binding => let* is faster. */
-      const SCM body = m_body (SCM_IM_LET, SCM_CDR (cdr_expr));
-      return scm_m_letstar (scm_cons2 (SCM_CAR (expr), bindings, body), env);
-    }
-  else
-    {
-      /* plain let */
-      SCM rvariables;
-      SCM inits;
-      transform_bindings (bindings, expr, &rvariables, &inits);
-
-      {
-        const SCM new_body = m_body (SCM_IM_LET, SCM_CDR (cdr_expr));
-        const SCM new_tail = scm_cons2 (rvariables, inits, new_body);
-        SCM_SETCAR (expr, SCM_IM_LET);
-        SCM_SETCDR (expr, new_tail);
-        return expr;
-      }
-    }
-}
-
-static SCM
-build_binding_list (SCM rnames, SCM rinits)
-{
-  SCM bindings = SCM_EOL;
-  while (!scm_is_null (rnames))
-    {
-      const SCM binding = scm_list_2 (SCM_CAR (rnames), SCM_CAR (rinits));
-      bindings = scm_cons (binding, bindings);
-      rnames = SCM_CDR (rnames);
-      rinits = SCM_CDR (rinits);
-    }
-  return bindings;
-}
-
-static SCM
-unmemoize_let (const SCM expr, const SCM env)
-{
-  const SCM cdr_expr = SCM_CDR (expr);
-  const SCM um_rnames = SCM_CAR (cdr_expr);
-  const SCM extended_env = SCM_EXTEND_ENV (um_rnames, SCM_EOL, env);
-  const SCM cddr_expr = SCM_CDR (cdr_expr);
-  const SCM um_inits = unmemoize_exprs (SCM_CAR (cddr_expr), env);
-  const SCM um_rinits = scm_reverse_x (um_inits, SCM_UNDEFINED);
-  const SCM um_bindings = build_binding_list (um_rnames, um_rinits);
-  const SCM um_body = unmemoize_exprs (SCM_CDR (cddr_expr), extended_env);
-
-  return scm_cons2 (scm_sym_let, um_bindings, um_body);
-}
-
-
-SCM_SYNTAX(s_letrec, "letrec", scm_i_makbimacro, scm_m_letrec);
-SCM_GLOBAL_SYMBOL(scm_sym_letrec, s_letrec);
-
-SCM 
-scm_m_letrec (SCM expr, SCM env)
-{
-  SCM bindings;
-
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 2, s_missing_expression, expr);
-
-  bindings = SCM_CAR (cdr_expr);
-  if (scm_is_null (bindings))
-    {
-      /* no bindings, let* is executed faster */
-      SCM body = m_body (SCM_IM_LETREC, SCM_CDR (cdr_expr));
-      return scm_m_letstar (scm_cons2 (SCM_CAR (expr), SCM_EOL, body), env);
-    }
-  else
-    {
-      SCM rvariables;
-      SCM inits;
-      SCM new_body;
-
-      check_bindings (bindings, expr);
-      transform_bindings (bindings, expr, &rvariables, &inits);
-      new_body = m_body (SCM_IM_LETREC, SCM_CDR (cdr_expr));
-      return scm_cons2 (SCM_IM_LETREC, rvariables, scm_cons (inits, new_body));
-    }
-}
-
-static SCM
-unmemoize_letrec (const SCM expr, const SCM env)
-{
-  const SCM cdr_expr = SCM_CDR (expr);
-  const SCM um_rnames = SCM_CAR (cdr_expr);
-  const SCM extended_env = SCM_EXTEND_ENV (um_rnames, SCM_EOL, env);
-  const SCM cddr_expr = SCM_CDR (cdr_expr);
-  const SCM um_inits = unmemoize_exprs (SCM_CAR (cddr_expr), extended_env);
-  const SCM um_rinits = scm_reverse_x (um_inits, SCM_UNDEFINED);
-  const SCM um_bindings = build_binding_list (um_rnames, um_rinits);
-  const SCM um_body = unmemoize_exprs (SCM_CDR (cddr_expr), extended_env);
-
-  return scm_cons2 (scm_sym_letrec, um_bindings, um_body);
-}
-
-
-
-SCM_SYNTAX (s_letstar, "let*", scm_i_makbimacro, scm_m_letstar);
-SCM_GLOBAL_SYMBOL (scm_sym_letstar, s_letstar);
-
-/* (let* ((v1 i1) (v2 i2) ...) body) with variables v1 .. vn and initializers
- * i1 .. in is transformed into the form (#@let* (v1 i1 v2 i2 ...) body).  */
-SCM
-scm_m_letstar (SCM expr, SCM env SCM_UNUSED)
-{
-  SCM binding_idx;
-  SCM new_body;
-
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 2, s_missing_expression, expr);
-
-  binding_idx = SCM_CAR (cdr_expr);
-  check_bindings (binding_idx, expr);
-
-  /* Transform ((v1 i1) (v2 i2) ...) into (v1 i1 v2 i2 ...).  The
-   * transformation is done in place.  At the beginning of one iteration of
-   * the loop the variable binding_idx holds the form
-   *   P1:( (vn . P2:(in . ())) . P3:( (vn+1 in+1) ... ) ),
-   * where P1, P2 and P3 indicate the pairs, that are relevant for the
-   * transformation.  P1 and P2 are modified in the loop, P3 remains
-   * untouched.  After the execution of the loop, P1 will hold
-   *   P1:( vn . P2:(in . P3:( (vn+1 in+1) ... )) )
-   * and binding_idx will hold P3.  */
-  while (!scm_is_null (binding_idx))
-    {
-      const SCM cdr_binding_idx = SCM_CDR (binding_idx);  /* remember P3 */
-      const SCM binding = SCM_CAR (binding_idx);
-      const SCM name = SCM_CAR (binding);
-      const SCM cdr_binding = SCM_CDR (binding);
-
-      SCM_SETCDR (cdr_binding, cdr_binding_idx);        /* update P2 */
-      SCM_SETCAR (binding_idx, name);                   /* update P1 */
-      SCM_SETCDR (binding_idx, cdr_binding);            /* update P1 */
-
-      binding_idx = cdr_binding_idx;                    /* continue with P3 */
-    }
-
-  new_body = m_body (SCM_IM_LETSTAR, SCM_CDR (cdr_expr));
-  SCM_SETCAR (expr, SCM_IM_LETSTAR);
-  /* the bindings have been changed in place */
-  SCM_SETCDR (cdr_expr, new_body);
-  return expr;
-}
-
-static SCM
-unmemoize_letstar (const SCM expr, const SCM env)
-{
-  const SCM cdr_expr = SCM_CDR (expr);
-  const SCM body = SCM_CDR (cdr_expr);
-  SCM bindings = SCM_CAR (cdr_expr);
-  SCM um_bindings = SCM_EOL;
-  SCM extended_env = env;
-  SCM um_body;
-
-  while (!scm_is_null (bindings))
-    {
-      const SCM variable = SCM_CAR (bindings);
-      const SCM init = SCM_CADR (bindings);
-      const SCM um_init = unmemoize_expression (init, extended_env);
-      um_bindings = scm_cons (scm_list_2 (variable, um_init), um_bindings);
-      extended_env = SCM_EXTEND_ENV (variable, SCM_BOOL_F, extended_env);
-      bindings = SCM_CDDR (bindings);
-    }
-  um_bindings = scm_reverse_x (um_bindings, SCM_UNDEFINED);
-
-  um_body = unmemoize_exprs (body, extended_env);
-
-  return scm_cons2 (scm_sym_letstar, um_bindings, um_body);
-}
-
-
-SCM_SYNTAX (s_or, "or", scm_i_makbimacro, scm_m_or);
-SCM_GLOBAL_SYMBOL (scm_sym_or, s_or);
-
-SCM
-scm_m_or (SCM expr, SCM env SCM_UNUSED)
-{
-  const SCM cdr_expr = SCM_CDR (expr);
-  const long length = scm_ilength (cdr_expr);
-
-  ASSERT_SYNTAX (length >= 0, s_bad_expression, expr);
-
-  if (length == 0)
-    {
-      /* Special case:  (or) is replaced by #f. */
-      return SCM_BOOL_F;
-    }
-  else
-    {
-      SCM_SETCAR (expr, SCM_IM_OR);
-      return expr;
-    }
-}
-
-static SCM
-unmemoize_or (const SCM expr, const SCM env)
-{
-  return scm_cons (scm_sym_or, unmemoize_exprs (SCM_CDR (expr), env));
-}
-
-
-SCM_SYNTAX (s_quasiquote, "quasiquote", scm_makacro, scm_m_quasiquote);
-SCM_GLOBAL_SYMBOL (scm_sym_quasiquote, s_quasiquote);
-SCM_GLOBAL_SYMBOL (scm_sym_unquote, "unquote");
-SCM_GLOBAL_SYMBOL (scm_sym_uq_splicing, "unquote-splicing");
-
-/* 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_is_pair (form))
-    {
-      const SCM tmp = SCM_CAR (form);
-      if (scm_is_eq (tmp, scm_sym_quasiquote))
-	{
-	  const SCM args = SCM_CDR (form);
-	  ASSERT_SYNTAX (scm_ilength (args) == 1, s_expression, form);
-	  return scm_list_2 (tmp, iqq (SCM_CAR (args), env, depth + 1));
-	}
-      else if (scm_is_eq (tmp, scm_sym_unquote))
-	{
-	  const SCM args = SCM_CDR (form);
-	  ASSERT_SYNTAX (scm_ilength (args) == 1, s_expression, form);
-	  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_is_pair (tmp)
-	       && scm_is_eq (SCM_CAR (tmp), scm_sym_uq_splicing))
-	{
-	  const SCM args = SCM_CDR (tmp);
-	  ASSERT_SYNTAX (scm_ilength (args) == 1, s_expression, form);
-	  if (depth - 1 == 0)
-	    {
-	      const SCM list = scm_eval_car (args, env);
-	      const SCM rest = SCM_CDR (form);
-	      ASSERT_SYNTAX_2 (scm_ilength (list) >= 0,
-			       s_splicing, list, form);
-	      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_is_vector (form))
-    return scm_vector (iqq (scm_vector_to_list (form), env, depth));
-  else
-    return form;
-}
-
-SCM 
-scm_m_quasiquote (SCM expr, SCM env)
-{
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) == 1, s_expression, expr);
-  return iqq (SCM_CAR (cdr_expr), env, 1);
-}
-
-
-SCM_SYNTAX (s_quote, "quote", scm_i_makbimacro, scm_m_quote);
-SCM_GLOBAL_SYMBOL (scm_sym_quote, s_quote);
-
-SCM
-scm_m_quote (SCM expr, SCM env SCM_UNUSED)
-{
-  SCM quotee;
-
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) == 1, s_expression, expr);
-  quotee = SCM_CAR (cdr_expr);
-  if (is_self_quoting_p (quotee))
-    return quotee;
-
-  SCM_SETCAR (expr, SCM_IM_QUOTE);
-  SCM_SETCDR (expr, quotee);
-  return expr;
-}
-
-static SCM
-unmemoize_quote (const SCM expr, const SCM env SCM_UNUSED)
-{
-  return scm_list_2 (scm_sym_quote, SCM_CDR (expr));
-}
-
-
-/* Will go into the RnRS module when Guile is factorized.
-SCM_SYNTAX (s_set_x, "set!", scm_i_makbimacro, 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 expr, SCM env SCM_UNUSED)
-{
-  SCM variable;
-  SCM new_variable;
-
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) == 2, s_expression, expr);
-  variable = SCM_CAR (cdr_expr);
-
-  /* Memoize the variable form. */
-  ASSERT_SYNTAX_2 (scm_is_symbol (variable), s_bad_variable, variable, expr);
-  new_variable = lookup_symbol (variable, env);
-  /* Leave the memoization of unbound symbols to lazy memoization: */
-  if (SCM_UNBNDP (new_variable))
-    new_variable = variable;
-
-  SCM_SETCAR (expr, SCM_IM_SET_X);
-  SCM_SETCAR (cdr_expr, new_variable);
-  return expr;
-}
-
-static SCM
-unmemoize_set_x (const SCM expr, const SCM env)
-{
-  return scm_cons (scm_sym_set_x, unmemoize_exprs (SCM_CDR (expr), env));
-}
-
-
-/* Start of the memoizers for non-R5RS builtin macros.  */
-
-
-SCM_SYNTAX (s_atapply, "@apply", scm_i_makbimacro, scm_m_apply);
-SCM_GLOBAL_SYMBOL (scm_sym_atapply, s_atapply);
-SCM_GLOBAL_SYMBOL (scm_sym_apply, s_atapply + 1);
-
-SCM 
-scm_m_apply (SCM expr, SCM env SCM_UNUSED)
-{
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) == 2, s_missing_expression, expr);
-
-  SCM_SETCAR (expr, SCM_IM_APPLY);
-  return expr;
-}
-
-static SCM
-unmemoize_apply (const SCM expr, const SCM env)
-{
-  return scm_list_2 (scm_sym_atapply, unmemoize_exprs (SCM_CDR (expr), env));
-}
-
-
-SCM_SYNTAX (s_atbind, "@bind", scm_i_makbimacro, scm_m_atbind);
-
-/* FIXME: The following explanation should go into the documentation: */
-/* (@bind ((var init) ...) body ...) will assign the values of the `init's to
- * the global variables named by `var's (symbols, not evaluated), creating
- * them if they don't exist, executes body, and then restores the previous
- * values of the `var's.  Additionally, whenever control leaves body, the
- * values of the `var's are saved and restored when control returns.  It is an
- * error when a symbol appears more than once among the `var's.  All `init's
- * are evaluated before any `var' is set.
- *
- * Think of this as `let' for dynamic scope.
- */
-
-/* (@bind ((var1 exp1) ... (varn expn)) body ...) is memoized into
- * (#@bind ((varn ... var1) . (exp1 ... expn)) body ...).
- *
- * FIXME - also implement `@bind*'.
- */
-SCM
-scm_m_atbind (SCM expr, SCM env)
-{
-  SCM bindings;
-  SCM rvariables;
-  SCM inits;
-  SCM variable_idx;
-
-  const SCM top_level = scm_env_top_level (env);
-
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 2, s_missing_expression, expr);
-  bindings = SCM_CAR (cdr_expr);
-  check_bindings (bindings, expr);
-  transform_bindings (bindings, expr, &rvariables, &inits);
-
-  for (variable_idx = rvariables;
-       !scm_is_null (variable_idx);
-       variable_idx = SCM_CDR (variable_idx))
-    {
-      /* The first call to scm_sym2var will look beyond the current module,
-       * while the second call wont.  */
-      const SCM variable = SCM_CAR (variable_idx);
-      SCM new_variable = scm_sym2var (variable, top_level, SCM_BOOL_F);
-      if (scm_is_false (new_variable))
-	new_variable = scm_sym2var (variable, top_level, SCM_BOOL_T);
-      SCM_SETCAR (variable_idx, new_variable);
-    }
-
-  SCM_SETCAR (expr, SCM_IM_BIND);
-  SCM_SETCAR (cdr_expr, scm_cons (rvariables, inits));
-  return expr;
-}
-
-
-SCM_SYNTAX(s_atcall_cc, "@call-with-current-continuation", scm_i_makbimacro, scm_m_cont);
-SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc, s_atcall_cc);
-
-SCM 
-scm_m_cont (SCM expr, SCM env SCM_UNUSED)
-{
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) == 1, s_expression, expr);
-
-  SCM_SETCAR (expr, SCM_IM_CONT);
-  return expr;
-}
-
-static SCM
-unmemoize_atcall_cc (const SCM expr, const SCM env)
-{
-  return scm_list_2 (scm_sym_atcall_cc, unmemoize_exprs (SCM_CDR (expr), env));
-}
-
-
-SCM_SYNTAX (s_at_call_with_values, "@call-with-values", scm_i_makbimacro, scm_m_at_call_with_values);
-SCM_GLOBAL_SYMBOL(scm_sym_at_call_with_values, s_at_call_with_values);
-
-SCM
-scm_m_at_call_with_values (SCM expr, SCM env SCM_UNUSED)
-{
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) == 2, s_expression, expr);
-
-  SCM_SETCAR (expr, SCM_IM_CALL_WITH_VALUES);
-  return expr;
-}
-
-static SCM
-unmemoize_at_call_with_values (const SCM expr, const SCM env)
-{
-  return scm_list_2 (scm_sym_at_call_with_values,
-                     unmemoize_exprs (SCM_CDR (expr), env));
-}
-
-#if 0
-
-/* See futures.h for a comment why futures are not enabled.
- */
-
-SCM_SYNTAX (s_future, "future", scm_i_makbimacro, scm_m_future);
-SCM_GLOBAL_SYMBOL (scm_sym_future, s_future);
-
-/* Like promises, futures are implemented as closures with an empty
- * parameter list.  Thus, (future <expression>) is transformed into
- * (#@future '() <expression>), where the empty list represents the
- * empty parameter list.  This representation allows for easy creation
- * of the closure during evaluation.  */
-SCM
-scm_m_future (SCM expr, SCM env)
-{
-  const SCM new_expr = memoize_as_thunk_prototype (expr, env);
-  SCM_SETCAR (new_expr, SCM_IM_FUTURE);
-  return new_expr;
-}
-
-static SCM
-unmemoize_future (const SCM expr, const SCM env)
-{
-  const SCM thunk_expr = SCM_CADDR (expr);
-  return scm_list_2 (scm_sym_future, unmemoize_expression (thunk_expr, env));
-}
-
-#endif
-
-SCM_SYNTAX (s_gset_x, "set!", scm_i_makbimacro, scm_m_generalized_set_x);
-SCM_SYMBOL (scm_sym_setter, "setter");
-
-SCM 
-scm_m_generalized_set_x (SCM expr, SCM env)
-{
-  SCM target, exp_target;
-
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) == 2, s_expression, expr);
-
-  target = SCM_CAR (cdr_expr);
-  if (!scm_is_pair (target))
-    {
-      /* R5RS usage */
-      return scm_m_set_x (expr, env);
-    }
-  else
-    {
-      /* (set! (foo bar ...) baz) becomes ((setter foo) bar ... baz) */
-      /* Macroexpanding the target might return things of the form
-	 (begin <atom>).  In that case, <atom> must be a symbol or a
-	 variable and we memoize to (set! <atom> ...).
-      */
-      exp_target = macroexp (target, env);
-      if (scm_is_eq (SCM_CAR (exp_target), SCM_IM_BEGIN)
-	  && !scm_is_null (SCM_CDR (exp_target))
-	  && scm_is_null (SCM_CDDR (exp_target)))
-	{
-	  exp_target= SCM_CADR (exp_target);
-	  ASSERT_SYNTAX_2 (scm_is_symbol (exp_target)
-			   || SCM_VARIABLEP (exp_target),
-			   s_bad_variable, exp_target, expr);
-	  return scm_cons (SCM_IM_SET_X, scm_cons (exp_target,
-						   SCM_CDR (cdr_expr)));
-	}
-      else
-	{
-	  const SCM setter_proc_tail = scm_list_1 (SCM_CAR (target));
-	  const SCM setter_proc = scm_cons_source (expr, scm_sym_setter,
-						   setter_proc_tail);
-
-	  const SCM cddr_expr = SCM_CDR (cdr_expr);
-	  const SCM setter_args = scm_append_x (scm_list_2 (SCM_CDR (target),
-							    cddr_expr));
-
-	  SCM_SETCAR (expr, setter_proc);
-	  SCM_SETCDR (expr, setter_args);
-	  return expr;
-	}
-    }
-}
-
-
-/* @slot-ref is bound privately in the (oop goops) module from goops.c.  As
- * soon as the module system allows us to more freely create bindings in
- * arbitrary modules during the startup phase, the code from goops.c should be
- * moved here.  */
-
-SCM_SYMBOL (sym_atslot_ref, "@slot-ref");
-
-SCM
-scm_m_atslot_ref (SCM expr, SCM env SCM_UNUSED)
-{
-  SCM slot_nr;
-
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) == 2, s_expression, expr);
-  slot_nr = SCM_CADR (cdr_expr);
-  ASSERT_SYNTAX_2 (SCM_I_INUMP (slot_nr), s_bad_slot_number, slot_nr, expr);
-
-  SCM_SETCAR (expr, SCM_IM_SLOT_REF);
-  SCM_SETCDR (cdr_expr, slot_nr);
-  return expr;
-}
-
-static SCM
-unmemoize_atslot_ref (const SCM expr, const SCM env)
-{
-  const SCM instance = SCM_CADR (expr);
-  const SCM um_instance = unmemoize_expression (instance, env);
-  const SCM slot_nr = SCM_CDDR (expr);
-  return scm_list_3 (sym_atslot_ref, um_instance, slot_nr);
-}
-
-
-/* @slot-set! is bound privately in the (oop goops) module from goops.c.  As
- * soon as the module system allows us to more freely create bindings in
- * arbitrary modules during the startup phase, the code from goops.c should be
- * moved here.  */
-
-SCM_SYMBOL (sym_atslot_set_x, "@slot-set!");
-
-SCM
-scm_m_atslot_set_x (SCM expr, SCM env SCM_UNUSED)
-{
-  SCM slot_nr;
-
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) == 3, s_expression, expr);
-  slot_nr = SCM_CADR (cdr_expr);
-  ASSERT_SYNTAX_2 (SCM_I_INUMP (slot_nr), s_bad_slot_number, slot_nr, expr);
-
-  SCM_SETCAR (expr, SCM_IM_SLOT_SET_X);
-  return expr;
-}
-
-static SCM
-unmemoize_atslot_set_x (const SCM expr, const SCM env)
-{
-  const SCM cdr_expr = SCM_CDR (expr);
-  const SCM instance = SCM_CAR (cdr_expr);
-  const SCM um_instance = unmemoize_expression (instance, env);
-  const SCM cddr_expr = SCM_CDR (cdr_expr);
-  const SCM slot_nr = SCM_CAR (cddr_expr);
-  const SCM cdddr_expr = SCM_CDR (cddr_expr);
-  const SCM value = SCM_CAR (cdddr_expr);
-  const SCM um_value = unmemoize_expression (value, env);
-  return scm_list_4 (sym_atslot_set_x, um_instance, slot_nr, um_value);
-}
-
-
-#if SCM_ENABLE_ELISP
-
-static const char s_defun[] = "Symbol's function definition is void";
-
-SCM_SYNTAX (s_nil_cond, "nil-cond", scm_i_makbimacro, scm_m_nil_cond);
-
-/* nil-cond expressions have the form
- *   (nil-cond COND VAL COND VAL ... ELSEVAL)  */
-SCM
-scm_m_nil_cond (SCM expr, SCM env SCM_UNUSED)
-{
-  const long length = scm_ilength (SCM_CDR (expr));
-  ASSERT_SYNTAX (length >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (length >= 1 && (length % 2) == 1, s_expression, expr);
-
-  SCM_SETCAR (expr, SCM_IM_NIL_COND);
-  return expr;
-}
-
-
-SCM_SYNTAX (s_atfop, "@fop", scm_i_makbimacro, scm_m_atfop);
-
-/* The @fop-macro handles procedure and macro applications for elisp.  The
- * input expression must have the form
- *    (@fop <var> (transformer-macro <expr> ...))
- * where <var> must be a symbol.  The expression is transformed into the
- * memoized form of either
- *    (apply <un-aliased var> (transformer-macro <expr> ...))
- * if the value of var (across all aliasing) is not a macro, or
- *    (<un-aliased var> <expr> ...)
- * if var is a macro. */
-SCM
-scm_m_atfop (SCM expr, SCM env SCM_UNUSED)
-{
-  SCM location;
-  SCM symbol;
-
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 1, s_missing_expression, expr);
-
-  symbol = SCM_CAR (cdr_expr);
-  ASSERT_SYNTAX_2 (scm_is_symbol (symbol), s_bad_variable, symbol, expr);
-
-  location = scm_symbol_fref (symbol);
-  ASSERT_SYNTAX_2 (SCM_VARIABLEP (location), s_defun, symbol, expr);
-
-  /* The elisp function `defalias' allows to define aliases for symbols.  To
-   * look up such definitions, the chain of symbol definitions has to be
-   * followed up to the terminal symbol.  */
-  while (scm_is_symbol (SCM_VARIABLE_REF (location)))
-    {
-      const SCM alias = SCM_VARIABLE_REF (location);
-      location = scm_symbol_fref (alias);
-      ASSERT_SYNTAX_2 (SCM_VARIABLEP (location), s_defun, symbol, expr);
-    }
-
-  /* Memoize the value location belonging to the terminal symbol.  */
-  SCM_SETCAR (cdr_expr, location);
-
-  if (!SCM_MACROP (SCM_VARIABLE_REF (location)))
-    {
-      /* Since the location does not contain a macro, the form is a procedure
-       * application.  Replace `@fop' by `@apply' and transform the expression
-       * including the `transformer-macro'.  */
-      SCM_SETCAR (expr, SCM_IM_APPLY);
-      return expr;
-    }
-  else
-    {
-      /* Since the location contains a macro, the arguments should not be
-       * transformed, so the `transformer-macro' is cut out.  The resulting
-       * expression starts with the memoized variable, that is at the cdr of
-       * the input expression.  */
-      SCM_SETCDR (cdr_expr, SCM_CDADR (cdr_expr));
-      return cdr_expr;
-    }
-}
-
-#endif /* SCM_ENABLE_ELISP */
-
-
-static SCM
-unmemoize_builtin_macro (const SCM expr, const SCM env)
-{
-  switch (ISYMNUM (SCM_CAR (expr)))
-    {
-    case (ISYMNUM (SCM_IM_AND)):
-      return unmemoize_and (expr, env);
-
-    case (ISYMNUM (SCM_IM_BEGIN)):
-      return unmemoize_begin (expr, env);
-
-    case (ISYMNUM (SCM_IM_CASE)):
-      return unmemoize_case (expr, env);
-
-    case (ISYMNUM (SCM_IM_COND)):
-      return unmemoize_cond (expr, env);
-
-    case (ISYMNUM (SCM_IM_DELAY)):
-      return unmemoize_delay (expr, env);
-
-    case (ISYMNUM (SCM_IM_DO)):
-      return unmemoize_do (expr, env);
-
-    case (ISYMNUM (SCM_IM_IF)):
-      return unmemoize_if (expr, env);
-
-    case (ISYMNUM (SCM_IM_LAMBDA)):
-      return unmemoize_lambda (expr, env);
-
-    case (ISYMNUM (SCM_IM_LET)):
-      return unmemoize_let (expr, env);
-
-    case (ISYMNUM (SCM_IM_LETREC)):
-      return unmemoize_letrec (expr, env);
-
-    case (ISYMNUM (SCM_IM_LETSTAR)):
-      return unmemoize_letstar (expr, env);
-
-    case (ISYMNUM (SCM_IM_OR)):
-      return unmemoize_or (expr, env);
-
-    case (ISYMNUM (SCM_IM_QUOTE)):
-      return unmemoize_quote (expr, env);
-
-    case (ISYMNUM (SCM_IM_SET_X)):
-      return unmemoize_set_x (expr, env);
-
-    case (ISYMNUM (SCM_IM_APPLY)):
-      return unmemoize_apply (expr, env);
-
-    case (ISYMNUM (SCM_IM_BIND)):
-      return unmemoize_exprs (expr, env);  /* FIXME */
-
-    case (ISYMNUM (SCM_IM_CONT)):
-      return unmemoize_atcall_cc (expr, env);
-
-    case (ISYMNUM (SCM_IM_CALL_WITH_VALUES)):
-      return unmemoize_at_call_with_values (expr, env);
-
-#if 0
-    /* See futures.h for a comment why futures are not enabled.
-     */
-    case (ISYMNUM (SCM_IM_FUTURE)):
-      return unmemoize_future (expr, env);
-#endif
-
-    case (ISYMNUM (SCM_IM_SLOT_REF)):
-      return unmemoize_atslot_ref (expr, env);
-
-    case (ISYMNUM (SCM_IM_SLOT_SET_X)):
-      return unmemoize_atslot_set_x (expr, env);
-
-    case (ISYMNUM (SCM_IM_NIL_COND)):
-      return unmemoize_exprs (expr, env);  /* FIXME */
-
-    default:
-      return unmemoize_exprs (expr, env);  /* FIXME */
-    }
-}
-
-
-/* scm_i_unmemocopy_expr and scm_i_unmemocopy_body take a memoized expression
- * respectively a memoized body together with its environment and rewrite it
- * to its original form.  Thus, these functions are the inversion of the
- * rewrite rules above.  The procedure is not optimized for speed.  It's used
- * in scm_i_unmemoize_expr, scm_procedure_source, macro_print and scm_iprin1.
- *
- * Unmemoizing is not a reliable process.  You cannot in general expect to get
- * the original source back.
- *
- * However, GOOPS currently relies on this for method compilation.  This ought
- * to change.  */
-
-SCM
-scm_i_unmemocopy_expr (SCM expr, SCM env)
-{
-  const SCM source_properties = scm_whash_lookup (scm_source_whash, expr);
-  const SCM um_expr = unmemoize_expression (expr, env);
-
-  if (scm_is_true (source_properties))
-    scm_whash_insert (scm_source_whash, um_expr, source_properties);
-
-  return um_expr;
-}
-
-SCM
-scm_i_unmemocopy_body (SCM forms, SCM env)
-{
-  const SCM source_properties = scm_whash_lookup (scm_source_whash, forms);
-  const SCM um_forms = unmemoize_exprs (forms, env);
-
-  if (scm_is_true (source_properties))
-    scm_whash_insert (scm_source_whash, um_forms, source_properties);
-
-  return um_forms;
-}
-
-
-#if (SCM_ENABLE_DEPRECATED == 1)
-
-/* Deprecated in guile 1.7.0 on 2003-11-09.  */
-SCM
-scm_m_expand_body (SCM exprs, SCM env)
-{
-  scm_c_issue_deprecation_warning 
-    ("`scm_m_expand_body' is deprecated.");
-  m_expand_body (exprs, env);
-  return exprs;
-}
-
-
-SCM_SYNTAX (s_undefine, "undefine", scm_makacro, scm_m_undefine);
-
-SCM
-scm_m_undefine (SCM expr, SCM env)
-{
-  SCM variable;
-  SCM location;
-
-  const SCM cdr_expr = SCM_CDR (expr);
-  ASSERT_SYNTAX (SCM_TOP_LEVEL (env), "Bad undefine placement in", expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr);
-  ASSERT_SYNTAX (scm_ilength (cdr_expr) == 1, s_expression, expr);
-
-  scm_c_issue_deprecation_warning
-    ("`undefine' is deprecated.\n");
-
-  variable = SCM_CAR (cdr_expr);
-  ASSERT_SYNTAX_2 (scm_is_symbol (variable), s_bad_variable, variable, expr);
-  location = scm_sym2var (variable, scm_env_top_level (env), SCM_BOOL_F);
-  ASSERT_SYNTAX_2 (scm_is_true (location)
-                   && !SCM_UNBNDP (SCM_VARIABLE_REF (location)),
-                   "variable already unbound ", variable, expr);
-  SCM_VARIABLE_SET (location, SCM_UNDEFINED);
-  return SCM_UNSPECIFIED;
-}
-
-SCM
-scm_macroexp (SCM x, SCM env)
-{
-  scm_c_issue_deprecation_warning
-    ("`scm_macroexp' is deprecated.");
-  return macroexp (x, env);
-}
-
-#endif
-
-
-#if (SCM_ENABLE_DEPRECATED == 1)
-
-SCM
-scm_unmemocar (SCM form, SCM env)
-{
-  scm_c_issue_deprecation_warning 
-    ("`scm_unmemocar' is deprecated.");
-
-  if (!scm_is_pair (form))
-    return form;
-  else
-    {
-      SCM c = SCM_CAR (form);
-      if (SCM_VARIABLEP (c))
-	{
-	  SCM sym = scm_module_reverse_lookup (scm_env_module (env), c);
-	  if (scm_is_false (sym))
-	    sym = sym_three_question_marks;
-	  SCM_SETCAR (form, sym);
-	}
-      else if (SCM_ILOCP (c))
-	{
-	  unsigned long int ir;
-
-	  for (ir = SCM_IFRAME (c); ir != 0; --ir)
-	    env = SCM_CDR (env);
-	  env = SCM_CAAR (env);
-	  for (ir = SCM_IDIST (c); ir != 0; --ir)
-	    env = SCM_CDR (env);
-
-	  SCM_SETCAR (form, SCM_ICDRP (c) ? env : SCM_CAR (env));
-	}
-      return form;
-    }
-}
-
-#endif
 
+\f
 /*****************************************************************************/
 /*****************************************************************************/
 /*                 The definitions for execution start here.                 */




[-- Attachment #3: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Evaluator cleanup

[Ludovic Courtès]

ludo@chbouib.org (Ludovic Courtès) writes:

> Neil Jerram <neil@ossau.uklinux.net> writes:

>> Do these need to be .i.c - i.e. implying that they need to be
>> #included?  Can't they be normal .c files?
>
> No, because some of them are `static' (all the `unmemoize_' functions
> for instance) and should remain so, and some could be subject to
> inlining.

OTOH, all the `scm_m_' functions are already exported and cannot be
inlined (a pointer to them is passed to `scm_make_synt ()').  So
memoizers do not need to be #included.  Sorry for the confusion.

Thanks,
Ludovic.



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Evaluator cleanup

[Han-Wen Nienhuys]

Ludovic Courtès escreveu:

> Not sure about this.  The alternative would be to keep both in a single
> file, but that would lead to a long file with mixed
> memoizing/unmemoizing logic, and with a load of helper functions for
> both.  Would that be preferable?

I think yes. I expect that memoize and unmemoize functions come in pairs,
and perhaps there could be 1 file per pair.

-- 
 Han-Wen Nienhuys - hanwen@xs4all.nl - http://www.xs4all.nl/~hanwen


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Evaluator cleanup

[Kevin Ryde]

ludo@chbouib.org (Ludovic Courtès) writes:
>
> Ok to commit?

No.  Please don't move stuff around, it works fine like it is.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Evaluator cleanup

[Neil Jerram]

Kevin Ryde <user42@zip.com.au> writes:

> ludo@chbouib.org (Ludovic Courtès) writes:
>>
>> Ok to commit?
>
> No.  Please don't move stuff around, it works fine like it is.

I must admit, that was my first reaction too.  I can't really see what
this change buys us.

Regards,
     Neil



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: Evaluator cleanup

[Ludovic Courtès]

Hi,

Neil Jerram <neil@ossau.uklinux.net> writes:

> I must admit, that was my first reaction too.  I can't really see what
> this change buys us.

Hackability.  Anyway, I'll give up for now due to lack of time and
energy.

Thanks,
Ludovic.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel